# HG changeset patch # User cvs # Date 1186990211 -7200 # Node ID 34a5b81f86ba8ba94011139dea50a2ee76d91bf5 # Parent b27e6771709277cfcde46d4462e37cf5775339e5 Import from CVS: tag r20-2b1 diff -r b27e67717092 -r 34a5b81f86ba CHANGES-beta --- a/CHANGES-beta Mon Aug 13 09:29:37 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:30:11 2007 +0200 @@ -1,4 +1,21 @@ -*- indented-text -*- +to 20.2 beta1 +-- W3-3.0.83 courtesy of William Perry +-- edmacro.el-3.09 courtesy of Hrvoje Niksic +-- live-icon.el-1.3 courtesy of Karl Hegbloom +-- values setf method +-- miscellaneous bug fixes +-- verilog.el-2.25 courtesy of Michael McNamara +-- tpu-edt.el modifications for zmacs region compatibility courtesy of + Kevin Oberman. +-- custom-1.89 courtesy of Per Abrahamsen +-- etags.c-11.83 courtesy of F. Potorti` +-- Mega Customizations courtesy of Hrvoje Niksic +-- "C" balloon help courtesy of Douglas Keller (experimental - placeholder) +-- update version numbers + +[XEmacs 20.1 was never released to the net] + to 20.1 -- facemenu.el boo boo. -- VM-6.27 diff -r b27e67717092 -r 34a5b81f86ba ChangeLog --- a/ChangeLog Mon Aug 13 09:29:37 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:30:11 2007 +0200 @@ -1,3 +1,12 @@ +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. diff -r b27e67717092 -r 34a5b81f86ba README --- a/README Mon Aug 13 09:29:37 2007 +0200 +++ b/README Mon Aug 13 09:30:11 2007 +0200 @@ -1,4 +1,4 @@ -This directory tree holds version 20.1 of XEmacs, the extensible, +This directory tree holds version 20.2 of XEmacs, the extensible, customizable, self-documenting real-time display editor. See the file `etc/NEWS' for information on new features and other @@ -48,7 +48,7 @@ `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 manual. +`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. diff -r b27e67717092 -r 34a5b81f86ba configure.in --- a/configure.in Mon Aug 13 09:29:37 2007 +0200 +++ b/configure.in Mon Aug 13 09:30:11 2007 +0200 @@ -3164,7 +3164,12 @@ dnl ############################################################################ ( -echo "uname -a: `uname -a`" +if test -f /etc/osversion; then + # SONY NEWS-OS + echo "osversion: `cat /etc/osversion`" +eles + echo "uname -a: `uname -a`" +fi echo "" echo "$0 $quoted_arguments" ) >> Installation diff -r b27e67717092 -r 34a5b81f86ba etc/BETA --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/BETA Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,183 @@ + -*- mode:outline; minor-mode:outl-mouse -*- + +* 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 with a subject of `subscribe' (without the quotes) to +xemacs-beta-request@xemacs.org and follow the directions. You do not +have to fill out the survey if you don't want to. + +*** Unsubscribing +----------------- + +To unsubscribe from the list send an email message with a subject of +`unsubscribe' (without the quotes) to xemacs-beta-request@xemacs.org. + +*** Administrivia +----------------- + +The XEmacs beta list is managed by the SmartList mailing list package, +and the usual SmartList 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 Mailing +List manager Chuck Thompson . + + +** Beta Release Schedule +======================== + +The URL ftp://ftp.xemacs.org/pub/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. + +While 19.15 and 20.x are in parallel development, a simultaneous +release day implies a release of 20.x first, followed a few hours +later by 19.15. + +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. + +* 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.4-beta10 to +XEmacs 20.4-beta11 and you have a full unmodified XEmacs 20.4-beta10 +source tree to work with. Cd to the top level directory and issue the +shell command: + +$ gunzip -c /tmp/xemacs-20.4-b10-20.4-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 starting compilation. + +After seeing that there were no rejections, issue the command + +$ make all-elc + +and go play minesweep for awhile on an older XEmacs while the binary +is rebuilt. + +** Building an 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.4-b11.tar.gz | tar xvf - + +(or the simpler `tar zxvf /tmp/xemacs-20.4-b11.tar.gz' if you use GNU +tar). + +cd to the top level directory and issue an appropriate configure +command. The maintainer uses the following at the time of this +writing: + +./configure --with-offix --with-mule=yes --with-dialogs=athena3d \ + --cflags="-m486 -g -O4 -fno-strength-reduce -malign-loops=2 \ + -malign-jumps=2 -malign-functions=2" --with-sound=no \ + --with-xface=yes --error-checking=all --debug=yes \ + --with-scrollbars=athena3d \ + --with-canna=yes --with-wnn=yes --wnn-includes=/usr/X11R6/include/wnn + +Save the output from configure that looks something like: +Configured for `i586-unknown-linux2.0.28'. + + Where should the build process find the source code? /usr/src/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 -m486 -g -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 + Should XEmacs use the GNU version of malloc? yes + 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/X11R6/include + Where do we find X Windows libraries? /usr/X11R6/lib + Compiling in support for XAUTH. + Compiling in support for XPM. + Compiling in support for X-Face 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 Berkeley DB. + Compiling in support for GNU DBM. + Compiling in Mule (multi-lingual) support. + Compiling in support for OffiX. + Using the Lucid menubar. + Using the Athena-3d scrollbar. + Using the Athena-3d dialog boxes. + +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-beta@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 + +5. Any other unusual items you feel should be brought to the attention + of the developers. diff -r b27e67717092 -r 34a5b81f86ba etc/README --- a/etc/README Mon Aug 13 09:29:37 2007 +0200 +++ b/etc/README Mon Aug 13 09:30:11 2007 +0200 @@ -20,7 +20,7 @@ MH-E-NEWS List of changes to MH-E to version 5.0. MORE.STUFF List of useful unbundled packages MSDOS Status of MSDOS port -NEWS XEmacs 20.1 release information +NEWS XEmacs 20.2 release information ORDERS ORDERS.EUROPE ORDERS.JAPAN diff -r b27e67717092 -r 34a5b81f86ba etc/w3/stylesheet --- a/etc/w3/stylesheet Mon Aug 13 09:29:37 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:30:11 2007 +0200 @@ -1,10 +1,10 @@ /****************************************************************************** ** File: default.css ** Purpose: Default Stylesheet for Emacs-W3 -** Info: Copyright (c) 1995 - 1996 William M. Perry +** Info: Copyright (c) 1995-1996 William M. Perry ** Copyright (c) 1997 Free Software Foundation, Inc. -** Created: William M. Perry , Aug-31-1995 -** Maintainer: William M. Perry +** Created: William M. Perry , Aug-31-1995 +** Maintainer: William M. Perry ** ** This contains the top level fallback default styles for Emacs-w3 ** @@ -264,9 +264,9 @@ li,dt,dd { pitch: 6; richness: 6; } dt { stress: 8; } -pre,xmp,plaintext,key,code,tt { pitch: 1; - pitch-range: 1; - stress: 1; +pre,xmp,plaintext,key,code,tt { pitch: 5; + pitch-range: 0; + stress: 0; richness: 8; } em { pitch: 6; pitch-range: 6; stress: 6; richness: 5; } diff -r b27e67717092 -r 34a5b81f86ba info/dir --- a/info/dir Mon Aug 13 09:29:37 2007 +0200 +++ b/info/dir Mon Aug 13 09:30:11 2007 +0200 @@ -36,12 +36,12 @@ * Info:: Documentation browsing system. * XEmacs:: The extensible user-friendly self-documenting text editor. - This manual is for XEmacs 20.1. + This manual is for XEmacs 20.2. * Lispref:: XEmacs Lisp technical reference. - This manual is for XEmacs 20.1. + This manual is for XEmacs 20.2. * New-Users-Guide:: - XEmacs User's Guide for XEmacs 20.1. -* XEmacs-FAQ:: XEmacs Frequently Asked Questions for 20.1. + XEmacs User's Guide for XEmacs 20.2. +* XEmacs-FAQ:: XEmacs Frequently Asked Questions for 20.2. * Internals:: Guide to the internals of XEmacs. * send-pr:: Submitting Bug Reports * gnats:: GNU Problem Report Management System diff -r b27e67717092 -r 34a5b81f86ba lib-src/etags.c --- a/lib-src/etags.c Mon Aug 13 09:29:37 2007 +0200 +++ b/lib-src/etags.c Mon Aug 13 09:30:11 2007 +0200 @@ -31,7 +31,7 @@ * Francesco Potorti` (F.Potorti@cnuce.cnr.it) is the current maintainer. */ -char pot_etags_version[] = "@(#) pot revision number is 11.78"; +char pot_etags_version[] = "@(#) pot revision number is 11.83"; #define TRUE 1 #define FALSE 0 @@ -86,7 +86,7 @@ #endif /* ETAGS_REGEXPS */ /* Define CTAGS to make the program "ctags" compatible with the usual one. - Let it undefined to make the program "etags", which makes emacs-style + 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 @@ -109,8 +109,10 @@ #define C_STAR 0x00003 /* C* */ #define YACC 0x10000 /* yacc file */ -#define streq(s,t) ((DEBUG &&!(s)&&!(t)&&(abort(),1)) || !strcmp(s,t)) -#define strneq(s,t,n) ((DEBUG &&!(s)&&!(t)&&(abort(),1)) || !strncmp(s,t,n)) +#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) @@ -568,7 +570,7 @@ at_filename }; -/* This structure helps us allow mixing of --lang and filenames. */ +/* This structure helps us allow mixing of --lang and file names. */ typedef struct { enum argument_type arg_type; @@ -590,7 +592,7 @@ /* v1.05 nmm 26-Jun-86 fn_exp - expand specification of list of file names - returning in each successive call the next filename matching the input + 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 @@ -599,7 +601,7 @@ If an error occurs, on return out_spec contains the value of in_spec when the error occurred. - With each successive filename returned in out_spec, the + 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. @@ -755,7 +757,7 @@ break; case 1: - /* This means that a filename has been seen. Record it. */ + /* 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; @@ -1106,12 +1108,12 @@ if (absolutefn (file)) { - /* file is an absolute filename. Canonicalise it. */ + /* file is an absolute file name. Canonicalise it. */ filename = absolute_filename (file, cwd); } else { - /* file is a filename relative to cwd. Make it relative + /* file is a file name relative to cwd. Make it relative to the directory of the tags file. */ filename = relative_filename (file, tagfiledir); } @@ -2100,16 +2102,28 @@ definedef = dnone; \ } while (0) -/* This macro should never be called when tok.valid is FALSE, but - we must protect about both invalid input and internal errors. */ -#define make_C_tag(isfun) do \ -if (tok.valid) { \ - char *name = NULL; \ - if (CTAGS || tok.named) \ - name = savestr (token_name.buffer); \ - pfnote (name, isfun, tok.buffer, tok.linelen, tok.lineno, tok.linepos); \ - tok.valid = FALSE; \ -} /* else if (DEBUG) abort (); */ while (0) + +void +make_C_tag (isfun, tokp) + logical isfun; + TOKEN *tokp; +{ + char *name = NULL; + + /* This function should never be called when tok.valid is FALSE, but + we must protect against invalid input or internal errors. */ + if (tokp->valid) + { + if (CTAGS || tokp->named) + name = savestr (token_name.buffer); + pfnote (name, isfun, + tokp->buffer, tokp->linelen, tokp->lineno, tokp->linepos); + tokp->valid = FALSE; + } + else if (DEBUG) + abort (); +} + void C_entries (c_ext, inf) @@ -2370,7 +2384,7 @@ switch_line_buffers (); } else - make_C_tag (is_func); + make_C_tag (is_func, &tok); } midtoken = FALSE; } @@ -2392,7 +2406,7 @@ funcdef = finlist; continue; case flistseen: - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); funcdef = fignore; break; case ftagseen: @@ -2427,7 +2441,7 @@ { case otagseen: objdef = oignore; - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); break; case omethodtag: case omethodparm: @@ -2445,7 +2459,7 @@ case ftagseen: if (yacc_rules) { - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); funcdef = fignore; } break; @@ -2461,7 +2475,7 @@ switch (typdef) { case tend: - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); /* FALLTHRU */ default: typdef = tnone; @@ -2484,7 +2498,7 @@ { case omethodtag: case omethodparm: - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); objdef = oinbody; break; } @@ -2499,7 +2513,7 @@ if (cblev == 0 && typdef == tend) { typdef = tignore; - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); break; } if (funcdef != finlist && funcdef != fignore) @@ -2522,10 +2536,10 @@ /* Make sure that the next char is not a '*'. This handles constructs like: typedef void OperatorFun (int fun); */ - if (*lp != '*') + if (tok.valid && *lp != '*') { typdef = tignore; - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); } break; } /* switch (typdef) */ @@ -2544,7 +2558,7 @@ break; if (objdef == ocatseen && parlev == 1) { - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); objdef = oignore; } if (--parlev == 0) @@ -2559,7 +2573,7 @@ if (cblev == 0 && typdef == tend) { typdef = tignore; - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); } } else if (parlev < 0) /* can happen due to ill-conceived #if's. */ @@ -2579,13 +2593,13 @@ case stagseen: case scolonseen: /* named struct */ structdef = sinbody; - make_C_tag (FALSE); + make_C_tag (FALSE, &tok); break; } switch (funcdef) { case flistseen: - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); /* FALLTHRU */ case fignore: funcdef = fnone; @@ -2594,12 +2608,12 @@ switch (objdef) { case otagseen: - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); objdef = oignore; break; case omethodtag: case omethodparm: - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); objdef = oinbody; break; default: @@ -2661,7 +2675,7 @@ case '\0': if (objdef == otagseen) { - make_C_tag (TRUE); + make_C_tag (TRUE, &tok); objdef = oignore; } /* If a macro spans multiple lines don't reset its state. */ @@ -3542,7 +3556,7 @@ else if (len = prolog_pred (dbp, last)) { /* Predicate. Store the function name so that we only - * generates a tag for the first clause. */ + generate a tag for the first clause. */ if (last == NULL) last = xnew(len + 1, char); else if (len + 1 > allocated) @@ -4399,7 +4413,7 @@ #endif /* not HAVE_GETCWD */ } -/* Return a newly allocated string containing the filename +/* Return a newly allocated string containing the file name of FILE relative to the absolute directory DIR (which should end with a slash). */ char * @@ -4407,6 +4421,7 @@ char *file, *dir; { char *fp, *dp, *abs, *res; + int i; /* Find the common root of file and dir (with a trailing slash). */ abs = absolute_filename (file, cwd); @@ -4415,27 +4430,28 @@ while (*fp++ == *dp++) continue; fp--, dp--; /* back to the first differing char */ - do /* look at the equal chars until / */ + do /* look at the equal chars until '/' */ fp--, dp--; while (*fp != '/'); - /* Build a sequence of "../" strings for the resulting relative filename. */ - for (dp = etags_strchr (dp + 1, '/'), res = ""; - dp != NULL; - dp = etags_strchr (dp + 1, '/')) - { - res = concat (res, "../", ""); - } - - /* Add the filename relative to the common root of file and dir. */ - res = concat (res, fp + 1, ""); + /* 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 (abs); return res; } /* Return a newly allocated string containing the - absolute filename of FILE given CWD (which should + absolute file name of FILE given CWD (which should end with a slash). */ char * absolute_filename (file, cwd) @@ -4444,12 +4460,12 @@ char *slashp, *cp, *res; if (absolutefn (file)) - res = concat (file, "", ""); + res = savestr (file); #ifdef DOS_NT - /* We don't support non-absolute filenames with a drive + /* 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 filenames with drive letters not supported", file); + fatal ("%s: relative file names with drive letters not supported", file); #endif else res = concat (cwd, file, ""); @@ -4467,24 +4483,16 @@ do cp--; while (cp >= res && !absolutefn (cp)); - if (*cp == '/') - { - strcpy (cp, slashp + 3); - } + if (cp < res) + cp = slashp; /* the absolute name begins with "/.." */ #ifdef DOS_NT /* Under MSDOS and NT we get `d:/NAME' as absolute - filename, so the luser could say `d:/../NAME'. + file name, so the luser could say `d:/../NAME'. We silently treat this as `d:/NAME'. */ - else if (cp[1] == ':') - strcpy (cp + 3, slashp + 4); + else if (cp[0] != '/') + cp = slashp; #endif - else /* else (cp == res) */ - { - if (slashp[3] != '\0') - strcpy (cp, slashp + 4); - else - return "."; - } + strcpy (cp, slashp + 3); slashp = cp; continue; } @@ -4497,12 +4505,15 @@ slashp = etags_strchr (slashp + 1, '/'); } - - return res; + + if (res[0] == '\0') + return savestr ("/"); + else + return res; } /* Return a newly allocated string containing the absolute - filename of dir where FILE resides given CWD (which should + file name of dir where FILE resides given CWD (which should end with a slash). */ char * absolute_dirname (file, cwd) @@ -4520,7 +4531,7 @@ slashp = etags_strrchr (file, '/'); if (slashp == NULL) - return cwd; + return savestr (cwd); save = slashp[1]; slashp[1] = '\0'; res = absolute_filename (file, cwd); diff -r b27e67717092 -r 34a5b81f86ba lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:30:11 2007 +0200 @@ -1,3 +1,67 @@ +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 diff -r b27e67717092 -r 34a5b81f86ba lisp/calendar/appt.el --- a/lisp/calendar/appt.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/calendar/appt.el Mon Aug 13 09:30:11 2007 +0200 @@ -157,40 +157,52 @@ (require 'calendar) (require 'diary-lib) -(defvar appt-issue-message t +(defcustom appt-issue-message t "*If T, the diary buffer is checked for appointments. For an appointment warning to be made, the time must be the first thing on - the line.") + the line." + :type 'boolean + :group 'appt) -(defvar appt-msg-countdown-list '(20 15 10 5 3 1) +(defcustom appt-msg-countdown-list '(20 15 10 5 3 1) "*A list of the intervals in minutes before the appointment when the warnings will be given. That is, if this were the list '(5 3 1), then a notification would be given five minutes, three minutes, and - one minute before the appointment.") + one minute before the appointment." + :type '(repeat integer) + :group 'appt) -(defvar appt-check-time-syntax nil +(defcustom appt-check-time-syntax nil "*Whether all diary entries are intended to beging with time specifications. Appt will beep and issue a warning message when encountering unparsable -lines.") +lines." + :type 'boolean + :group 'appt) -(defvar appt-audible t +(defcustom appt-audible t "*Controls whether appointment announcements should beep. Appt uses two sound-types for beeps: `appt' and `appt-final'. If this is a number, then that many beeps will occur. If this is a cons, the car is how many beeps, and the cdr is the delay between them (a float, fraction of a second to sleep.) -See also the variable `appt-msg-countdown-list'") +See also the variable `appt-msg-countdown-list'" + :type 'boolean + :group 'appt) -(defvar appt-display-mode-line t - "*Controls if minutes-to-appointment should be displayed on the mode line.") +(defcustom appt-display-mode-line t + "*Controls if minutes-to-appointment should be displayed on the mode line." + :type 'boolean + :group 'appt) -(defvar appt-announce-method 'appt-window-announce +(defcustom appt-announce-method 'appt-window-announce "*The name of the function used to notify the user of an impending appointment. This is called with two arguments, the number of minutes until the appointment, and the appointment description list. Reasonable values for this variable are 'appt-window-announce, -'appt-message-announce, or 'appt-persistent-message-announce.") +'appt-message-announce, or 'appt-persistent-message-announce." + :type 'function + :group 'appt) (defvar appt-time-msg-list nil @@ -247,9 +259,11 @@ )) -(defvar appt-display-duration 5 +(defcustom appt-display-duration 5 "*The number of seconds an appointment message is displayed in its own - window if appt-announce-method is 'appt-window-announce.") + window if appt-announce-method is 'appt-window-announce." + :type 'integer + :group 'appt) (defun appt-window-announce (min-to-app appt) "Set appt-announce-method to the name of this function to cause appointment @@ -341,8 +355,10 @@ ;;; just adding stuff to the display-time-string -- this causes less ;;; flicker. -(defvar appt-mode-line-string "" - "*The string displayed in the mode line by the appointment package.") +(defcustom appt-mode-line-string "" + "*The string displayed in the mode line by the appointment package." + :type 'string + :group 'appt) (defun appt-display-mode-line (min-to-app) "Add an appointment annotation to the mode line." diff -r b27e67717092 -r 34a5b81f86ba lisp/calendar/calendar.el --- a/lisp/calendar/calendar.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/calendar/calendar.el Mon Aug 13 09:30:11 2007 +0200 @@ -100,31 +100,51 @@ ;;; Code: +(defgroup diary nil + "Diary customization" + :group 'calendar) + +(defgroup holidays nil + "Holidays in calendar" + :group 'calendar) + (defun calendar-version () (interactive) (message "Version 5.3, January 25, 1994")) -;;;###autoload -(defvar calendar-week-start-day 0 - "*The day of the week on which a week in the calendar begins. -0 means Sunday (default), 1 means Monday, and so on.") +(defgroup appt nil + "Appointment notification" + :tag "Appointments" + :group 'calendar) + ;;;###autoload -(defvar calendar-offset 0 +(defcustom calendar-week-start-day 0 + "*The day of the week on which a week in the calendar begins. +0 means Sunday (default), 1 means Monday, and so on." + :type 'integer + :group 'calendar) + +;;;###autoload +(defcustom calendar-offset 0 "*The offset of the principal month from the center of the calendar window. 0 means the principal month is in the center (default), -1 means on the left, +1 means on the right. Larger (or smaller) values push the principal month off -the screen.") +the screen." + :type 'integer + :group 'calendar) ;;;###autoload -(defvar view-diary-entries-initially nil +(defcustom view-diary-entries-initially nil "*Non-nil means display current date's diary entries on entry. The diary is displayed in another window when the calendar is first displayed, if the current date is visible. The number of days of diary entries displayed -is governed by the variable `number-of-diary-entries'.") +is governed by the variable `number-of-diary-entries'." + :type 'boolean + :group 'diary) ;;;###autoload -(defvar number-of-diary-entries 1 +(defcustom number-of-diary-entries 1 "*Specifies how many days of diary entries are to be displayed initially. This variable affects the diary display when the command M-x diary is used, or if the value of the variable `view-diary-entries-initially' is t. For @@ -140,14 +160,18 @@ This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the -number of days of diary entries displayed.") +number of days of diary entries displayed." + :type 'integer + :group 'diary) ;;;###autoload -(defvar mark-diary-entries-in-calendar nil +(defcustom mark-diary-entries-in-calendar nil "*Non-nil means mark dates with diary entries, in the calendar window. -The marking symbol is specified by the variable `diary-entry-marker'.") - -(defvar diary-entry-marker +The marking symbol is specified by the variable `diary-entry-marker'." + :type 'boolean + :group 'diary) + +(defcustom diary-entry-marker (progn (make-face 'diary-face) (cond ((face-differs-from-default-p 'diary-face) nil) @@ -167,18 +191,22 @@ gray-tag))))))) 'diary-face) "*Used to mark dates that have diary entries. -Can be either a single-character string or a face.") - -(defvar calendar-today-marker +Can be either a single-character string or a face." + :type '(choice string face) + :group 'diary) + +(defcustom calendar-today-marker (progn (make-face 'calendar-today-face) (if (not (face-differs-from-default-p 'calendar-today-face)) (set-face-underline-p 'calendar-today-face t)) 'calendar-today-face) "*Used to mark today's date. -Can be either a single-character string or a face.") - -(defvar calendar-holiday-marker +Can be either a single-character string or a face." + :type '(choice string face) + :group 'calendar) + +(defcustom calendar-holiday-marker (progn (make-face 'holiday-face) (cond ((face-differs-from-default-p 'holiday-face) nil) @@ -197,56 +225,72 @@ (set-face-reverse-p 'holiday-face t 'global 'tty)))) 'holiday-face) "*Used to mark notable dates in the calendar. -Can be either a single-character string or a face.") +Can be either a single-character string or a face." + :type '(choice string face) + :group 'holidays) ;;;###autoload -(defvar view-calendar-holidays-initially nil +(defcustom view-calendar-holidays-initially nil "*Non-nil means display holidays for current three month period on entry. The holidays are displayed in another window when the calendar is first -displayed.") +displayed." + :type 'boolean + :group 'holidays) ;;;###autoload -(defvar mark-holidays-in-calendar nil +(defcustom mark-holidays-in-calendar nil "*Non-nil means mark dates of holidays in the calendar window. -The marking symbol is specified by the variable `calendar-holiday-marker'.") +The marking symbol is specified by the variable `calendar-holiday-marker'." + :type 'boolean + :group 'holidays) ;;;###autoload -(defvar all-hebrew-calendar-holidays nil +(defcustom all-hebrew-calendar-holidays nil "*If nil, show only major holidays from the Hebrew calendar. This means only those Jewish holidays that appear on secular calendars. -If t, show all the holidays that would appear in a complete Hebrew calendar.") +If t, show all the holidays that would appear in a complete Hebrew calendar." + :type 'boolean + :group 'holidays) ;;;###autoload -(defvar all-christian-calendar-holidays nil +(defcustom all-christian-calendar-holidays nil "*If nil, show only major holidays from the Christian calendar. This means only those Christian holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Christian -calendar.") +calendar." + :type 'boolean + :group 'holidays) ;;;###autoload -(defvar all-islamic-calendar-holidays nil +(defcustom all-islamic-calendar-holidays nil "*If nil, show only major holidays from the Islamic calendar. This means only those Islamic holidays that appear on secular calendars. If t, show all the holidays that would appear in a complete Islamic -calendar.") +calendar." + :type 'boolean + :group 'holidays) ;;;###autoload -(defvar calendar-load-hook nil +(defcustom calendar-load-hook nil "*List of functions to be called after the calendar is first loaded. -This is the place to add key bindings to `calendar-mode-map'.") +This is the place to add key bindings to `calendar-mode-map'." + :type 'hook + :group 'calendar) ;;;###autoload -(defvar initial-calendar-window-hook nil +(defcustom initial-calendar-window-hook nil "*List of functions to be called when the calendar window is first opened. The functions invoked are called after the calendar window is opened, but once opened is never called again. Leaving the calendar with the `q' command -and reentering it will cause these functions to be called again.") +and reentering it will cause these functions to be called again." + :type 'hook + :group 'calendar) ;;;###autoload -(defvar today-visible-calendar-hook nil +(defcustom today-visible-calendar-hook nil "*List of functions called whenever the current date is visible. This can be used, for example, to replace today's date with asterisks; a function `calendar-star-date' is included for this purpose: @@ -261,10 +305,12 @@ Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the -functions that move by days and weeks.") +functions that move by days and weeks." + :type 'hook + :group 'calendar) ;;;###autoload -(defvar today-invisible-calendar-hook nil +(defcustom today-invisible-calendar-hook nil "*List of functions called whenever the current date is not visible. The corresponding variable `today-visible-calendar-hook' is the list of @@ -273,10 +319,12 @@ Other than the use of the provided functions, the changing of any characters in the calendar buffer by the hooks may cause the failure of the -functions that move by days and weeks.") +functions that move by days and weeks." + :type 'hook + :group 'calendar) ;;;###autoload -(defvar diary-file "~/diary" +(defcustom diary-file "~/diary" "*Name of the file in which one's personal diary of dates is kept. The file's entries are lines in any of the forms @@ -370,38 +418,52 @@ for these functions for details. Diary files can contain directives to include the contents of other files; for -details, see the documentation for the variable `list-diary-entries-hook'.") +details, see the documentation for the variable `list-diary-entries-hook'." + :type 'file + :group 'diary) ;;;###autoload -(defvar diary-nonmarking-symbol "&" - "*Symbol indicating that a diary entry is not to be marked in the calendar.") +(defcustom diary-nonmarking-symbol "&" + "*Symbol indicating that a diary entry is not to be marked in the calendar." + :type 'string + :group 'diary) ;;;###autoload -(defvar hebrew-diary-entry-symbol "H" - "*Symbol indicating a diary entry according to the Hebrew calendar.") +(defcustom hebrew-diary-entry-symbol "H" + "*Symbol indicating a diary entry according to the Hebrew calendar." + :type 'string + :group 'diary) ;;;###autoload -(defvar islamic-diary-entry-symbol "I" - "*Symbol indicating a diary entry according to the Islamic calendar.") +(defcustom islamic-diary-entry-symbol "I" + "*Symbol indicating a diary entry according to the Islamic calendar." + :type 'string + :group 'diary) ;;;###autoload -(defvar diary-include-string "#include" +(defcustom diary-include-string "#include" "*The string indicating inclusion of another file of diary entries. -See the documentation for the function `include-other-diary-files'.") +See the documentation for the function `include-other-diary-files'." + :type 'string + :group 'diary) ;;;###autoload -(defvar sexp-diary-entry-symbol "%%" +(defcustom sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in diary-file. -See the documentation for the function `list-sexp-diary-entries'.") +See the documentation for the function `list-sexp-diary-entries'." + :type 'string + :group 'diary) ;;;###autoload -(defvar abbreviated-calendar-year t +(defcustom abbreviated-calendar-year t "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. For the Gregorian calendar; similarly for the Hebrew and Islamic calendars. -If this variable is nil, years must be written in full.") +If this variable is nil, years must be written in full." + :type 'boolean + :group 'diary) ;;;###autoload -(defvar european-calendar-style nil +(defcustom european-calendar-style nil "*Use the European style of dates in the diary and in any displays. If this variable is t, a date 1/2/1990 would be interpreted as February 1, 1990. The accepted European date styles are @@ -413,29 +475,49 @@ DAYNAME Names can be capitalized or not, written in full, or abbreviated to three -characters with or without a period.") +characters with or without a period." + :type 'boolean + :group 'diary) ;;;###autoload -(defvar american-date-diary-pattern +(defcustom american-date-diary-pattern '((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the American patterns of date used. -See the documentation of `diary-date-forms' for an explanation.") +See the documentation of `diary-date-forms' for an explanation." + :type '(repeat (choice (cons :tag "Backup" + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) + :group 'diary) ;;;###autoload -(defvar european-date-diary-pattern +(defcustom european-date-diary-pattern '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the European patterns of date used. -See the documentation of `diary-date-forms' for an explanation.") - -(defvar diary-date-forms +See the documentation of `diary-date-forms' for an explanation." + :type '(repeat (choice (cons :tag "Backup" + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) + :group 'diary) + +(defcustom diary-date-forms (if european-calendar-style european-date-diary-pattern american-date-diary-pattern) @@ -460,21 +542,34 @@ diary entry itself, the first element of the pattern MUST be `backup'. This directive causes the date recognizer to back up to the beginning of the current word of the diary entry, so in no case can the pattern match more than -a portion of the first word of the diary entry.") +a portion of the first word of the diary entry." + :type '(repeat (choice (cons :tag "Backup" + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) + :group 'diary) ;;;###autoload -(defvar european-calendar-display-form +(defcustom european-calendar-display-form '((if dayname (concat dayname ", ")) day " " monthname " " year) "*Pseudo-pattern governing the way a date appears in the European style. -See the documentation of calendar-date-display-form for an explanation.") +See the documentation of calendar-date-display-form for an explanation." + :type 'sexp + :group 'calendar) ;;;###autoload -(defvar american-calendar-display-form +(defcustom american-calendar-display-form '((if dayname (concat dayname ", ")) monthname " " day ", " year) "*Pseudo-pattern governing the way a date appears in the American style. -See the documentation of `calendar-date-display-form' for an explanation.") - -(defvar calendar-date-display-form +See the documentation of `calendar-date-display-form' for an explanation." + :type 'sexp + :group 'calendar) + +(defcustom calendar-date-display-form (if european-calendar-style european-calendar-display-form american-calendar-display-form) @@ -497,7 +592,9 @@ would give the usual American style in fixed-length fields. -See the documentation of the function `calendar-date-string'.") +See the documentation of the function `calendar-date-string'." + :type 'sexp + :group 'calendar) (defun european-calendar () "Set the interpretation and display of dates to the European style." @@ -516,15 +613,17 @@ (update-calendar-mode-line)) ;;;###autoload -(defvar print-diary-entries-hook 'lpr-buffer +(defcustom print-diary-entries-hook 'lpr-buffer "*List of functions called after a temporary diary buffer is prepared. The buffer shows only the diary entries currently visible in the diary buffer. The default just does the printing. Other uses might include, for example, rearranging the lines into order by day and time, saving the buffer -instead of deleting it, or changing the function used to do the printing.") +instead of deleting it, or changing the function used to do the printing." + :type 'hook + :group 'diary) ;;;###autoload -(defvar list-diary-entries-hook nil +(defcustom list-diary-entries-hook nil "*List of functions called after diary file is culled for relevant entries. It is to be used for diary entries that are not found in the diary file. @@ -549,15 +648,19 @@ in your `.emacs' file to cause the fancy diary buffer to be displayed with diary entries from various included files, each day's entries sorted into -lexicographic order.") +lexicographic order." + :type 'hook + :group 'diary) ;;;###autoload -(defvar diary-hook nil +(defcustom diary-hook nil "*List of functions called after the display of the diary. -Can be used for appointment notification.") +Can be used for appointment notification." + :type 'hook + :group 'diary) ;;;###autoload -(defvar diary-display-hook nil +(defcustom diary-display-hook nil "*List of functions that handle the display of the diary. If nil (the default), `simple-diary-display' is used. Use `ignore' for no diary display. @@ -577,18 +680,22 @@ variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy diary buffer will 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 `diary-list-include-blanks' to t.") +diary buffer, set the variable `diary-list-include-blanks' to t." + :type 'hook + :group 'diary) ;;;###autoload -(defvar nongregorian-diary-listing-hook nil +(defcustom nongregorian-diary-listing-hook nil "*List of functions called for listing diary file and included files. As the files are processed for diary entries, these functions are used to cull relevant entries. You can use either or both of `list-hebrew-diary-entries' and `list-islamic-diary-entries'. The documentation for these functions -describes the style of such diary entries.") +describes the style of such diary entries." + :type 'hook + :group 'diary) ;;;###autoload -(defvar mark-diary-entries-hook nil +(defcustom mark-diary-entries-hook nil "*List of functions called after marking diary entries in the calendar. A function `mark-included-diary-files' is also provided for use as the @@ -600,33 +707,41 @@ obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'. When you use `mark-included-diary-files' as part of the mark-diary-entries-hook, you will probably also want to use the -function `include-other-diary-files' as part of `list-diary-entries-hook'.") +function `include-other-diary-files' as part of `list-diary-entries-hook'." + :type 'hook + :group 'diary) ;;;###autoload -(defvar nongregorian-diary-marking-hook nil +(defcustom nongregorian-diary-marking-hook nil "*List of functions called for marking diary file and included files. As the files are processed for diary entries, these functions are used to cull relevant entries. You can use either or both of `mark-hebrew-diary-entries' and `mark-islamic-diary-entries'. The documentation for these functions -describes the style of such diary entries.") +describes the style of such diary entries." + :type 'hook + :group 'diary) ;;;###autoload -(defvar diary-list-include-blanks nil +(defcustom diary-list-include-blanks nil "*If nil, do not include days with no diary entry in the list of diary entries. Such days will then not be shown in the fancy diary buffer, even if they -are holidays.") +are holidays." + :type 'boolean + :group 'diary) ;;;###autoload -(defvar holidays-in-diary-buffer t +(defcustom holidays-in-diary-buffer t "*Non-nil means include holidays in the diary display. The holidays appear in the mode line of the diary buffer, or in the fancy diary buffer next to the date. This slows down the diary functions -somewhat; setting it to nil makes the diary display faster.") +somewhat; setting it to nil makes the diary display faster." + :type 'boolean + :group 'diary) (defvar calendar-mark-ring nil) ;;;###autoload -(defvar general-holidays +(defcustom general-holidays '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") @@ -645,22 +760,29 @@ (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving")) "*General holidays. Default value is for the United States. -See the documentation for `calendar-holidays' for details.") +See the documentation for `calendar-holidays' for details." + :type 'sexp + :group 'holidays) ;;;###autoload (put 'general-holidays 'risky-local-variable t) ;;;###autoload -(defvar local-holidays nil +(defcustom local-holidays nil "*Local holidays. -See the documentation for `calendar-holidays' for details.") +See the documentation for `calendar-holidays' for details." + :type 'sexp + :group 'holidays + :group 'local) ;;;###autoload (put 'local-holidays 'risky-local-variable t) ;;;###autoload -(defvar other-holidays nil +(defcustom other-holidays nil "*User defined holidays. -See the documentation for `calendar-holidays' for details.") +See the documentation for `calendar-holidays' for details." + :type 'sexp + :group 'holidays) ;;;###autoload (put 'other-holidays 'risky-local-variable t) diff -r b27e67717092 -r 34a5b81f86ba lisp/cl/cl-macs.el --- a/lisp/cl/cl-macs.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/cl/cl-macs.el Mon Aug 13 09:30:11 2007 +0200 @@ -1737,6 +1737,21 @@ (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. (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE. diff -r b27e67717092 -r 34a5b81f86ba lisp/comint/background.el --- a/lisp/comint/background.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/comint/background.el Mon Aug 13 09:30:11 2007 +0200 @@ -48,11 +48,20 @@ (provide 'background) (require 'comint) +(defgroup background nil + "Fun with background jobs" + :group 'processes) + + ;; user variables -(defvar background-show t - "*If non-nil, background jobs' buffers are shown when they're started.") -(defvar background-select nil - "*If non-nil, background jobs' buffers are selected when they're started.") +(defcustom background-show t + "*If non-nil, background jobs' buffers are shown when they're started." + :type 'boolean + :group 'background) +(defcustom background-select nil + "*If non-nil, background jobs' buffers are selected when they're started." + :type 'boolean + :group 'background) (defun background (command &optional buffer-name) "Run COMMAND in the background like csh. diff -r b27e67717092 -r 34a5b81f86ba lisp/comint/comint.el --- a/lisp/comint/comint.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/comint/comint.el Mon Aug 13 09:30:11 2007 +0200 @@ -148,6 +148,20 @@ ;;; comint-completion-autolist - boolean behavior ;;; comint-completion-recexact - boolean ... +(defgroup comint nil + "General command interpreter in a window stuff." + :group 'processes) + +(defgroup comint-completion nil + "Completion facilities in comint" + :group 'comint) + +(defgroup comint-source nil + "Source finding facilities in comint" + :prefix "comint-" + :group 'comint) + + (defvar comint-prompt-regexp "^" "Regexp to recognise prompts in the inferior process. Defaults to \"^\", the null string at BOL. @@ -182,7 +196,7 @@ ;; ;; XEmacs - So turn this off by default. -- jwz ;; -(defvar comint-input-autoexpand nil +(defcustom comint-input-autoexpand nil "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). @@ -191,31 +205,45 @@ into the buffer's input ring. See also `comint-magic-space' and `comint-dynamic-complete'. -This variable is buffer-local.") +This variable is buffer-local." + :type '(choice (const :tag "off" nil) + (const :tag "on" t) + (const input) + (const history)) + :group 'comint) ;; XEmacs - this should default to t for consistency with minibuffer history. -jwz -(defvar comint-input-ignoredups t +(defcustom comint-input-ignoredups t "*If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'comint) -(defvar comint-input-ring-file-name nil +(defcustom comint-input-ring-file-name nil "*If non-nil, name of the file to read/write input history. See also `comint-read-input-ring' and `comint-write-input-ring'. -This variable is buffer-local, and is a good thing to set in mode hooks.") +This variable is buffer-local, and is a good thing to set in mode hooks." + :type 'boolean + :group 'comint) -(defvar comint-scroll-to-bottom-on-input nil +(defcustom comint-scroll-to-bottom-on-input nil "*Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. The default is nil. -See `comint-preinput-scroll-to-bottom'. This variable is buffer-local.") +See `comint-preinput-scroll-to-bottom'. This variable is buffer-local." + :type '(choice (const :tag "off" nil) + (const t) + (const all) + (const this)) + :group 'comint) -(defvar comint-scroll-to-bottom-on-output nil +(defcustom comint-scroll-to-bottom-on-output nil "*Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. @@ -224,38 +252,52 @@ The default is nil. See variable `comint-scroll-show-maximum-output' and function -`comint-postoutput-scroll-to-bottom'. This variable is buffer-local.") +`comint-postoutput-scroll-to-bottom'. This variable is buffer-local." + :type '(choice (const :tag "off" nil) + (const t) + (const all) + (const this) + (const others)) + :group 'comint) ;; XEmacs - Default this to nil: this is just horrible -(defvar comint-scroll-show-maximum-output nil +(defcustom comint-scroll-show-maximum-output nil "*Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `comint-scroll-to-bottom-on-output' and function -`comint-postoutput-scroll-to-bottom'. This variable is buffer-local.") +`comint-postoutput-scroll-to-bottom'. This variable is buffer-local." + :type 'boolean + :group 'comint) -(defvar comint-buffer-maximum-size 1024 +(defcustom comint-buffer-maximum-size 1024 "*The maximum size in lines for comint buffers. Comint buffers are truncated from the top to be no greater than this number, if -the function `comint-truncate-buffer' is on `comint-output-filter-functions'.") +the function `comint-truncate-buffer' is on `comint-output-filter-functions'." + :type 'integer + :group 'comint) (defvar comint-input-ring-size 32 "Size of input history ring.") -(defvar comint-process-echoes nil +(defcustom comint-process-echoes nil "*If non-nil, assume that the subprocess echoes any input. If so, delete one copy of the input so that only one copy eventually appears in the buffer. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'comint) ;; AIX puts the name of the person being su'd to in from of the prompt. -(defvar comint-password-prompt-regexp +(defcustom comint-password-prompt-regexp (if (eq system-type 'aix-v3) "\\(\\([Oo]ld \\|[Nn]ew \\|^\\|^..*s\\)[Pp]assword\\|pass phrase\\):\\s *\\'" "\\(\\([Oo]ld \\|[Nn]ew \\|^\\)[Pp]assword\\|pass phrase\\):\\s *\\'") "*Regexp matching prompts for passwords in the inferior process. -This is used by `comint-watch-for-password-prompt'.") +This is used by `comint-watch-for-password-prompt'." + :type 'regexp + :group 'comint) ;;; Here are the per-interpreter hooks. (defvar comint-get-old-input (function comint-get-old-input-default) @@ -267,13 +309,15 @@ ;; XEmacs - fsf doesn't have this, and I think it ought to default to 't' ;; because it's good idiot-proof interface. --stig -(defvar comint-append-old-input t +(defcustom comint-append-old-input t "*If nil, old text selected by \\[comint-send-input] is re-sent immediately. If non-nil, the old text is appended to the end of the buffer, and a prompting message is printed. This flag does not affect the behavior of \\[comint-send-input] -after the process output mark.") +after the process output mark." + :type 'boolean + :group 'comint) (defvar comint-dynamic-complete-functions '(comint-replace-by-expanded-history comint-dynamic-complete-filename) @@ -315,20 +359,26 @@ `comint-simple-send' just sends the string plus a newline. This is called from the user command `comint-send-input'.") -(defvar comint-eol-on-send t +(defcustom comint-eol-on-send t "*Non-nil means go to the end of the line before sending input. -See `comint-send-input'.") +See `comint-send-input'." + :type 'boolean + :group 'comint) -(defvar comint-mode-hook '() +(defcustom comint-mode-hook '() "Called upon entry into comint-mode -This is run before the process is cranked up.") +This is run before the process is cranked up." + :type 'hook + :group 'comint) -(defvar comint-exec-hook '() +(defcustom comint-exec-hook '() "Called each time a process is exec'd by `comint-exec'. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a comint mode buffer (e.g., `(process-kill-without-query)'). In contrast, the `comint-mode-hook' is only -executed once when the buffer is created.") +executed once when the buffer is created." + :type 'hook + :group 'comint) (defvar comint-mode-map nil) @@ -586,8 +636,10 @@ (list "---" (cons "Command History" history))) comint-popup-menu)))) -(defvar comint-history-menu-max 40 - "*Maximum number of entries to display on the Comint command-history menu.") +(defcustom comint-history-menu-max 40 + "*Maximum number of entries to display on the Comint command-history menu." + :type 'integer + :group 'comint) (defun comint-history-menu-filter (menu) (append menu (comint-make-history-menu))) @@ -2031,27 +2083,35 @@ ;;; Commands like this are fine things to put in load hooks if you ;;; want them present in specific modes. -(defvar comint-completion-autolist nil +(defcustom comint-completion-autolist nil "*If non-nil, automatically list possibilities on partial completion. -This mirrors the optional behavior of tcsh.") +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'comint-completion) -(defvar comint-completion-addsuffix t +(defcustom comint-completion-addsuffix t "*If non-nil, add a `/' to completed directories, ` ' to file names. If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. -This mirrors the optional behavior of tcsh.") +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'comint-completion) -(defvar comint-completion-recexact nil +(defcustom comint-completion-recexact nil "*If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. -A non-nil value is useful if `comint-completion-autolist' is non-nil too.") +A non-nil value is useful if `comint-completion-autolist' is non-nil too." + :type 'boolean + :group 'comint-completion) -(defvar comint-completion-fignore nil +(defcustom comint-completion-fignore nil "*List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. -Note that this applies to `comint-dynamic-complete-filename' only.") +Note that this applies to `comint-dynamic-complete-filename' only." + :type '(repeat (string :tag "Suffix")) + :group 'comint-completion) (defvar comint-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. @@ -2519,25 +2579,31 @@ ;;; Commands for extracting source locations: -(defvar comint-find-source-code-max-lines 100 +(defcustom comint-find-source-code-max-lines 100 "*Maximum number of lines to search backward for a source location, -when using \\[comint-find-source-code\\] with an interactive prefix.") +when using \\[comint-find-source-code\\] with an interactive prefix." + :type 'integer + :group 'comint-source) -(defvar comint-find-source-file-hook nil +(defcustom comint-find-source-file-hook nil "*Function to call instead of comint-default-find-source-file when comint-find-source-code parses out a file name and then wants to visit its buffer. The sole argument is the file name. The function must find the file, setting the current buffer, and return the file name. It may also adjust the file name. If you change this variable, -make it buffer local.") +make it buffer local." + :type 'function + :group 'comint-source) -(defvar comint-goto-source-line-hook nil +(defcustom comint-goto-source-line-hook nil "*Function to call instead of comint-default-goto-source-line after comint-find-source-code finds a file and then wants to go to a line number mentioned in a source location. The sole argument is the line number. The function must return the line number, possibly adjusted. If you change -this variable, make it buffer local.") +this variable, make it buffer local." + :type 'function + :group 'comint-source) (defun comint-find-source-code (multi-line) "Search backward from point for a source location. diff -r b27e67717092 -r 34a5b81f86ba lisp/comint/rlogin.el --- a/lisp/comint/rlogin.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/comint/rlogin.el Mon Aug 13 09:30:11 2007 +0200 @@ -20,7 +20,7 @@ ;; along with this program; if not, write to: The Free Software Foundation, ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA. -;; $Id: rlogin.el,v 1.1.1.1 1996/12/18 22:42:36 steve Exp $ +;; $Id: rlogin.el,v 1.2 1997/04/19 23:20:49 steve Exp $ ;;; Commentary: @@ -39,24 +39,39 @@ (require 'comint) (require 'shell) -(defvar rlogin-program "rlogin" - "*Name of program to invoke rlogin") +(defgroup rlogin nil + "Remote login interface" + :group 'processes + :group 'unix) + + +(defcustom rlogin-program "rlogin" + "*Name of program to invoke rlogin" + :type 'string + :group 'rlogin) -(defvar rlogin-explicit-args nil - "*List of arguments to pass to rlogin on the command line.") +(defcustom rlogin-explicit-args nil + "*List of arguments to pass to rlogin on the command line." + :type '(repeat (string :tag "Argument")) + :group 'rlogin) -(defvar rlogin-mode-hook nil - "*Hooks to run after setting current buffer to rlogin-mode.") +(defcustom rlogin-mode-hook nil + "*Hooks to run after setting current buffer to rlogin-mode." + :type 'hook + :group 'rlogin) -(defvar rlogin-process-connection-type nil +(defcustom rlogin-process-connection-type nil "*If non-`nil', use a pty for the local rlogin process. If `nil', use a pipe (if pipes are supported on the local system). Generally it is better not to waste ptys on systems which have a static number of them. On the other hand, some implementations of `rlogin' assume -a pty is being used, and errors will result from using a pipe instead.") +a pty is being used, and errors will result from using a pipe instead." + :type '(choice (const :tag "ptys" t) + (const :tag "pipes" nil)) + :group 'rlogin) -(defvar rlogin-directory-tracking-mode 'local +(defcustom rlogin-directory-tracking-mode 'local "*Control whether and how to do directory tracking in an rlogin buffer. nil means don't do directory tracking. @@ -72,18 +87,26 @@ It is better to use the function of the same name to change the behavior of directory tracking in an rlogin session once it has begun, rather than simply setting this variable, since the function does the necessary -re-synching of directories.") +re-synching of directories." + :type '(choice (const :tag "off" nil) + (const :tag "ftp" t) + (const :tag "local" local)) + :group 'rlogin) (make-variable-buffer-local 'rlogin-directory-tracking-mode) -(defvar rlogin-host nil - "*The name of the remote host. This variable is buffer-local.") +(defcustom rlogin-host nil + "*The name of the remote host. This variable is buffer-local." + :type '(choice (const nil) string) + :group 'rlogin) -(defvar rlogin-remote-user nil +(defcustom rlogin-remote-user nil "*The username used on the remote host. This variable is buffer-local and defaults to your local user name. If rlogin is invoked with the `-l' option to specify the remote username, -this variable is set from that.") +this variable is set from that." + :type '(choice (const nil) string) + :group 'rlogin) ;; Initialize rlogin mode map. (defvar rlogin-mode-map '()) diff -r b27e67717092 -r 34a5b81f86ba lisp/comint/shell.el --- a/lisp/comint/shell.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/comint/shell.el Mon Aug 13 09:30:11 2007 +0200 @@ -110,6 +110,19 @@ (require 'comint) +(defgroup shell nil + "Running shell from within Emacs buffers" + :group 'processes + :group 'unix) + +(defgroup shell-directories nil + "Directory support in shell mode" + :group 'shell) + +(defgroup shell-faces nil + "Faces in shell buffers" + :group 'shell) + ;;;###autoload (defvar shell-prompt-pattern (purecopy "^[^#$%>\n]*[#$%>] *") "Regexp to match prompts in the inferior shell. @@ -123,13 +136,15 @@ This is a fine thing to set in your `.emacs' file.") -(defvar shell-completion-fignore nil +(defcustom shell-completion-fignore nil "*List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like (\"~\" \"#\" \"%\"). -This is a fine thing to set in your `.emacs' file.") +This is a fine thing to set in your `.emacs' file." + :type '(repeat (string :tag "Suffix")) + :group 'shell) ;jwz: turned this off; it's way too broken. (defvar shell-delimiter-argument-list nil ;'(?\| ?& ?< ?> ?\( ?\) ?\; @@ -160,53 +175,75 @@ This is a fine thing to set in your `.emacs' file.") -(defvar shell-command-regexp "[^;&|\n]+" +(defcustom shell-command-regexp "[^;&|\n]+" "*Regexp to match a single command within a pipeline. -This is used for directory tracking and does not do a perfect job.") +This is used for directory tracking and does not do a perfect job." + :type 'regexp + :group 'shell) -(defvar shell-completion-execonly t +(defcustom shell-completion-execonly t "*If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. -Detecting executability of files may slow command completion considerably.") +Detecting executability of files may slow command completion considerably." + :type 'boolean + :group 'shell) -(defvar shell-multiple-shells nil - "*If non-nil, each time shell mode is invoked, a new shell is made") +(defcustom shell-multiple-shells nil + "*If non-nil, each time shell mode is invoked, a new shell is made" + :type 'boolean + :group 'shell) -(defvar shell-popd-regexp "popd" - "*Regexp to match subshell commands equivalent to popd.") +(defcustom shell-popd-regexp "popd" + "*Regexp to match subshell commands equivalent to popd." + :type 'regexp + :group 'shell-directories) -(defvar shell-pushd-regexp "pushd" - "*Regexp to match subshell commands equivalent to pushd.") - -(defvar shell-pushd-tohome nil - "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). -This mirrors the optional behavior of tcsh.") +(defcustom shell-pushd-regexp "pushd" + "*Regexp to match subshell commands equivalent to pushd." + :type 'regexp + :group 'shell-directories) -(defvar shell-pushd-dextract nil - "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. -This mirrors the optional behavior of tcsh.") +(defcustom shell-pushd-tohome nil + "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'shell-directories) -(defvar shell-pushd-dunique nil - "*If non-nil, make pushd only add unique directories to the stack. -This mirrors the optional behavior of tcsh.") +(defcustom shell-pushd-dextract nil + "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'shell-directories) -(defvar shell-cd-regexp "cd" - "*Regexp to match subshell commands equivalent to cd.") +(defcustom shell-pushd-dunique nil + "*If non-nil, make pushd only add unique directories to the stack. +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'shell-directories) -(defvar explicit-shell-file-name nil - "*If non-nil, is file name to use for explicitly requested inferior shell.") +(defcustom shell-cd-regexp "cd" + "*Regexp to match subshell commands equivalent to cd." + :type 'regexp + :group 'shell-directories) -(defvar explicit-csh-args +(defcustom explicit-shell-file-name nil + "*If non-nil, is file name to use for explicitly requested inferior shell." + :type '(choice (const :tag "None" nil) file) + :group 'shell) + +(defcustom explicit-csh-args (if (eq system-type 'hpux) ;; -T persuades HP's csh not to think it is smarter ;; than us about what terminal modes to use. '("-i" "-T") '("-i")) "*Args passed to inferior shell by M-x shell, if the shell is csh. -Value is a list of strings, which may be nil.") +Value is a list of strings, which may be nil." + :type '(repeat (string :tag "Argument")) + :group 'shell) -(defvar shell-input-autoexpand 'history +(defcustom shell-input-autoexpand 'history "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). @@ -216,7 +253,9 @@ `comint-dynamic-complete'. This variable supplies a default for `comint-input-autoexpand', -for Shell mode only.") +for Shell mode only." + :type '(choice (const nil) (const input) (const history)) + :type 'shell) (defvar shell-dirstack nil "List of directories saved by pushd in this buffer's shell. @@ -247,21 +286,33 @@ (define-key map "\M-\C-m" 'shell-resync-dirs) (setq shell-mode-map map))) -(defvar shell-mode-hook nil - "*Hook for customising Shell mode.") +(defcustom shell-mode-hook nil + "*Hook for customising Shell mode." + :type 'hook + :group 'shell) ;; font-locking -(defvar shell-prompt-face 'shell-prompt-face - "Face for shell prompts.") -(defvar shell-option-face 'shell-option-face - "Face for command line options.") -(defvar shell-output-face 'shell-output-face - "Face for generic shell output.") -(defvar shell-output-2-face 'shell-output-2-face - "Face for grep-like output.") -(defvar shell-output-3-face 'shell-output-3-face - "Face for [N] output where N is a number.") +(defcustom shell-prompt-face 'shell-prompt-face + "Face for shell prompts." + :type 'face + :group 'shell-faces) +(defcustom shell-option-face 'shell-option-face + "Face for command line options." + :type 'face + :group 'shell-faces) +(defcustom shell-output-face 'shell-output-face + "Face for generic shell output." + :type 'face + :group 'shell-faces) +(defcustom shell-output-2-face 'shell-output-2-face + "Face for grep-like output." + :type 'face + :group 'shell-faces) +(defcustom shell-output-3-face 'shell-output-3-face + "Face for [N] output where N is a number." + :type 'face + :group 'shell-faces) (make-face shell-prompt-face) (make-face shell-option-face) diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/ChangeLog --- a/lisp/custom/ChangeLog Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:30:11 2007 +0200 @@ -1,3 +1,135 @@ +Thu Apr 17 18:55:15 1997 Per Abrahamsen + + * Version 1.89 released. + +Thu Apr 17 11:23:20 1997 Per Abrahamsen + + * cus-edit.el (custom-toggle-hide): New function. + (custom-level-action): Use it. + (custom-group-menu): Ditto. + (custom-face-menu): Ditto. + (custom-variable-menu): Ditto. + + * cus-edit.el (custom-redraw): Goto old line and column instead of + old character position. This is more tolerant for changes. + + * wid-edit.el (widget-choice-action): Only notify parent if + something was chosen. + + * widget.texi (Sexp Types): Documented `function-item' and + `variable-item'. + (group): New subsection. + (Widget Browser): New section. + (Widget Minor Mode): New sextion. + + * wid-edit.el: Moved widget minor mode support to + `wid-browse.el'. + + * custom.el (custom-declare-group): Make sure initial members + aren't duplicated even if the `defgroup' is evaluated twice. + + * custom.el (custom-declare-variable): Use `append' instead of + `copy-list'. + + * widget.texi (checklist): Documented `:greedy'. + +Wed Apr 16 19:24:47 1997 Per Abrahamsen + + * Version 1.88 released. + +Wed Apr 16 13:28:37 1997 Per Abrahamsen + + * wid-edit.el (widget-minor-mode): New variable and command. + (widget-minor-mode-map): New variable. + Add to `'minor-mode-alist' and `minor-mode-map-alist'. + * widget.el: Added autoload. + + * wid-edit.el (widget-specify-inactive): Set priority. + + * wid-edit.el (widget-move): Skip inactive widgets. + + * cus-edit.el (custom-display-unselected-match): Matched too many + displays. + + * Version 1.87 released. + +Wed Apr 16 00:15:26 1997 Per Abrahamsen + + * wid-edit.el (widget-field-face): Changed default background + color. + + * custom.el (custom-declare-variable): Set `custom-get' the right + place. + + * cus-edit.el (custom-magic): Don't notify the parent. + + * cus-edit.el (custom-variable-menu): Allow more actions on + `changed' and `rogue' states. + + * custom.el (custom-initialize-set): New function. + (custom-initialize-reset): New function. + (custom-initialize-changed): New function. + (custom-declare-variable): Use `custom-initialize-set' as + default for `:initialize'. + + * Version 1.86 released. + +Wed Apr 16 00:02:19 1997 Per Abrahamsen + + * cus-edit.el (custom-save-variables): Save :require symbols. + + * Version 1.85 released. + +Tue Apr 15 11:56:16 1997 Per Abrahamsen + + * custom.el (:initialize, :set, :get, :request): New keywords. + (custom-declare-variable): Support them. + (custom-set-variables): Ditto. + (defcustom): Document them. + (custom-initialize-default): New function. + * custom.texi (Declaring Variables): Documented them. + * cus-edit.el (custom-variable-value-create): Support them. + (custom-variable-set): Ditto. + (custom-variable-save): Ditto. + (custom-variable-reset-saved): Ditto. + (custom-variable-reset-factory): Ditto. + (custom-variable-state-set): Ditto. + + * cus-edit.el (custom-menu-filter): New function. + (custom-variable-menu): New format. + (custom-variable-action): Use it. + (custom-face-menu): New format. + (custom-face-action): Use it. + (custom-group-menu): New format. + (custom-group-action): Use it. + + * wid-edit.el (widget-choose): Accept unselectable items. + + * wid-edit.el (widget-default-create): Clear undo buffer. + (widget-default-delete): Ditto. + + * cus-edit.el (customize-other-window): New function. + + * cus-face.el (custom-frame-parameter): Replace + `frame-parameter'. + (custom-background-mode, custom-extract-frame-properties, + custom-get-frame-properties): Updated callers. + + * custom.el: Minor doc fixes from RMS. + + * cus-face.el (custom-declare-face): Protest when dumping defface + in Emacs. + + * wid-edit.el (widget-info-link-action): Steal mouse up event. + + * wid-edit.el (widget-specify-insert): Use old style backquote. + Patch by "William M. Perry" . + +Sun Apr 13 19:19:33 1997 Per Abrahamsen + + * custom.texi (Declaring Faces): Documentation property symbol is + `face-documentation'. + Sat Apr 12 18:31:22 1997 Per Abrahamsen * Version 1.84 released. diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/cus-edit.el --- a/lisp/custom/cus-edit.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,11 +4,13 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: ;; +;; This file implements the code to create and edit customize buffers. +;; ;; See `custom.el'. ;;; Code: @@ -17,6 +19,10 @@ (require 'wid-edit) (require 'easymenu) +(condition-case nil + (require 'cus-load) + (error nil)) + (define-widget-keywords :custom-prefixes :custom-menu :custom-show :custom-magic :custom-state :custom-level :custom-form :custom-set :custom-save :custom-reset-current :custom-reset-saved @@ -336,6 +342,23 @@ (list (if (equal val "") v (intern val))))) +(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 @@ -545,6 +568,21 @@ (custom-buffer-create (list (list symbol 'custom-group)))) ;;;###autoload +(defun customize-other-window (symbol) + "Customize SYMBOL, which must be a customization group." + (interactive (list (completing-read "Customize group: (default emacs) " + obarray + (lambda (symbol) + (get symbol 'custom-group)) + t))) + + (when (stringp symbol) + (if (string-equal "" symbol) + (setq symbol 'emacs) + (setq symbol (intern symbol)))) + (custom-buffer-create-other-window (list (list symbol 'custom-group)))) + +;;;###autoload (defun customize-variable (symbol) "Customize SYMBOL, which must be a variable." (interactive (custom-variable-prompt)) @@ -917,6 +955,7 @@ "Show and manipulate state for a customization option." :format "%v" :action 'widget-choice-item-action + :notify 'ignore :value-get 'ignore :value-create 'custom-magic-value-create :value-delete 'widget-children-value-delete) @@ -976,15 +1015,7 @@ (defun custom-level-action (widget &optional event) "Toggle visibility for parent to WIDGET." - (let* ((parent (widget-get widget :parent)) - (state (widget-get parent :custom-state))) - (cond ((memq state '(invalid modified)) - (error "There are unset changes")) - ((eq state 'hidden) - (widget-put parent :custom-state 'unknown)) - (t - (widget-put parent :custom-state 'hidden))) - (custom-redraw parent))) + (custom-toggle-hide (widget-get widget :parent))) ;;; The `custom' Widget. @@ -1072,14 +1103,20 @@ (defun custom-redraw (widget) "Redraw WIDGET with current settings." - (let ((pos (point)) + (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)) - (goto-char pos)))) + (condition-case nil + (progn + (goto-line line) + (move-to-column column)) + (error nil))))) (defun custom-redraw-magic (widget) "Redraw WIDGET state with current settings." @@ -1128,6 +1165,17 @@ "Load all dependencies for WIDGET." (custom-load-symbol (widget-value widget))) +(defun custom-toggle-hide (widget) + "Toggle visibility of 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 :custom-state 'hidden))) + (custom-redraw widget))) + ;;; The `custom-variable' Widget. (defface custom-variable-sample-face '((t (:underline t))) @@ -1181,8 +1229,10 @@ (tag (widget-get widget :tag)) (type (custom-variable-type symbol)) (conv (widget-convert type)) + (get (or (get symbol 'custom-get) 'default-value)) + (set (or (get symbol 'custom-set) 'set-default)) (value (if (default-boundp symbol) - (default-value symbol) + (funcall get symbol) (widget-get conv :value)))) ;; If the widget is new, the child determine whether it is hidden. (cond (state) @@ -1212,7 +1262,7 @@ ((get symbol 'factory-value) (car (get symbol 'factory-value))) ((default-boundp symbol) - (custom-quote (default-value symbol))) + (custom-quote (funcall get symbol))) (t (custom-quote (widget-get conv :value)))))) (push (widget-create-child-and-convert @@ -1244,8 +1294,9 @@ (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) - (default-value symbol) + (funcall get symbol) (widget-get widget :value))) tmp (state (cond ((setq tmp (get symbol 'customized-value)) @@ -1270,17 +1321,41 @@ (widget-put widget :custom-state state))) (defvar custom-variable-menu - '(("Edit" . custom-variable-edit) - ("Edit Lisp" . custom-variable-edit-lisp) - ("Set" . custom-variable-set) - ("Save" . custom-variable-save) - ("Reset to Current" . custom-redraw) - ("Reset to Saved" . custom-variable-reset-saved) - ("Reset to Factory Settings" . custom-variable-reset-factory)) + '(("Hide" custom-toggle-hide + (lambda (widget) + (not (memq (widget-get widget :custom-state) '(modified invalid))))) + ("Edit" custom-variable-edit + (lambda (widget) + (not (eq (widget-get widget :custom-form) 'edit)))) + ("Edit Lisp" custom-variable-edit-lisp + (lambda (widget) + (not (eq (widget-get widget :custom-form) 'lisp)))) + ("Set" custom-variable-set + (lambda (widget) + (eq (widget-get widget :custom-state) 'modified))) + ("Save" 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))))) + ("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 Factory Settings" custom-variable-reset-factory + (lambda (widget) + (and (get (widget-value widget) 'factory-value) + (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)))))) "Alist of actions for the `custom-variable' widget. -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.") +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. @@ -1292,7 +1367,8 @@ (let* ((completion-ignore-case t) (answer (widget-choose (custom-unlispify-tag-name (widget-get widget :value)) - custom-variable-menu + (custom-menu-filter custom-variable-menu + widget) event))) (if answer (funcall answer widget))))) @@ -1311,32 +1387,34 @@ (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)) - val) + (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))) ((eq form 'lisp) - (set-default symbol (eval (setq val (widget-value child)))) + (funcall set symbol (eval (setq val (widget-value child)))) (put symbol 'customized-value (list val))) (t - (set-default symbol (setq val (widget-value child))) + (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 the default 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)) - val) + (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)) @@ -1344,12 +1422,12 @@ (error "%s" (widget-get val :error))) ((eq form 'lisp) (put symbol 'saved-value (list (widget-value child))) - (set-default symbol (eval (widget-value child)))) + (funcall set symbol (eval (widget-value child)))) (t (put symbol 'saved-value (list (custom-quote (widget-value child)))) - (set-default symbol (widget-value child)))) + (funcall set symbol (widget-value child)))) (put symbol 'customized-value nil) (custom-save-all) (custom-variable-state-set widget) @@ -1357,10 +1435,11 @@ (defun custom-variable-reset-saved (widget) "Restore the saved value for the variable being edited by WIDGET." - (let ((symbol (widget-value widget))) + (let* ((symbol (widget-value widget)) + (set (or (get symbol 'custom-set) 'set-default))) (if (get symbol 'saved-value) (condition-case nil - (set-default symbol (eval (car (get symbol 'saved-value)))) + (funcall set symbol (eval (car (get symbol 'saved-value)))) (error nil)) (error "No saved value for %s" symbol)) (put symbol 'customized-value nil) @@ -1369,9 +1448,10 @@ (defun custom-variable-reset-factory (widget) "Restore the factory setting for the variable being edited by WIDGET." - (let ((symbol (widget-value widget))) + (let* ((symbol (widget-value widget)) + (set (or (get symbol 'custom-set) 'set-default))) (if (get symbol 'factory-value) - (set-default symbol (eval (car (get symbol 'factory-value)))) + (funcall set symbol (eval (car (get symbol 'factory-value)))) (error "No factory default for %S" symbol)) (put symbol 'customized-value nil) (when (get symbol 'saved-value) @@ -1528,9 +1608,7 @@ (defun custom-display-unselected-match (widget value) "Non-nil if VALUE is an unselected display specification." - (and (listp value) - (eq (length value) 2) - (not (custom-display-match-frame value (selected-frame))))) + (not (custom-display-match-frame value (selected-frame)))) (define-widget 'custom-face-selected 'group "Edit the attributes of the selected display in a face specification." @@ -1578,17 +1656,32 @@ (message "Creating face editor...done"))) (defvar custom-face-menu - '(("Edit Selected" . custom-face-edit-selected) - ("Edit All" . custom-face-edit-all) - ("Edit Lisp" . custom-face-edit-lisp) - ("Set" . custom-face-set) - ("Save" . custom-face-save) - ("Reset to Saved" . custom-face-reset-saved) - ("Reset to Factory Setting" . custom-face-reset-factory)) + '(("Hide" custom-toggle-hide + (lambda (widget) + (not (memq (widget-get widget :custom-state) '(modified invalid))))) + ("Edit Selected" custom-face-edit-selected + (lambda (widget) + (not (eq (widget-get widget :custom-form) 'selected)))) + ("Edit All" custom-face-edit-all + (lambda (widget) + (not (eq (widget-get widget :custom-form) 'all)))) + ("Edit Lisp" custom-face-edit-lisp + (lambda (widget) + (not (eq (widget-get widget :custom-form) 'lisp)))) + ("Set" custom-face-set) + ("Save" custom-face-save) + ("Reset to Saved" custom-face-reset-saved + (lambda (widget) + (get (widget-value widget) 'saved-face))) + ("Reset to Factory Setting" custom-face-reset-factory + (lambda (widget) + (get (widget-value widget) 'factory-face)))) "Alist of actions for the `custom-face' widget. -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.") +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." @@ -1630,7 +1723,9 @@ (let* ((completion-ignore-case t) (symbol (widget-get widget :value)) (answer (widget-choose (custom-unlispify-tag-name symbol) - custom-face-menu event))) + (custom-menu-filter custom-face-menu + widget) + event))) (if answer (funcall answer widget))))) @@ -1851,15 +1946,33 @@ (message "Creating group... done"))))) (defvar custom-group-menu - '(("Set" . custom-group-set) - ("Save" . custom-group-save) - ("Reset to Current" . custom-group-reset-current) - ("Reset to Saved" . custom-group-reset-saved) - ("Reset to Factory" . custom-group-reset-factory)) + '(("Hide" custom-toggle-hide + (lambda (widget) + (not (memq (widget-get widget :custom-state) '(modified invalid))))) + ("Set" custom-group-set + (lambda (widget) + (eq (widget-get widget :custom-state) 'modified))) + ("Save" custom-group-save + (lambda (widget) + (memq (widget-get widget :custom-state) '(modified set)))) + ("Reset to Current" custom-group-reset-current + (lambda (widget) + (and (default-boundp (widget-value widget)) + (memq (widget-get widget :custom-state) '(modified))))) + ("Reset to Saved" custom-group-reset-saved + (lambda (widget) + (and (get (widget-value widget) 'saved-value) + (memq (widget-get widget :custom-state) '(modified set))))) + ("Reset to Factory" custom-group-reset-factory + (lambda (widget) + (and (get (widget-value widget) 'factory-value) + (memq (widget-get widget :custom-state) '(modified set saved)))))) "Alist of actions for the `custom-group' widget. -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.") +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. @@ -1871,7 +1984,8 @@ (let* ((completion-ignore-case t) (answer (widget-choose (custom-unlispify-tag-name (widget-get widget :value)) - custom-group-menu + (custom-menu-filter custom-group-menu + widget) event))) (if answer (funcall answer widget))))) @@ -1972,17 +2086,26 @@ (princ "\n")) (princ "(custom-set-variables") (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-value))) + (let ((value (get symbol 'saved-value)) + (requests (get symbol 'custom-requests)) + (now (not (or (get symbol 'factory-value) + (and (not (boundp symbol)) + (not (get symbol 'force-value))))))) (when value (princ "\n '(") (princ symbol) (princ " ") (prin1 (car value)) - (if (or (get symbol 'factory-value) - (and (not (boundp symbol)) - (not (get symbol 'force-value)))) - (princ ")") - (princ " t)")))))) + (cond (requests + (if now + (princ " t ") + (princ " nil ")) + (prin1 requests) + (princ ")")) + (now + (princ " t)")) + (t + (princ ")"))))))) (princ ")") (unless (looking-at "\n") (princ "\n"))))) @@ -2164,7 +2287,7 @@ (easy-menu-define custom-mode-customize-menu custom-mode-map - "Menu used in customization buffers." + "Menu used to customize customization buffers." (customize-menu-create 'customize)) (easy-menu-define custom-mode-menu diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/cus-face.el --- a/lisp/custom/cus-face.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -37,13 +37,20 @@ 'face-font-name 'face-font)) + (eval-and-compile - (unless (fboundp 'frame-property) - ;; XEmacs function missing in Emacs. - (defun frame-property (frame property &optional default) - "Return FRAME's value for property PROPERTY." - (or (cdr (assq property (frame-parameters frame))) - default))) + (cond ((fboundp 'frame-property) + ;; XEmacs. + (defalias 'custom-frame-parameter 'frame-property)) + ((fboundp 'frame-parameter) + ;; Emacs 19.35. + (defalias 'custom-frame-parameter 'frame-parameter)) + (t + ;; Old emacsen. + (defun custom-frame-parameter (frame property &optional default) + "Return FRAME's value for property PROPERTY." + (or (cdr (assq property (frame-parameters frame))) + default)))) (unless (fboundp 'face-doc-string) ;; XEmacs function missing in Emacs. @@ -146,12 +153,12 @@ ;; (interactive (list (read-face-name "Reverse face: "))) ;; (let ((fg (or (face-foreground face frame) ;; (face-foreground 'default frame) -;; (frame-property (or frame (selected-frame)) +;; (custom-frame-parameter (or frame (selected-frame)) ;; 'foreground-color) ;; "black")) ;; (bg (or (face-background face frame) ;; (face-background 'default frame) -;; (frame-property (or frame (selected-frame)) +;; (custom-frame-parameter (or frame (selected-frame)) ;; 'background-color) ;; "white"))) ;; (set-face-foreground face bg frame) @@ -177,7 +184,7 @@ (mode (cond (bg-resource (intern (downcase bg-resource))) ((and (setq color (condition-case () - (or (frame-property + (or (custom-frame-parameter frame 'background-color) (custom-face-background @@ -201,16 +208,16 @@ (list 'type (device-type (frame-device frame)) 'class (device-class (frame-device frame)) 'background (or custom-background-mode - (frame-property frame + (custom-frame-parameter frame 'background-mode) (custom-background-mode frame)))) ;; Emacs. (defun custom-extract-frame-properties (frame) "Return a plist with the frame properties of FRAME used by custom." (list 'type window-system - 'class (frame-property frame 'display-type) + 'class (custom-frame-parameter frame 'display-type) 'background (or custom-background-mode - (frame-property frame 'background-mode) + (custom-frame-parameter frame 'background-mode) (custom-background-mode frame)))))) ;;; Declaring a face. @@ -218,7 +225,9 @@ ;;;###autoload (defun custom-declare-face (face spec doc &rest args) "Like `defface', but FACE is evaluated as a normal argument." - (when (fboundp 'load-gc) + (when (or (fboundp 'load-gc) ;XEmacs. + ;; Emacs. + (and (boundp purify-flag) purify-flag)) ;; This should be allowed, somehow. (error "Attempt to declare a face during dump")) (unless (get face 'factory-face) @@ -443,7 +452,7 @@ If FRAME is nil, return the default frame properties." (cond (frame ;; Try to get from cache. - (let ((cache (frame-property frame 'custom-properties))) + (let ((cache (custom-frame-parameter frame 'custom-properties))) (unless cache ;; Oh well, get it then. (setq cache (custom-extract-frame-properties frame)) diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/custom.el --- a/lisp/custom/custom.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -21,12 +21,14 @@ (require 'widget) -(define-widget-keywords :prefix :tag :load :link :options :type :group) +(define-widget-keywords :initialize :set :get :require :prefix :tag + :load :link :options :type :group) ;; These autoloads should be deleted eventually. (unless (fboundp 'load-gc) ;; From cus-edit.el (autoload 'customize "cus-edit" nil t) + (autoload 'customize-other-window "cus-edit" nil t) (autoload 'customize-variable "cus-edit" nil t) (autoload 'customize-variable-other-window "cus-edit" nil t) (autoload 'customize-face "cus-edit" nil t) @@ -48,14 +50,62 @@ ;;; The `defcustom' Macro. -(defun custom-declare-variable (symbol value doc &rest args) - "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." - ;; Bind this variable unless it already is bound. +(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 factory setting. (set-default symbol (if (get symbol 'saved-value) (eval (car (get symbol 'saved-value))) - (eval 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 factory 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 factory setting. (put symbol 'factory-value (list value)) ;; Maybe this option was rogue in an earlier version. It no longer is. @@ -64,29 +114,42 @@ (put symbol 'force-value nil)) (when doc (put symbol 'variable-documentation doc)) - (while args - (let ((arg (car args))) - (setq args (cdr args)) - (unless (symbolp arg) - (error "Junk in args %S" args)) - (let ((keyword arg) - (value (car args))) - (unless args - (error "Keyword %s is missing an argument" keyword)) + (let ((initialize 'custom-initialize-set) + (requests nil)) + (while args + (let ((arg (car args))) (setq args (cdr args)) - (cond ((eq keyword :type) - (put symbol 'custom-type value)) - ((eq keyword :options) - (if (get symbol 'custom-options) - ;; Slow safe code to avoid duplicates. - (mapcar (lambda (option) - (custom-add-option symbol option)) - value) - ;; Fast code for the common case. - (put symbol 'custom-options (copy-list value)))) - (t - (custom-handle-keyword symbol keyword value - 'custom-variable)))))) + (unless (symbolp arg) + (error "Junk in args %S" args)) + (let ((keyword arg) + (value (car args))) + (unless args + (error "Keyword %s 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) + (push value requests)) + ((eq keyword :type) + (put symbol 'custom-type value)) + ((eq keyword :options) + (if (get symbol 'custom-options) + ;; Slow safe code to avoid duplicates. + (mapcar (lambda (option) + (custom-add-option symbol option)) + value) + ;; Fast code for the common case. + (put symbol 'custom-options (append value nil)))) + (t + (custom-handle-keyword symbol keyword value + 'custom-variable)))))) + (put symbol 'custom-requests requests) + ;; Do the actual initialization. + (funcall initialize symbol value)) (run-hooks 'custom-define-hook) symbol) @@ -102,12 +165,27 @@ The following KEYWORD's are defined: -:type VALUE should be a widget type. +: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-default' +: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 +Read the section about customization in the Emacs Lisp manual for more information." `(eval-and-compile (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))) @@ -157,7 +235,7 @@ `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 +Read the section about customization in the Emacs Lisp manual for more information." `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) @@ -165,6 +243,9 @@ (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)) + (setq members (cdr members))) (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) @@ -206,7 +287,7 @@ :group VALUE should be a customization group. Add SYMBOL to that group. -Read the section about customization in the emacs lisp manual for more +Read the section about customization in the Emacs Lisp manual for more information." `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) @@ -287,17 +368,22 @@ (while args (let ((entry (car args))) (if (listp entry) - (let ((symbol (nth 0 entry)) - (value (nth 1 entry)) - (now (nth 2 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) - (set-default symbol (eval value))) + (funcall set symbol (eval value))) ((default-boundp symbol) ;; Something already set this, overwrite it. - (set-default symbol (eval value)))) + (funcall set symbol (eval value)))) + (when requests + (put symbol 'custom-requests requests) + (mapcar 'require requests)) (setq args (cdr args))) ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/wid-browse.el --- a/lisp/custom/wid-browse.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: extensions -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -245,6 +245,37 @@ (put :button 'widget-keyword-printer 'widget-browse-widget) (put :args 'widget-keyword-printer 'widget-browse-sexps) +;;; Widget Minor Mode. + +(defvar widget-minor-mode nil + "I non-nil, we are in Widget Minor Mode.") + (make-variable-buffer-local 'widget-minor-mode) + +(defvar widget-minor-mode-map nil + "Keymap used in Widget Minor Mode.") + +(unless widget-minor-mode-map + (setq widget-minor-mode-map (make-sparse-keymap)) + (set-keymap-parent widget-minor-mode-map widget-keymap)) + +;;;###autoload +(defun widget-minor-mode (&optional arg) + "Togle minor mode for traversing widgets. +With arg, turn widget mode on if and only if arg is positive." + (interactive "P") + (cond ((null arg) + (setq widget-minor-mode (not widget-minor-mode))) + ((<= 0 arg) + (setq widget-minor-mode nil)) + (t + (setq widget-minor-mode t))) + (force-mode-line-update)) + +(add-to-list 'minor-mode-alist '(widget-minor-mode " Widget")) + +(add-to-list 'minor-mode-map-alist + (cons 'widget-minor-mode widget-minor-mode-map)) + ;;; The End: (provide 'wid-browse) diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/wid-edit.el --- a/lisp/custom/wid-edit.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: extensions -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -58,7 +58,7 @@ ;; 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)) + (` (defvar (, var) (, value) (, doc)))) (defmacro defface (&rest args) nil) (define-widget-keywords :prefix :tag :load :link :options :type :group) (when (fboundp 'copy-face) @@ -117,7 +117,7 @@ (defface widget-field-face '((((class grayscale color) (background light)) - (:background "light gray")) + (:background "gray85")) (((class grayscale color) (background dark)) (:background "dark gray")) @@ -167,7 +167,9 @@ "Choose an item from a list. First argument TITLE is the name of the list. -Second argument ITEMS is an alist (NAME . VALUE). +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, @@ -188,7 +190,9 @@ (mapcar (function (lambda (x) - (vector (car x) (list (car x)) t))) + (if (stringp x) + (vector x nil nil) + (vector (car x) (list (car x)) t)))) items))))) (setq val (and val (listp (event-object val)) @@ -196,6 +200,7 @@ (car (event-object val)))) (cdr (assoc val items)))) (t + (setq items (remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -371,7 +376,8 @@ (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. - `(save-restriction + (` + (save-restriction (let ((inhibit-read-only t) result after-change-functions) @@ -379,11 +385,11 @@ (narrow-to-region (- (point) 2) (point)) (widget-specify-none (point-min) (point-max)) (goto-char (1+ (point-min))) - (setq result (progn ,@form)) + (setq result (progn (,@ form))) (delete-region (point-min) (1+ (point-min))) (delete-region (1- (point-max)) (point-max)) (goto-char (point-max)) - result))) + result)))) (defface widget-inactive-face '((((class grayscale color) (background dark)) @@ -401,7 +407,8 @@ (unless (widget-get widget :inactive) (let ((overlay (make-overlay from to nil t nil))) (overlay-put overlay 'face 'widget-inactive-face) - (overlay-put overlay 'evaporate 't) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'priority 100) (overlay-put overlay (if (string-match "XEmacs" emacs-version) 'read-only 'modification-hooks) '(widget-overlay-inactive)) @@ -783,8 +790,9 @@ (t (error "No buttons or fields found")))))) (setq button (widget-at (point))) - (if (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) + (if (or (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) + (and button (not (widget-apply button :active)))) (setq arg (1+ arg)))))) (while (< arg 0) (if (= (point-min) (point)) @@ -821,8 +829,9 @@ (button (goto-char button)) (field (goto-char field))) (setq button (widget-at (point))) - (if (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) + (if (or (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) + (and button (not (widget-apply button :active)))) (setq arg (1- arg))))) (widget-echo-help (point)) (run-hooks 'widget-move-hook)) @@ -1070,7 +1079,8 @@ (set-marker-insertion-type from t) (set-marker-insertion-type to nil) (widget-put widget :from from) - (widget-put widget :to to)))) + (widget-put widget :to to))) + (widget-clear-undo)) (defun widget-default-format-handler (widget escape) ;; We recognize the %h escape by default. @@ -1132,7 +1142,8 @@ ;; Kludge: this doesn't need to be true for empty formats. (delete-region from to)) (set-marker from nil) - (set-marker to nil))) + (set-marker to nil)) + (widget-clear-undo)) (defun widget-default-value-set (widget value) ;; Recreate widget with new value. @@ -1280,7 +1291,17 @@ (defun widget-info-link-action (widget &optional event) "Open the info node specified by WIDGET." - (Info-goto-node (widget-value widget))) + (Info-goto-node (widget-value widget)) + ;; Steal button release event. + (if (and (fboundp 'button-press-event-p) + (fboundp 'next-command-event)) + ;; XEmacs + (and event + (button-press-event-p event) + (next-command-event)) + ;; Emacs + (when (memq 'down (event-modifiers event)) + (read-event)))) ;;; The `url-link' Widget. @@ -1490,11 +1511,8 @@ (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) - (widget-apply widget :notify widget event) - (widget-setup))) - ;; Notify parent. - (widget-apply widget :notify widget event) - (widget-clear-undo)) + (widget-apply widget :notify widget event) + (widget-setup)))) (defun widget-choice-validate (widget) ;; Valid if we have made a valid choice. @@ -1550,7 +1568,7 @@ ;; Toggle value. (widget-value-set widget (not (widget-value widget))) (widget-apply widget :notify widget event)) - + ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/widget-example.el --- a/lisp/custom/widget-example.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget) diff -r b27e67717092 -r 34a5b81f86ba lisp/custom/widget.el --- a/lisp/custom/widget.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.84 +;; Version: 1.89 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -51,7 +51,8 @@ (autoload 'widget-insert "wid-edit") (autoload 'widget-browse "wid-browse" nil t) (autoload 'widget-browse-other-window "wid-browse" nil t) - (autoload 'widget-browse-at "wid-browse" nil t)) + (autoload 'widget-browse-at "wid-browse" nil t) + (autoload 'widget-minor-mode "wid-browse" nil t)) (defun define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff-diff.el --- a/lisp/ediff/ediff-diff.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff-diff.el Mon Aug 13 09:30:11 2007 +0200 @@ -39,8 +39,13 @@ (require 'ediff-init) +(defgroup ediff-diff nil + "Diff related utilities" + :prefix "ediff-" + :group 'ediff) -(defvar ediff-shell + +(defcustom ediff-shell (cond ((eq system-type 'emx) "cmd") ; OS/2 ((memq system-type '(ms-dos windows-nt windows-95)) shell-file-name) ; no standard name on MS-DOS @@ -50,37 +55,53 @@ .cshrc files are set up correctly, any shell will do. However, some people set $prompt or other things incorrectly, which leads to undesirable output messages. These may cause Ediff to fail. In such a case, set ediff-shell -to a shell that you are not using or, better, fix your shell's startup file.") +to a shell that you are not using or, better, fix your shell's startup file." + :type 'string + :group 'ediff-diff) -(defvar ediff-diff-program "diff" - "*Program to use for generating the differential of the two files.") -(defvar ediff-diff-options "" +(defcustom ediff-diff-program "diff" + "*Program to use for generating the differential of the two files." + :type 'string + :group 'ediff-diff) +(defcustom ediff-diff-options "" "*Options to pass to `ediff-diff-program'. If diff\(1\) is used as `ediff-diff-program', then the most useful options are `-w', to ignore space, and `-i', to ignore case of letters. At present, the option `-c' is ignored, since Ediff doesn't understand this -type of output.") +type of output." + :type 'string + :group 'ediff-diff) -(defvar ediff-custom-diff-program ediff-diff-program +(defcustom ediff-custom-diff-program ediff-diff-program "*Program to use for generating custom diff output for saving it in a file. -This output is not used by Ediff internally.") -(defvar ediff-custom-diff-options "-c" - "*Options to pass to `ediff-custom-diff-program'.") +This output is not used by Ediff internally." + :type 'string + :group 'ediff-diff) +(defcustom ediff-custom-diff-options "-c" + "*Options to pass to `ediff-custom-diff-program'." + :type 'string + :group 'ediff-diff) ;;; Support for diff3 (defvar ediff-match-diff3-line "^====\\(.?\\)$" "Pattern to match lines produced by diff3 that describe differences.") -(defvar ediff-diff3-program "diff3" +(defcustom ediff-diff3-program "diff3" "*Program to be used for three-way comparison. -Must produce output compatible with Unix's diff3 program.") -(defvar ediff-diff3-options "" - "*Options to pass to `ediff-diff3-program'.") -(defvar ediff-diff3-ok-lines-regexp +Must produce output compatible with Unix's diff3 program." + :type 'string + :group 'ediff-diff) +(defcustom ediff-diff3-options "" + "*Options to pass to `ediff-diff3-program'." + :type 'string + :group 'ediff-diff) +(defcustom ediff-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)" "*Regexp that matches normal output lines from `ediff-diff3-program'. -Lines that do not match are assumed to be error messages.") +Lines that do not match are assumed to be error messages." + :type 'regexp + :group 'ediff-diff) ;; keeps the status of the current diff in 3-way jobs. ;; the status can be =diff(A), =diff(B), or =diff(A+B) diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff-merg.el --- a/lisp/ediff/ediff-merg.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff-merg.el Mon Aug 13 09:30:11 2007 +0200 @@ -25,6 +25,12 @@ (provide 'ediff-merg) +(defgroup ediff-merge nil + "Merging utilities" + :prefix "ediff-" + :group 'ediff) + + ;; compiler pacifier (defvar ediff-window-A) (defvar ediff-window-B) @@ -44,11 +50,13 @@ (require 'ediff-init) -(defvar ediff-default-variant 'combined +(defcustom ediff-default-variant 'combined "*The variant to be used as a default for buffer C in merging. -Valid values are the symbols `default-A', `default-B', and `combined'.") +Valid values are the symbols `default-A', `default-B', and `combined'." + :type '(radio (const default-A) (const default-B) (const combined)) + :group 'ediff-merge) -(defvar ediff-combination-pattern +(defcustom ediff-combination-pattern '("<<<<<<<<<<<<<< variant A" ">>>>>>>>>>>>>> variant B" "======= end of combination") "*Pattern to be used for combining difference regions in buffers A and B. The value is (STRING1 STRING2 STRING3). The combined text will look like this: @@ -58,7 +66,9 @@ STRING2 diff region from variant B STRING3 -") +" + :type '(list string string string) + :group 'ediff-merge) (ediff-defvar-local ediff-show-clashes-only nil "*If t, show only those diff regions where both buffers disagree with the ancestor. diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff-mult.el --- a/lisp/ediff/ediff-mult.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff-mult.el Mon Aug 13 09:30:11 2007 +0200 @@ -92,6 +92,12 @@ (provide 'ediff-mult) +(defgroup ediff-mult nil + "Multi-file and multi-buffer processing in ediff" + :prefix "ediff-" + :group 'ediff) + + ;; compiler pacifier (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) @@ -163,22 +169,34 @@ ;; The registry of Ediff sessions. A list of control buffers. (defvar ediff-session-registry nil) -(defvar ediff-registry-setup-hook nil - "*Hooks run just after the registry control panel is set up.") -(defvar ediff-session-group-setup-hook nil +(defcustom ediff-registry-setup-hook nil + "*Hooks run just after the registry control panel is set up." + :type 'hook + :group 'ediff-mult) +(defcustom ediff-session-group-setup-hook nil "*Hooks run just after a meta-buffer controlling a session group, such as -ediff-directories, is run.") -(defvar ediff-quit-session-group-hook nil - "*Hooks run just before exiting a session group.") -(defvar ediff-show-registry-hook nil - "*Hooks run just after the registry buffer is shown.") -(defvar ediff-show-session-group-hook nil - "*Hooks run just after a session group buffer is shown.") -(defvar ediff-meta-buffer-keymap-setup-hook nil +ediff-directories, is run." + :type 'hook + :group 'ediff-mult) +(defcustom ediff-quit-session-group-hook nil + "*Hooks run just before exiting a session group." + :type 'hook + :group 'ediff-mult) +(defcustom ediff-show-registry-hook nil + "*Hooks run just after the registry buffer is shown." + :type 'hook + :group 'ediff-mult) +(defcustom ediff-show-session-group-hook nil + "*Hooks run just after a session group buffer is shown." + :type 'hook + :group 'ediff-mult) +(defcustom ediff-meta-buffer-keymap-setup-hook nil "*Hooks run just after setting up the ediff-meta-buffer-map. This keymap controls key bindings in the meta buffer and is a local variable. This means that you can set different bindings for different kinds of meta -buffers.") +buffers." + :type 'hook + :group 'ediff-mult) ;; buffer holding the multi-file patch. local to the meta buffer (ediff-defvar-local ediff-meta-patchbufer nil "") diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff-ptch.el --- a/lisp/ediff/ediff-ptch.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff-ptch.el Mon Aug 13 09:30:11 2007 +0200 @@ -26,6 +26,12 @@ (provide 'ediff-ptch) +(defgroup ediff-ptch nil + "Ediff patch support" + :tag "Patch" + :prefix "ediff-" + :group 'ediff) + ;; compiler pacifier (defvar ediff-window-A) (defvar ediff-window-B) @@ -53,7 +59,7 @@ "Backup extension used by the patch program. See also `ediff-backup-specs'.") -(defvar ediff-backup-specs (format "-b %s" ediff-backup-extension) +(defcustom ediff-backup-specs (format "-b %s" ediff-backup-extension) "*Backup directives to pass to the patch program. Ediff requires that the old version of the file \(before applying the patch\) is saved in a file named `the-patch-file.extension'. Usually `extension' is @@ -67,31 +73,41 @@ Note that both `ediff-backup-extension' and `ediff-backup-specs' must be properly set. If your patch program takes the option `-b', but not `-b extension', the variable `ediff-backup-extension' must -still be set so Ediff will know which extension to use.") +still be set so Ediff will know which extension to use." + :type 'string + :group 'ediff-ptch) -(defvar ediff-patch-default-directory nil - "*Default directory to look for patches.") +(defcustom ediff-patch-default-directory nil + "*Default directory to look for patches." + :type '(choice (const nil) string) + :group 'ediff-ptch) -(defvar ediff-context-diff-label-regexp +(defcustom ediff-context-diff-label-regexp (concat "\\(" ; context diff 2-liner "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)" "\\|" ; GNU unified format diff 2-liner "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)" "\\)") - "*Regexp matching filename 2-liners at the start of each context diff.") + "*Regexp matching filename 2-liners at the start of each context diff." + :type 'regexp + :group 'ediff-ptch) -(defvar ediff-patch-program "patch" +(defcustom ediff-patch-program "patch" "*Name of the program that applies patches. -It is recommended to use GNU-compatible versions.") -(defvar ediff-patch-options "-f" +It is recommended to use GNU-compatible versions." + :type 'string + :group 'ediff-ptch) +(defcustom ediff-patch-options "-f" "*Options to pass to ediff-patch-program. Note: the `-b' option should be specified in `ediff-backup-specs'. It is recommended to pass the `-f' option to the patch program, so it won't ask questions. However, some implementations don't accept this option, in which -case the default value for this variable should be changed.") +case the default value for this variable should be changed." + :type 'string + :group 'ediff-ptch) ;; The buffer of the patch file. Local to control buffer. (ediff-defvar-local ediff-patchbufer nil "") diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff-wind.el --- a/lisp/ediff/ediff-wind.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff-wind.el Mon Aug 13 09:30:11 2007 +0200 @@ -60,8 +60,14 @@ (defun ediff-compute-toolbar-width () 0))) (defun ediff-compute-toolbar-width () 0)) +(defgroup ediff-window nil + "Ediff window manipulation" + :prefix "ediff-" + :group 'ediff + :group 'frames) -(defvar ediff-window-setup-function (if (ediff-window-display-p) + +(defcustom ediff-window-setup-function (if (ediff-window-display-p) 'ediff-setup-windows-multiframe 'ediff-setup-windows-plain) "*Function called to set up windows. @@ -82,7 +88,9 @@ buffer-A, buffer-B, buffer-C, control-buffer Buffer C may not be used in jobs that compare only two buffers. If you plan to do something fancy, take a close look at how the two -provided functions are written.") +provided functions are written." + :type 'function + :group 'ediff-window) ;; indicates if we are in a multiframe setup (ediff-defvar-local ediff-multiframe nil "") @@ -103,21 +111,25 @@ (ediff-defvar-local ediff-window-config-saved "" "") -(defvar ediff-split-window-function 'split-window-vertically +(defcustom ediff-split-window-function 'split-window-vertically "*The function used to split the main window between buffer-A and buffer-B. You can set it to a horizontal split instead of the default vertical split by setting this variable to `split-window-horizontally'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B are shown in different frames. -In this case, Ediff will use those frames to display these buffers.") +In this case, Ediff will use those frames to display these buffers." + :type 'function + :group 'ediff-window) -(defvar ediff-merge-split-window-function 'split-window-horizontally +(defcustom ediff-merge-split-window-function 'split-window-horizontally "*The function used to split the main window between buffer-A and buffer-B. You can set it to a vertical split instead of the default horizontal split by setting this variable to `split-window-vertically'. You can also have your own function to do fancy splits. This variable has no effect when buffer-A/B/C are shown in different frames. -In this case, Ediff will use those frames to display these buffers.") +In this case, Ediff will use those frames to display these buffers." + :type 'function + :group 'ediff-window) (defconst ediff-control-frame-parameters (list @@ -152,40 +164,50 @@ (defvar ediff-mouse-pixel-threshold 30 "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.") -(defvar ediff-grab-mouse t +(defcustom ediff-grab-mouse t "*If t, Ediff will always grab the mouse and put it in the control frame. If 'maybe, Ediff will do it sometimes, but not after operations that require relatively long time. If nil, the mouse will be entirely user's -responsibility.") +responsibility." + :type 'boolean + :group 'ediff-window) -(defvar ediff-control-frame-position-function 'ediff-make-frame-position +(defcustom ediff-control-frame-position-function 'ediff-make-frame-position "Function to call to determine the desired location for the control panel. Expects three parameters: the control buffer, the desired width and height of the control frame. It returns an association list -of the form \(\(top . \) \(left . \)\)") +of the form \(\(top . \) \(left . \)\)" + :type 'boolean + :group 'ediff-window) -(defvar ediff-control-frame-upward-shift (if ediff-xemacs-p 42 14) +(defcustom ediff-control-frame-upward-shift (if ediff-xemacs-p 42 14) "*The upward shift of control frame from the top of buffer A's frame. Measured in pixels. This is used by the default control frame positioning function, `ediff-make-frame-position'. This variable is provided for easy -customization of the default.") +customization of the default." + :type 'integer + :group 'ediff-window) -(defvar ediff-narrow-control-frame-leftward-shift (if ediff-xemacs-p 7 3) +(defcustom ediff-narrow-control-frame-leftward-shift (if ediff-xemacs-p 7 3) "*The leftward shift of control frame from the right edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the short menu. This variable is provided for easy -customization of the default.") +customization of the default." + :type 'integer + :group 'ediff-window) -(defvar ediff-wide-control-frame-rightward-shift 7 +(defcustom ediff-wide-control-frame-rightward-shift 7 "*The rightward shift of control frame from the left edge of buf A's frame. Measured in characters. This is used by the default control frame positioning function, `ediff-make-frame-position' to adjust the position of the control frame when it shows the full menu. This variable is provided for easy -customization of the default.") +customization of the default." + :type 'integer + :group 'ediff-window) ;; Wide frame display @@ -209,7 +231,7 @@ ;; Frame used for the control panel in a windowing system. (ediff-defvar-local ediff-control-frame nil "") -(defvar ediff-prefer-iconified-control-frame nil +(defcustom ediff-prefer-iconified-control-frame nil "*If t, keep control panel iconified when help message is off. This has effect only on a windowing system. If t, hitting `?' to toggle control panel off iconifies it. @@ -217,7 +239,9 @@ This is only useful in Emacs and only for certain kinds of window managers, such as TWM and its derivatives, since the window manager must permit keyboard input to go into icons. XEmacs completely ignores keyboard input -into icons, regardless of the window manager.") +into icons, regardless of the window manager." + :type 'boolean + :group 'ediff-window) ;;; Functions diff -r b27e67717092 -r 34a5b81f86ba lisp/ediff/ediff.el --- a/lisp/ediff/ediff.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/ediff/ediff.el Mon Aug 13 09:30:11 2007 +0200 @@ -130,9 +130,16 @@ (require 'ediff-init) (require 'ediff-mult) ; required because of the registry stuff -(defvar ediff-use-last-dir nil - "*If t, Ediff uses previous directory as default when reading file name.") - +(defgroup ediff nil + "A comprehensive visual interface to diff & patch" + :group 'tools) + + +(defcustom ediff-use-last-dir nil + "*If t, Ediff uses previous directory as default when reading file name." + :type 'boolean + :group 'ediff) + (defvar ediff-last-dir-A nil "Last directory used by an Ediff command for file-A.") (defvar ediff-last-dir-B nil diff -r b27e67717092 -r 34a5b81f86ba lisp/egg/egg.el --- a/lisp/egg/egg.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/egg/egg.el Mon Aug 13 09:30:11 2007 +0200 @@ -408,7 +408,9 @@ (if (and (key-press-event-p event) (eq 0 (event-modifier-bits event))) (setq ch (event-key event)) - (setq unread-command-events (list event))) + (if (eq 1 (event-modifier-bits event)) + (setq ch (int-to-char (- (char-to-int (event-key event)) 96))) + (setq unread-command-events (list event)))) ch)) (eval-when-compile (require 'egg-jsymbol)) @@ -697,13 +699,13 @@ (menu:select-goto-menu (1- menu:*select-menu-no*))) ((eq ch ?\C-l) ;;; redraw menu (menu:select-goto-menu menu:*select-menu-no*)) - ((and (numberp ch) (<= ?0 ch) (<= ch ?9) + ((and (characterp ch) (<= ?0 ch) (<= ch ?9) (<= ch (+ ?0 (1- (length menu:*select-items*))))) (menu:select-goto-item (- ch ?0))) - ((and (numberp ch) (<= ?a ch) (<= ch ?z) + ((and (characterp ch) (<= ?a ch) (<= ch ?z) (<= (+ 10 ch) (+ ?a (1- (length menu:*select-items*))))) (menu:select-goto-item (+ 10 (- ch ?a)))) - ((and (numberp ch) (<= ?A ch) (<= ch ?Z) + ((and (characterp ch) (<= ?A ch) (<= ch ?Z) (<= (+ 10 ch) (+ ?A (1- (length menu:*select-items*))))) (menu:select-goto-item (+ 10 (- ch ?A)))) ((or (eq ch ?\C-m) (eq ch 'return)) diff -r b27e67717092 -r 34a5b81f86ba lisp/emulators/tpu-edt.el --- a/lisp/emulators/tpu-edt.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/emulators/tpu-edt.el Mon Aug 13 09:30:11 2007 +0200 @@ -7,6 +7,8 @@ ;; Version: 4.2 ;; Keywords: emulations +;; Modified for XEmacs by R. Kevin Oberman + ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it @@ -215,8 +217,8 @@ ;; ; Repeat the preceding mappings for X-windows. ;; (cond ;; (window-system -;; (global-set-key [kp-7] 'tpu-paragraph) ; KP7 -;; (define-key GOLD-map [kp-f1] 'universal-argument))) ; GOLD-PF1 +;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7 +;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1 ;; ; Display the TPU-edt version. ;; (tpu-version) @@ -524,6 +526,7 @@ (defun tpu-show-match-markers nil "Show the values of the match markers." (interactive) + (setq zmacs-region-stays t) (if (markerp tpu-match-beginning-mark) (let ((beg (marker-position tpu-match-beginning-mark))) (message "(%s, %s) in %s -- current %s in %s" @@ -607,12 +610,14 @@ (defun tpu-drop-breadcrumb (num) "Drops a breadcrumb that can be returned to later with goto-breadcrumb." (interactive "p") + (setq zmacs-region-stays t) (put tpu-breadcrumb-plist num (list (current-buffer) (point))) (message "Mark %d set." num)) (defun tpu-goto-breadcrumb (num) "Returns to a breadcrumb set with drop-breadcrumb." (interactive "p") + (setq zmacs-region-stays t) (cond ((get tpu-breadcrumb-plist num) (switch-to-buffer (car (get tpu-breadcrumb-plist num))) (goto-char (tpu-cadr (get tpu-breadcrumb-plist num))) @@ -665,6 +670,7 @@ (defun tpu-version nil "Print the TPU-edt version number." (interactive) + (setq zmacs-region-stays t) (message "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)" tpu-version)) @@ -672,12 +678,14 @@ (defun tpu-reset-screen-size (height width) "Sets the screen size." (interactive "nnew screen height: \nnnew screen width: ") + (setq zmacs-region-stays t) (set-screen-height height) (set-screen-width width)) (defun tpu-toggle-newline-and-indent nil "Toggle between 'newline and indent' and 'simple newline'." (interactive) + (setq zmacs-region-stays t) (cond (tpu-newline-and-indent-p (setq tpu-newline-and-indent-string "") (setq tpu-newline-and-indent-p nil) @@ -704,6 +712,7 @@ (defun tpu-toggle-overwrite-mode nil "Switches in and out of overwrite mode" (interactive) + (setq zmacs-region-stays t) (cond (overwrite-mode (tpu-local-set-key "\177" tpu-saved-delete-func) (overwrite-mode 0)) @@ -716,6 +725,7 @@ "Insert a character or control code according to its ASCII decimal value." (interactive "P") + (setq zmacs-region-stays t) (if overwrite-mode (delete-char 1)) (insert (if num num 0))) @@ -723,6 +733,7 @@ "Read next input character and insert it. This is useful for inserting control characters." (interactive "*p") + (setq zmacs-region-stays t) (let ((char (read-char)) ) (if overwrite-mode (delete-char num)) (insert-char char num))) @@ -734,6 +745,7 @@ (defun tpu-include (file) "TPU-like include file" (interactive "fInclude file: ") + (setq zmacs-region-stays t) (save-excursion (insert-file file) (message ""))) @@ -741,12 +753,14 @@ (defun tpu-get (file) "TPU-like get file" (interactive "FFile to get: ") + (setq zmacs-region-stays t) (find-file file)) (defun tpu-what-line nil "Tells what line the point is on, and the total number of lines in the buffer." (interactive) + (setq zmacs-region-stays t) (if (eobp) (message "You are at the End of Buffer. The last line is %d." (count-lines 1 (point-max))) @@ -935,6 +949,7 @@ (defun tpu-help nil "Display TPU-edt help." (interactive) + (setq zmacs-region-stays t) ;; Save current window configuration (save-window-excursion ;; Create and fill help buffer if necessary @@ -1007,11 +1022,13 @@ (defun tpu-insert-escape nil "Inserts an escape character, and so becomes the escape-key alias." (interactive) + (setq zmacs-region-stays t) (insert "\e")) (defun tpu-insert-formfeed nil "Inserts a formfeed character." (interactive) + (setq zmacs-region-stays t) (insert "\C-L")) @@ -1023,6 +1040,7 @@ (defun tpu-end-define-macro-key (key) "Ends the current macro definition" (interactive "kPress the key you want to use to do what was just learned: ") + (setq zmacs-region-stays t) (end-kbd-macro nil) (global-set-key key last-kbd-macro) (global-set-key "\C-r" tpu-saved-control-r)) @@ -1030,6 +1048,7 @@ (defun tpu-define-macro-key nil "Bind a set of keystrokes to a single key, or key combination." (interactive) + (setq zmacs-region-stays t) (setq tpu-saved-control-r (global-key-binding "\C-r")) (global-set-key "\C-r" 'tpu-end-define-macro-key) (start-kbd-macro nil)) @@ -1054,6 +1073,7 @@ (defun tpu-write-current-buffers nil "Save all modified buffers without exiting." (interactive) + (setq zmacs-region-stays t) (save-some-buffers t)) (defun tpu-next-buffer nil @@ -1079,12 +1099,14 @@ (defun tpu-next-window nil "Move to the next window." (interactive) + (setq zmacs-region-stays t) (if (one-window-p) (message "There is only one window on screen.") (other-window 1))) (defun tpu-previous-window nil "Move to the previous window." (interactive) + (setq zmacs-region-stays t) (if (one-window-p) (message "There is only one window on screen.") (select-window (previous-window)))) @@ -1095,6 +1117,7 @@ (defun tpu-toggle-regexp nil "Switches in and out of regular expression search and replace mode." (interactive) + (setq zmacs-region-stays t) (setq tpu-regexp-p (not tpu-regexp-p)) (tpu-set-search) (and (interactive-p) @@ -1112,6 +1135,7 @@ "Search for a string or regular expression. The search is performed in the current direction." (interactive) + (setq zmacs-region-stays t) (tpu-set-search) (tpu-search-internal "")) @@ -1119,6 +1143,7 @@ "Search for a string or regular expression. The search is begins in the forward direction." (interactive) + (setq zmacs-region-stays t) (setq tpu-searching-forward t) (tpu-set-search t) (tpu-search-internal "")) @@ -1127,6 +1152,7 @@ "Search for a string or regular expression. The search is begins in the reverse direction." (interactive) + (setq zmacs-region-stays t) (setq tpu-searching-forward nil) (tpu-set-search t) (tpu-search-internal "")) @@ -1135,6 +1161,7 @@ "Search for the same string or regular expression as last time. The search is performed in the current direction." (interactive) + (setq zmacs-region-stays t) (tpu-search-internal tpu-search-last-string)) ;; tpu-set-search defines the search functions used by the TPU-edt internal @@ -1231,6 +1258,7 @@ "Toggle the TPU-edt search direction. Used for reversing a search in progress." (interactive) + (setq zmacs-region-stays t) (setq tpu-searching-forward (not tpu-searching-forward)) (tpu-set-search t) (and (interactive-p) @@ -1240,6 +1268,7 @@ (defun tpu-search-forward-exit nil "Set search direction forward and exit minibuffer." (interactive) + (setq zmacs-region-stays t) (setq tpu-searching-forward t) (tpu-set-search t) (exit-minibuffer)) @@ -1247,6 +1276,7 @@ (defun tpu-search-backward-exit nil "Set search direction backward and exit minibuffer." (interactive) + (setq zmacs-region-stays t) (setq tpu-searching-forward nil) (tpu-set-search t) (exit-minibuffer)) @@ -1280,6 +1310,7 @@ (defun tpu-toggle-rectangle nil "Toggle rectangular mode for remove and insert." (interactive) + (setq zmacs-region-stays t) (setq tpu-rectangular-p (not tpu-rectangular-p)) (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) (tpu-update-mode-line) @@ -1335,6 +1366,7 @@ "Copy the selected region to the cut buffer without deleting it. The text is saved for the tpu-paste command." (interactive) + (setq zmacs-region-stays t) (cond ((tpu-mark) (cond (tpu-rectangular-p (save-excursion @@ -1385,6 +1417,7 @@ This includes the newline character at the end of each line. They are saved for the TPU-edt undelete-lines command." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (forward-line num) (if (not (eq (preceding-char) ?\n)) @@ -1398,6 +1431,7 @@ With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (forward-char 1) (end-of-line num) @@ -1410,6 +1444,7 @@ With argument, delete up to to Nth line-end past point. They are saved for the TPU-edt undelete-lines command." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (tpu-next-beginning-of-line num) (setq tpu-last-deleted-lines @@ -1420,6 +1455,7 @@ "Delete one or specified number of words after point. They are saved for the TPU-edt undelete-words command." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (tpu-forward-to-word num) (setq tpu-last-deleted-words @@ -1430,6 +1466,7 @@ "Delete one or specified number of words before point. They are saved for the TPU-edt undelete-words command." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (tpu-backward-to-word num) (setq tpu-last-deleted-words @@ -1440,6 +1477,7 @@ "Delete one or specified number of characters after point. The last character deleted is saved for the TPU-edt undelete-char command." (interactive "p") + (setq zmacs-region-stays t) (while (and (> num 0) (not (eobp))) (setq tpu-last-deleted-char (char-after (point))) (cond (overwrite-mode @@ -1457,6 +1495,7 @@ "Insert the last region or rectangle of killed text. With argument reinserts the text that many times." (interactive "p") + (setq zmacs-region-stays t) (while (> num 0) (cond (tpu-rectangular-p (let ((beg (point))) @@ -1472,6 +1511,7 @@ "Insert lines deleted by last TPU-edt line-deletion command. With argument reinserts lines that many times." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (while (> num 0) (insert tpu-last-deleted-lines) @@ -1482,6 +1522,7 @@ "Insert words deleted by last TPU-edt word-deletion command. With argument reinserts words that many times." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (point))) (while (> num 0) (insert tpu-last-deleted-words) @@ -1492,6 +1533,7 @@ "Insert character deleted by last TPU-edt character-deletion command. With argument reinserts the character that many times." (interactive "p") + (setq zmacs-region-stays t) (while (> num 0) (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) (insert tpu-last-deleted-char) @@ -1613,6 +1655,7 @@ or each line in the entire buffer if no region is selected." (interactive (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist))) + (setq zmacs-region-stays t) (if (string= "" text) (error "No string specified.")) (cond ((tpu-mark) (save-excursion @@ -1631,6 +1674,7 @@ or each line of the entire buffer if no region is selected." (interactive (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) + (set zmacs-region-stays t) (if (string= "" text) (error "No string specified.")) (cond ((tpu-mark) (save-excursion @@ -1649,6 +1693,7 @@ (defun tpu-trim-line-ends nil "Removes trailing whitespace from every line in the buffer." (interactive) + (setq zmacs-region-stays t) (picture-clean)) @@ -1659,16 +1704,19 @@ "Move to the next character in the current direction. A repeat count means move that many characters." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-forward-char num) (tpu-backward-char num))) (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (forward-char num)) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (backward-char num)) @@ -1685,12 +1733,14 @@ "Move to the beginning of the next word in the current direction. A repeat count means move that many words." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num))) (defun tpu-forward-to-word (num) "Move forward until encountering the beginning of a word. With argument, do this that many times." (interactive "p") + (setq zmacs-region-stays t) (while (and (> num 0) (not (eobp))) (let* ((beg (point)) (end (prog2 (end-of-line) (point) (goto-char beg)))) @@ -1708,6 +1758,7 @@ "Move backward until encountering the beginning of a word. With argument, do this that many times." (interactive "p") + (setq zmacs-region-stays t) (while (and (> num 0) (not (bobp))) (let* ((beg (point)) (end (prog2 (beginning-of-line) (point) (goto-char beg)))) @@ -1725,6 +1776,7 @@ (defun tpu-add-word-separators (separators) "Add new word separators for TPU-edt word commands." (interactive "sSeparators: ") + (setq zmacs-region-stays t) (let* ((n 0) (length (length separators))) (while (< n length) (let ((char (aref separators n)) @@ -1745,12 +1797,14 @@ (defun tpu-reset-word-separators nil "Reset word separators to default value." (interactive) + (setq zmacs-region-stays t) (setq tpu-word-separator-list nil) (setq tpu-skip-chars "^ \t")) (defun tpu-set-word-separators (separators) "Set new word separators for TPU-edt word commands." (interactive "sSeparators: ") + (setq zmacs-region-stays t) (tpu-reset-word-separators) (tpu-add-word-separators separators)) @@ -1762,6 +1816,7 @@ "Move to next line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (next-line-internal num) (setq this-command 'next-line)) @@ -1769,6 +1824,7 @@ "Move to previous line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (next-line-internal (- num)) (setq this-command 'previous-line)) @@ -1776,6 +1832,7 @@ "Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (backward-char 1) (forward-line (- 1 num))) @@ -1783,12 +1840,14 @@ "Move to the next end of line in the current direction. A repeat count means move that many lines." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num))) (defun tpu-next-end-of-line (num) "Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (forward-char 1) (end-of-line num)) @@ -1796,11 +1855,13 @@ "Move EOL upward. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (end-of-line (- 1 num))) (defun tpu-current-end-of-line nil "Move point to end of current line." (interactive) + (setq zmacs-region-stays t) (let ((beg (point))) (end-of-line) (if (= beg (point)) (message "You are already at the end of a line.")))) @@ -1809,18 +1870,21 @@ "Move to the beginning of the next line in the current direction. A repeat count means move that many lines." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-forward-line num) (tpu-backward-line num))) (defun tpu-forward-line (num) "Move to beginning of next line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (forward-line num)) (defun tpu-backward-line (num) "Move to beginning of previous line. Prefix argument serves as repeat count." (interactive "p") + (setq zmacs-region-stays t) (or (bolp) (>= 0 num) (setq num (- num 1))) (forward-line (- num))) @@ -1832,6 +1896,7 @@ "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-next-paragraph num) (tpu-previous-paragraph num))) @@ -1839,6 +1904,7 @@ "Move to beginning of the next paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") + (setq zmacs-region-stays t) (beginning-of-line) (while (and (not (eobp)) (> num 0)) (if (re-search-forward "^[ \t]*$" nil t) @@ -1853,6 +1919,7 @@ "Move to beginning of previous paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") + (setq zmacs-region-stays t) (end-of-line) (while (and (not (bobp)) (> num 0)) (if (not (and (re-search-backward "^[ \t]*$" nil t) @@ -1872,6 +1939,7 @@ "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (forward-page num) (backward-page num)) (if (eobp) (recenter -1))) @@ -1883,12 +1951,14 @@ "Scroll the display to the next section in the current direction. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num))) (defun tpu-scroll-window-down (num) "Scroll the display down to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -1899,6 +1969,7 @@ "Scroll the display up to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -1909,28 +1980,33 @@ "Pan right tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." (interactive "p") + (setq zmacs-region-stays t) (scroll-left (* tpu-pan-columns num))) (defun tpu-pan-left (num) "Pan left tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." (interactive "p") + (setq zmacs-region-stays t) (scroll-right (* tpu-pan-columns num))) (defun tpu-move-to-beginning nil "Move cursor to the beginning of buffer, but don't set the mark." (interactive) + (setq zmacs-region-stays t) (goto-char (point-min))) (defun tpu-move-to-end nil "Move cursor to the end of buffer, but don't set the mark." (interactive) + (setq zmacs-region-stays t) (goto-char (point-max)) (recenter -1)) (defun tpu-goto-percent (perc) "Move point to ARG percentage of the buffer." (interactive "NGoto-percentage: ") + (setq zmacs-region-stays t) (if (or (> perc 100) (< perc 0)) (error "Percentage %d out of range 0 < percent < 100" perc) (goto-char (/ (* (point-max) perc) 100)))) @@ -1938,21 +2014,25 @@ (defun tpu-beginning-of-window nil "Move cursor to top of window." (interactive) + (setq zmacs-region-stays t) (move-to-window-line 0)) (defun tpu-end-of-window nil "Move cursor to bottom of window." (interactive) + (setq zmacs-region-stays t) (move-to-window-line -1)) (defun tpu-line-to-bottom-of-window nil "Move the current line to the bottom of the window." (interactive) + (setq zmacs-region-stays t) (recenter -1)) (defun tpu-line-to-top-of-window nil "Move the current line to the top of the window." (interactive) + (setq zmacs-region-stays t) (recenter 0)) @@ -1962,6 +2042,7 @@ (defun tpu-advance-direction nil "Set TPU Advance mode so keypad commands move forward." (interactive) + (setq zmacs-region-stays t) (setq tpu-direction-string " Advance") (setq tpu-advance t) (setq tpu-reverse nil) @@ -1971,6 +2052,7 @@ (defun tpu-backup-direction nil "Set TPU Backup mode so keypad commands move backward." (interactive) + (setq zmacs-region-stays t) (setq tpu-direction-string " Reverse") (setq tpu-advance nil) (setq tpu-reverse t) @@ -2250,7 +2332,7 @@ ;;; -;;; Minibuffer map additions to make KP-enter = RET +;;; Minibuffer map additions to make KP_enter = RET ;;; (define-key minibuffer-local-map "\eOM" 'exit-minibuffer) (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer) @@ -2316,6 +2398,7 @@ (defun tpu-toggle-control-keys nil "Toggles control key bindings between TPU-edt and Emacs." (interactive) + (setq zmacs-region-stays t) (tpu-reset-control-keys (not tpu-control-keys)) (and (interactive-p) (message "Control keys function with %s bindings." @@ -2328,18 +2411,21 @@ (defun tpu-next-history-element (n) "Insert the next element of the minibuffer history into the minibuffer." (interactive "p") + (setq zmacs-region-stays t) (next-history-element n) (goto-char (point-max))) (defun tpu-previous-history-element (n) "Insert the previous element of the minibuffer history into the minibuffer." (interactive "p") + (setq zmacs-region-stays t) (previous-history-element n) (goto-char (point-max))) (defun tpu-arrow-history nil "Modify minibuffer maps to use arrows for history recall." (interactive) + (setq zmacs-region-stays t) (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil)) (while (setq cur (car loc)) (define-key read-expression-map cur 'tpu-previous-history-element) @@ -2367,6 +2453,7 @@ If FILE is nil, try to load a default file. The default file names are `~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs." (interactive "fX key definition file: ") + (setq zmacs-region-stays t) (cond (file (setq file (expand-file-name file))) (tpu-xkeys-file @@ -2419,6 +2506,7 @@ (defun tpu-copy-keyfile (oldname newname) "Copy the TPU-edt X key definitions file to the new default name." (interactive "fOld name: \nFNew name: ") + (setq zmacs-region-stays t) (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*")) (set-buffer "*TPU-Notice*") (erase-buffer) diff -r b27e67717092 -r 34a5b81f86ba lisp/eterm/term.el --- a/lisp/eterm/term.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/eterm/term.el Mon Aug 13 09:30:11 2007 +0200 @@ -86,6 +86,12 @@ (require 'ring) (require 'ehelp) + +(defgroup term nil + "General command interpreter in a window" + :group 'processes + :group 'unix) + ;;; Buffer Local Variables: ;;;============================================================================ @@ -156,8 +162,10 @@ (defvar term-pager-old-local-map nil) ;; Saves old keymap while paging. (defvar term-pager-old-filter) ;; Saved process-filter while paging. -(defvar explicit-shell-file-name nil - "*If non-nil, is file name to use for explicitly requested inferior shell.") +(defcustom explicit-shell-file-name nil + "*If non-nil, is file name to use for explicitly requested inferior shell." + :type '(choice (const nil) file) + :group 'term) (defvar term-prompt-regexp "^" "Regexp to recognise prompts in the inferior process. @@ -184,7 +192,7 @@ This is a good thing to set in mode hooks.") -(defvar term-input-autoexpand nil +(defcustom term-input-autoexpand nil "*If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). @@ -193,21 +201,27 @@ into the buffer's input ring. See also `term-magic-space' and `term-dynamic-complete'. -This variable is buffer-local.") +This variable is buffer-local." + :type '(choice (const nil) (const t) (const input) (const history)) + :group 'term) -(defvar term-input-ignoredups nil +(defcustom term-input-ignoredups nil "*If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'term) -(defvar term-input-ring-file-name nil +(defcustom term-input-ring-file-name nil "*If non-nil, name of the file to read/write input history. See also `term-read-input-ring' and `term-write-input-ring'. -This variable is buffer-local, and is a good thing to set in mode hooks.") +This variable is buffer-local, and is a good thing to set in mode hooks." + :type 'boolean + :group 'term) -(defvar term-scroll-to-bottom-on-output nil +(defcustom term-scroll-to-bottom-on-output nil "*Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. @@ -216,14 +230,18 @@ The default is nil. See variable `term-scroll-show-maximum-output'. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'term) -(defvar term-scroll-show-maximum-output nil +(defcustom term-scroll-show-maximum-output nil "*Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `term-scroll-to-bottom-on-output'. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'term) ;; Where gud-display-frame should put the debugging arrow. This is ;; set by the marker-filter, which scans the debugger's output for @@ -265,20 +283,26 @@ the user command term-send-input. term-simple-send just sends the string plus a newline.") -(defvar term-eol-on-send t +(defcustom term-eol-on-send t "*Non-nil means go to the end of the line before sending input. -See `term-send-input'.") +See `term-send-input'." + :type 'boolean + :group 'term) -(defvar term-mode-hook '() +(defcustom term-mode-hook '() "Called upon entry into term-mode -This is run before the process is cranked up.") +This is run before the process is cranked up." + :type 'hook + :group 'term) -(defvar term-exec-hook '() +(defcustom term-exec-hook '() "Called each time a process is exec'd by term-exec. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a term-mode buffer (e.g., (process-kill-without-query)). In contrast, the term-mode-hook is only -executed once when the buffer is created.") +executed once when the buffer is created." + :type 'hook + :group 'term) (defvar term-mode-map nil) (defvar term-raw-map nil diff -r b27e67717092 -r 34a5b81f86ba lisp/mh-e/mh-comp.el --- a/lisp/mh-e/mh-comp.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/mh-e/mh-comp.el Mon Aug 13 09:30:11 2007 +0200 @@ -25,7 +25,7 @@ ;;; Change Log: -;; $Id: mh-comp.el,v 1.1.1.1 1996/12/18 22:43:20 steve Exp $ +;; $Id: mh-comp.el,v 1.2 1997/04/19 23:21:00 steve Exp $ ;;; Code: @@ -34,6 +34,12 @@ ;;; Site customization (see also mh-utils.el): +(defgroup mh-compose nil + "Mh-e functions for composing messages" + :prefix "mh-" + :group 'mh) + + (defvar mh-send-prog "send" "Name of the MH send program. Some sites need to change this because of a name conflict.") @@ -80,37 +86,51 @@ ;;; Personal preferences: -(defvar mh-delete-yanked-msg-window nil +(defcustom mh-delete-yanked-msg-window nil "*Controls window display when a message is yanked by \\\\[mh-yank-cur-msg]. If non-nil, yanking the current message into a draft letter deletes any -windows displaying the message.") +windows displaying the message." + :type 'boolean + :group 'mh-compose) -(defvar mh-yank-from-start-of-msg t +(defcustom mh-yank-from-start-of-msg t "*Controls which part of a message is yanked by \\\\[mh-yank-cur-msg]. If non-nil, include the entire message. If the symbol `body', then yank the message minus the header. If nil, yank only the portion of the message following the point. If the show buffer has a region, this variable is -ignored.") +ignored." + :type '(choice (const t) (const nil) (const body)) + :group 'mh-compose) -(defvar mh-ins-buf-prefix "> " +(defcustom mh-ins-buf-prefix "> " "*String to put before each non-blank line of a yanked or inserted message. \\Used when the message is inserted into an outgoing letter -by \\[mh-insert-letter] or \\[mh-yank-cur-msg].") +by \\[mh-insert-letter] or \\[mh-yank-cur-msg]." + :type 'string + :group 'mh-compose) -(defvar mh-reply-default-reply-to nil +(defcustom mh-reply-default-reply-to nil "*Sets the person or persons to whom a reply will be sent. If nil, prompt for recipient. If non-nil, then \\`\\[mh-reply]' will use this value and it should be one of \"from\", \"to\", \"cc\", or \"all\". -The values \"cc\" and \"all\" do the same thing.") +The values \"cc\" and \"all\" do the same thing." + :type '(choice (const :tag "Prompt" nil) + (const "from") (const "to") + (const "cc") (const "all")) + :group 'mh-compose) -(defvar mh-signature-file-name "~/.signature" +(defcustom mh-signature-file-name "~/.signature" "*Name of file containing the user's signature. -Inserted into message by \\\\[mh-insert-signature].") +Inserted into message by \\\\[mh-insert-signature]." + :type 'file + :group 'mh-compose) -(defvar mh-forward-subject-format "%s: %s" +(defcustom mh-forward-subject-format "%s: %s" "*Format to generate the Subject: line contents for a forwarded message. The two string arguments to the format are the sender of the original -message and the original subject line.") +message and the original subject line." + :type 'string + :group 'mh-compose) (defvar mh-comp-formfile "components" "Name of file to be used as a skeleton for composing messages. @@ -126,15 +146,21 @@ ;;; Hooks: -(defvar mh-letter-mode-hook nil - "Invoked in `mh-letter-mode' on a new letter.") +(defcustom mh-letter-mode-hook nil + "Invoked in `mh-letter-mode' on a new letter." + :type 'hook + :group 'mh-compose) -(defvar mh-compose-letter-function nil +(defcustom mh-compose-letter-function nil "Invoked when setting up a letter draft. -It is passed three arguments: TO recipients, SUBJECT, and CC recipients.") +It is passed three arguments: TO recipients, SUBJECT, and CC recipients." + :type 'function + :group 'mh-compose) -(defvar mh-before-send-letter-hook nil - "Invoked at the beginning of the \\\\[mh-send-letter] command.") +(defcustom mh-before-send-letter-hook nil + "Invoked at the beginning of the \\\\[mh-send-letter] command." + :type 'hook + :group 'mh-compose) (defvar mh-rejected-letter-start diff -r b27e67717092 -r 34a5b81f86ba lisp/mh-e/mh-e.el --- a/lisp/mh-e/mh-e.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/mh-e/mh-e.el Mon Aug 13 09:30:11 2007 +0200 @@ -63,7 +63,7 @@ ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu -(defconst mh-e-RCS-id "$Id: mh-e.el,v 1.1.1.1 1996/12/18 22:43:21 steve Exp $") +(defconst mh-e-RCS-id "$Id: mh-e.el,v 1.2 1997/04/19 23:21:00 steve Exp $") ;;; Code: @@ -73,67 +73,108 @@ ;;; Hooks: -(defvar mh-folder-mode-hook nil - "Invoked in MH-Folder mode on a new folder.") +(defgroup mh nil + "Emacs interface to the MH mail system" + :group 'mail) -(defvar mh-inc-folder-hook nil - "Invoked by \\`\\[mh-inc-folder]' after incorporating mail into a folder.") +(defgroup mh-hook nil + "Hooks to mh-e mode" + :prefix "mh-" + :group 'mh) + -(defvar mh-show-hook nil - "Invoked after \\`\\[mh-show]' shows a message.") +(defcustom mh-folder-mode-hook nil + "Invoked in MH-Folder mode on a new folder." + :type 'hook + :group 'mh-hook) -(defvar mh-show-mode-hook nil - "Invoked in MH-Show mode on each message.") +(defcustom mh-inc-folder-hook nil + "Invoked by \\`\\[mh-inc-folder]' after incorporating mail into a folder." + :type 'hook + :group 'mh-hook) + +(defcustom mh-show-hook nil + "Invoked after \\`\\[mh-show]' shows a message." + :type 'hook + :group 'mh-hook) -(defvar mh-delete-msg-hook nil - "Invoked after marking each message for deletion.") +(defcustom mh-show-mode-hook nil + "Invoked in MH-Show mode on each message." + :type 'hook + :group 'mh-hook) -(defvar mh-refile-msg-hook nil - "Invoked after marking each message for refiling.") +(defcustom mh-delete-msg-hook nil + "Invoked after marking each message for deletion." + :type 'hook + :group 'mh-hook) -(defvar mh-before-quit-hook nil - "Invoked by \\`\\[mh-quit]' before quitting mh-e. See also mh-quit-hook.") +(defcustom mh-refile-msg-hook nil + "Invoked after marking each message for refiling." + :type 'hook + :group 'mh-hook) -(defvar mh-quit-hook nil - "Invoked after \\`\\[mh-quit]' quits mh-e. See also mh-before-quit-hook.") +(defcustom mh-before-quit-hook nil + "Invoked by \\`\\[mh-quit]' before quitting mh-e. See also mh-quit-hook." + :type 'hook + :group 'mh-hook) + +(defcustom mh-quit-hook nil + "Invoked after \\`\\[mh-quit]' quits mh-e. See also mh-before-quit-hook." + :type 'hook + :group 'mh-hook) ;;; Personal preferences: -(defvar mh-lpr-command-format "lpr -J '%s'" +(defcustom mh-lpr-command-format "lpr -J '%s'" "*Format for Unix command that prints a message. The string should be a Unix command line, with the string '%s' where the job's name (folder and message number) should appear. The formatted -message text is piped to this command when you type \\`\\[mh-print-msg]'.") +message text is piped to this command when you type \\`\\[mh-print-msg]'." + :type 'string + :group 'mh) -(defvar mh-scan-prog "scan" +(defcustom mh-scan-prog "scan" "*Program to run to generate one-line-per-message listing of a folder. Normally \"scan\" or a file name linked to scan. This file is searched for relative to the mh-progs directory unless it is an absolute pathname. -Automatically becomes buffer-local when set in any fashion.") +Automatically becomes buffer-local when set in any fashion." + :type 'string + :group 'mh) (make-variable-buffer-local 'mh-scan-prog) -(defvar mh-inc-prog "inc" +(defcustom mh-inc-prog "inc" "*Program to run to incorporate new mail into a folder. Normally \"inc\". This file is searched for relative to -the mh-progs directory unless it is an absolute pathname.") +the mh-progs directory unless it is an absolute pathname." + :type 'string + :group 'mh) -(defvar mh-print-background nil +(defcustom mh-print-background nil "*Print messages in the background if non-nil. WARNING: do not delete the messages until printing is finished; -otherwise, your output may be truncated.") +otherwise, your output may be truncated." + :type 'boolean + :group 'mh) -(defvar mh-recenter-summary-p nil - "*Recenter summary window when the show window is toggled off if non-nil.") +(defcustom mh-recenter-summary-p nil + "*Recenter summary window when the show window is toggled off if non-nil." + :type 'boolean + :group 'mh) -(defvar mh-do-not-confirm nil +(defcustom mh-do-not-confirm nil "*Non-nil means do not prompt for confirmation before some mh-e commands. -Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder.") +Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder." + :type 'boolean + :group 'mh) -(defvar mh-store-default-directory nil +(defcustom mh-store-default-directory nil "*Last directory used by \\[mh-store-msg]; default for next store. -A directory name string, or nil to use current directory.") +A directory name string, or nil to use current directory." + :type '(choice (const :tag "Current" nil) + directory) + :group 'mh) ;;; Parameterize mh-e to work with different scan formats. The defaults work ;;; with the standard MH scan listings, in which the first 4 characters on diff -r b27e67717092 -r 34a5b81f86ba lisp/mh-e/mh-utils.el --- a/lisp/mh-e/mh-utils.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/mh-e/mh-utils.el Mon Aug 13 09:30:11 2007 +0200 @@ -28,7 +28,7 @@ ;;; Change Log: -;; $Id: mh-utils.el,v 1.1.1.1 1996/12/18 22:43:21 steve Exp $ +;; $Id: mh-utils.el,v 1.2 1997/04/19 23:21:01 steve Exp $ ;;; Code: @@ -53,23 +53,37 @@ ;;; User preferences: -(defvar mh-auto-folder-collect t +(defgroup mh-buffer nil + "Layout of MH-E buffers" + :prefix "mh-" + :group 'mh) + + +(defcustom mh-auto-folder-collect t "*Whether to start collecting MH folder names immediately in the background. Non-nil means start a background process collecting the names of all -folders as soon as mh-e is loaded.") +folders as soon as mh-e is loaded." + :type 'boolean + :group 'mh) -(defvar mh-recursive-folders nil - "*If non-nil, then commands which operate on folders do so recursively.") +(defcustom mh-recursive-folders nil + "*If non-nil, then commands which operate on folders do so recursively." + :type 'boolean + :group 'mh) -(defvar mh-clean-message-header nil +(defcustom mh-clean-message-header nil "*Non-nil means clean headers of messages that are displayed or inserted. The variables `mh-visible-headers' and `mh-invisible-headers' control what -is removed.") +is removed." + :type 'boolean + :group 'mh-buffer) -(defvar mh-visible-headers nil +(defcustom mh-visible-headers nil "*If non-nil, contains a regexp specifying the headers to keep when cleaning. Only used if `mh-clean-message-header' is non-nil. Setting this variable -overrides `mh-invisible-headers'.") +overrides `mh-invisible-headers'." + :type '(choice (const nil) regexp) + :group 'mh-buffer) (defvar mh-invisible-headers "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^Delivery-Date: \\|^In-Reply-To: \\|^Resent-" @@ -77,11 +91,15 @@ If `mh-visible-headers' is non-nil, it is used instead to specify what to keep.") -(defvar mh-bury-show-buffer t - "*Non-nil means that the displayed show buffer for a folder is buried.") +(defcustom mh-bury-show-buffer t + "*Non-nil means that the displayed show buffer for a folder is buried." + :type 'boolean + :group 'mh-buffer) -(defvar mh-summary-height 4 - "*Number of lines in MH-Folder window (including the mode line).") +(defcustom mh-summary-height 4 + "*Number of lines in MH-Folder window (including the mode line)." + :type 'integer + :group 'mh-buffer) (defvar mh-msg-number-regexp "^ *\\([0-9]+\\)" "Regexp to find the number of a message in a scan line. @@ -91,13 +109,15 @@ "Format string containing a regexp matching the scan listing for a message. The desired message's number will be an argument to format.") -(defvar mhl-formfile nil +(defcustom mhl-formfile nil "*Name of format file to be used by mhl to show and print messages. A value of T means use the default format file. Nil means don't use mhl to format messages when showing; mhl is still used, with the default format file, to format messages when printing them. The format used should specify a non-zero value for overflowoffset so -the message continues to conform to RFC 822 and mh-e can parse the headers.") +the message continues to conform to RFC 822 and mh-e can parse the headers." + :type '(choice (const nil) (const t) string) + :group 'mh) (put 'mhl-formfile 'info-file "mh-e") (defvar mh-default-folder-for-message-function nil diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/asm-mode.el --- a/lisp/modes/asm-mode.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/asm-mode.el Mon Aug 13 09:30:11 2007 +0200 @@ -51,16 +51,25 @@ ;;; Code: -(defvar asm-comment-char ?; - "*The comment-start character assumed by Asm mode.") +(defgroup asm nil + "Assembler programming" + :group 'languages) + + +(defcustom asm-comment-char ?; + "*The comment-start character assumed by Asm mode." + :type 'sexp + :group 'asm) ;; XEmacs change (This is the primary difference, why was this ;; feature removed? -sb) -(defvar asm-support-c-comments-p t +(defcustom asm-support-c-comments-p t "*Support C style comments. If t C style comments will be -supported. This is mainly for the benefit of font-lock.") +supported. This is mainly for the benefit of font-lock." + :type 'boolean + :group 'asm) -(defvar asm-mode-syntax-table nil +(defcustom asm-mode-syntax-table nil "Syntax table used while in Asm mode.") (defvar asm-mode-abbrev-table nil diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/cmacexp.el --- a/lisp/modes/cmacexp.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/cmacexp.el Mon Aug 13 09:30:11 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc. ;; Author: Francesco Potorti` -;; Version: $Id: cmacexp.el,v 1.1.1.1 1996/12/18 22:42:45 steve Exp $ +;; Version: $Id: cmacexp.el,v 1.2 1997/04/19 23:21:02 steve Exp $ ;; Adapted-By: ESR ;; Keywords: c @@ -92,13 +92,22 @@ (provide 'cmacexp) -(defvar c-macro-shrink-window-flag nil - "*Non-nil means shrink the *Macroexpansion* window to fit its contents.") +(defgroup c-macro nil + "Expand C macros in a region." + :group 'c) + -(defvar c-macro-prompt-flag nil - "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments.") +(defcustom c-macro-shrink-window-flag nil + "*Non-nil means shrink the *Macroexpansion* window to fit its contents." + :type 'boolean + :group 'c-macro) -(defvar c-macro-preprocessor +(defcustom c-macro-prompt-flag nil + "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments." + :type 'boolean + :group 'c-macro) + +(defcustom c-macro-preprocessor ;; Cannot rely on standard directory on MS-DOS to find CPP. (cond ((eq system-type 'ms-dos) "cpp -C") ;; Solaris has it in an unusual place. @@ -110,10 +119,14 @@ "The preprocessor used by the cmacexp package. If you change this, be sure to preserve the `-C' (don't strip comments) -option, or to set an equivalent one.") +option, or to set an equivalent one." + :type 'string + :group 'c-macro) -(defvar c-macro-cppflags "" - "*Preprocessor flags used by `c-macro-expand'.") +(defcustom c-macro-cppflags "" + "*Preprocessor flags used by `c-macro-expand'." + :type 'string + :group 'c-macro) (defconst c-macro-buffer-name "*Macroexpansion*") diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/enriched.el --- a/lisp/modes/enriched.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/enriched.el Mon Aug 13 09:30:11 2007 +0200 @@ -55,21 +55,32 @@ ;;; Variables controlling the display ;;; -(defvar enriched-verbose t - "*If non-nil, give status messages when reading and writing files.") +(defgroup enriched nil + "Read and save files in text/enriched format" + :group 'wp) + -(defvar enriched-default-right-margin 10 +(defcustom enriched-verbose t + "*If non-nil, give status messages when reading and writing files." + :type 'boolean + :group 'enriched) + +(defcustom enriched-default-right-margin 10 "*Default amount of space to leave on the right edge of the screen. This can be increased inside text by changing the 'right-margin text property. Measured in character widths. If the screen is narrower than this, it is -assumed to be 0.") +assumed to be 0." + :type 'integer + :group 'enriched) -(defvar enriched-fill-after-visiting t +(defcustom enriched-fill-after-visiting t "If t, fills paragraphs when reading in enriched documents. If nil, only fills when you explicitly request it. If the value is 'ask, then it will query you whether to fill. Filling is never done if the current text-width is the same as the value -stored in the file.") +stored in the file." + :type '(choice (const nil) (const t) (const ask)) + :group 'enriched) ;;; ;;; Set up faces & display table @@ -156,11 +167,13 @@ (cons '(enriched-mode " Enriched") minor-mode-alist))) -(defvar enriched-mode-hook nil +(defcustom enriched-mode-hook nil "Functions to run when entering Enriched mode. If you set variables in this hook, you should arrange for them to be restored to their old values if you leave Enriched mode. One way to do this is to add -them and their old values to `enriched-old-bindings'.") +them and their old values to `enriched-old-bindings'." + :type 'hook + :group 'enriched) (defvar enriched-old-bindings nil "Store old variable values that we change when entering mode. diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/f90.el --- a/lisp/modes/f90.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/f90.el Mon Aug 13 09:30:11 2007 +0200 @@ -147,54 +147,96 @@ "Address of mailing list for F90 mode bugs.") ;; User options -(defvar f90-do-indent 3 - "*Extra indentation applied to DO blocks.") + +(defgroup f90 nil + "Fortran-90 mode" + :group 'fortran) -(defvar f90-if-indent 3 - "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks.") +(defgroup f90-indent nil + "Fortran-90 indentation" + :prefix "f90-" + :group 'f90) + -(defvar f90-type-indent 3 - "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks.") +(defcustom f90-do-indent 3 + "*Extra indentation applied to DO blocks." + :type 'integer + :group 'f90-indent) -(defvar f90-program-indent 2 - "*Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks.") +(defcustom f90-if-indent 3 + "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." + :type 'integer + :group 'f90-indent) -(defvar f90-continuation-indent 5 - "*Extra indentation applied to F90 continuation lines.") +(defcustom f90-type-indent 3 + "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks." + :type 'integer + :group 'f90-indent) -(defvar f90-comment-region "!!$" +(defcustom f90-program-indent 2 + "*Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks." + :type 'integer + :group 'f90-indent) + +(defcustom f90-continuation-indent 5 + "*Extra indentation applied to F90 continuation lines." + :type 'integer + :group 'f90-indent) + +(defcustom f90-comment-region "!!$" "*String inserted by \\[f90-comment-region]\ - at start of each line in region.") - -(defvar f90-indented-comment-re "!" - "*Regexp saying which comments to be indented like code.") + at start of each line in region." + :type 'string + :group 'f90-indent) -(defvar f90-directive-comment-re "!hpf\\$" - "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.") +(defcustom f90-indented-comment-re "!" + "*Regexp saying which comments to be indented like code." + :type 'regexp + :group 'f90-indent) -(defvar f90-beginning-ampersand t - "*t makes automatic insertion of \& at beginning of continuation line.") +(defcustom f90-directive-comment-re "!hpf\\$" + "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." + :type 'regexp + :group 'f90-indent) -(defvar f90-smart-end 'blink +(defcustom f90-beginning-ampersand t + "*t makes automatic insertion of \& at beginning of continuation line." + :type 'boolean + :group 'f90) + +(defcustom f90-smart-end 'blink "*From an END statement, check and fill the end using matching block start. Allowed values are 'blink, 'no-blink, and nil, which determine -whether to blink the matching beginning.") +whether to blink the matching beginning." + :type '(choice (const blink) (const no-blink) (const nil)) + :group 'f90) -(defvar f90-break-delimiters "[-+\\*/><=,% \t]" - "*Regexp holding list of delimiters at which lines may be broken.") +(defcustom f90-break-delimiters "[-+\\*/><=,% \t]" + "*Regexp holding list of delimiters at which lines may be broken." + :type 'regexp + :group 'f90) -(defvar f90-break-before-delimiters t - "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters.") +(defcustom f90-break-before-delimiters t + "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters." + :type 'regexp + :group 'f90) -(defvar f90-auto-keyword-case nil +(defcustom f90-auto-keyword-case nil "*Automatic case conversion of keywords. - The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil") + The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil" + :type '(choice (const downcase-word) (const upcase-word) + (const capitalize-word) (const nil)) + :group 'f90) -(defvar f90-leave-line-no nil - "*If nil, left-justify linenumbers.") +(defcustom f90-leave-line-no nil + "*If nil, left-justify linenumbers." + :type 'boolean + :group 'f90) -(defvar f90-startup-message t - "*Non-nil displays a startup message when F90 mode is first called.") +(defcustom f90-startup-message t + "*Non-nil displays a startup message when F90 mode is first called." + :type 'boolean + :group 'f90) (defconst f90-keywords-re ;;("allocate" "allocatable" "assign" "assignment" "backspace" "block" diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/fortran.el --- a/lisp/modes/fortran.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/fortran.el Mon Aug 13 09:30:11 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: Michael D. Prange ;; Maintainer: bug-fortran-mode@erl.mit.edu -;; Version 1.30.6 (July 27, 1995) +;; Version 1.30.6-x (July 27, 1995) ;; Keywords: languages ;; This file is part of XEmacs. @@ -51,90 +51,146 @@ ;;; Code: -(defconst fortran-mode-version "version 1.30.6") +(defconst fortran-mode-version "version 1.30.6-x") + +(defgroup fortran nil + "Fortran mode for Emacs" + :group 'languages) + +(defgroup fortran-indent nil + "Indentation variables in Fortran mode" + :prefix "fortran-" + :group 'fortran) + +(defgroup fortran-comment nil + "Comment-handling variables in Fortran mode" + :prefix "fortran-" + :group 'fortran) + ;;;###autoload -(defvar fortran-tab-mode-default nil +(defcustom fortran-tab-mode-default nil "*Default tabbing/carriage control style for empty files in Fortran mode. A value of t specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked -with a character in column 6.") +with a character in column 6." + :type 'boolean + :group 'fortran-indent) ;; Buffer local, used to display mode line. -(defvar fortran-tab-mode-string nil - "String to appear in mode line when TAB format mode is on.") +(defcustom fortran-tab-mode-string nil + "String to appear in mode line when TAB format mode is on." + :type '(choice (const nil) string) + :group 'fortran-indent) -(defvar fortran-do-indent 3 - "*Extra indentation applied to DO blocks.") +(defcustom fortran-do-indent 3 + "*Extra indentation applied to DO blocks." + :type 'integer + :group 'fortran-indent) -(defvar fortran-if-indent 3 - "*Extra indentation applied to IF blocks.") +(defcustom fortran-if-indent 3 + "*Extra indentation applied to IF blocks." + :type 'integer + :group 'fortran-indent) -(defvar fortran-structure-indent 3 - "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks.") +(defcustom fortran-structure-indent 3 + "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks." + :type 'integer + :group 'fortran-indent) -(defvar fortran-continuation-indent 5 - "*Extra indentation applied to Fortran continuation lines.") +(defcustom fortran-continuation-indent 5 + "*Extra indentation applied to Fortran continuation lines." + :type 'integer + :group 'fortran-indent) -(defvar fortran-comment-indent-style 'fixed +(defcustom fortran-comment-indent-style 'fixed "*nil forces comment lines not to be touched, 'fixed makes fixed comment indentation to `fortran-comment-line-extra-indent' columns beyond `fortran-minimum-statement-indent-fixed' (for `indent-tabs-mode' of nil) or `fortran-minimum-statement-indent-tab' (for `indent-tabs-mode' of t), and 'relative indents to current -Fortran indentation plus `fortran-comment-line-extra-indent'.") +Fortran indentation plus `fortran-comment-line-extra-indent'." + :type '(radio (const nil) (const fixed) (const relative)) + :group 'fortran-indent) -(defvar fortran-comment-line-extra-indent 0 - "*Amount of extra indentation for text within full-line comments.") +(defcustom fortran-comment-line-extra-indent 0 + "*Amount of extra indentation for text within full-line comments." + :type 'integer + :group 'fortran-indent + :group 'fortran-comment) -(defvar comment-line-start nil - "*Delimiter inserted to start new full-line comment.") +(defcustom comment-line-start nil + "*Delimiter inserted to start new full-line comment." + :type '(choice string (const nil)) + :group 'fortran-comment) -(defvar comment-line-start-skip nil - "*Regexp to match the start of a full-line comment.") +(defcustom comment-line-start-skip nil + "*Regexp to match the start of a full-line comment." + :type '(choice string (const nil)) + :group 'fortran-comment) -(defvar fortran-minimum-statement-indent-fixed 6 - "*Minimum statement indentation for fixed format continuation style.") +(defcustom fortran-minimum-statement-indent-fixed 6 + "*Minimum statement indentation for fixed format continuation style." + :type 'integer + :group 'fortran-indent) -(defvar fortran-minimum-statement-indent-tab (max tab-width 6) - "*Minimum statement indentation for TAB format continuation style.") +(defcustom fortran-minimum-statement-indent-tab (max tab-width 6) + "*Minimum statement indentation for TAB format continuation style." + :type 'integer + :group 'fortran-indent) ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. -(defvar fortran-comment-indent-char " " +(defcustom fortran-comment-indent-char " " "*Single-character string inserted for Fortran comment indentation. -Normally a space.") +Normally a space." + :type 'string + :group 'fortran-comment) -(defvar fortran-line-number-indent 1 +(defcustom fortran-line-number-indent 1 "*Maximum indentation for Fortran line numbers. -5 means right-justify them within their five-column field.") +5 means right-justify them within their five-column field." + :type 'integer + :group 'fortran-indent) -(defvar fortran-check-all-num-for-matching-do nil - "*Non-nil causes all numbered lines to be treated as possible DO loop ends.") +(defcustom fortran-check-all-num-for-matching-do nil + "*Non-nil causes all numbered lines to be treated as possible DO loop ends." + :type 'boolean + :group 'fortran) -(defvar fortran-blink-matching-if nil +(defcustom fortran-blink-matching-if nil "*Non-nil causes \\[fortran-indent-line] on ENDIF statement to blink on matching IF. -Also, from an ENDDO statement blink on matching DO [WHILE] statement.") +Also, from an ENDDO statement blink on matching DO [WHILE] statement." + :type 'boolean + :group 'fortran) -(defvar fortran-continuation-string "$" +(defcustom fortran-continuation-string "$" "*Single-character string used for Fortran continuation lines. In fixed format continuation style, this character is inserted in column 6 by \\[fortran-split-line] to begin a continuation line. Also, if \\[fortran-indent-line] finds this at the beginning of a line, it will convert the line into a continuation line of the appropriate style. -Normally $.") +Normally $." + :type 'string + :group 'fortran) -(defvar fortran-comment-region "c$$$" +(defcustom fortran-comment-region "c$$$" "*String inserted by \\[fortran-comment-region]\ - at start of each line in region.") + at start of each line in region." + :type 'string + :group 'fortran-comment) -(defvar fortran-electric-line-number t +(defcustom fortran-electric-line-number t "*Non-nil causes line number digits to be moved to the correct column as\ - typed.") + typed." + :type 'boolean + :group 'fortran) -(defvar fortran-startup-message t - "*Non-nil displays a startup message when Fortran mode is first called.") +(defcustom fortran-startup-message t + "*Non-nil displays a startup message when Fortran mode is first called." + :type 'boolean + :group 'fortran) (defvar fortran-column-ruler-fixed "0 4 6 10 20 30 40 5\ @@ -162,8 +218,10 @@ "Number of lines to scan to determine whether to use fixed or TAB format\ style.") -(defvar fortran-break-before-delimiters t - "*Non-nil causes `fortran-fill' to break lines before delimiters.") +(defcustom fortran-break-before-delimiters t + "*Non-nil causes `fortran-fill' to break lines before delimiters." + :type 'boolean + :group 'fortran) (if fortran-mode-syntax-table () diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/pascal.el --- a/lisp/modes/pascal.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/pascal.el Mon Aug 13 09:30:11 2007 +0200 @@ -65,6 +65,11 @@ (defconst pascal-mode-version "2.4" "Version of `pascal.el'.") +(defgroup pascal nil + "Major mode for editing Pascal source in Emacs" + :group 'languages) + + (defvar pascal-mode-abbrev-table nil "Abbrev table in use in Pascal-mode buffers.") (define-abbrev-table 'pascal-mode-abbrev-table ()) @@ -180,58 +185,81 @@ "Additional expressions to highlight in Pascal mode.") (put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t)) -(defvar pascal-indent-level 3 - "*Indentation of Pascal statements with respect to containing block.") +(defcustom pascal-indent-level 3 + "*Indentation of Pascal statements with respect to containing block." + :type 'integer + :group 'pascal) -(defvar pascal-case-indent 2 - "*Indentation for case statements.") - -(defvar pascal-auto-newline nil - "*Non-nil means automatically newline after semicolons and the punctuation mark -after an end.") +(defcustom pascal-case-indent 2 + "*Indentation for case statements." + :type 'integer + :group 'pascal) -(defvar pascal-tab-always-indent t - "*Non-nil means TAB in Pascal mode should always reindent the current line, -regardless of where in the line point is when the TAB command is used.") +(defcustom pascal-auto-newline nil + "*Non-nil means automatically newline after semicolons and the punctuation mark +after an end." + :type 'boolean + :group 'pascal) -(defvar pascal-auto-endcomments t +(defcustom pascal-tab-always-indent t + "*Non-nil means TAB in Pascal mode should always reindent the current line, +regardless of where in the line point is when the TAB command is used." + :type 'boolean + :group 'pascal) + +(defcustom pascal-auto-endcomments t "*Non-nil means a comment { ... } is set after the ends which ends cases and -functions. The name of the function or case will be set between the braces.") +functions. The name of the function or case will be set between the braces." + :type 'boolean + :group 'pascal) -(defvar pascal-auto-lineup '(all) +(defcustom pascal-auto-lineup '(all) "*List of contexts where auto lineup of :'s or ='s should be done. Elements can be of type: 'paramlist', 'declaration' or 'case', which will do auto lineup in parameterlist, declarations or case-statements respectively. The word 'all' will do all lineups. '(case paramlist) for instance will do lineup in case-statements and parameterlist, while '(all) -will do all lineups.") +will do all lineups." + :type '(repeat (choice (const all) + (const paramlist) + (const declaration) + (const case))) + :group 'pascal) -(defvar pascal-toggle-completions nil +(defcustom pascal-toggle-completions nil "*Non-nil means that \\\\[pascal-complete-label] should \ not display a completion buffer when the label couldn't be completed, but instead toggle the possible completions -with repeated \\[pascal-complete-label]'s.") +with repeated \\[pascal-complete-label]'s." + :type 'boolean + :group 'pascal) -(defvar pascal-type-keywords +(defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") "*Keywords for types used when completing a word in a declaration or parmlist. \(eg. integer, real, char.) The types defined within the Pascal program -will be completed runtime, and should not be added to this list.") +will be completed runtime, and should not be added to this list." + :type '(repeat (string :tag "Keyword")) + :group 'pascal) -(defvar pascal-start-keywords +(defcustom pascal-start-keywords '("begin" "end" "function" "procedure" "repeat" "until" "while" "read" "readln" "reset" "rewrite" "write" "writeln") "*Keywords to complete when standing at the first word of a statement. \(eg. begin, repeat, until, readln.) The procedures and variables defined within the Pascal program -will be completed runtime and should not be added to this list.") +will be completed runtime and should not be added to this list." + :type '(repeat (string :tag "Keyword")) + :group 'pascal) -(defvar pascal-separator-keywords +(defcustom pascal-separator-keywords '("downto" "else" "mod" "div" "then") "*Keywords to complete when NOT standing at the first word of a statement. \(eg. downto, else, mod, then.) Variables and function names defined within the -Pascal program are completed runtime and should not be added to this list.") +Pascal program are completed runtime and should not be added to this list." + :type '(repeat (string :tag "Keyword")) + :group 'pascal) ;;; ;;; Macros diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/prolog.el --- a/lisp/modes/prolog.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/prolog.el Mon Aug 13 09:30:11 2007 +0200 @@ -35,21 +35,37 @@ (defvar prolog-mode-syntax-table nil) (defvar prolog-mode-abbrev-table nil) (defvar prolog-mode-map nil) + +(defgroup prolog nil + "Major mode for editing and running Prolog under Emacs" + :group 'languages) + -(defvar prolog-program-name "prolog" - "*Program name for invoking an inferior Prolog with `run-prolog'.") +(defcustom prolog-program-name "prolog" + "*Program name for invoking an inferior Prolog with `run-prolog'." + :type 'string + :group 'prolog) -(defvar prolog-consult-string "reconsult(user).\n" - "*(Re)Consult mode (for C-Prolog and Quintus Prolog). ") +(defcustom prolog-consult-string "reconsult(user).\n" + "*(Re)Consult mode (for C-Prolog and Quintus Prolog). " + :type 'string + :group 'prolog) -(defvar prolog-compile-string "compile(user).\n" - "*Compile mode (for Quintus Prolog).") +(defcustom prolog-compile-string "compile(user).\n" + "*Compile mode (for Quintus Prolog)." + :type 'string + :group 'prolog) -(defvar prolog-eof-string "end_of_file.\n" +(defcustom prolog-eof-string "end_of_file.\n" "*String that represents end of file for prolog. -nil means send actual operating system end of file.") +nil means send actual operating system end of file." + :type 'string + :group 'prolog) -(defvar prolog-indent-width 4) +(defcustom prolog-indent-width 4 + "Level of indentation in Prolog buffers." + :type 'integer + :group 'prolog) (defconst prolog-font-lock-keywords (purecopy (list diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/rexx-mode.el --- a/lisp/modes/rexx-mode.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/rexx-mode.el Mon Aug 13 09:30:11 2007 +0200 @@ -76,27 +76,44 @@ (provide 'rexx-mode) -(defconst rexx-indent 8 - "*This variable contains the indentation in rexx-mode.") +(defgroup rexx nil + "Major mode for editing REXX program files" + :group 'languages) + -(defconst rexx-end-indent 0 - "*This variable indicates the relative position of the \"end\" in REXX mode.") +(defcustom rexx-indent 8 + "*This variable contains the indentation in rexx-mode." + :type 'integer + :group 'rexx) -(defconst rexx-cont-indent 8 - "*This variable indicates how far a continued line shall be intended.") +(defcustom rexx-end-indent 0 + "*This variable indicates the relative position of the \"end\" in REXX mode." + :type 'integer + :group 'rexx) -(defconst rexx-comment-col 32 - "*This variable gives the desired comment column -for comments to the right of text.") +(defcustom rexx-cont-indent 8 + "*This variable indicates how far a continued line shall be intended." + :type 'integer + :group 'rexx) -(defconst rexx-tab-always-indent t +(defcustom rexx-comment-col 32 + "*This variable gives the desired comment column +for comments to the right of text." + :type 'integer + :group 'rexx) + +(defcustom rexx-tab-always-indent t "*Non-nil means TAB in REXX mode should always reindent the current line, -regardless of where in the line point is when the TAB command is used.") +regardless of where in the line point is when the TAB command is used." + :type 'boolean + :group 'rexx) -(defconst rexx-special-regexp +(defcustom rexx-special-regexp ".*\\(,\\|then\\|else\\)[ \t]*\\(/\\*.*\\*/\\)?[ \t]*$" "*Regular expression for parsing lines which shall be followed by -a extra indention") +a extra indention" + :type 'regexp + :group 'rexx) (defconst rexx-font-lock-keywords (purecopy diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/rsz-minibuf.el --- a/lisp/modes/rsz-minibuf.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/rsz-minibuf.el Mon Aug 13 09:30:11 2007 +0200 @@ -10,7 +10,7 @@ ;;; Keywords: minibuffer, window, frames, display ;;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. -;;; $Id: rsz-minibuf.el,v 1.3 1997/03/08 23:26:27 steve Exp $ +;;; $Id: rsz-minibuf.el,v 1.4 1997/04/19 23:21:04 steve 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 @@ -61,36 +61,52 @@ ;;;###autoload -(defvar resize-minibuffer-mode nil - "*If non-`nil', resize the minibuffer so its entire contents are visible.") + +(defgroup resize-minibuffer nil + "Dynamically resize minibuffer to display entire contents" + :group 'frames) + + +(defcustom resize-minibuffer-mode nil + "*If non-`nil', resize the minibuffer so its entire contents are visible." + :type 'boolean + :group 'resize-minibuffer) ;;;###autoload -(defvar resize-minibuffer-window-max-height nil +(defcustom resize-minibuffer-window-max-height nil "*Maximum size the minibuffer window is allowed to become. If less than 1 or not a number, the limit is the height of the frame in -which the active minibuffer window resides.") +which the active minibuffer window resides." + :type '(choice (const nil) integer) + :group 'resize-minibuffer) ;;;###autoload -(defvar resize-minibuffer-window-exactly t +(defcustom resize-minibuffer-window-exactly t "*If non-`nil', make minibuffer exactly the size needed to display all its contents. Otherwise, the minibuffer window can temporarily increase in size but -never get smaller while it is active.") +never get smaller while it is active." + :type 'boolean + :group 'resize-minibuffer) ;;;###autoload -(defvar resize-minibuffer-frame nil - "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.") +(defcustom resize-minibuffer-frame nil + "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height." + :type 'boolean + :group 'resize-minibuffer) ;;;###autoload -(defvar resize-minibuffer-frame-max-height nil +(defcustom resize-minibuffer-frame-max-height nil "*Maximum size the minibuffer frame is allowed to become. If less than 1 or not a number, there is no limit.") ;;;###autoload -(defvar resize-minibuffer-frame-exactly nil +(defcustom resize-minibuffer-frame-exactly nil "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents. Otherwise, the minibuffer frame can temporarily increase in size but -never get smaller while it is active.") +never get smaller while it is active." + :type 'boolean + :group 'resize-minibuffer) ;;;###autoload diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/verilog-mode.el --- a/lisp/modes/verilog-mode.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/verilog-mode.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,4 +1,6 @@ ;;; verilog-mode.el --- major mode for editing verilog source in Emacs +;; +;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.3 1997/04/19 23:21:05 steve Exp $ ;; Copyright (C) 1996 Free Software Foundation, Inc. @@ -24,376 +26,197 @@ ;;; Commentary: -;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.2 1997/03/08 23:26:28 steve Exp $ -;; For help figuring out what to do with this file, visit -;; - -;; This mode borrows heavily from the pascal-mode and the cc-mode of emacs - -;; USAGE -;; ===== - -;; A major mode for editing Verilog HDL source code. When you have -;; entered Verilog mode, you may get more info by pressing C-h m. You -;; may also get online help describing various functions by: C-h f -;; - -;; To set up automatic verilog mode, put this file in your load path, -;; and include stuff like this in your .emacs: - -;; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t ) -;; (setq auto-mode-alist (cons '("\\.v\\'" . verilog-mode) auto-mode-alist)) -;; (setq auto-mode-alist (cons '("\\.dv\\'" . verilog-mode) auto-mode-alist)) +;;; This mode borrows heavily from the pascal-mode and the cc-mode of emacs -;; If you want to customize Verilog mode to fit your needs better, -;; you may add these lines (the values of the variables presented -;; here are the defaults): -;; -;; ;; User customization for Verilog mode -;; (setq verilog-indent-level 3 -;; verilog-case-indent 2 -;; verilog-auto-newline t -;; verilog-auto-indent-on-newline t -;; verilog-tab-always-indent t -;; verilog-auto-endcomments t -;; verilog-minimum-comment-distance 40 -;; verilog-indent-begin-after-if t -;; verilog-auto-lineup '(all)) - -;; I've put in the common support for colored displays for older -;; emacs-19 behaviour, and newer emacs-19 behaviour, as well as -;; support for xemacs. After that, customizing according to your -;; particular emacs version is up to you. I've used the following -;; for emacs 19.27 and emacs 19.30; also xemacs seems to work for me -;; as well. I must caution that since the font-lock package doesn't -;; have a version number, I've had to key off the emacs version -;; number, which might not corrolate with the font-lock package you -;; happen to be using... - -;; Cut the following (From ";;;; - HERE - " to ";;;; - THERE -") and -;; place the text in your .emacs file. The delete all the single ; -;; at the beginning of the lines. - -;; (If you set the mark at the word HERE, (get cursor of the word -;; and type C-@) and point at word THERE, and then type C-u M-x -;; comment-region it will magically delete all the ; for you) - -;; As coded this should work for modern versions of emacs, and also -;; should be a basis where you could build from to get colors for -;; other modes. It owes a fair bit to the excellent sample.emacs -;; from Xemacs. - +;;; USAGE +;;; ===== -;; ;;; - HERE - -;;(defvar background-mode 'light) -;;(defvar display-type 'color) -;; ;; figure out background color. We could ask the user, but that would be too easy -;;(cond -;; ((and -;; (fboundp 'device-type) -;; (string= "x" (device-type))) -;; (setq display-type (device-class) -;; background-mode -;; (condition-case nil -;; (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode" 'string)) -;; (params (frame-parameters))) -;; (cond (bg-resource (intern (downcase bg-resource))) -;; ((and (cdr (assq 'background-color params)) -;; (< (apply '+ (x-color-values -;; (cdr (assq 'background-color params)))) -;; (/ (apply '+ (x-color-values "white")) 3))) -;; 'dark) -;; ((and (cdr (assq 'border-color params)) -;; (> (apply '+ (color-instance-rgb-components -;; (make-color-instance (cdr (assq 'border-color params))))) -;; (/ 255 3))) -;; 'dark) -;; (t 'light))) -;; (error 'light)) -;; ) -;; ) -;; ((and -;; (boundp 'window-system) -;; (string= window-system "x")) -;; (setq display-type -;; (condition-case nil -;; (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) -;; (cond (display-resource (intern (downcase display-resource))) -;; ((x-display-color-p) 'color) -;; ((x-display-grayscale-p) 'grayscale) -;; (t 'mono))) -;; (error 'mono)) -;; ) -;; (setq background-mode -;; (condition-case nil -;; (let ((bg-resource (x-get-resource ".backgroundMode" -;; "BackgroundMode" )) -;; (params (frame-parameters))) -;; (cond (bg-resource (intern (downcase bg-resource))) -;; ((and (cdr (assq 'background-color params)) -;; (< (apply '+ (x-color-values -;; (cdr (assq 'background-color params)))) -;; (/ (apply '+ (x-color-values "white")) 3))) -;; 'dark) -;; ((and (fboundp 'color-instance-rgb-components ) -;; (cdr (assq 'border-color params)) -;; (> (apply '+ (color-instance-rgb-components -;; (make-color-instance (cdr (assq 'border-color params))))) -;; (/ 255 3))) -;; 'dark) -;; (t 'light))) -;; (error 'light)) -;; ) -;; )) +;;; 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 +;;; -;;(message "It appears you have a %s background" background-mode) +;;; To set up automatic verilog mode, put this file in your load path, +;;; and include stuff like this in your .emacs: -;; ; Now do emacs version specific color setup -;;(cond -;; ((and (string-match "XEmacs" emacs-version) -;; (boundp 'emacs-major-version) -;; (= emacs-major-version 19) -;; (>= emacs-minor-version 12)) +; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t ) +; (setq auto-mode-alist (cons '("\\.v\\'" . verilog-mode) auto-mode-alist)) +; (setq auto-mode-alist (cons '("\\.dv\\'" . verilog-mode) auto-mode-alist)) -;; ;; If you want the default colors, you could do this: -;; ;; (setq font-lock-use-default-fonts nil) -;; ;; (setq font-lock-use-default-colors t) -;; ;; but I want to specify my own colors, so I turn off all -;; ;; default values. -;; (setq font-lock-use-default-fonts nil) -;; (setq font-lock-use-default-colors nil) -;; (require 'font-lock) - -;; ;; Mess around with the faces a bit. Note that you have -;; ;; to change the font-lock-use-default-* variables *before* -;; ;; loading font-lock, and wait till *after* loading font-lock -;; ;; to customize the faces. - -;; ;; (use copy-face instead of make-face-italic/make-face-bold because -;; ;; the startup code does intelligent things to the 'italic and 'bold -;; ;; faces to ensure that they are different from the default face. -;; ;; For example, if the default face is bold, then the 'bold face -;; ;; will be unbold.) -;; ;; Underling comments looks terrible on tty's -;; (set-face-underline-p 'font-lock-comment-face nil 'global 'tty) -;; (set-face-highlight-p 'font-lock-comment-face t 'global 'tty) +;;; If you want to customize Verilog mode to fit your needs better, +;;; you may add these lines (the values of the variables presented +;;; here are the defaults): +;;; +;;; ;; User customization for Verilog mode +;;; (setq verilog-indent-level 3 +;;; verilog-indent-level-module 3 +;;; verilog-indent-level-declaration 3 +;;; verilog-indent-level-behavorial 3 +;;; verilog-case-indent 2 +;;; verilog-auto-newline t +;;; verilog-auto-indent-on-newline t +;;; verilog-tab-always-indent t +;;; verilog-auto-endcomments t +;;; verilog-minimum-comment-distance 40 +;;; verilog-indent-begin-after-if t +;;; verilog-auto-lineup '(all)) -;; (make-face-unitalic 'font-lock-comment-face) -;; (make-face-unitalic 'font-lock-string-face) -;; (copy-face 'bold 'font-lock-function-name-face) -;; (cond -;; ((eq background-mode 'light) -;; (set-face-foreground 'font-lock-comment-face "orchid") -;; (set-face-foreground 'font-lock-function-name-face "red") -;; (set-face-foreground 'font-lock-keyword-face "blue") -;; (set-face-foreground 'font-lock-string-face "steelblue") -;; (set-face-foreground 'font-lock-type-face "darkgreen") -;; ) -;; ((eq background-mode 'dark) -;; (set-face-foreground 'font-lock-comment-face "#efc80c") -;; (set-face-foreground 'font-lock-function-name-face "red") -;; (set-face-foreground 'font-lock-keyword-face "tan") -;; (set-face-foreground 'font-lock-string-face "lightskyblue") -;; (set-face-foreground 'font-lock-type-face "Aquamarine") -;; ) -;; ) -;; ;; misc. faces -;; (and (find-face 'font-lock-preprocessor-face) ; 19.13 and above -;; (copy-face 'bold 'font-lock-preprocessor-face)) -;; ) -;; ((> emacs-minor-version 29) -;; (if (eq background-mode 'light) -;; (setq font-lock-face-attributes -;; '( -;; (font-lock-comment-face "orchid" nil nil t nil) -;; (font-lock-function-name-face "red" nil t nil nil) -;; (font-lock-keyword-face "blue" nil nil nil nil) -;; (font-lock-reference-face "indianred" nil t nil nil ) -;; (font-lock-string-face "steelblue" nil nil nil nil) -;; (font-lock-type-face "darkgreen" nil nil nil nil) -;; (font-lock-variable-name-face "brown") -;; ) -;; ) -;; (setq font-lock-face-attributes -;; '( -;; (font-lock-comment-face "#efc80c" nil nil t nil) -;; (font-lock-function-name-face "red" nil t nil nil) -;; (font-lock-keyword-face "tan" nil nil nil nil) -;; (font-lock-reference-face "indianred" nil t nil nil ) -;; (font-lock-string-face "lightskyblue" nil nil nil nil) -;; (font-lock-type-face "Aquamarine" nil nil nil nil) -;; (font-lock-variable-name-face "LightGoldenrod") -;; ) -;; ) -;; ) -;; ) -;; (t -;; (if (eq background-mode 'dark) -;; (progn -;; (make-face 'my-font-lock-function-name-face) -;; (set-face-foreground 'my-font-lock-function-name-face "red") -;; (setq font-lock-function-name-face 'my-font-lock-function-name-face) - -;; (make-face 'my-font-lock-keyword-face) -;; (set-face-foreground 'my-font-lock-keyword-face "tan") -;; (setq font-lock-keyword-face 'my-font-lock-keyword-face) - -;; (make-face 'my-font-lock-string-face) -;; (set-face-foreground 'my-font-lock-string-face "lightskyblue") -;; (setq font-lock-string-face 'my-font-lock-string-face) - -;; (make-face 'my-font-lock-type-face) -;; (set-face-foreground 'my-font-lock-type-face "#efc80c") ; yellow -;; (setq font-lock-type-face 'my-font-lock-type-face) - -;; (make-face 'my-font-lock-variable-name-face) -;; (set-face-foreground 'my-font-lock-variable-name-face "LightGoldenrod") -;; (setq font-lock-variable-name-face 'my-font-lock-variable-name-face) -;; ) -;; (progn -;; (make-face 'my-font-lock-function-name-face) -;; (set-face-foreground 'my-font-lock-function-name-face "DarkGreen") -;; (setq font-lock-function-name-face 'my-font-lock-function-name-face) - -;; (make-face 'my-font-lock-keyword-face) -;; (set-face-foreground 'my-font-lock-keyword-face "indianred") -;; (setq font-lock-keyword-face 'my-font-lock-keyword-face) - -;; (make-face 'my-font-lock-string-face) -;; (set-face-foreground 'my-font-lock-string-face "RoyalBlue") -;; (setq font-lock-string-face 'my-font-lock-string-face) - -;; (make-face 'my-font-lock-type-face) -;; (set-face-foreground 'my-font-lock-type-face "#003800") ; yellow -;; (setq font-lock-type-face 'my-font-lock-type-face) - -;; (make-face 'my-font-lock-variable-name-face) -;; (set-face-foreground 'my-font-lock-variable-name-face "LightGoldenrod") -;; (setq font-lock-variable-name-face 'my-font-lock-variable-name-face) -;; ) -;; ) -;; ) -;; ) - -;;(cond -;; ((eq display-type 'color) -;; ;; Pretty Colors in source windows. -;; (require 'font-lock) -;; (autoload 'turn-on-fast-lock "fast-lock" -;; "Unconditionally turn on Fast Lock mode.") -;; (add-hook 'c-mode-hook 'font-lock-mode) -;; (add-hook 'verilog-mode-hook 'font-lock-mode) -;; (add-hook 'perl-mode-hook 'font-lock-mode) -;; (add-hook 'elisp-mode-hook 'font-lock-mode) -;; (add-hook 'asm-mode-hook 'font-lock-mode) -;; (setq fast-lock-cache-directories '("~/.backups" ".")) -;; (setq c-font-lock-keywords c-font-lock-keywords-2) -;; (setq c++-font-lock-keywords c++-font-lock-keywords-2) -;; (autoload 'verilog-make-faces "verilog-mode" "Set up faces for verilog") -;; (if (not (string-match "XEmacs" emacs-version)) -;; (progn -;; (cond -;; ((eq background-mode 'dark) -;; ;; Make background a light gray -;; (set-face-background (quote region) "gray30")) -;; ;; Make background a dark gray -;; ((eq background-mode 'light) -;; (set-face-background (quote region) "gray70")) -;; ) -;; ) -;; ) -;; ) -;; ((eq display-type 'mono) -;; (progn -;; ;; Frames are too expensive to create -;; ;; on my NCD running x-remote, which happens -;; ;; to be the only place I run X mono color -;; (setq vm-frame-per-composition nil -;; vm-frame-per-folder nil) -;; ) -;; ) -;; ) -;; ;;; - THERE - - -;; KNOWN BUGS / BUGREPORTS -;; ======================= This is beta code, and likely has -;; bugs. Please report any and all bugs to me at mac@silicon-sorcery.com. +;;; KNOWN BUGS / BUGREPORTS +;;; ======================= This is beta code, and likely has +;;; bugs. Please report any and all bugs to me at mac@silicon-sorcery.com. ;; - ;;; Code: (provide 'verilog-mode) ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "$$Revision: 1.2 $$" +(defconst verilog-mode-version "$$Revision: 1.3 $$" "Version of this verilog mode.") -(defvar verilog-indent-level 3 - "*Indentation of Verilog statements with respect to containing block.") +;; +;; A hack so we can support either custom, or the old defvar +;; +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro customize (&rest args) + (message "Sorry, Customise is not available with this version of emacs")) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) -(defvar verilog-cexp-indent 1 - "*Indentation of Verilog statements split across lines.") - -(defvar verilog-case-indent 2 - "*Indentation for case statements.") +(defun verilog-customize () + "Link to customize screen for Verilog" + (interactive) + (customize 'verilog-mode) + ) -(defvar verilog-auto-newline t - "*Non-nil means automatically newline after semicolons") +(defgroup verilog-mode nil + "Faciliates easy editing of Verilog source text" + :group 'languages) + +(defcustom verilog-indent-level 3 + "*Indentation of Verilog statements with respect to containing block." + :group 'verilog-mode + :type 'integer + ) -(defvar verilog-auto-indent-on-newline t - "*Non-nil means automatically indent line after newline") +(defcustom verilog-indent-level-module 3 + "* Indentation of Module level Verilog statements. (eg always, initial) + Set to 0 to get initial and always statements lined up + on the left side of your screen." + :group 'verilog-mode + :type 'integer + ) -(defvar verilog-tab-always-indent t - "*Non-nil means TAB in Verilog mode should always reindent the current line, -regardless of where in the line point is when the TAB command is used.") +(defcustom verilog-indent-level-declaration 3 + "*Indentation of declarations with respect to containing block. + Set to 0 to get them list right under containing block." + :group 'verilog-mode + :type 'integer + ) + +(defcustom verilog-indent-level-behavorial 3 + "*Absolute indentation of first begin in a task or function block + Set to 0 to get such code to start at the left side of the screen." + :group 'verilog-mode + :type 'integer + ) -(defvar verilog-indent-begin-after-if t - "*If true, indent begin statements following if, else, while, for and repeat. -otherwise, line them up.") +(defcustom verilog-cexp-indent 1 + "*Indentation of Verilog statements split across lines." + :group 'verilog-mode + :type 'integer + ) + +(defcustom verilog-case-indent 2 + "*Indentation for case statements." + :group 'verilog-mode + :type 'integer + ) -(defvar verilog-auto-endcomments t - "*Non-nil means a comment /* ... */ is set after the ends which ends cases and -functions. The name of the function or case will be set between the braces.") +(defcustom verilog-auto-newline t + "*Non-nil means automatically newline after semicolons" + :group 'verilog-mode + :type 'integer + ) + +(defcustom verilog-auto-indent-on-newline t + "*Non-nil means automatically indent line after newline" + :group 'verilog-mode + :type 'integer + ) -(defvar verilog-minimum-comment-distance 40 - "*Minimum distance between begin and end required before a comment will be inserted. -Setting this variable to zero results in every end aquiring a comment; the default avoids -too many redundanet comments in tight quarters") +(defcustom verilog-tab-always-indent t + "*Non-nil means TAB in Verilog mode should always reindent the + current line, regardless of where in the line point is when the TAB + command is used." + :group 'verilog-mode + :type 'integer + ) + +(defcustom verilog-indent-begin-after-if t + "*If true, indent begin statements following if, else, while, for + and repeat. otherwise, line them up." + :group 'verilog-mode + :type 'boolean ) -(defvar verilog-auto-lineup '(all) "*List of contexts where auto - lineup of :'s or ='s should be done. Elements can be of type: - 'declaration' or 'case', which will do auto lineup in declarations - or case-statements respectively. The word 'all' will do all - lineups. '(case declaration) for instance will do lineup in - case-statements and parameterlist, while '(all) will do all - lineups." ) +(defcustom verilog-auto-endcomments t + "*Non-nil means a comment /* ... */ is set after the ends which ends + cases and functions. The name of the function or case will be set + between the braces." + :group 'verilog-mode + :type 'boolean ) + +(defcustom verilog-minimum-comment-distance 40 + "*Minimum distance between begin and end required before a comment + will be inserted. Setting this variable to zero results in every + end aquiring a comment; the default avoids too many redundanet + comments in tight quarters" + :group 'verilog-mode + :type 'integer + ) + +(defvar verilog-auto-lineup '(all) + "*List of contexts where auto lineup of :'s or ='s should be done. +Elements can be of type: 'declaration' or 'case', which will do auto +lineup in declarations or case-statements respectively. The word 'all' +will do all lineups. '(case declaration) for instance will do lineup +in case-statements and parameterlist, while '(all) will do all +lineups." + ) (defvar verilog-mode-abbrev-table nil "Abbrev table in use in Verilog-mode buffers.") (defvar verilog-font-lock-keywords-after-1930 '( - ("^[ \t]*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>[ \t]*" + ;; + ("^\\s-*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>" 1 font-lock-keyword-face) - ("^[ \t]*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>[ \t]*\\(\\sw+\\)" + ("^\\s-*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>\\s-*\\(\\sw+\\)" 2 font-lock-function-name-face nil t) - ("\\\\[^ \t]*" 0 'font-lock-function-name-face) ( - "\\(@\\)\\|\\(#\[ \t\]*\\(\\(\[0-9\]+\\('[hdxbo][0-9_xz]*\\)?\\)\\|\\((\[^)\]*)\\)\\)\\)" - 0 font-lock-type-face) - ("\\(`[ \t]*[A-Za-z][A-Za-z0-9_]*\\)" 0 font-lock-type-face) - ("\\<\\(in\\(teger\\|put\\|out\\)\\|parameter\\|defparam\\|output\\|supply[01]?\\|event\\|tri\\(0\\|1\\|reg\\|and\\|or\\)?\\|w\\(ire\\|or\\|and\\)\\|time\\|re\\(al\\(time\\)?\\|g\\)\\)\\>" - 0 font-lock-type-face) - ("\\(\\$[a-zA-Z][a-zA-Z0-9_\\$]*\\)\\|\\(\\<\\(begin\\|case[xz]?\\|end\\(case\\|function\\|task\\|module\\|table\\|primitive\\|specify\\)?\\|a\\(ssign\\|lways\\)\\|default\\|initial\\|table\\|\\(pos\\|neg\\)edge\\|else\\|for\\(ever\\|k\\)?\\|join\\|if\\|repeat\\|then\\|while\\|specify\\)\\>\\)" + ("\\\\\\s-*" 0 'font-lock-function-name-face) + ("\\(@\\)\\|\\(#\\s-*\\(\\(\[0-9\]+\\('[hdxbo][0-9_xz]*\\)?\\)\\|\\((\[^)\]*)\\|\\sw+\\)\\)\\)" 0 font-lock-type-face) + ("\\(`\\s-*[A-Za-z][A-Za-z0-9_]*\\)" 0 font-lock-type-face) + ("\\<\\(in\\(teger\\|put\\|out\\)\\|parameter\\|defparam\\|output\\|supply[01]?\\|event\\|tri\\(0\\|1\\|reg\\|and\\|or\\)?\\|w\\(ire\\|or\\|and\\)\\|time\\|re\\(al\\(time\\)?\\|g\\)\\)\\>" + 0 font-lock-type-face) + ("\\(\\$[a-zA-Z][a-zA-Z0-9_\\$]*\\)\\|\\(\\<\\(begin\\|case[xz]?\\|end\\(case\\|function\\|task\\|module\\|table\\|primitive\\|specify\\)?\\|a\\(ssign\\|lways\\)\\|default\\|initial\\|table\\|\\(pos\\|neg\\)edge\\|else\\|for\\(ever\\|k\\)?\\|join\\|if\\|repeat\\|then\\|while\\|specify\\)\\>\\)" 0 font-lock-keyword-face) ) ) -(defvar verilog-font-lock-keywords nil) + (defvar verilog-font-lock-keywords-before-1930 '( - ("^[ \t]*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>[ \t]*" . 1) - ("^[ \t]*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>[ \t]*\\(\\sw+\\)" + ("^\\s-*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>" . 1) + ("^\\s-*\\(function\\|task\\|module\\|macromodule\\|primitive\\)\\>\\s-*\\(\\sw+\\)" 2 font-lock-function-name-face nil t) - ("\\(\\\\[^ \t]*\\)\\|\\(`[ \t]*[A-Za-z][A-Za-z0-9_]*\\)" 0 font-lock-function-name-face) + ("\\(\\\\\\s-*\\)\\|\\(`[ \t]*[A-Za-z][A-Za-z0-9_]*\\)" 0 font-lock-function-name-face) ("[@#]" . font-lock-type-face) ("\\<\\(in\\(teger\\|put\\|out\\)\\|parameter\\|defparam\\|output\\|supply[01]?\\|event\\|tri\\(0\\|1\\|reg\\|and\\|or\\)?\\|w\\(ire\\|or\\|and\\)\\|time\\|re\\(al\\(time\\)?\\|g\\)\\)\\>" 0 font-lock-type-face) @@ -401,8 +224,23 @@ ) ) +;; Insure we have certain packages + +(if (fboundp 'eval-when-compile) + (eval-when-compile + (condition-case nil + (require 'imenu) + (error nil)) + (condition-case nil + (require 'reporter) + (error nil)) + (condition-case nil + (require 'easymenu) + (error nil)))) + (defvar verilog-imenu-generic-expression - '("^[ \t]*\\(module\\|macromodule\\|primitive\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2)) + '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 3) + ("*Vars*" "^\\s-*\\(reg\\|wire\\)\\)\\s-+\\(\\|\\[[^\\]+]\\s-+\\)\\([-A-Za-z0-9+]+\\)" 3)) "Imenu expression for Verilog-mode. See `imenu-generic-expression'.") (defvar verilog-mode-abbrev-table nil @@ -425,78 +263,189 @@ (define-key verilog-mode-map "\M-\C-b" 'electric-verilog-backward-sexp) (define-key verilog-mode-map "\M-\C-f" 'electric-verilog-forward-sexp) (define-key verilog-mode-map "\M-\r" (function (lambda () - (interactive) (electric-verilog-terminate-line 1)))) + (interactive) (electric-verilog-terminate-line 1)))) (define-key verilog-mode-map "\177" 'backward-delete-char-untabify) (define-key verilog-mode-map "\M-\t" 'verilog-complete-word) (define-key verilog-mode-map "\M-?" 'verilog-show-completions) (define-key verilog-mode-map "\M-\C-h" 'verilog-mark-defun) (define-key verilog-mode-map "\C-c\C-b" 'verilog-insert-block) (define-key verilog-mode-map "\C-cb" 'verilog-label-be) + (define-key verilog-mode-map "\C-ci" 'verilog-pretty-declarations) + (define-key verilog-mode-map "\C-cC-b" 'verilog-submit-bug-report) (define-key verilog-mode-map "\M-*" 'verilog-star-comment) - (define-key verilog-mode-map "\C-c\C-c" 'verilog-comment-area) - (define-key verilog-mode-map "\C-c\C-u" 'verilog-uncomment-area) + (define-key verilog-mode-map "\C-c\C-c" 'verilog-comment-region) + (define-key verilog-mode-map "\C-c\C-u" 'verilog-uncomment-region) (define-key verilog-mode-map "\M-\C-a" 'verilog-beg-of-defun) (define-key verilog-mode-map "\M-\C-e" 'verilog-end-of-defun) (define-key verilog-mode-map "\C-c\C-d" 'verilog-goto-defun) ) +;; menus + +(if (string-match "XEmacs" emacs-version) + (defvar verilog-xemacs-menu + '("Verilog" + ["Line up declarations around point" verilog-pretty-declarations t] + ["Redo/insert comments on every end" verilog-label-be t] + "----" + ["Beginning of function" verilog-beg-of-defun t] + ["End of function" verilog-end-of-defun t] + ["Mark function" verilog-mark-defun t] + "----" + ["Move to beginning of block" electric-verilog-backward-sexp t] + ["Move to end of block" electric-verilog-forward-sexp t] + "----" + ["Comment Region" verilog-comment-region t] + ["UnComment Region" verilog-uncomment-region t] + ["Multi-line comment insert" verilog-star-comment t] + "----" + ["Insert begin-end block" verilog-insert-block t] + ["Complete word" verilog-complete-word t] + "----" + ["Submit bug report" verilog-submit-bug-report t] + ["Customize Verilog Mode..." verilog-customize t] + "XEmacs menu for VERILOG mode.")) + (progn + (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" + '("Verilog" + ["Line up declarations around point" verilog-pretty-declarations t] + ["Redo/insert comments on every end" verilog-label-be t] + "----" + ["Beginning of function" verilog-beg-of-defun t] + ["End of function" verilog-end-of-defun t] + ["Mark function" verilog-mark-defun t] + "----" + ["Move to beginning of block" electric-verilog-backward-sexp t] + ["Move to end of block" electric-verilog-forward-sexp t] + "----" + ["Comment Region" verilog-comment-region t] + ["UnComment Region" verilog-uncomment-region t] + ["Multi-line comment insert" verilog-star-comment t] + "----" + ["Insert begin-end block" verilog-insert-block t] + ["Complete word" verilog-complete-word t] + "----" + ["Submit bug report" verilog-submit-bug-report t] + ["Customize Verilog Mode..." verilog-customize t] + )))) + +(defvar verilog-mode-abbrev-table nil + "Abbrev table in use in Verilog-mode buffers.") + +(define-abbrev-table 'verilog-mode-abbrev-table ()) ;;; ;;; Regular expressions used to calculate indent, etc. ;;; (defconst verilog-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>") -(defconst verilog-case-re "\\(\\[^:]\\)") +(defconst verilog-case-re "\\(\\\\)") ;; Want to match ;; aa : ;; aa,bb : ;; a[34:32] : ;; a, ;; b : -(defconst verilog-no-indent-begin-re "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\)\\>") +(defconst + verilog-no-indent-begin-re + "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\)\\>") +(defconst verilog-ends-re + (concat + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)")) + + +(defconst verilog-enders-re + (concat "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)")) (defconst verilog-endcomment-reason-re (concat - "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|" - "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\(\[ \t\]*@\\)?\\)\\|" - "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\.*\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\(\[ \t\]*@\\)?\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|" + "\\(\\\\)\\|\\(\\\\)\\|" "#")) (defconst verilog-named-block-re "begin[ \t]*:") -(defconst verilog-beg-block-re "\\<\\(begin\\|case\\|casex\\|casez\\|fork\\|table\\|specify\\)\\>") -(defconst verilog-beg-block-re-1 "\\<\\(begin\\)\\|\\(case[xz]?\\)\\|\\(fork\\)\\|\\(table\\)\\|\\(specify\\)\\|\\(function\\)\\|\\(task\\)\\>") -(defconst verilog-end-block-re "\\<\\(end\\|join\\|endcase\\|endtable\\|endspecify\\)\\>") +(defconst verilog-beg-block-re + ;; "begin" "case" "casex" "fork" "casez" "table" "specify" "function" "task" + "\\(\\<\\(begin\\>\\|case\\(\\>\\|x\\>\\|z\\>\\)\\|f\\(ork\\>\\|unction\\>\\)\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)") + +(defconst verilog-beg-block-re-1 + "\\<\\(begin\\)\\|\\(case[xz]?\\)\\|\\(fork\\)\\|\\(table\\)\\|\\(specify\\)\\|\\(function\\)\\|\\(task\\)\\>") +(defconst verilog-end-block-re + ;; "end" "join" "endcase" "endtable" "endspecify" "endtask" "endfunction" + "\\<\\(end\\(\\>\\|case\\>\\|function\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\|join\\>\\)") + (defconst verilog-end-block-re-1 "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)") (defconst verilog-declaration-re - (concat "\\(\\\\|" - "\\\\|\\\\|\\\\|\\\\|" - "\\\\|" - "\\\\|\\\\|" - "\\\\|\\\\)")) + ;; "input" "inout" "output" "integer" "parameter" "defparam" "event" + ;; "real" "reg" "realtime" "time" "tri" "tri0" "tri1" "trireg" "triand" + ;; "trior" "supply0" "supply1" "wire" "wor" "wand" +"\\(\\<\\(defparam\\>\\|event\\>\\|in\\(out\\>\\|put\\>\\|teger\\>\\)\\|output\\>\\|parameter\\>\\|re\\(al\\(\\>\\|time\\>\\)\\|g\\>\\)\\|supply\\(0\\>\\|1\\>\\)\\|t\\(ime\\>\\|ri\\(0\\>\\|1\\>\\|\\>\\|and\\>\\|or\\>\\|reg\\>\\)\\)\\|w\\(and\\>\\|ire\\>\\|or\\>\\)\\)\\)") (defconst verilog-declaration-re-1 (concat "^[ \t]*" verilog-declaration-re "[ \t]*\\(\\[[^]]*\\][ \t]*\\)?")) -(defconst verilog-defun-re "\\<\\(module\\|macromodule\\|primitive\\)\\>") -(defconst verilog-end-defun-re "\\<\\(endmodule\\|endprimitive\\)\\>") +(defconst verilog-declaration-re-2 (concat "[ \t]*" verilog-declaration-re "[ \t]*\\(\\[[^]]*\\][ \t]*\\)?")) +(defconst verilog-defun-re + ;;"module" "macromodule" "primitive" + "\\(\\<\\(m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\)\\)") +(defconst verilog-end-defun-re + ;; "endmodule" "endprimitive" +"\\(\\\\|primitive\\>\\)\\)") (defconst verilog-zero-indent-re (concat verilog-defun-re "\\|" verilog-end-defun-re)) (defconst verilog-directive-re - "\\(`else\\)\\|\\(`ifdef\\)\\|\\(`endif\\)\\|\\(`define\\)\\|\\(`undef\\)\\|\\(`include\\)") + ;; "`else" "`ifdef" "`endif" "`define" "`undef" "`include" + "\\(\\<`\\(define\\>\\|e\\(lse\\>\\|ndif\\>\\)\\|i\\(fdef\\>\\|nclude\\>\\)\\|undef\\>\\)\\)") (defconst verilog-autoindent-lines-re - (concat - "\\<\\(\\(macro\\)?module\\|primitive\\|end\\(case\\|function\\|task\\|module\\|primitive\\|specify\\|table\\)?\\|join\\|begin\\|else\\)\\>\\|`\\(else\\|ifdef\\|endif\\)\\|" - verilog-directive-re - "\\>")) + ;; "macromodule" "module" "primitive" "end" "endcase" "endfunction" + ;; "endtask" "endmodule" "endprimitive" "endspecify" "endtable" "join" + ;; "begin" "else" "`else" "`ifdef" "`endif" "`define" "`undef" "`include" + "\\(\\<\\(`\\(define\\>\\|e\\(lse\\>\\|ndif\\>\\)\\|i\\(fdef\\>\\|nclude\\>\\)\\|undef\\>\\)\\|begin\\>\\|e\\(lse\\>\\|nd\\(\\>\\|case\\>\\|function\\>\\|module\\>\\|primitive\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)\\|join\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\)\\)") + (defconst verilog-behavorial-block-beg-re "\\(\\\\|\\\\|\\\\|\\\\)") (defconst verilog-indent-reg - (concat "\\(\\\\|\\[^:]\\|\\\\|\\\\|\\\\)\\|" - "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|" - "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|" - "\\(\\\\|\\\\)\\|" - "\\(\\\\|\\\\)\\|" - "\\(\\\\|\\\\)" -;; "\\|\\(\\\\|\\\\)" - )) + (concat + "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|" + "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|" + "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|" + "\\(\\\\|\\\\)\\|" + "\\(\\\\|\\\\)\\|" + "\\(\\\\|\\\\)" + ;; "\\|\\(\\\\|\\\\)" + )) +(defconst verilog-indent-re + "\\(\\<\\(always\\>\\|begin\\>\\|case\\(\\>\\|x\\>\\|z\\>\\)\\|end\\(\\>\\|case\\>\\|function\\>\\|module\\>\\|primitive\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\|f\\(ork\\>\\|unction\\>\\)\\|initial\\>\\|join\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)") + +(defconst verilog-defun-level-re + ;; "module" "macromodule" "primitive" "initial" "always" "endtask" "endfunction" + "\\(\\<\\(always\\>\\|end\\(function\\>\\|task\\>\\)\\|initial\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\)\\)") +(defconst verilog-cpp-level-re + ;;"endmodule" "endprimitive" + "\\(\\\\|primitive\\>\\)\\)") +(defconst verilog-behavorial-level-re + ;; "function" "task" + "\\(\\<\\(function\\>\\|task\\>\\)\\)") (defconst verilog-complete-reg - "\\(\\\\)\\|\\(\\\\)\\|\\(\\[^:]\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)") + ;; "always" "repeat" "case" "casex" "casez" "while" "if" "for" "forever" + "\\(\\<\\(always\\>\\|case\\(\\>\\|x\\>\\|z\\>\\)\\|else\\|for\\(\\>\\|ever\\>\\)\\|if\\>\\|repeat\\>\\|while\\>\\)\\)") (defconst verilog-end-statement-re (concat "\\(" verilog-beg-block-re "\\)\\|\\(" verilog-end-block-re "\\)")) @@ -530,18 +479,18 @@ (cond ((= major 18) (setq major 'v18)) ;Emacs 18 ((= major 4) (setq major 'v18)) ;Epoch 4 + ((= major 20) (setq major 'v20 + flavor 'XEmacs)) ((= major 19) (setq major 'v19 ;Emacs 19 flavor (if (or (string-match "Lucid" emacs-version) (string-match "XEmacs" emacs-version)) 'XEmacs 'FSF))) - ((= major 20) (setq major 'v20 ;XEmacs 20 - flavor 'XEmacs)) ;; I don't know (t (error "Cannot recognize major version number: %s" major))) - ;; All XEmacs 19's (formerly Lucid) use 8-bit modify-syntax-entry - ;; flags, as do all patched (obsolete) Emacs 19, Emacs 18, - ;; Epoch 4's. Only vanilla Emacs 19 uses 1-bit flag. Lets be - ;; as smart as we can about figuring this out. + ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all + ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a + ;; 1-bit flag. Let's be as smart as we can about figuring this + ;; out. (if (or (eq major 'v20) (eq major 'v19)) (let ((table (copy-syntax-table))) (modify-syntax-entry ?a ". 12345678" table) @@ -569,17 +518,17 @@ ) (with-output-to-temp-buffer "*verilog-mode warnings*" (print (format - "The version of Emacs that you are running, %s, +"The version of Emacs that you are running, %s, has known bugs in its syntax parsing routines which will affect the performance of verilog-mode. You should strongly consider upgrading to the latest available version. verilog-mode may continue to work, after a fashion, but strange indentation errors could be encountered." - emacs-version)))) + emacs-version)))) ;; Emacs 18, with no patch is not too good (if (and (eq major 'v18) (eq comments 'no-dual-comments)) (with-output-to-temp-buffer "*verilog-mode warnings*" (print (format - "The version of Emacs 18 you are running, %s, +"The version of Emacs 18 you are running, %s, has known deficiencies in its ability to handle the dual verilog (and C++) comments, (e.g. the // and /* */ comments). This will not be much of a problem for you if you only use the /* */ comments, @@ -588,12 +537,12 @@ Emacs 19 has some new built-in routines which will speed things up for you. Because of these inherent problems, verilog-mode is not supported on emacs-18." - emacs-version)))) + emacs-version)))) ;; Emacs 18 with the syntax patches are no longer supported (if (and (eq major 'v18) (not (eq comments 'no-dual-comments))) (with-output-to-temp-buffer "*verilog-mode warnings*" (print (format - "You are running a syntax patched Emacs 18 variant. While this should +"You are running a syntax patched Emacs 18 variant. While this should work for you, you may want to consider upgrading to Emacs 19. The syntax patches are no longer supported either for verilog-mode.")))) (list major comments)) @@ -605,6 +554,7 @@ Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments) Emacs 18/Epoch 4 (patch2): (v18 8-bit) XEmacs (formerly Lucid) 19: (v19 8-bit) + XEmacs 20: (v20 8-bit) Emacs 19: (v19 1-bit).") (defconst verilog-comment-start-regexp "//\\|/\\*" @@ -654,6 +604,38 @@ ;; add extra comment syntax (verilog-setup-dual-comments verilog-mode-syntax-table) ) + +(defvar verilog-font-lock-keywords nil + "keyword highlighting used in verilog-mode buffers.") +(defvar verilog-font-lock-keywords-1 nil + "keyword highlighting used in verilog-mode buffers.") +(defvar verilog-font-lock-keywords-2 nil + "keyword highlighting used in verilog-mode buffers.") +(defvar verilog-font-lock-keywords-3 nil + "keyword highlighting used in verilog-mode buffers.") +(defvar verilog-font-lock-keywords-4 nil + "keyword highlighting used in verilog-mode buffers.") +(if verilog-font-lock-keywords + () + (cond + ;; We can assume 8-bit syntax table emacsen aupport new syntax + ((memq '8-bit verilog-emacs-features) + (setq verilog-font-lock-keywords verilog-font-lock-keywords-after-1930 + verilog-font-lock-keywords-1 verilog-font-lock-keywords-after-1930 + verilog-font-lock-keywords-2 verilog-font-lock-keywords-after-1930 + verilog-font-lock-keywords-3 verilog-font-lock-keywords-after-1930 + verilog-font-lock-keywords-4 verilog-font-lock-keywords-after-1930) + ) + (t + (setq verilog-font-lock-keywords verilog-font-lock-keywords-before-1930 + verilog-font-lock-keywords-1 verilog-font-lock-keywords-before-1930 + verilog-font-lock-keywords-2 verilog-font-lock-keywords-before-1930 + verilog-font-lock-keywords-3 verilog-font-lock-keywords-before-1930 + verilog-font-lock-keywords-4 verilog-font-lock-keywords-before-1930) + ) + ) + ) + ;;; ;;; Macros ;;; @@ -731,9 +713,9 @@ (verilog-re-search-backward reg nil 'move)) (cond ((match-end 1) ; endblock - ; try to leap back to matching outward block by striding across - ; indent level changing tokens then immediately - ; previous line governs indentation. + ; try to leap back to matching outward block by striding across + ; indent level changing tokens then immediately + ; previous line governs indentation. (verilog-leap-to-head) ) ((match-end 2) ; else, we're in deep @@ -748,7 +730,7 @@ ) ) ) - ((looking-at verilog-end-block-re-1);; end|join|endcase|endtable|endspecify + ((looking-at verilog-end-block-re) (verilog-leap-to-head) ) ((looking-at "\\(endmodule\\>\\)\\|\\(\\\\)") @@ -847,6 +829,13 @@ (save-excursion (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) +(put 'verilog-mode 'font-lock-defaults + '((verilog-font-lock-keywords-after-1930 ) + nil ;; nil means highlight strings & comments as well as keywords + nil ;; nil means keywords must match case + nil ;; syntax table handled elsewhere + verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight + )) ;;;###autoload (defun verilog-mode () @@ -859,13 +848,23 @@ verilog-indent-level (default 3) Indentation of Verilog statements with respect to containing block. + verilog-indent-level-module (default 3) + Absolute indentation of Module level Verilog statements. + Set to 0 to get initial and always statements lined up + on the left side of your screen. + verilog-indent-level-declaration (default 3) + Indentation of declarations with respect to containing block. + Set to 0 to get them list right under containing block. + verilog-indent-level-behavorial (default 3) + Indentation of first begin in a task or function block + Set to 0 to get such code to linedup underneath the task or function keyword verilog-cexp-indent (default 1) Indentation of Verilog statements broken across lines. verilog-case-indent (default 2) Indentation for case statements. verilog-auto-newline (default nil) - Non-nil means automatically newline after semicolons and the punctuation mark - after an end. + Non-nil means automatically newline after semicolons and the punctation + mark after an end. verilog-auto-indent-on-newline (default t) Non-nil means automatically indent line after newline verilog-tab-always-indent (default t) @@ -881,24 +880,33 @@ if (a) begin verilog-auto-endcomments (default t) - Non-nil means a comment /* ... */ is set after the ends which ends cases, tasks, functions and modules. + Non-nil means a comment /* ... */ is set after the ends which ends + cases, tasks, functions and modules. The type and name of the object will be set between the braces. + verilog-minimum-comment-distance (default 40) + Minimum distance between begin and end required before a comment + will be inserted. Setting this variable to zero results in every + end aquiring a comment; the default avoids too many redundanet + comments in tight quarters. verilog-auto-lineup (default `(all)) List of contexts where auto lineup of :'s or ='s should be done. Turning on Verilog mode calls the value of the variable verilog-mode-hook with no args, if that value is non-nil. Other useful functions are: -\\[verilog-complete-word]\t-complete word with appropriate possibilities (functions, verilog keywords...) -\\[verilog-comment-area]\t- Put marked area in a comment, fixing nested comments. -\\[verilog-uncomment-area]\t- Uncomment an area commented with \ -\\[verilog-comment-area]. +\\[verilog-complete-word]\t-complete word with appropriate possibilities + (functions, verilog keywords...) +\\[verilog-comment-region]\t- Put marked area in a comment, fixing + nested comments. +\\[verilog-uncomment-region]\t- Uncomment an area commented with \ +\\[verilog-comment-region]. \\[verilog-insert-block]\t- insert begin ... end; \\[verilog-star-comment]\t- insert /* ... */ \\[verilog-mark-defun]\t- Mark function. \\[verilog-beg-of-defun]\t- Move to beginning of current function. \\[verilog-end-of-defun]\t- Move to end of current function. -\\[verilog-label-be]\t- Label matching begin ... end, fork ... join and case ... endcase statements; +\\[verilog-label-be]\t- Label matching begin ... end, fork ... join + and case ... endcase statements; " (interactive) (kill-all-local-variables) @@ -920,19 +928,26 @@ comment-end "" comment-start-skip "/\\*+ *\\|// *" comment-multi-line nil) - ;; Imenu support - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression verilog-imenu-generic-expression) - ;; Font lock support - (make-local-variable 'font-lock-keywords) - (if (string-match "XEmacs\\|Lucid" emacs-version) - (setq verilog-font-lock-keywords verilog-font-lock-keywords-after-1930 ) - (cond ((> emacs-minor-version 29) - (setq verilog-font-lock-keywords verilog-font-lock-keywords-after-1930 )) - ('t - (setq verilog-font-lock-keywords verilog-font-lock-keywords-before-1930 )) - )) - (setq font-lock-keywords verilog-font-lock-keywords) + ;; Setting up things for font-lock + (if (string-match "XEmacs" emacs-version) + (progn + (if (and current-menubar + (not (assoc "Verilog" current-menubar))) + (progn + (set-buffer-menubar (copy-sequence current-menubar)) + (add-submenu nil verilog-xemacs-menu))) )) + ;; Stuff for GNU emacs + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '((verilog-font-lock-keywords verilog-font-lock-keywords-1 + verilog-font-lock-keywords-2 + verilog-font-lock-keywords-3 + verilog-font-lock-keywords-4) + nil t)) + ;; Tell imenu how to handle verilog. + (make-local-variable 'imenu-generic-expression) + (setq imenu-generic-expression verilog-imenu-generic-expression) + ;; End GNU emacs stuff (run-hooks 'verilog-mode-hook)) @@ -962,9 +977,7 @@ ((nth 4 state) ; Inside any comment (hence /**/) (newline) (beginning-of-line) - (verilog-indent-comment t) - (insert-string "* ") ) ((eolp) ;; First, check if current line should be indented @@ -986,9 +999,11 @@ (progn (end-of-line) (delete-horizontal-space) - (newline)))) + 't + ))) (newline) - (forward-line 1)) + (forward-line 1) + ) ;; Indent next line (if verilog-auto-indent-on-newline (verilog-indent-line)) @@ -1004,12 +1019,14 @@ "Insert `;' character and reindent the line." (interactive) (insert last-command-char) - (save-excursion - (beginning-of-line) - (verilog-indent-line)) - (if (and verilog-auto-newline - (= 0 (verilog-parenthesis-depth))) - (electric-verilog-terminate-line))) + (if (verilog-in-comment-or-string-p) + () + (save-excursion + (beginning-of-line) + (verilog-indent-line)) + (if (and verilog-auto-newline + (= 0 (verilog-parenthesis-depth))) + (electric-verilog-terminate-line)))) (defun electric-verilog-colon () "Insert `:' and do all indentions except line indent on this line." @@ -1046,7 +1063,10 @@ "Insert back-tick, and indent to coulmn 0 if this is a CPP directive." (interactive) (insert last-command-char) - (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*\`\\(\\\\|\\\\\|\\\\|\\\\)")) + (if (save-excursion + (beginning-of-line) + (looking-at +"^[ \t]*\`\\(\\\\|\\\\\|\\\\|\\\\)")) (save-excursion (beginning-of-line) (delete-horizontal-space)))) @@ -1055,21 +1075,25 @@ (interactive) ;; If verilog-tab-always-indent, indent the beginning of the line. (if verilog-tab-always-indent - (let* ((boi-point (save-excursion - (beginning-of-line) - (skip-chars-forward " \t") - (let (type state ) - (setq type (verilog-indent-line)) - (setq state (car type)) - (cond - ((eq state 'block) - (if (looking-at verilog-behavorial-block-beg-re ) - (error (concat "The reserved word \"" - (buffer-substring (match-beginning 0) (match-end 0)) - "\" must be at the behavorial level!")))) - )) - (back-to-indentation) - (point)))) + (let* ( + (boi-point + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (let (type state ) + (setq type (verilog-indent-line)) + (setq state (car type)) + (cond + ((eq state 'block) + (if (looking-at verilog-behavorial-block-beg-re ) + (error + (concat + "The reserved word \"" + (buffer-substring (match-beginning 0) (match-end 0)) + "\" must be at the behavorial level!")))) + )) + (back-to-indentation) + (point)))) (if (< (point) boi-point) (back-to-indentation))) (progn (insert "\t")) @@ -1115,16 +1139,16 @@ (if (fboundp 'zmacs-activate-region) (zmacs-activate-region))) -(defun verilog-comment-area (start end) +(defun verilog-comment-region (start end) "Put the region into a Verilog comment. The comments that are in this area are \"deformed\": `*)' becomes `!(*' and `}' becomes `!{'. These deformed comments are returned to normal if you use -\\[verilog-uncomment-area] to undo the commenting. +\\[verilog-uncomment-region] to undo the commenting. The commented area starts with `verilog-exclude-str-start', and ends with `verilog-include-str-end'. But if you change these variables, -\\[verilog-uncomment-area] won't recognize the comments." +\\[verilog-uncomment-region] won't recognize the comments." (interactive "r") (save-excursion ;; Insert start and endcomments @@ -1144,14 +1168,18 @@ (goto-char end) (save-excursion (while (re-search-backward "\\*/" start t) - (replace-match "!/*" t t))) + (replace-match "*-/" t t))) + (save-excursion + (let ((s+1 (1+ start))) + (while (re-search-backward "/\\*" s+1 t) + (replace-match "/-*" t t)))) ) ) -(defun verilog-uncomment-area () +(defun verilog-uncomment-region () "Uncomment a commented area; change deformed comments back to normal. This command does nothing if the pointer is not in a commented -area. See also `verilog-comment-area'." +area. See also `verilog-comment-region'." (interactive) (save-excursion (let ((start (point)) @@ -1174,8 +1202,11 @@ (delete-region pos (1+ (point)))) ;; Change comments back to normal (save-excursion - (while (re-search-backward "!/\\*" start t) + (while (re-search-backward "\\*-/" start t) (replace-match "*/" t t))) + (save-excursion + (while (re-search-backward "/-\\*" start t) + (replace-match "/*" t t))) ;; Remove startcomment (goto-char start) (beginning-of-line) @@ -1194,8 +1225,9 @@ ) (defun verilog-label-be (&optional arg) - "Label matching begin ... end, fork ... join and case ... endcase statements in this module; -With argument, first kill any existing labels." + "Label matching begin ... end, fork ... join and case ... endcase + statements in this module; With argument, first kill any existing + labels." (interactive) (let ((cnt 0) (oldpos (point)) @@ -1213,7 +1245,8 @@ (> (marker-position e) (point)) (verilog-re-search-forward (concat - "\\" + "\\" "\\|\\(`endif\\)\\|\\(`else\\)") nil 'move)) (goto-char (match-beginning 0)) @@ -1233,14 +1266,13 @@ (message "%d lines autocommented" cnt)) ) ) - (defun verilog-beg-of-statement () "Move backward to beginning of statement" (interactive) (while (save-excursion (and (not (looking-at verilog-complete-reg)) - (skip-chars-backward " \t") + (verilog-backward-syntactic-ws) (not (or (bolp) (= (preceding-char) ?\;))) ) ) @@ -1255,11 +1287,34 @@ (verilog-forward-syntactic-ws) ) ) + +(defun verilog-beg-of-statement-1 () + "Move backward to beginning of statement" + (interactive) + (let ((pt (point))) + + (while (and (not (looking-at verilog-complete-reg)) + (setq pt (point)) + (verilog-backward-token) + (setq pt (point)) + (verilog-backward-syntactic-ws) + (not (bolp)) + (not (= (preceding-char) ?\;))) + ) + (goto-char pt) + (while (progn + (setq pt (point)) + (and (not (looking-at verilog-complete-reg)) + (not (= (preceding-char) ?\;)) + (verilog-continued-line)))) + (goto-char pt) + (verilog-forward-syntactic-ws) + ) + ) (defun verilog-end-of-statement () "Move forward to end of current statement." (interactive) (let ((nest 0) pos) - (if (not (looking-at "[ \t\n]")) (forward-sexp -1)) (or (looking-at verilog-beg-block-re) ;; Skip to end of statement (setq pos (catch 'found @@ -1291,7 +1346,8 @@ (throw 'found (verilog-end-of-statement)))))) pos))) (defun verilog-in-case-region-p () - "Return TRUE if in a case region: more specifically, point @ in the line foo : @ begin" + "Return TRUE if in a case region: more specifically, point @ in the + line foo : @ begin" (interactive) (save-excursion (if (and @@ -1302,7 +1358,10 @@ (catch 'found (let ((nest 1)) (while t - (verilog-re-search-backward "\\(\\\\)\\|\\(\\[^:]\\)\\|\\(\\\\)\\>" nil 'move) + (verilog-re-search-backward + (concat "\\(\\\\)\\|\\(\\[^:]\\)\\|" + "\\(\\\\)\\>") + nil 'move) (cond ((match-end 3) (setq nest (1+ nest))) @@ -1325,15 +1384,21 @@ (interactive) (let ( (str 'nil) - (lim1 (progn - (save-excursion (verilog-re-search-backward verilog-endcomment-reason-re lim 'move) - (point))))) + (lim1 + (progn + (save-excursion + (verilog-re-search-backward verilog-endcomment-reason-re + lim 'move) + (point))))) ;; Try to find the real : (if (save-excursion (search-backward ":" lim1 t)) (let ((colon 0) b e ) - (while (and (< colon 1) - (verilog-re-search-backward "\\(\\[\\)\\|\\(\\]\\)\\|\\(:\\)" lim1 'move)) + (while + (and + (< colon 1) + (verilog-re-search-backward "\\(\\[\\)\\|\\(\\]\\)\\|\\(:\\)" + lim1 'move)) (cond ((match-end 1) ;; [ (setq colon (1+ colon)) @@ -1351,30 +1416,36 @@ (skip-chars-backward "\t ") (verilog-skip-backward-comment-or-string) (setq e (point)) - (setq b (progn - (if (verilog-re-search-backward "\\<\\(case[zx]?\\)\\>\\|;\\|\\" nil 'move) - (progn - (cond - ((match-end 1) - (goto-char (match-end 1)) - (verilog-forward-ws&directives) - (if (looking-at "(") - (progn - (forward-sexp) - (verilog-forward-ws&directives) - )) - (point)) - (t - (goto-char (match-end 0)) - (verilog-forward-ws&directives) - (point)) - )) - (error "Malformed case item") - ) + (setq b + (progn + (if + (verilog-re-search-backward + "\\<\\(case[zx]?\\)\\>\\|;\\|\\" nil 'move) + (progn + (cond + ((match-end 1) + (goto-char (match-end 1)) + (verilog-forward-ws&directives) + (if (looking-at "(") + (progn + (forward-sexp) + (verilog-forward-ws&directives) + )) + (point)) + (t + (goto-char (match-end 0)) + (verilog-forward-ws&directives) + (point)) + )) + (error "Malformed case item") ) + ) ) (setq str (buffer-substring b e)) - (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) + (if + (setq e + (string-match + "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) (setq str (concat (substring str 0 e) "..."))) str) 'nil) @@ -1471,7 +1542,7 @@ (if (eq type 'declaration) () (if - (looking-at "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)") + (looking-at verilog-enders-re) (cond (;- This is a case block; search back for the start of this case (match-end 1) @@ -1538,7 +1609,10 @@ (;- try to find "reason" for this begin (cond (; - (eq here (progn (verilog-beg-of-statement) (point))) + (eq here (progn + (verilog-backward-token) + (verilog-beg-of-statement) + (point))) (setq err nil) (setq str "")) ((looking-at verilog-endcomment-reason-re) @@ -1590,6 +1664,34 @@ ) ) ) + (;- end else + (match-end 5) + (goto-char there) + (let ((nest 0) + ( reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)") + ) + (catch 'skip + (while (verilog-re-search-backward reg nil 'move) + (cond + ((match-end 1) ; begin + (setq nest (1- nest))) + ((match-end 2) ; end + (setq nest (1+ nest))) + ((match-end 3) + (if (= 0 nest) + (progn + (goto-char (match-end 0)) + (setq there (point)) + (setq err nil) + (setq str (verilog-get-expr)) + (setq str (concat " // else: !if" str )) + (throw 'skip 1)) + ))) + ) + ) + ) + ) + (;- task/function/initial et cetera t (match-end 0) @@ -1736,10 +1838,10 @@ (case . (+ ind verilog-case-indent)) (cparenexp . (+ ind verilog-indent-level)) (cexp . (+ ind verilog-indent-level)) - (defun . verilog-indent-level) - (declaration . verilog-indent-level) + (defun . verilog-indent-level-module) + (declaration . verilog-indent-level-declaration) (tf . verilog-indent-level) - (behavorial . verilog-indent-level) + (behavorial . (+ verilog-indent-level-behavorial verilog-indent-level-module)) (statement . ind) (cpp . 0) (comment . (verilog-indent-comment)) @@ -1773,19 +1875,23 @@ ;; trap out if we crawl off the top of the buffer (if (bobp) (throw 'nesting 'cpp)) - (if (verilog-continued-line) + (if (verilog-continued-line-1) (let ((sp (point))) (if (and (not (looking-at verilog-complete-reg)) - (verilog-continued-line)) + (verilog-continued-line-1)) (progn (goto-char sp) (throw 'nesting 'cexp)) (goto-char sp)) + (if (and begin (not verilog-indent-begin-after-if) (looking-at verilog-no-indent-begin-re)) (throw 'nesting 'statement) - (throw 'nesting 'cexp))) + (progn + (throw 'nesting 'cexp) + ) + )) ;; not a continued line (goto-char starting_position)) @@ -1793,47 +1899,50 @@ (if (looking-at "\\") ;; search back for governing if, striding across begin..end pairs ;; appropriately - (let ((reg (concat - verilog-end-block-re - "\\|\\(\\\\)" - "\\|\\(\\\\)" - )) - (elsec 1) - ) - (while (verilog-re-search-backward reg nil 'move) + (let ((elsec 1)) + (while (verilog-re-search-backward verilog-ends-re nil 'move) (cond - ((match-end 1) ; endblock - ; try to leap back to matching outward block by striding across - ; indent level changing tokens then immediately - ; previous line governs indentation. + ((match-end 1) ; else, we're in deep + (setq elsec (1+ elsec)) + ) + ((match-end 2) ; found it + (setq elsec (1- elsec)) + (if (= 0 elsec) + ;; Now previous line describes syntax + (throw 'nesting 'statement) + )) + (t ; endblock + ; try to leap back to matching outward block by striding across + ; indent level changing tokens then immediately + ; previous line governs indentation. (let ((reg)(nest 1)) - (looking-at verilog-end-block-re-1);; end|join|endcase|endtable|endspecify +;; (looking-at verilog-end-block-re-1);; end|join|endcase|endtable|endspecify (cond - ((match-end 1) ; end + ((match-end 3) ; end ;; Search back for matching begin (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 2) ; endcase + ((match-end 4) ; endcase ;; Search back for matching case (setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ) ) - ((match-end 3) ; join + ((match-end 5) ; join ;; Search back for matching fork (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 4) ; endtable + ((match-end 6) ; endtable ;; Search back for matching table (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 5) ; endspecify + ((match-end 7) ; endspecify ;; Search back for matching specify (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 6) ; endfunction + ((match-end 8) ; endfunction ;; Search back for matching function (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 7) ; endspecify + ((match-end 9) ; endtask ;; Search back for matching task (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) @@ -1850,49 +1959,11 @@ ) ) ) - ((match-end 2) ; else, we're in deep - (setq elsec (1+ elsec)) - ) - ((match-end 3) ; found it - (setq elsec (1- elsec)) - (if (= 0 elsec) - ;; Now previous line describes syntax - (throw 'nesting 'statement) - ))) + ) ) ) ) - (while (verilog-re-search-backward verilog-indent-reg nil 'move) - (cond - ((match-end 1) ; beg-block - (looking-at verilog-beg-block-re-1) - (cond - ((match-end 2) (throw 'nesting 'case)) - (t (throw 'nesting 'block)))) - - ((match-end 2) ;; end-block - (verilog-leap-to-head) - (if (verilog-in-case-region-p) - (progn - (verilog-leap-to-case-head) - (if (looking-at verilog-case-re) - (throw 'nesting 'case)) - ))) - - ((or (match-end 3) ;; module.. primitive - (match-end 5)) ;; endtask.. - (throw 'nesting 'defun)) - - ((match-end 4) ;; endmodule - (throw 'nesting 'cpp)) - - ((match-end 6) ;; function/task - (throw 'nesting 'behavorial)) - - ((bobp) - (throw 'nesting 'cpp)) - ) - ) + (throw 'nesting (verilog-calc-1)) ) ) ) @@ -1902,9 +1973,53 @@ (setq type 'cpp)) (if (> par 0) ; Unclosed Parenthesis (list 'cparenexp par) - (if (eq type 'case) - (list type (verilog-case-indent-level)) - (list type (verilog-indent-level))))))) + (cond + ((eq type 'case) + (list type (verilog-case-indent-level))) + ((eq type 'statement) + (list type (current-column))) + ((eq type 'defun) + (list type 0)) + (t + (list type (verilog-indent-level))))) + ) + ) + ) +(defun verilog-calc-1 () + "" + (catch 'nesting + (while (verilog-re-search-backward verilog-indent-re nil 'move) + (cond + ((looking-at verilog-beg-block-re-1) + (cond + ((match-end 2) (throw 'nesting 'case)) + (t (throw 'nesting 'block)))) + + ((looking-at verilog-end-block-re) + (verilog-leap-to-head) + (if (verilog-in-case-region-p) + (progn + (verilog-leap-to-case-head) + (if (looking-at verilog-case-re) + (throw 'nesting 'case)) + ))) + + ((looking-at verilog-defun-level-re) + (throw 'nesting 'defun)) + + ((looking-at verilog-cpp-level-re) + (throw 'nesting 'cpp)) + + ((looking-at verilog-behavorial-level-re) + (throw 'nesting 'behavorial)) + + ((bobp) + (throw 'nesting 'cpp)) + ) + ) + ) + ) + (defun verilog-leap-to-case-head () "" (let ((nest 1)) (while (/= 0 nest) @@ -1922,82 +2037,98 @@ ) ) -(defun verilog-leap-to-head () "foo" +(defun verilog-leap-to-head () + "Move point to the head of this block; jump from end to matching begin, + from endcase to matching case, and so on." (let (reg snest (nest 1)) - (if (looking-at verilog-end-block-re-1);; end|join|endcase|endtable|endspecify - (progn + (cond + ((looking-at "\\") + ;; Search back for matching begin + (setq reg (concat "\\(\\\\)\\|\\(\\\\)\\|" + "\\(\\\\)\\|\\(\\\\)" ))) + + ((looking-at "\\") + ;; Search back for matching case + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ((looking-at "\\") + ;; Search back for matching fork + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ((looking-at "\\") + ;; Search back for matching table + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ((looking-at "\\") + ;; Search back for matching specify + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ((looking-at "\\") + ;; Search back for matching function + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ((looking-at "\\") + ;; Search back for matching task + (setq reg "\\(\\\\)\\|\\(\\\\)" ) + ) + ) + (catch 'skip + (let (sreg) + (while (verilog-re-search-backward reg nil 'move) (cond - ((match-end 1) ; end - ;; Search back for matching begin - (setq reg (concat "\\(\\\\)\\|\\(\\\\)\\|" - "\\(\\\\)\\|\\(\\\\)" ))) - - ((match-end 2) ; endcase - ;; Search back for matching case + ((match-end 1) ; begin + (setq nest (1- nest)) + (if (= 0 nest) + ;; Now previous line describes syntax + (throw 'skip 1)) + (if (and snest + (= snest nest)) + (setq reg sreg)) + ) + ((match-end 2) ; end + (setq nest (1+ nest)) + ) + ((match-end 3) + ;; endcase, jump to case + (setq snest nest) + (setq nest (1+ nest)) + (setq sreg reg) (setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ) ) - ((match-end 3) ; join - ;; Search back for matching fork + ((match-end 4) + ;; join, jump to fork + (setq snest nest) + (setq nest (1+ nest)) + (setq sreg reg) (setq reg "\\(\\\\)\\|\\(\\\\)" ) ) - ((match-end 4) ; endtable - ;; Search back for matching table - (setq reg "\\(\\\\)\\|\\(\\\\)" ) - ) - ((match-end 5) ; endspecify - ;; Search back for matching specify - (setq reg "\\(\\\\)\\|\\(\\\\)" ) - ) - ((match-end 6) ; endfunction - ;; Search back for matching function - (setq reg "\\(\\\\)\\|\\(\\\\)" ) - ) - ((match-end 7) ; endspecify - ;; Search back for matching task - (setq reg "\\(\\\\)\\|\\(\\\\)" ) - ) ) - (catch 'skip - (let (sreg) - (while (verilog-re-search-backward reg nil 'move) - - (cond - ((match-end 1) ; begin - (setq nest (1- nest)) - (if (= 0 nest) - ;; Now previous line describes syntax - (throw 'skip 1)) - (if (and snest - (= snest nest)) - (setq reg sreg)) - ) - ((match-end 2) ; end - (setq nest (1+ nest)) - ) - ((match-end 3) - ;; endcase, jump to case - (setq snest nest) - (setq nest (1+ nest)) - (setq sreg reg) - (setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ) - ) - ((match-end 4) - ;; join, jump to fork - (setq snest nest) - (setq nest (1+ nest)) - (setq sreg reg) - (setq reg "\\(\\\\)\\|\\(\\\\)" ) - ) - ) - ) - ) - ) ) + ) ) ) ) + +(defun verilog-continued-line-1 () + "Return true if this is a continued line. + Set point to where line starts" + (let ((continued 't)) + (if (eq 0 (forward-line -1)) + (progn + (end-of-line) + (verilog-backward-ws&directives) + (if (bobp) + (setq continued nil) + (setq continued (verilog-backward-token)) + ) + ) + (setq continued nil) + ) + continued) + ) + (defun verilog-continued-line () "Return true if this is a continued line. Set point to where line starts" @@ -2012,7 +2143,7 @@ (save-excursion (skip-chars-backward " \t") (not (bolp)))) - (setq continued (verilog-backward-token)) + (setq continued (verilog-backward-token)) ) ;; while ) ) @@ -2030,10 +2161,6 @@ (;-- Anything ending in a ; is complete (= (preceding-char) ?\;) nil) -;; (;-- Anything ending in a , is deemed complete -;; (= (preceding-char) ?\,) -;; nil) - (;-- Could be 'case (foo)' or 'always @(bar)' which is complete (= (preceding-char) ?\)) (progn @@ -2042,13 +2169,12 @@ (verilog-backward-syntactic-ws) (forward-word -1) (not (looking-at "\\[^:]")))) - (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete t (forward-word -1) (cond ( - (looking-at "\\(initial\\>\\)\\|\\(always\\>\\)") + (looking-at "\\(else\\)\\|\\(initial\\>\\)\\|\\(always\\>\\)") t) ( (looking-at verilog-indent-reg) @@ -2069,6 +2195,9 @@ ((= (preceding-char) ?\#) (backward-char) t) + ((= (preceding-char) ?\`) + (backward-char) + t) (t (goto-char back) @@ -2098,7 +2227,8 @@ (setq bol (progn (beginning-of-line) (point)))) (search-backward "//" bol t) ))) - ))) + )) + t) (defun verilog-forward-syntactic-ws (&optional lim) ;; forward skip over syntactic whitespace for Emacs 19. @@ -2315,60 +2445,60 @@ (ind (car (cdr indent-str)))) (delete-horizontal-space) (cond - (; handle comma continued exp + (; handle continued exp (eq type 'cexp) (let ((here (point))) - (if (progn (verilog-backward-syntactic-ws) - (= (preceding-char) ?\,)) - (let* ( fst - (column - (save-excursion - (backward-char 1) - (verilog-beg-of-statement) - (setq fst (point)) - (if (looking-at verilog-declaration-re) - (progn ;; we have multiple words - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (if (= (following-char) ?\[) - (progn - (forward-char 1) - (backward-up-list -1) - (skip-chars-forward " \t") - ) - ) + (verilog-backward-syntactic-ws) + (cond + ((= (preceding-char) ?\,) + (let* ( fst + (column + (save-excursion + (backward-char 1) + (verilog-beg-of-statement) + (setq fst (point)) + (if (looking-at verilog-declaration-re) + (progn ;; we have multiple words + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (if (= (following-char) ?\[) + (progn + (forward-char 1) + (backward-up-list -1) + (skip-chars-forward " \t") + ) ) - (;; we have a single word - goto-char fst) - ) - (current-column) + ) + (;; we have a single word + goto-char fst) ) + (current-column) ) - ) - (goto-char here) - (beginning-of-line) - (delete-horizontal-space) - (indent-to column)) - (progn + ) + ) (goto-char here) - (let ((val (eval (cdr (assoc type verilog-indent-alist))))) - ;; (verilog-comment-depth type val) - (delete-horizontal-space) - (indent-to val) - )) + (beginning-of-line) + (delete-horizontal-space) + (indent-to column)) + ) + ((= (preceding-char) ?\) ) + (goto-char here) + (indent-to (eval (cdr (assoc type verilog-indent-alist)))) ) + (t + (goto-char here) + (let ((val)) + (verilog-beg-of-statement) + (if (verilog-re-search-forward "=[ \\t]*" here 'move) + (setq val (current-column)) + (setq val (eval (cdr (assoc type verilog-indent-alist))))) + (goto-char here) + (indent-to val) + ) + ) + ) ) ) - (;-- Declaration -- maybe line 'em up - (and (not (or - (eq type 'cpp) - (eq type 'comment))) - (looking-at verilog-declaration-re) - (or (memq 'all verilog-auto-lineup) - (memq 'declaration verilog-auto-lineup))) - (verilog-indent-declaration (cond ((eq type 'defun) 0) - (t ind))) - ) (; handle inside parenthetical expressions (eq type 'cparenexp) (let ((column (save-excursion @@ -2380,6 +2510,11 @@ (delete-horizontal-space) (indent-to column))) + (;-- Handle the ends + (looking-at verilog-end-block-re ) + (if (eq type 'statement) + (indent-to (- ind verilog-indent-level)) + (indent-to ind))) (;-- Case -- maybe line 'em up (and (eq type 'case) (not (looking-at "^[ \t]*$"))) (progn @@ -2390,27 +2525,28 @@ (indent-to (eval (cdr (assoc type verilog-indent-alist)))) )))) - (;-- Handle the ends - (looking-at verilog-end-block-re) - (if (eq type 'statement) - (indent-to (- ind verilog-indent-level)) - (indent-to ind))) + (;-- defun (and (eq type 'defun) - (looking-at verilog-zero-indent-re)) + (looking-at verilog-zero-indent-re)) (indent-to 0)) + (;-- declaration + (and (or + (eq type 'defun) + (eq type 'block)) + (looking-at verilog-declaration-re)) + (verilog-indent-declaration ind)) + (;-- Everything else t (let ((val (eval (cdr (assoc type verilog-indent-alist))))) - ;; (verilog-comment-depth type val) - (delete-horizontal-space) (indent-to val) )) ) (if (looking-at "[ \t]+$") (skip-chars-forward " \t")) - indent-str ; Return verilog-calculate-indent data + indent-str ; Return indent data ) ) @@ -2426,13 +2562,12 @@ "Return the indent-level the current statement has. Do not count named blocks or case-statements." (save-excursion - (beginning-of-line) (skip-chars-forward " \t") (cond ((looking-at verilog-named-block-re) (current-column)) ((and (not (looking-at verilog-case-re)) - (looking-at "[^:;]+[ \t]*:")) + (looking-at "^[^:;]+[ \t]*:")) (search-forward ":" nil t) (skip-chars-forward " \t") (current-column)) @@ -2468,91 +2603,145 @@ ;;; - -(defun verilog-indent-declaration (base-ind &optional arg start end) - "Indent current lines as declaration, lining up the variable names" +(defun verilog-pretty-declarations () + "Line up declarations arround point" + (interactive) + (save-excursion + (if (progn + (verilog-beg-of-statement-1) + (looking-at verilog-declaration-re)) + (let* ((m1 (make-marker)) + (e) (r) + (here (point)) + (start + (progn + (verilog-beg-of-statement-1) + (while (looking-at verilog-declaration-re) + (beginning-of-line) + (setq e (point)) + (verilog-backward-syntactic-ws) + (backward-char) + (verilog-beg-of-statement-1)) + e)) + (end + (progn + (goto-char here) + (verilog-end-of-statement) + (setq e (point)) ;Might be on last line + (verilog-forward-syntactic-ws) + (while (looking-at verilog-declaration-re) + (beginning-of-line) + (verilog-end-of-statement) + (setq e (point)) + (verilog-forward-syntactic-ws) + ) + e)) + (edpos (set-marker (make-marker) end)) + (ind) + (base-ind + (progn + (goto-char start) + (verilog-do-indent (verilog-calculate-indent)) + (verilog-forward-ws&directives) + (current-column) + )) + ) + (goto-char end) + (goto-char start) + (if (> (- end start) 100) + (message "Lining up declarations..(please stand by)")) + ;; Get the begining of line indent first + (while (progn (setq e (marker-position edpos)) + (< (point) e)) + (delete-horizontal-space) + (indent-to base-ind) + (forward-line)) + ;; Now find biggest prefix + (setq ind (verilog-get-lineup-indent start edpos)) + ;; Now indent each line. + (goto-char start) + (while (progn (setq e (marker-position edpos)) + (setq r (- e (point))) + (> r 0)) + (setq e (point)) + (message "%d" r) + (cond + ((looking-at verilog-declaration-re-1) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "\\[" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (just-one-space) + (indent-to ind) + ) + (progn + (just-one-space) + (indent-to ind)) + ) + )) + ((verilog-continued-line-1) + (goto-char e) + (delete-horizontal-space) + (indent-to ind)) + (t ; Must be comment or white space + (goto-char e) + (verilog-forward-ws&directives) + (forward-line -1) + ) + ) + (forward-line 1) + ) + (message "") + ) + ) + ) + ) +(defun verilog-indent-declaration (baseind) + "Indent current lines as declaration, lining up the variable names + based on previous declaration's indentation." (interactive) (let ((pos (point-marker)) - (lim (save-excursion (progn (end-of-line) (point-marker)))) + (lim (save-excursion + (verilog-re-search-backward "\\(\\\\)\\|\\(\\\\)" nil 'move) + (point))) + (ind) + (m1 (make-marker)) ) - (if (and (not (or arg start)) (not (verilog-re-search-forward verilog-declaration-re lim t))) - () - (progn - (beginning-of-line) - (delete-horizontal-space) - (indent-to (+ base-ind (eval (cdr (assoc 'declaration verilog-indent-alist))))) - (let* ((pos2 (point-marker)) - (more 1) - here - (stpos (if start start - (save-excursion - - (goto-char pos2) - (catch 'first - (while more - (setq here (point)) - (verilog-backward-syntactic-ws) - (if (= (preceding-char) ?\;) - (backward-char)) - (verilog-beg-of-statement) - (if (bobp) - (throw 'first (point-marker))) - (if (looking-at verilog-declaration-re) - (setq more (/= (point) here)) - (throw 'first (point-marker)))) - (throw 'first (point-marker))) - ) - ) + ;; Use previous declaration (in this module) as template. + (if (verilog-re-search-backward verilog-declaration-re-1 lim t) + (progn + (goto-char (match-end 0)) + (setq ind (current-column)) + (goto-char pos) + (beginning-of-line) + (indent-to (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) + (if (looking-at verilog-declaration-re-2) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "\\[" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (just-one-space) + (indent-to ind) ) - (edpos (if end - (set-marker (make-marker) end) - lim)) - ind) - (goto-char stpos) - ;; Indent lines in declaration block - (if arg - (while (<= (point) (marker-position edpos)) - (beginning-of-line) - (delete-horizontal-space) - (cond - ((looking-at "^[ \t]*$") - ()) - ((not (looking-at verilog-declaration-re)) - (indent-to arg)) - (t - (indent-to (+ arg verilog-indent-level)))) - (forward-line 1))) - - ;; Do lineup - (setq ind (verilog-get-lineup-indent stpos edpos)) - (goto-char stpos) - (if (> (- edpos stpos) 100) - (message "Lining up declarations..(please stand by)")) - (let (e) - (while (progn (setq e (marker-position edpos)) - (< (point) e)) - (if (verilog-re-search-forward verilog-declaration-re-1 e 'move) - (just-one-space)) -;; (forward-char -1)) - (save-excursion - (let ((p (point))) - (beginning-of-line) - (if (verilog-re-search-forward "\\[" p 'move) - (progn - (forward-char -1) - (just-one-space))) - )) - (delete-horizontal-space) - (indent-to ind) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (+ base-ind (eval (cdr (assoc 'declaration verilog-indent-alist))))) - (forward-line 1))))) - - ;; If arg - move point - (message "") - (if arg (forward-line -1) - (goto-char (marker-position pos)))))) + (progn + (just-one-space) + (indent-to ind) + ) + ) + ) + ) + ) + (indent-to (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) + ) + (goto-char pos) + ) + ) ; "Return the indent level that will line up several lines within the region ;from b to e nicely. The lineup string is str." @@ -2963,7 +3152,6 @@ ;; is an exact match. If flag is 'lambda, the function returns t if ;; STR is an exact match, nil otherwise. - (defun verilog-comp-defun (verilog-str verilog-pred verilog-flag) (save-excursion (let ((verilog-all nil) @@ -3075,4 +3263,47 @@ (setq tag (format "%3d" this-linenum))) (insert tag ?:))))))) (set-buffer-modified-p nil)))) + +(defun verilog-submit-bug-report () + "Submit via mail a bug report on lazy-lock.el." + (interactive) + (let ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report + "verilog-mode-bugs@silicon-sorcery.com" + (concat "verilog-mode v" (substring verilog-mode-version 12 -3)) + '(verilog-indent-level + verilog-indent-level-module + verilog-indent-level-declaration + verilog-indent-level-behavorial + verilog-case-indent + verilog-auto-newline + verilog-auto-indent-on-newline + verilog-tab-always-indent + verilog-auto-endcomments + verilog-minimum-comment-distance + verilog-indent-begin-after-if + verilog-auto-lineup) + nil nil + (concat "Hi Mac, + +I want to report a bug. I've read the `Bugs' section of `Info' on +Emacs, so I know how to make a clear and unambiguous report. To get +to that Info section, I typed + +M-x info RET m " invocation-name " RET m bugs RET + +Before I go further, I want to say that Verilog mode has changed my life. +I save so much time, my files are colored nicely, my co workers respect +my coding ability... until now. I'd really appreciate anything you +could do to help me out with this minor deficiency in the product. + +To reproduce the bug, start a fresh Emacs via " invocation-name " +-no-init-file -no-site-file'. In a new buffer, in verilog mode, type +the code included below. + +Given those lines, I expected [[Fill in here]] to happen; +but instead, [[Fill in here]] happens!. + +== The code: ==")))) + ;;; verilog.el ends here diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/whitespace-mode.el --- a/lisp/modes/whitespace-mode.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/whitespace-mode.el Mon Aug 13 09:30:11 2007 +0200 @@ -26,7 +26,7 @@ ;;; Commentary: -;; $Id: whitespace-mode.el,v 1.2 1997/02/24 01:13:44 steve Exp $ +;; $Id: whitespace-mode.el,v 1.3 1997/04/19 23:21:05 steve Exp $ ;; Description: ;; ;; This is a minor mode, which highlights whitespaces (blanks and @@ -87,7 +87,13 @@ ;;; variables: -(defvar whitespace-chars 'tabs-and-blanks +(defgroup whitespace nil + "Minor mode for making whitespace visible" + :group 'outlines + :group 'matching) + + +(defcustom whitespace-chars 'tabs-and-blanks "*Determines, which whitespaces are highlighted. Valid values are: 'tabs-and-blanks => tabs and blanks are highlighted; @@ -95,54 +101,74 @@ 'blanks => only blanks are highlighted;. Changing this variable during the whitespace-*-mode is active could lead -to wrong highlighted whitespaces.") +to wrong highlighted whitespaces." + :type '(radio (const tabs-and-blanks) + (const tabs) + (const blanks)) + :group 'whitespace) (make-variable-buffer-local 'whitespace-chars) -(defvar whitespace-mode-hook nil - "*Run after the `whitespace-mode' is switched on.") +(defcustom whitespace-mode-hook nil + "*Run after the `whitespace-mode' is switched on." + :type 'hook + :group 'whitespace) -(defvar whitespace-incremental-mode-hook nil - "*Run after the `whitespace-incremental-mode' is switched on.") +(defcustom whitespace-incremental-mode-hook nil + "*Run after the `whitespace-incremental-mode' is switched on." + :type 'hook + :group 'whitespace) (if (adapt-xemacsp) (progn -(defvar whitespace-install-toolbar-icon nil +(defcustom whitespace-install-toolbar-icon nil "Set it to t, if a toolbar icon should be installed during loading this file. -The icon calls the function 'whitespace-toolbar-function'.") +The icon calls the function 'whitespace-toolbar-function'." + :type 'boolean + :group 'whitespace) -(defvar whitespace-install-submenu nil - "Set it to t, if a submenu should be installed during loading this file.") +(defcustom whitespace-install-submenu nil + "Set it to t, if a submenu should be installed during loading this file." + :type 'boolean + :group 'whitespace) )) -(defvar whitespace-toolbar-function 'whitespace-incremental-mode +(defcustom whitespace-toolbar-function 'whitespace-incremental-mode "*The toolbar icon for the whitespace mode calls this function. -Valid values are: 'whitespace--mode and 'whitespace-incremental-mode.") +Valid values are: 'whitespace--mode and 'whitespace-incremental-mode." + :type 'function + :group 'whitespace) -(defvar whitespace-blank-and-tab-search-string "\\( \\)\\|\\(\t\\)" - "The regexp used to search for tabs and blanks.") +(defcustom whitespace-blank-and-tab-search-string "\\( \\)\\|\\(\t\\)" + "The regexp used to search for tabs and blanks." + :type 'regexp + :group 'whitespace) -(defvar whitespace-tab-search-string "\t" - "The search string used to find tabs.") +(defcustom whitespace-tab-search-string "\t" + "The search string used to find tabs." + :type 'string + :group 'whitespace) -(defvar whitespace-blank-search-string " " - "The search string used to find blanks.") +(defcustom whitespace-blank-search-string " " + "The search string used to find blanks." + :type 'string + :group 'whitespace) -;;; Defining faces -(if (facep 'whitespace-blank-face) - nil - (make-face 'whitespace-blank-face) - (set-face-background 'whitespace-blank-face "LightBlue1")) +(defface whitespace-blank-face + '((t + (:background "LightBlue1"))) + "Face to show blanks with" + :group 'whitespace) -(if (facep 'whitespace-tab-face) - nil - (make-face 'whitespace-tab-face) - (set-face-background 'whitespace-tab-face "yellow") - (set-face-underline-p 'whitespace-tab-face t)) +(defface whitespace-tab-face + '((t + (:background "yellow" :underline t))) + "Face to show TABs with" + :group 'whitespace) (defun whitespace-show-faces () "Shows the faces used by the `whitespace-mode'." diff -r b27e67717092 -r 34a5b81f86ba lisp/modes/xrdb-mode.el --- a/lisp/modes/xrdb-mode.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/modes/xrdb-mode.el Mon Aug 13 09:30:11 2007 +0200 @@ -67,13 +67,22 @@ ;; These variables are available for your customization -(defvar xrdb-mode-hook nil - "*Hook to be run when `xrdb-mode' is entered.") +(defgroup xrdb nil + "Mode for editing X resource database files." + :group 'languages) -(defvar xrdb-subdivide-by 'paragraph +(defcustom xrdb-mode-hook nil + "*Hook to be run when `xrdb-mode' is entered." + :type 'hook + :group 'xrdb) + +(defcustom xrdb-subdivide-by 'paragraph "*Extent of alignment calculations. Can be one of `buffer', `paragraph', `page', or `line'. Do a -\\[describe-function] xrdb-indent-buffer RET for more information.") +\\[describe-function] xrdb-indent-buffer RET for more information." + :type '(radio (const buffer) (const paragraph) + (const page) (const line)) + :group 'xrdb) diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/auto-save.el --- a/lisp/packages/auto-save.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/auto-save.el Mon Aug 13 09:30:11 2007 +0200 @@ -2,7 +2,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; File: auto-save.el -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; RCS: ;; Description: Safer autosaving with support for efs and /tmp. ;; This version of auto-save is designed to work with efs, @@ -11,7 +11,7 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst auto-save-version (substring "$Revision: 1.3 $" 11 -2) +(defconst auto-save-version (substring "$Revision: 1.4 $" 11 -2) "Version number of auto-save.") ;;; Copyright (C) 1992 by Sebastian Kremer @@ -268,7 +268,17 @@ ;; 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. - (name-prefix (if file-name nil (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. +;; (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 @@ -494,10 +504,10 @@ (t (setq total (1+ total)) (with-output-to-temp-buffer "*Directory*" - (call-process "ls" nil standard-output nil - "-l" afile (if file (list file)))) + (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? " - file)) + (or file "non-file buffer"))) (let* ((obuf (current-buffer)) (buf (set-buffer (if file diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/avoid.el --- a/lisp/packages/avoid.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/avoid.el Mon Aug 13 09:30:11 2007 +0200 @@ -72,6 +72,12 @@ (provide 'avoid) +(defgroup avoid nil + "Make mouse pointer stay out of the way of editing." + :prefix "mouse-avoidance-" + :group 'mouse) + + ;;;###autoload (defvar mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor. @@ -79,21 +85,29 @@ variable is NOT the recommended way to change modes; use that function instead.") -(defvar mouse-avoidance-nudge-dist 15 +(defcustom mouse-avoidance-nudge-dist 15 "*Average distance that mouse will be moved when approached by cursor. Only applies in mouse-avoidance-mode `jump' and its derivatives. -For best results make this larger than `mouse-avoidance-threshold'.") - -(defvar mouse-avoidance-nudge-var 10 - "*Variability of `mouse-avoidance-nudge-dist' (which see).") +For best results make this larger than `mouse-avoidance-threshold'." + :type 'integer + :group 'avoid) -(defvar mouse-avoidance-animation-delay .01 - "Delay between animation steps, in seconds.") +(defcustom mouse-avoidance-nudge-var 10 + "*Variability of `mouse-avoidance-nudge-dist' (which see)." + :type 'integer + :group 'avoid) -(defvar mouse-avoidance-threshold 5 +(defcustom mouse-avoidance-animation-delay .01 + "Delay between animation steps, in seconds." + :type 'number + :group 'avoid) + +(defcustom mouse-avoidance-threshold 5 "*Mouse-pointer's flight distance. If the cursor gets closer than this, the mouse pointer will move away. -Only applies in mouse-avoidance-modes `animate' and `jump'.") +Only applies in mouse-avoidance-modes `animate' and `jump'." + :type 'integer + :group 'avoid) ;; Internal variables (defvar mouse-avoidance-state nil) @@ -281,14 +295,15 @@ (defun mouse-avoidance-kbd-command (key) "Return t if the KEYSEQENCE is composed of keyboard events only. Return nil if there are any lists in the key sequence." - (cond ((null key) nil) ; Null event seems to be + (cond ((null key) nil) ; Null event seems to be ; returned occasionally. ((not (vectorp key)) t) ; Strings are keyboard events. ((catch 'done (let ((i 0) (l (length key))) (while (< i l) - (if (listp (aref key i)) + ;; XEmacs change: (Emacs version was: (listp (aref key i))) + (if (not (key-press-event-p (aref key i))) (throw 'done nil)) (setq i (1+ i)))) t)))) diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/completion.el --- a/lisp/packages/completion.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/completion.el Mon Aug 13 09:30:11 2007 +0200 @@ -281,44 +281,69 @@ ;; User changeable parameters ;;--------------------------------------------------------------------------- -(defvar enable-completion t +(defgroup completion nil + "Dynamic word-completion code." + :group 'matching) + + +(defcustom enable-completion t "*Non-nil means enable recording and saving of completions. -If nil, no new words added to the database or saved to the init file.") +If nil, no new words added to the database or saved to the init file." + :type 'boolean + :group 'completion) -(defvar save-completions-flag t +(defcustom save-completions-flag t "*Non-nil means save most-used completions when exiting Emacs. -See also `saved-completions-retention-time'.") +See also `saved-completions-retention-time'." + :type 'boolean + :group 'completion) -(defvar save-completions-file-name (convert-standard-filename "~/.completions") - "*The filename to save completions to.") +(defcustom save-completions-file-name (convert-standard-filename "~/.completions") + "*The filename to save completions to." + :type 'file + :group 'completion) -(defvar save-completions-retention-time 336 +(defcustom save-completions-retention-time 336 "*Discard a completion if unused for this many hours. \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions -will not be saved unless these are used. Default is two weeks.") +will not be saved unless these are used. Default is two weeks." + :type 'integer + :group 'completion) -(defvar completion-on-separator-character nil +(defcustom completion-on-separator-character nil "*Non-nil means separator characters mark previous word as used. -This means the word will be saved as a completion.") +This means the word will be saved as a completion." + :type 'boolean + :group 'completion) -(defvar completions-file-versions-kept kept-new-versions - "*Number of versions to keep for the saved completions file.") +(defcustom completions-file-versions-kept kept-new-versions + "*Number of versions to keep for the saved completions file." + :type 'integer + :group 'completion) -(defvar completion-prompt-speed-threshold 4800 - "*Minimum output speed at which to display next potential completion.") +(defcustom completion-prompt-speed-threshold 4800 + "*Minimum output speed at which to display next potential completion." + :type 'integer + :group 'completion) -(defvar completion-cdabbrev-prompt-flag nil +(defcustom completion-cdabbrev-prompt-flag nil "*If non-nil, the next completion prompt does a cdabbrev search. -This can be time consuming.") +This can be time consuming." + :type 'boolean + :group 'completion) -(defvar completion-search-distance 15000 +(defcustom completion-search-distance 15000 "*How far to search in the buffer when looking for completions. -In number of characters. If nil, search the whole buffer.") +In number of characters. If nil, search the whole buffer." + :type 'integer + :group 'completion) -(defvar completions-merging-modes '(lisp c) +(defcustom completions-merging-modes '(lisp c) "*List of modes {`c' or `lisp'} for automatic completions merging. Definitions from visited files which have these modes -are automatically added to the completion database.") +are automatically added to the completion database." + :type '(set (const lisp) (const c)) + :group 'completion) ;;(defvar *record-cmpl-statistics-p* nil ;; "*If non-nil, record completion statistics.") diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/desktop.el --- a/lisp/packages/desktop.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/desktop.el Mon Aug 13 09:30:11 2007 +0200 @@ -108,17 +108,24 @@ ;; ---------------------------------------------------------------------------- ;; USER OPTIONS -- settings you might want to play with. ;; ---------------------------------------------------------------------------- + +(defgroup desktop nil + "Save partial status of Emacs when killed" + :group 'frames) + (defconst desktop-basefilename (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) "emacs.dsk" ; Ms-Dos does not support multiple dots in file name ".emacs.desktop") "File for Emacs desktop, not including the directory name.") -(defvar desktop-missing-file-warning t +(defcustom desktop-missing-file-warning t "*If non-nil then desktop warns when a file no longer exists. -Otherwise it simply ignores that file.") +Otherwise it simply ignores that file." + :type 'boolean + :group 'desktop) -(defvar desktop-globals-to-save +(defcustom desktop-globals-to-save (list 'desktop-missing-file-warning ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer ;; 'kill-ring @@ -133,9 +140,13 @@ An element may be variable name (a symbol) or a cons cell of the form (VAR . MAX-SIZE), which means to truncate VAR's value to at most MAX-SIZE elements -\(if the value is a list) before saving the value.") +\(if the value is a list) before saving the value." + :type '(repeat (choice (symbol :tag "Variable") + (cons (symbol :tag "Variable") + (integer :tag "Size")))) + :group 'desktop) -(defvar desktop-locals-to-save +(defcustom desktop-locals-to-save (list 'desktop-locals-to-save ; Itself! Think it over. 'truncate-lines 'case-fold-search @@ -146,20 +157,28 @@ 'line-number-mode ) "List of local variables to save for each buffer. -The variables are saved only when they really are local.") +The variables are saved only when they really are local." + :type '(repeat (choice (symbol :tag "Variable") + (cons (symbol :tag "Variable") + (integer :tag "Size")))) + :group 'desktop) (make-variable-buffer-local 'desktop-locals-to-save) ;; We skip .log files because they are normally temporary. ;; (ftp) files because they require passwords and whatnot. ;; TAGS files to save time (tags-file-name is saved instead). -(defvar desktop-buffers-not-to-save +(defcustom desktop-buffers-not-to-save "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" - "Regexp identifying buffers that are to be excluded from saving.") + "Regexp identifying buffers that are to be excluded from saving." + :type 'regexp + :group 'desktop) ;; Skip ange-ftp files -(defvar desktop-files-not-to-save +(defcustom desktop-files-not-to-save "^/[^/:]*:" - "Regexp identifying files whose buffers are to be excluded from saving.") + "Regexp identifying files whose buffers are to be excluded from saving." + :type 'regexp + :group 'desktop) (defvar desktop-buffer-major-mode nil "When desktop creates a buffer, this holds the desired Major mode.") @@ -174,7 +193,7 @@ "When desktop creates a buffer, this holds a list of misc info. It is used by the `desktop-buffer-handlers' functions.") -(defvar desktop-buffer-handlers +(defcustom desktop-buffer-handlers '(desktop-buffer-dired desktop-buffer-rmail desktop-buffer-mh @@ -185,14 +204,18 @@ variables `desktop-buffer-major-mode', `desktop-buffer-file-name', `desktop-buffer-name'. If one function returns non-nil, no further functions are called. -If the function returns t then the buffer is considered created.") +If the function returns t then the buffer is considered created." + :type '(repeat function) + :group 'desktop) (defvar desktop-create-buffer-form "(desktop-create-buffer 205" "Opening of form for creation of new buffers.") -(defvar desktop-save-hook nil +(defcustom desktop-save-hook nil "Hook run before saving the desktop to allow you to cut history lists and -the like shorter.") +the like shorter." + :type 'hook + :group 'desktop) ;; ---------------------------------------------------------------------------- (defvar desktop-dirname nil "The directory in which the current desktop file resides.") diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/fast-lock.el --- a/lisp/packages/fast-lock.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/fast-lock.el Mon Aug 13 09:30:11 2007 +0200 @@ -227,7 +227,12 @@ ;; User Variables: -(defvar fast-lock-cache-directories '("." "~/.emacs-flc") +(defgroup fast-lock nil + "Automagic text properties caching for fast Font Lock mode" + :group 'faces) + + +(defcustom fast-lock-cache-directories '("." "~/.emacs-flc") ; - `internal', keep each file's Font Lock cache file in the same file. ; - `external', keep each file's Font Lock cache file in the same directory. "*Directories in which Font Lock cache files are saved and read. @@ -245,9 +250,11 @@ ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\") would cause a file's current directory to be used if the file is under your -home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.") +home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'." + :type '(repeat (choice (cons regexp directory) directory)) + :group 'fast-lock) -(defvar fast-lock-minimum-size (* 25 1024) +(defcustom fast-lock-minimum-size (* 25 1024) "*Minimum size of a buffer for cached fontification. Only buffers more than this can have associated Font Lock cache files saved. If nil, means cache files are never created. @@ -255,18 +262,25 @@ where MAJOR-MODE is a symbol or t (meaning the default). For example: ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) means that the minimum size is 25K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise.") +for buffers in Rmail mode, and size is irrelevant otherwise." + :type '(choice (integer :tag "Size") (repeat (cons (symbol :tag "Major Mode") + (integer :tag "Size")))) + :group 'fast-lock) -(defvar fast-lock-save-events '(kill-buffer kill-emacs) +(defcustom fast-lock-save-events '(kill-buffer kill-emacs) "*Events under which caches will be saved. Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. If concurrent editing sessions use the same associated cache file for a file's -buffer, then you should add `save-buffer' to this list.") +buffer, then you should add `save-buffer' to this list." + :type '(set (const kill-buffer) (const save-buffer) (const kill-emacs)) + :group 'fast-lock) -(defvar fast-lock-save-others t +(defcustom fast-lock-save-others t "*If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated -Font Lock cache files saved. Ownership may be unknown for networked files.") +Font Lock cache files saved. Ownership may be unknown for networked files." + :type 'boolean + :group 'fast-lock) (defvar fast-lock-save-faces (when (save-match-data (string-match "XEmacs" (emacs-version))) @@ -275,9 +289,11 @@ "Faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved.") -(defvar fast-lock-verbose font-lock-verbose +(defcustom fast-lock-verbose font-lock-verbose "*If non-nil, means show status messages for cache processing. -If a number, only buffers greater than this size have processing messages.") +If a number, only buffers greater than this size have processing messages." + :type '(choice integer boolean) + :group 'fast-lock) ;; User Functions: diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/feedmail.el --- a/lisp/packages/feedmail.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/feedmail.el Mon Aug 13 09:30:11 2007 +0200 @@ -98,35 +98,49 @@ ;;; (autoload 'feedmail-send-it "feedmail") ;;; - -(defvar feedmail-confirm-outgoing nil - "*If non-nil, gives a y-or-n confirmation prompt after prepping, -before sending mail.") +(defgroup feedmail nil + "Outbound mail handling." + :group 'mail) -(defvar feedmail-nuke-bcc t +(defcustom feedmail-confirm-outgoing nil + "*If non-nil, gives a y-or-n confirmation prompt after prepping, +before sending mail." + :type 'boolean + :group 'feedmail) + + +(defcustom feedmail-nuke-bcc t "*Non-nil means get rid of the BCC: lines from the message header text before sending the mail. In any case, the BCC: lines do participate in the composed address list. You probably want to keep -them if you're using sendmail (see feedmail-buffer-eating-function).") +them if you're using sendmail (see feedmail-buffer-eating-function)." + :type 'boolean + :group 'feedmail) -(defvar feedmail-fill-to-cc t +(defcustom feedmail-fill-to-cc t "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header lines. If nil, the lines are left as-is. The filling is done after -mail address alias expansion.") +mail address alias expansion." + :type 'boolean + :group 'feedmail) -(defvar feedmail-fill-to-cc-fill-column default-fill-column - "*Fill column used when wrapping mail TO: and CC: lines.") +(defcustom feedmail-fill-to-cc-fill-column default-fill-column + "*Fill column used when wrapping mail TO: and CC: lines." + :type 'integer + :group 'feedmail) -(defvar feedmail-nuke-empty-headers t +(defcustom feedmail-nuke-empty-headers t "*If non-nil, headers with no contents are removed from the outgoing email. A completely empty SUBJECT: header is always removed, regardless of the setting of this variable. The only time you would want them left in would be if you used some headers whose presence -indicated something rather than their contents.") +indicated something rather than their contents." + :type 'boolean + :group 'feedmail) ;;; wjc sez: I think the use of the SENDER: line is pretty pointless, ;;; but I left it in to be compatible with sendmail.el and because @@ -134,25 +148,29 @@ ;;; want a sender line in your mail, just put one in there and don't ;;; wait for feedmail to do it for you. -(defvar feedmail-sender-line nil +(defcustom feedmail-sender-line nil "*If nil, no SENDER: header is forced. If non-nil and the email already has a FROM: header, a SENDER: header is forced with this as its contents. You can probably leave this nil, but if you feel like using it, a good value would be a fully-qualified domain name form of your address. For example, william.j.carpenter@att.com. Don't include a trailing newline or the keyword SENDER:. They're -automatically provided.") +automatically provided." + :type 'boolean + :group 'feedmail) ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins) -(defvar feedmail-from-line +(defcustom feedmail-from-line (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")") "*If non-nil and the email has no FROM: header, one will be forced with this as its contents. A good value would be a fully-qualified domain name form of your address. For example, william.j.carpenter@att.com. (The default value of this variable is probably not very good, since it doesn't have a domain part.) Don't include a trailing newline or -the keyword FROM:. They're automatically provided.") +the keyword FROM:. They're automatically provided." + :type '(choice (const nil) string) + :group 'feedmail) ;;; Here's how I use the GNUS Message-ID generator for mail but not @@ -174,7 +192,7 @@ ;;; (defun gnus-inews-message-id () nil) ;;; )) ;;; -(defvar feedmail-message-id-generator nil +(defcustom feedmail-message-id-generator nil "*If non-nil, should be a function (called with no arguments) which will generate a unique message ID which will be inserted on a Message-ID: header. The message ID should be the return value of the @@ -186,7 +204,9 @@ (the function may inspect it, but shouldn't modify it). If the returned value doesn't contain any non-whitespace characters, no message ID header is generated, so you could generate them conditionally, -based on the contents of the mail.") +based on the contents of the mail." + :type 'boolean + :group 'feedmail) (defun feedmail-confirm-addresses-hook-example () @@ -199,7 +219,7 @@ (error "Sending...gave up in last chance hook")))) -(defvar feedmail-last-chance-hook nil +(defcustom feedmail-last-chance-hook nil "*User's last opportunity to modify the message on its way out. It has already had all the header prepping from the standard package. The next step after running the hook will be to push the buffer into a @@ -210,10 +230,12 @@ the subprocess (the hook may change them). feedmail-error-buffer is an empty buffer intended to soak up errors for display to the user. If the hook allows interactive activity, the user should not send more -mail while in the hook since some of the internal buffers will be reused.") +mail while in the hook since some of the internal buffers will be reused." + :type 'hook + :group 'feedmail) ;; XEmacs change: make the default more sensible. -(defvar feedmail-buffer-eating-function +(defcustom feedmail-buffer-eating-function (if (and (boundp 'sendmail-program) (string-match "sendmail" sendmail-program)) 'feedmail-buffer-to-sendmail @@ -225,10 +247,12 @@ addresses. Two popular choices for this are 'feedmail-buffer-to-binmail and 'feedmail-buffer-to-sendmail. If you use the sendmail form, you probably want to set feedmail-nuke-bcc to nil. If you use the binmail -form, check the value of feedmail-binmail-template.") +form, check the value of feedmail-binmail-template." + :type 'function + :group 'feedmail) -(defvar feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") +(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") "*Command template for the subprocess which will get rid of the mail. It can result in any command understandable by /bin/sh. The single '%s', if present, gets replaced by the space-separated, @@ -238,7 +262,9 @@ instead of immediately in a buffer, try /bin/rmail instead of /bin/mail (this can be accomplished by keeping the default nil setting of mail-interactive). You might also like to consult local mail -experts for any other interesting command line possibilities.") +experts for any other interesting command line possibilities." + :type 'string + :group 'feedmail) ;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail are the diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/func-menu.el --- a/lisp/packages/func-menu.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/func-menu.el Mon Aug 13 09:30:11 2007 +0200 @@ -215,6 +215,11 @@ (defconst fume-version "2.45") +(defgroup fume nil + "Jump to a function within a buffer." + :tag "Func Menu" + :group 'tools) + (defconst fume-developer "David Hughes ") (defun fume-about () @@ -394,9 +399,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;; Customizable Variables ;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar fume-auto-position-popup t +(defcustom fume-auto-position-popup t "*Set to nil if you don't want the menu to appear in the corner of the window -in which case it will track the mouse position instead.") +in which case it will track the mouse position instead." + :type 'boolean + :group 'fume) (fume-defvar-local fume-display-in-modeline-p t "*Set to nil if you don't want the function name appearing in the modeline. @@ -409,8 +416,10 @@ (defvar fume-buffer-name "*Function List*" "Name of buffer used to list functions when fume-list-functions called") -(defvar fume-menubar-menu-name "Functions" - "*Set this to the string you want to appear in the menubar") +(defcustom fume-menubar-menu-name "Functions" + "*Set this to the string you want to appear in the menubar" + :type 'string + :group 'fume) ;;; Bob Weiner (defvar fume-menu-path nil @@ -419,33 +428,48 @@ of strings, each string names a successively deeper menu under which the new menu should be located.") -(defvar fume-menubar-menu-location "Buffers" +(defcustom fume-menubar-menu-location "Buffers" "*Set this nil if you want the menu to appear last on the menubar. -Otherwise set this to the menu you want \"Functions\" to appear in front of.") +Otherwise set this to the menu you want \"Functions\" to appear in front of." + :type '(choice (const :tag "Last" nil) (string :format "%v")) + :group 'fume) -(defvar fume-max-items 24 - "*Maximum number of elements in a function (sub)menu.") +(defcustom fume-max-items 24 + "*Maximum number of elements in a function (sub)menu." + :type 'integer + :group 'fume) -(defvar fume-fn-window-position 3 +(defcustom fume-fn-window-position 3 "*Number of lines from top of window at which to show function. -If nil, display function start from the centre of the window.") +If nil, display function start from the centre of the window." + :type '(choice (const :tag "Center" nil) integer) + :group 'fume) -(defvar fume-index-method 3 +(defcustom fume-index-method 3 "*Set this to the method number you want used. Methods currently supported: 0 = if you want submenu names to be numbered 1 = if you want submenu range indicated by first character 2 = if you want submenu range indicated by first 12 characters -3 = if you want submenu range indicated by as many characters as needed") +3 = if you want submenu range indicated by as many characters as needed" + :type '(radio (const :tag "Numbered" 0) + (const :tag "Indicated by first character" 1) + (const :tag "Indicated by first 12 characters" 2) + (const :tag "Indicated by as many characters as needed" 3)) + :group 'fume) -(defvar fume-scanning-message "Scanning buffer... (%3d%%)" +(defcustom fume-scanning-message "Scanning buffer... (%3d%%)" "*Set to nil if you don't want progress messages during manual scanning -of the buffer.") +of the buffer." + :type '(choice (const :tag "None" nil) string) + :group 'fume) -(defvar fume-rescanning-message nil +(defcustom fume-rescanning-message nil "*Set to non-nil if you want progress messages during automatic scanning -of the buffer. For example \"Re-Scanning buffer...\"") +of the buffer. For example \"Re-Scanning buffer...\"" + :type '(choice (const :tag "None" nil) string) + :group 'fume) (defvar fume-rescan-trigger-counter-buffer-size 10000 "Used to tune the frequency of automatic checks on the buffer. diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/generic-sc.el --- a/lisp/packages/generic-sc.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/generic-sc.el Mon Aug 13 09:30:11 2007 +0200 @@ -36,26 +36,41 @@ ;; in years gone by and revised at MIT's Project Athena. ;;; This can be customized by the user -(defvar sc-diff-command '("diff") - "*The command/flags list to be used in constructing diff commands.") + +(defgroup generic-sc nil + "Generic interface to source control systems" + :prefix "sc-" + :group 'tools) + + +(defcustom sc-diff-command '("diff") + "*The command/flags list to be used in constructing diff commands." + :type '(repeat string) + :group 'generic-sc) ;; Duplicated from pcl-cvs. (defvar cvs-program "cvs" "*The command name of the cvs program.") -(defvar sc-mode-expert () - "*Treat user as expert; suppress yes-no prompts on some things.") +(defcustom sc-mode-expert () + "*Treat user as expert; suppress yes-no prompts on some things." + :type 'boolean + :group 'generic-sc) -(defvar sc-max-log-size 510 - "*Maximum allowable size of a source control log message.") +(defcustom sc-max-log-size 510 + "*Maximum allowable size of a source control log message." + :type 'integer + :group 'generic-sc) -(defvar sc-ccase-comment-on '(checkout checkout-dir checkin-dir rename +(defcustom sc-ccase-comment-on '(checkout checkout-dir checkin-dir rename new-brtype new-branch checkin-merge create-label label-sources) "*Operations on which comments would be appreciated. We check the values checkout, checkout-dir, checkin-dir, rename, new-brtype, new-branch, create-label, -and label-sources as symbols.") +and label-sources as symbols." + :type '(repeat symbol) + :group 'generic-sc) (defvar sc-ccase-reserve nil "Whether to reserve checkouts or not. By default, this is nil - don't. diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/gopher.el --- a/lisp/packages/gopher.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/gopher.el Mon Aug 13 09:30:11 2007 +0200 @@ -199,53 +199,84 @@ )) )) -(defvar gopher-root-node (vector ?1 "root" "" "ucs_gopher" 70) - "The root gopher server, as a gopher object.") +(defgroup gopher nil + "An Emacs gopher client." + :group 'hypermedia) + -(defvar gopher-directory-mode-hook nil - "*Invoked when entering a new gopher directory.") +(defcustom gopher-root-node (vector ?1 "root" "" "ucs_gopher" 70) + "The root gopher server, as a gopher object." + :type '(vector character string string + (string :tag "Host") + (integer :tag "Port")) + :group 'gopher + :group 'local) + +(defcustom gopher-directory-mode-hook nil + "*Invoked when entering a new gopher directory." + :type 'hook + :group 'gopher) (defvar gopher-directory-mode-map (make-keymap) "Keymap for gopher-directory-mode.") -(defvar gopher-document-mode-hook nil - "*Invoked when showing gopher document.") +(defcustom gopher-document-mode-hook nil + "*Invoked when showing gopher document." + :type 'hook + :group 'gopher) (defvar gopher-document-mode-map (make-keymap) "Keymap for gopher-document-mode.") -(defvar gopher-form-mode-hooks nil - "*Invoked with entering a gopher form (i.e., for CSO).") +(defcustom gopher-form-mode-hooks nil + "*Invoked with entering a gopher form (i.e., for CSO)." + :type 'hook + :group 'gopher) (defvar gopher-form-mode-map (make-keymap) "Keymap for gopher-form-mode.") (defvar gopher-tmp-buf nil "Buffer used to receive output from gopher.") -(defvar gopher-debug-read t - "*If non-nil, show the current status about reading the gopher server output.") +(defcustom gopher-debug-read t + "*If non-nil, show the current status about reading the gopher server output." + :type 'boolean + :group 'gopher) ;; On some systems (such as SGI Iris), accept-process-output doesn't seem ;; to return for the last packet received on a connection. Turn this on ;; to work around the problem, but does anyone know what causes this? -(defvar gopher-buggy-accept nil +(defcustom gopher-buggy-accept nil "*If non-nil, use sit-for instead of accept-process-output. -If gopher consistently hangs while fetching an object, try turning this on.") +If gopher consistently hangs while fetching an object, try turning this on." + :type 'boolean + :group 'gopher) -(defvar gopher-hostname-aliases +(defcustom gopher-hostname-aliases '(("128.230.33.31" . "oliver.syr.edu")) "Emacs can't deal with raw IP addresses used as a hostname. -Use this to work around...") +Use this to work around..." + :type '(repeat (cons (string :tag "IP Address") + (string :tag "Host Name"))) + :group 'gopher) -(defvar gopher-port-aliases +(defcustom gopher-port-aliases '(("whois_port" . 43)) "Some losing hosts send a port name instead of a number. -Use this table to convert...") +Use this table to convert..." + :type '(repeat (cons (string :tag "Named Port") + (integer :tag "Port Number"))) + :group 'gopher) -(defvar gopher-support-bookmarks nil +(defcustom gopher-support-bookmarks nil "*If nil, do not implement bookmarks. If 'unix or t, read and write bookmarks to ~/.gopherrc. If a filename, read and save vector from there directly (not implemented yet). -If a vector, treat as a built-in directory.") +If a vector, treat as a built-in directory." + :type '(choice (const :tag "off" nil) + (const t) (const unix) + file + vector) + :group 'gopher) (defconst gopher-bookmarks nil "Internal bookmark directory.") (defconst gopher-bookmarks-modified nil "Do bookmarks need to be saved?") @@ -257,7 +288,7 @@ "Counts each time the bookmark vector is modified.") -(defvar gopher-telnet-command +(defcustom gopher-telnet-command (cond ((eq system-type 'vax-vms) (if (getenv "DECW$DISPLAY") "create/terminal/wait/window=(title=\"telnet\") telnet")) @@ -268,14 +299,18 @@ "*Command to use to start a telnet session. If this is nil, the emacs-lisp telnet package will be used. The default setting is to create a terminal window running telnet -if you've specified an X server, and to use the emacs-lisp telnet otherwise.") +if you've specified an X server, and to use the emacs-lisp telnet otherwise." + :type '(choice (const nil) string) + :group 'gopher) -(defvar gopher-image-display-command "xv -geometry +200+200" - "*The command used to try to display an image object.") +(defcustom gopher-image-display-command "xv -geometry +200+200" + "*The command used to try to display an image object." + :type 'string + :group 'gopher) -(defvar gopher-object-type-alist +(defcustom gopher-object-type-alist '(( ?0 "" gopher-document-object) ( ?1 "/" gopher-directory-object) ( ?2 " " gopher-cso-object) @@ -301,7 +336,9 @@ The third element is the function to use to retrieve the object. It is called with two arguments: the gopher object to retrieve and the buffer which should be returned to when the user is done -with this object.") +with this object." + :type '(repeat (list character string function)) + :group 'object) ;;; diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/hyper-apropos.el --- a/lisp/packages/hyper-apropos.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/hyper-apropos.el Mon Aug 13 09:30:11 2007 +0200 @@ -63,23 +63,36 @@ (fset 'pprint 'pp))) ;;(require 'tags "etags") -;;;###autoload -(defvar hypropos-show-brief-docs t - "*If non-nil, `hyper-apropos' will display some documentation in the -\"*Hyper Apropos*\" buffer. Setting this to nil will speed up searches.") +(defgroup hyper-apropos nil + "Hypertext emacs lisp documentation interface." + :prefix "hypropos-" + :group 'docs) -(defvar hypropos-shrink-window nil - "*If non-nil, shrink *Hyper Help* buffer if possible.") +;;;###autoload +(defcustom hypropos-show-brief-docs t + "*If non-nil, `hyper-apropos' will display some documentation in the +\"*Hyper Apropos*\" buffer. Setting this to nil will speed up searches." + :type 'boolean + :group 'hyper-apropos) -(defvar hypropos-prettyprint-long-values t - "*If non-nil, then try to beautify the printing of very long values.") +(defcustom hypropos-shrink-window nil + "*If non-nil, shrink *Hyper Help* buffer if possible." + :type 'boolean + :group 'hyper-apropos) + +(defcustom hypropos-prettyprint-long-values t + "*If non-nil, then try to beautify the printing of very long values." + :type 'boolean + :group 'hyper-apropos) ;; I changed this to true because I think it's more useful this way. --ben -(defvar hypropos-programming-apropos t +(defcustom hypropos-programming-apropos t "*If non-nil, then `hyper-apropos' takes a bit longer and generates more output. If nil, then only functions that are interactive and variables that -are user variables are found by `hyper-apropos'.") +are user variables are found by `hyper-apropos'." + :type 'boolean + :group 'hyper-apropos) (defvar hypropos-ref-buffer) (defvar hypropos-prev-wconfig) diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/igrep.el --- a/lisp/packages/igrep.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/igrep.el Mon Aug 13 09:30:11 2007 +0200 @@ -166,30 +166,47 @@ ;;; User options: -(defvar igrep-options nil +(defgroup igrep nil + "An improved interface to `grep'." + :group 'processes) + + +(defcustom igrep-options nil "*The options passed by \\[igrep] to `igrep-program', or nil. `-n' will automatically be passed to `igrep-program', to generate the output expected by \\[next-error] and \\[compile-goto-error]. `-e' will automatically be passed to `igrep-program', if it supports -that option.") - -(defvar igrep-read-options nil - "*If non-nil, `\\[igrep]' always prompts for options; -otherwise, it only prompts when 1 or 3 `C-u's are given as a prefix arg.") +that option." + :type '(repeat (string :tag "Option")) + :group 'igrep) -(defvar igrep-read-multiple-files nil +(defcustom igrep-read-options nil + "*If non-nil, `\\[igrep]' always prompts for options; +otherwise, it only prompts when 1 or 3 `C-u's are given as a prefix arg." + :type 'boolean + :group 'igrep) + +(defcustom igrep-read-multiple-files nil "*If non-nil, `\\[igrep]' always prompts for multiple-files; -otherwise, it only prompts when 2 or 3 `C-u's are given as a prefix arg.") +otherwise, it only prompts when 2 or 3 `C-u's are given as a prefix arg." + :type 'boolean + :group 'igrep) -(defvar igrep-verbose-prompts t +(defcustom igrep-verbose-prompts t "*If t, \\[igrep] prompts for arguments verbosely; if not t but non-nil, \\[igrep] prompts for arguments semi-verbosely; -if nil, \\[igrep] prompts for arguments tersely.") +if nil, \\[igrep] prompts for arguments tersely." + :type 'boolean + :group 'igrep) -(defvar igrep-save-buffers 'query +(defcustom igrep-save-buffers 'query "*If t, \\[igrep] first saves each modified file buffer; -if not t but non-nil, \\[igrep] offers to save each modified file buffer.") +if not t but non-nil, \\[igrep] offers to save each modified file buffer." + :type '(choice (const :tag "Save" t) + (const :tag "Dont Save" nil) + (const :tag "Query" query)) + :group 'igrep) (defvar igrep-program-table ; referenced by igrep-use-zgrep (let ((exec-directories exec-path) diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/lpr.el --- a/lisp/packages/lpr.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/lpr.el Mon Aug 13 09:30:11 2007 +0200 @@ -32,40 +32,59 @@ ;;; Code: +(defgroup lpr nil + "Print Emacs buffer on line printer" + :group 'wp) + + ;;;###autoload -(defvar lpr-switches nil +(defcustom lpr-switches nil "*List of strings to pass as extra options for the printer program. -See `lpr-command'.") +See `lpr-command'." + :type '(repeat (string :tag "Argument")) + :group 'lpr) -(defvar lpr-add-switches (eq system-type 'berkeley-unix) +(defcustom lpr-add-switches (eq system-type 'berkeley-unix) "*Non-nil means construct -T and -J options for the printer program. These are made assuming that the program is `lpr'; if you are using some other incompatible printer program, -this variable should be nil.") +this variable should be nil." + :type 'boolean + :group 'lpr) ;;;###autoload -(defvar lpr-command +(defcustom lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix)) "lp" "lpr") - "*Name of program for printing a file.") + "*Name of program for printing a file." + :type 'string + :group 'lpr) ;; Default is nil, because that enables us to use pr -f ;; which is more reliable than pr with no args, which is what lpr -p does. -(defvar lpr-headers-switches nil +(defcustom lpr-headers-switches nil "*List of strings of options to request page headings in the printer program. If nil, we run `lpr-page-header-program' to make page headings -and print the result.") +and print the result." + :type '(repeat (string :tag "Argument")) + :group 'lpr) -(defvar print-region-function nil +(defcustom print-region-function nil "Function to call to print the region on a printer. -See definition of `print-region-1' for calling conventions.") +See definition of `print-region-1' for calling conventions." + :type 'function + :group 'lpr) -(defvar lpr-page-header-program "pr" - "*Name of program for adding page headers to a file.") +(defcustom lpr-page-header-program "pr" + "*Name of program for adding page headers to a file." + :type 'string + :group 'lpr) -(defvar lpr-page-header-switches '("-f") +(defcustom lpr-page-header-switches '("-f") "*List of strings to use as options for the page-header-generating program. -The variable `lpr-page-header-program' specifies the program to use.") +The variable `lpr-page-header-program' specifies the program to use." + :type '(repeat string) + :group 'lpr) ;;;###autoload (defun lpr-buffer () diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/page-ext.el --- a/lisp/packages/page-ext.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/page-ext.el Mon Aug 13 09:30:11 2007 +0200 @@ -237,30 +237,49 @@ ;;; Customarily customizable variable definitions -(defvar pages-directory-buffer-narrowing-p t - "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.") +(defgroup pages nil + "Extended page-handling commands." + :group 'extensions) + + +(defcustom pages-directory-buffer-narrowing-p t + "*If non-nil, `pages-directory-goto' narrows pages buffer to entry." + :type 'boolean + :group 'pages) -(defvar pages-directory-for-adding-page-narrowing-p t - "*If non-nil, `add-new-page' narrows page buffer to new entry.") +(defcustom pages-directory-for-adding-page-narrowing-p t + "*If non-nil, `add-new-page' narrows page buffer to new entry." + :type 'boolean + :group 'pages) -(defvar pages-directory-for-adding-new-page-before-current-page-p t - "*If non-nil, `add-new-page' inserts new page before current page.") +(defcustom pages-directory-for-adding-new-page-before-current-page-p t + "*If non-nil, `add-new-page' inserts new page before current page." + :type 'boolean + :group 'pages) ;;; Addresses related variables -(defvar pages-addresses-file-name "~/addresses" +(defcustom pages-addresses-file-name "~/addresses" "*Standard name for file of addresses. Entries separated by page-delimiter. -Used by `pages-directory-for-addresses' function.") +Used by `pages-directory-for-addresses' function." + :type 'file + :group 'pages) -(defvar pages-directory-for-addresses-goto-narrowing-p t - "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.") +(defcustom pages-directory-for-addresses-goto-narrowing-p t + "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry." + :type 'boolean + :group 'pages) -(defvar pages-directory-for-addresses-buffer-keep-windows-p t - "*If nil, `pages-directory-for-addresses' deletes other windows.") +(defcustom pages-directory-for-addresses-buffer-keep-windows-p t + "*If nil, `pages-directory-for-addresses' deletes other windows." + :type 'boolean + :group 'pages) -(defvar pages-directory-for-adding-addresses-narrowing-p t - "*If non-nil, `add-new-page' narrows addresses buffer to new entry.") +(defcustom pages-directory-for-adding-addresses-narrowing-p t + "*If non-nil, `add-new-page' narrows addresses buffer to new entry." + :type 'boolean + :group 'pages) ;;; Key bindings for page handling functions diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/rcompile.el --- a/lisp/packages/rcompile.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/rcompile.el Mon Aug 13 09:30:11 2007 +0200 @@ -72,25 +72,41 @@ ;;;; user defined variables -(defvar remote-compile-host nil - "*Host for remote compilations.") +(defgroup remote-compile nil + "Run a compilation on a remote machine" + :group 'processes + :group 'tools) + -(defvar remote-compile-user nil +(defcustom remote-compile-host nil + "*Host for remote compilations." + :type '(choice string (const nil)) + :group 'remote-compile) + +(defcustom remote-compile-user nil "User for remote compilations. -nil means use the value returned by \\[user-login-name].") +nil means use the value returned by \\[user-login-name]." + :type '(choice string (const nil)) + :group 'remote-compile) -(defvar remote-compile-run-before nil +(defcustom remote-compile-run-before nil "*Command to run before compilation. This can be used for setting up environment variables, since rsh does not invoke the shell as a login shell and files like .login \(tcsh\) and .bash_profile \(bash\) are not run. -nil means run no commands.") +nil means run no commands." + :type '(choice string (const nil)) + :group 'remote-compile) -(defvar remote-compile-prompt-for-host nil - "*Non-nil means prompt for host if not available from filename.") +(defcustom remote-compile-prompt-for-host nil + "*Non-nil means prompt for host if not available from filename." + :type 'boolean + :group 'remote-compile) -(defvar remote-compile-prompt-for-user nil - "*Non-nil means prompt for user if not available from filename.") +(defcustom remote-compile-prompt-for-user nil + "*Non-nil means prompt for user if not available from filename." + :type 'boolean + :group 'remote-compile) ;;;; internal variables diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/recent-files.el --- a/lisp/packages/recent-files.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/recent-files.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,5 +1,5 @@ ;;; recent-files.el --- Maintain menu of recently opened files. -;;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.1.1.1 1996/12/18 22:42:54 steve Exp $ +;;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.2 1997/04/19 23:21:11 steve Exp $ ;;; ;;; Copyright (C) 1994, 1995 Juergen Nickelsen ;;; @@ -206,74 +206,124 @@ ;;; User options -(defvar recent-files-number-of-entries 15 - "*Maximum of non-permanent entries in the recent-files menu.") +(defgroup recent-files nil + "Maintain a menu of recently opened files." + :group 'data) -(defvar recent-files-number-of-saved-entries 50 - "*Maximum of non-permanent entries saved to `recent-files-save-file'.") +(defgroup recent-files-menu nil + "Menu options of recent-files." + :prefix "recent-files-" + :group 'recent-files) + + +(defcustom recent-files-number-of-entries 15 + "*Maximum of non-permanent entries in the recent-files menu." + :type 'integer + :group 'recent-files) -(defvar recent-files-save-file (expand-file-name "~/.recent-files.el") - "*File to save the recent-files list in.") +(defcustom recent-files-number-of-saved-entries 50 + "*Maximum of non-permanent entries saved to `recent-files-save-file'." + :type 'integer + :group 'recent-files) -(defvar recent-files-dont-include nil - "*List of regexps for filenames *not* to keep in recent-files.") +(defcustom recent-files-save-file (expand-file-name "~/.recent-files.el") + "*File to save the recent-files list in." + :type 'file + :group 'recent-files) -(defvar recent-files-use-full-names t +(defcustom recent-files-dont-include nil + "*List of regexps for filenames *not* to keep in recent-files." + :type '(repeat regexp) + :group 'recent-files) + +(defcustom recent-files-use-full-names t "*If non-nil, use the full pathname of a file in the recent-files menu. Otherwise use only the filename part. The `recent-files-filename-replacements' -are not applied in the latter case.") +are not applied in the latter case." + :type 'boolean + :group 'recent-files) -(defvar recent-files-filename-replacements +(defcustom recent-files-filename-replacements (list (cons (expand-file-name "~") "~")) "*List of regexp/replacement pairs for filename filenamees. If a filename of a filename matches one of the regexps, it is replaced -by the corresponding replacement.") +by the corresponding replacement." + :type '(repeat (cons regexp (string :tag "Replacement"))) + :group 'recent-files) -(defvar recent-files-sort-function (function recent-files-dont-sort) +(defcustom recent-files-sort-function (function recent-files-dont-sort) "*Function to sort the recent-files list with. The value `recent-files-dont-sort' means to keep the \"most recent on top\" -order.") +order." + :type 'function + :group 'recent-files) -(defvar recent-files-permanent-submenu nil - "*If non-nil, put the permanent entries of recent-files into a submenu.") +(defcustom recent-files-permanent-submenu nil + "*If non-nil, put the permanent entries of recent-files into a submenu." + :type 'boolean + :group 'recent-files-menu) -(defvar recent-files-non-permanent-submenu t - "*If non-nil, put the non-permanent entries of recent-files into a submenu.") +(defcustom recent-files-non-permanent-submenu t + "*If non-nil, put the non-permanent entries of recent-files into a submenu." + :type 'boolean + :group 'recent-files-menu) -(defvar recent-files-commands-submenu nil - "*If non-nil, put the commands of recent-files into a submenu.") +(defcustom recent-files-commands-submenu nil + "*If non-nil, put the commands of recent-files into a submenu." + :type 'boolean + :group 'recent-files-menu) -(defvar recent-files-commands-submenu-title "Commands..." - "*Title of the commands submenu of recent-files.") +(defcustom recent-files-commands-submenu-title "Commands..." + "*Title of the commands submenu of recent-files." + :type 'string + :group 'recent-files-menu) -(defvar recent-files-menu-title "Recent Files" - "*Name to be displayed as title of the recent-files menu.") +(defcustom recent-files-menu-title "Recent Files" + "*Name to be displayed as title of the recent-files menu." + :type 'string + :group 'recent-files-menu) -(defvar recent-files-menu-path nil +(defcustom recent-files-menu-path nil "*Path where to add the recent-files menu. A value of nil means add it as top-level menu. -For more information look up the documentation of `add-menu'.") +For more information look up the documentation of `add-menu'." + :type '(choice (const :tag "Top Level" nil) + (sexp :tag "Menu Path")) + :group 'recent-files-menu) -(defvar recent-files-add-menu-before nil +(defcustom recent-files-add-menu-before nil "*Name of the menu before which the recent-files menu shall be added. A value of nil means add it as the last menu in recent-files-menu-path. -For more information look up the documentation of `add-menu'.") +For more information look up the documentation of `add-menu'." + :type '(choice (string :tag "Name") + (const :tag "Last" nil)) + :group 'recent-files-menu) -(defvar recent-files-actions-on-top nil - "*If non-nil, put the actions on top of the recent-files menu.") +(defcustom recent-files-actions-on-top nil + "*If non-nil, put the actions on top of the recent-files menu." + :type 'boolean + :group 'recent-files-menu) -(defvar recent-files-permanent-first 'sort +(defcustom recent-files-permanent-first 'sort "*Control the placement of entries in the recent-files menu. If the value is t, permanent entries are put first. If the value is nil, non-permanent entries are put first. If the value is neither, the entries are mixed following -recent-files-sort-function if neither appear in a submenu.") +recent-files-sort-function if neither appear in a submenu." + :type '(choice (const :tag "Permanent First" t) + (const :tag "Non-Permanent First" nil) + (sexp :tag "Mixed")) + :group 'recent-files-menu) -(defvar recent-files-find-file-command (function find-file) - "*Command to invoke with an entry of the recent-files list.") +(defcustom recent-files-find-file-command (function find-file) + "*Command to invoke with an entry of the recent-files list." + :type 'function + :group 'recent-files) -(defvar recent-files-include-save-now nil - "*If non-nil, have a menu entry to save the recent-files list immediately.") +(defcustom recent-files-include-save-now nil + "*If non-nil, have a menu entry to save the recent-files list immediately." + :type 'boolean + :group 'recent-files-menu) ;;; Internal variables @@ -365,7 +415,7 @@ "Return a string identifying the current verion of recent-files. If called interactively, show it in the echo area." (interactive) - (let ((version "$Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.1.1.1 1996/12/18 22:42:54 steve Exp $")) + (let ((version "$Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.2 1997/04/19 23:21:11 steve Exp $")) (if (interactive-p) (message version) version))) diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/saveplace.el --- a/lisp/packages/saveplace.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/saveplace.el Mon Aug 13 09:30:11 2007 +0200 @@ -43,6 +43,11 @@ ;; this is what I was using during testing: ;; (define-key ctl-x-map "p" 'toggle-save-place) +(defgroup save-place nil + "Automatically save place in files." + :group 'data) + + (defvar save-place-alist nil "Alist of saved places to go back to when revisiting files. Each element looks like (FILENAME . POSITION); @@ -50,7 +55,7 @@ rather than the beginning of the buffer. This alist is saved between Emacs sessions.") -(defvar save-place nil +(defcustom save-place nil "*Non-nil means automatically save place in each file. This means when you visit a file, point goes to the last place where it was when you previously visited the same file. @@ -59,25 +64,37 @@ If you wish your place in any file to always be automatically saved, simply put this in your `~/.emacs' file: -\(setq-default save-place t\)") +\(setq-default save-place t\)" + :type 'boolean + :group 'save-place) (make-variable-buffer-local 'save-place) -(defvar save-place-file (convert-standard-filename "~/.emacs-places") - "*Name of the file that records `save-place-alist' value.") +(defcustom save-place-file (convert-standard-filename "~/.emacs-places") + "*Name of the file that records `save-place-alist' value." + :type 'file + :group 'save-place) -(defvar save-place-version-control 'nospecial +(defcustom save-place-version-control 'nospecial "*Controls whether to make numbered backups of master save-place file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just use the -value of `version-control'.") +value of `version-control'." + :type '(radio (const :tag "Unconditionally" t) + (const :tag "For VC Files" nil) + (const never) + (const :tag "Use value of version-control" nospecial)) + :group 'save-place) (defvar save-place-loaded nil "Non-nil means that the `save-place-file' has been loaded.") -(defvar save-place-limit nil - "Maximum number of entries to retain in the list; nil means no limit.") +(defcustom save-place-limit nil + "Maximum number of entries to retain in the list; nil means no limit." + :type '(choice (integer :tag "Entries" :value 1) + (const :tag "No Limit" nil)) + :group 'save-place) (defun toggle-save-place (&optional parg) "Toggle whether to save your place in this file between sessions. diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/time-stamp.el --- a/lisp/packages/time-stamp.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/time-stamp.el Mon Aug 13 09:30:11 2007 +0200 @@ -52,21 +52,31 @@ ;; Originally based on the 19 Dec 88 version of ;; date.el by John Sturdy ;; version 2, January 1995: replaced functions with %-escapes -;; $Id: time-stamp.el,v 1.1.1.2 1996/12/18 22:50:44 steve Exp $ +;; $Id: time-stamp.el,v 1.2 1997/04/19 23:21:12 steve Exp $ ;;; Code: -(defvar time-stamp-active t +(defgroup time-stamp nil + "Maintain last change time stamps in files edited by Emacs." + :group 'data + :group 'extensions) + + +(defcustom time-stamp-active t "*Non-nil to enable time-stamping of buffers by \\[time-stamp]. Can be toggled by \\[time-stamp-toggle-active]. -See also the variable time-stamp-warn-inactive.") +See also the variable time-stamp-warn-inactive." + :type 'boolean + :group 'time-stamp) -(defvar time-stamp-warn-inactive t +(defcustom time-stamp-warn-inactive t "*Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped. A warning is printed if time-stamp-active is nil and the buffer contains -a time stamp template that would otherwise have been updated.") +a time stamp template that would otherwise have been updated." + :type 'boolean + :group 'time-stamp) -(defvar time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u" +(defcustom time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u" "*Template for the string inserted by \\[time-stamp]. Value may be a string or a list. (Lists are supported only for backward compatibility.) A string is used verbatim except @@ -97,7 +107,9 @@ A leading zero causes numbers to be zero-filled. For example, to get the format used by the `date' command, -use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"") +use \"%3a %3b %2d %02H:%02M:%02S %Z %y\"" + :type 'string + :group 'time-stamp) ;;; Do not change time-stamp-line-limit, time-stamp-start, or diff -r b27e67717092 -r 34a5b81f86ba lisp/packages/upd-copyr.el --- a/lisp/packages/upd-copyr.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/packages/upd-copyr.el Mon Aug 13 09:30:11 2007 +0200 @@ -34,26 +34,38 @@ ;;; Code: +(defgroup copyright nil + "Update the copyright notice in a Lisp file." + :group 'maint) + + ;; #### - this will break if you dump it into emacs (defconst copyright-year (substring (current-time-string) -4) "String representing the current year.") ;;;###autoload -(defvar copyright-do-not-disturb "Free Software Foundation, Inc." +(defcustom copyright-do-not-disturb "Free Software Foundation, Inc." "*If non-nil, the existing copyright holder is checked against this regexp. If it does not match, then a new copyright line is added with the copyright -holder set to the value of `copyright-whoami'.") +holder set to the value of `copyright-whoami'." + :type '(choice (const nil) string) + :group 'copyright) ;;;###autoload -(defvar copyright-whoami nil - "*A string containing the name of the owner of new copyright notices.") +(defcustom copyright-whoami nil + "*A string containing the name of the owner of new copyright notices." + :type '(choice (const nil) string) + :group 'copyright) ;;;###autoload -(defvar copyright-notice-file nil - "*If non-nil, replace copying notices with this file.") +(defcustom copyright-notice-file nil + "*If non-nil, replace copying notices with this file." + :type '(choice (const nil) file) + :group 'copyright) -(defvar copyright-files-to-ignore-regex "loaddefs.el$" - "*Regular expression for files that should be ignored") +(defcustom copyright-files-to-ignore-regex "loaddefs.el$" + "*Regular expression for files that should be ignored" + :type 'regexp) (defvar current-gpl-version "2" "String representing the current version of the GPL.") diff -r b27e67717092 -r 34a5b81f86ba lisp/prim/auto-autoloads.el --- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:30:11 2007 +0200 @@ -169,373 +169,85 @@ ;;;### (autoloads (list-yahrzeit-dates calendar) "calendar" "calendar/calendar.el") -(defvar calendar-week-start-day 0 "\ -*The day of the week on which a week in the calendar begins. -0 means Sunday (default), 1 means Monday, and so on.") - -(defvar calendar-offset 0 "\ -*The offset of the principal month from the center of the calendar window. -0 means the principal month is in the center (default), -1 means on the left, -+1 means on the right. Larger (or smaller) values push the principal month off -the screen.") - -(defvar view-diary-entries-initially nil "\ -*Non-nil means display current date's diary entries on entry. -The diary is displayed in another window when the calendar is first displayed, -if the current date is visible. The number of days of diary entries displayed -is governed by the variable `number-of-diary-entries'.") - -(defvar number-of-diary-entries 1 "\ -*Specifies how many days of diary entries are to be displayed initially. -This variable affects the diary display when the command M-x diary is used, -or if the value of the variable `view-diary-entries-initially' is t. For -example, if the default value 1 is used, then only the current day's diary -entries will be displayed. If the value 2 is used, then both the current -day's and the next day's entries will be displayed. - -The value can also be a vector such as [0 2 2 2 2 4 1]; this value -says to display no diary entries on Sunday, the display the entries -for the current date and the day after on Monday through Thursday, -display Friday through Monday's entries on Friday, and display only -Saturday's entries on Saturday. - -This variable does not affect the diary display with the `d' command -from the calendar; in that case, the prefix argument controls the -number of days of diary entries displayed.") - -(defvar mark-diary-entries-in-calendar nil "\ -*Non-nil means mark dates with diary entries, in the calendar window. -The marking symbol is specified by the variable `diary-entry-marker'.") - -(defvar view-calendar-holidays-initially nil "\ -*Non-nil means display holidays for current three month period on entry. -The holidays are displayed in another window when the calendar is first -displayed.") - -(defvar mark-holidays-in-calendar nil "\ -*Non-nil means mark dates of holidays in the calendar window. -The marking symbol is specified by the variable `calendar-holiday-marker'.") - -(defvar all-hebrew-calendar-holidays nil "\ -*If nil, show only major holidays from the Hebrew calendar. -This means only those Jewish holidays that appear on secular calendars. - -If t, show all the holidays that would appear in a complete Hebrew calendar.") - -(defvar all-christian-calendar-holidays nil "\ -*If nil, show only major holidays from the Christian calendar. -This means only those Christian holidays that appear on secular calendars. - -If t, show all the holidays that would appear in a complete Christian -calendar.") - -(defvar all-islamic-calendar-holidays nil "\ -*If nil, show only major holidays from the Islamic calendar. -This means only those Islamic holidays that appear on secular calendars. - -If t, show all the holidays that would appear in a complete Islamic -calendar.") - -(defvar calendar-load-hook nil "\ -*List of functions to be called after the calendar is first loaded. -This is the place to add key bindings to `calendar-mode-map'.") - -(defvar initial-calendar-window-hook nil "\ -*List of functions to be called when the calendar window is first opened. -The functions invoked are called after the calendar window is opened, but -once opened is never called again. Leaving the calendar with the `q' command -and reentering it will cause these functions to be called again.") - -(defvar today-visible-calendar-hook nil "\ -*List of functions called whenever the current date is visible. -This can be used, for example, to replace today's date with asterisks; a -function `calendar-star-date' is included for this purpose: - (setq today-visible-calendar-hook 'calendar-star-date) -It can also be used to mark the current date with `calendar-today-marker'; -a function is also provided for this: - (setq today-visible-calendar-hook 'calendar-mark-today) - -The corresponding variable `today-invisible-calendar-hook' is the list of -functions called when the calendar function was called when the current -date is not visible in the window. - -Other than the use of the provided functions, the changing of any -characters in the calendar buffer by the hooks may cause the failure of the -functions that move by days and weeks.") - -(defvar today-invisible-calendar-hook nil "\ -*List of functions called whenever the current date is not visible. - -The corresponding variable `today-visible-calendar-hook' is the list of -functions called when the calendar function was called when the current -date is visible in the window. - -Other than the use of the provided functions, the changing of any -characters in the calendar buffer by the hooks may cause the failure of the -functions that move by days and weeks.") - -(defvar diary-file "~/diary" "\ -*Name of the file in which one's personal diary of dates is kept. - -The file's entries are lines in any of the forms - - MONTH/DAY - MONTH/DAY/YEAR - MONTHNAME DAY - MONTHNAME DAY, YEAR - DAYNAME - -at the beginning of the line; the remainder of the line is the diary entry -string for that date. MONTH and DAY are one or two digit numbers, YEAR is -a number and may be written in full or abbreviated to the final two digits. -If the date does not contain a year, it is generic and applies to any year. -DAYNAME entries apply to any date on which is on that day of the week. -MONTHNAME and DAYNAME can be spelled in full, abbreviated to three -characters (with or without a period), capitalized or not. Any of DAY, -MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, -respectively. - -The European style (in which the day precedes the month) can be used -instead, if you execute `european-calendar' when in the calendar, or set -`european-calendar-style' to t in your .emacs file. The European forms are - - DAY/MONTH - DAY/MONTH/YEAR - DAY MONTHNAME - DAY MONTHNAME YEAR - DAYNAME - -To revert to the default American style from the European style, execute -`american-calendar' in the calendar. - -A diary entry can be preceded by the character -`diary-nonmarking-symbol' (ordinarily `&') to make that entry -nonmarking--that is, it will not be marked on dates in the calendar -window but will appear in a diary window. - -Multiline diary entries are made by indenting lines after the first with -either a TAB or one or more spaces. - -Lines not in one the above formats are ignored. Here are some sample diary -entries (in the default American style): - - 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. - -If the first line of a diary entry consists only of the date or day name with -no trailing blanks or punctuation, then that line is not displayed in the -diary window; only the continuation lines is shown. For example, the -single diary entry - - 02/11/1989 - Bill Blattner visits Princeton today - 2pm Cognitive Studies Committee meeting - 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative' - 4:00pm Jamie Tappenden - 7:30pm Dinner at George and Ed's for Alan Ryan - 7:30-10:00pm dance at Stewart Country Day School - -will appear in the diary window without the date line at the beginning. This -facility allows the diary window to look neater, but can cause confusion if -used with more than one day's entries displayed. - -Diary entries can be based on Lisp sexps. For example, the diary entry - - %%(diary-block 11 1 1990 11 10 1990) Vacation - -causes the diary entry \"Vacation\" to appear from November 1 through November -10, 1990. Other functions available are `diary-float', `diary-anniversary', -`diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date', -`diary-hebrew-date', `diary-islamic-date', `diary-mayan-date', -`diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon', -`diary-parasha', `diary-omer', `diary-rosh-hodesh', and -`diary-sabbath-candles'. See the documentation for the function -`list-sexp-diary-entries' for more details. - -Diary entries based on the Hebrew and/or the Islamic calendar are also -possible, but because these are somewhat slow, they are ignored -unless you set the `nongregorian-diary-listing-hook' and the -`nongregorian-diary-marking-hook' appropriately. See the documentation -for these functions for details. - -Diary files can contain directives to include the contents of other files; for -details, see the documentation for the variable `list-diary-entries-hook'.") - -(defvar diary-nonmarking-symbol "&" "\ -*Symbol indicating that a diary entry is not to be marked in the calendar.") - -(defvar hebrew-diary-entry-symbol "H" "\ -*Symbol indicating a diary entry according to the Hebrew calendar.") - -(defvar islamic-diary-entry-symbol "I" "\ -*Symbol indicating a diary entry according to the Islamic calendar.") - -(defvar diary-include-string "#include" "\ -*The string indicating inclusion of another file of diary entries. -See the documentation for the function `include-other-diary-files'.") - -(defvar sexp-diary-entry-symbol "%%" "\ -*The string used to indicate a sexp diary entry in diary-file. -See the documentation for the function `list-sexp-diary-entries'.") - -(defvar abbreviated-calendar-year t "\ -*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. -For the Gregorian calendar; similarly for the Hebrew and Islamic calendars. -If this variable is nil, years must be written in full.") - -(defvar european-calendar-style nil "\ -*Use the European style of dates in the diary and in any displays. -If this variable is t, a date 1/2/1990 would be interpreted as February 1, -1990. The accepted European date styles are - - DAY/MONTH - DAY/MONTH/YEAR - DAY MONTHNAME - DAY MONTHNAME YEAR - DAYNAME - -Names can be capitalized or not, written in full, or abbreviated to three -characters with or without a period.") - -(defvar american-date-diary-pattern '((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W")) "\ -*List of pseudo-patterns describing the American patterns of date used. -See the documentation of `diary-date-forms' for an explanation.") - -(defvar european-date-diary-pattern '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W")) "\ -*List of pseudo-patterns describing the European patterns of date used. -See the documentation of `diary-date-forms' for an explanation.") - -(defvar european-calendar-display-form '((if dayname (concat dayname ", ")) day " " monthname " " year) "\ -*Pseudo-pattern governing the way a date appears in the European style. -See the documentation of calendar-date-display-form for an explanation.") - -(defvar american-calendar-display-form '((if dayname (concat dayname ", ")) monthname " " day ", " year) "\ -*Pseudo-pattern governing the way a date appears in the American style. -See the documentation of `calendar-date-display-form' for an explanation.") - -(defvar print-diary-entries-hook 'lpr-buffer "\ -*List of functions called after a temporary diary buffer is prepared. -The buffer shows only the diary entries currently visible in the diary -buffer. The default just does the printing. Other uses might include, for -example, rearranging the lines into order by day and time, saving the buffer -instead of deleting it, or changing the function used to do the printing.") - -(defvar list-diary-entries-hook nil "\ -*List of functions called after diary file is culled for relevant entries. -It is to be used for diary entries that are not found in the diary file. - -A function `include-other-diary-files' is provided for use as the value of -this hook. This function enables you to use shared diary files together -with your own. The files included are specified in the diary file by lines -of the form - - #include \"filename\" - -This is recursive; that is, #include directives in files thus included are -obeyed. You can change the \"#include\" to some other string by changing -the variable `diary-include-string'. When you use `include-other-diary-files' -as part of the list-diary-entries-hook, you will probably also want to use the -function `mark-included-diary-files' as part of `mark-diary-entries-hook'. - -For example, you could use - - (setq list-diary-entries-hook - '(include-other-diary-files sort-diary-entries)) - (setq diary-display-hook 'fancy-diary-display) - -in your `.emacs' file to cause the fancy diary buffer to be displayed with -diary entries from various included files, each day's entries sorted into -lexicographic order.") - -(defvar diary-hook nil "\ -*List of functions called after the display of the diary. -Can be used for appointment notification.") - -(defvar diary-display-hook nil "\ -*List of functions that handle the display of the diary. -If nil (the default), `simple-diary-display' is used. Use `ignore' for no -diary display. - -Ordinarily, this just displays the diary buffer (with holidays indicated in -the mode line), if there are any relevant entries. At the time these -functions are called, the variable `diary-entries-list' is a list, in order -by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) -STRING), where string is the diary entry for the given date. This can be -used, for example, a different buffer for display (perhaps combined with -holidays), or produce hard copy output. - -A function `fancy-diary-display' is provided as an alternative -choice for this hook; this function prepares a special noneditable diary -buffer with the relevant diary entries that has neat day-by-day arrangement -with headings. The fancy diary buffer will show the holidays unless the -variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy -diary buffer will 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 `diary-list-include-blanks' to t.") - -(defvar nongregorian-diary-listing-hook nil "\ -*List of functions called for listing diary file and included files. -As the files are processed for diary entries, these functions are used to cull -relevant entries. You can use either or both of `list-hebrew-diary-entries' -and `list-islamic-diary-entries'. The documentation for these functions -describes the style of such diary entries.") - -(defvar mark-diary-entries-hook nil "\ -*List of functions called after marking diary entries in the calendar. - -A function `mark-included-diary-files' is also provided for use as the -mark-diary-entries-hook; it enables you to use shared diary files together -with your own. The files included are specified in the diary file by lines -of the form - #include \"filename\" -This is recursive; that is, #include directives in files thus included are -obeyed. You can change the \"#include\" to some other string by changing the -variable `diary-include-string'. When you use `mark-included-diary-files' as -part of the mark-diary-entries-hook, you will probably also want to use the -function `include-other-diary-files' as part of `list-diary-entries-hook'.") - -(defvar nongregorian-diary-marking-hook nil "\ -*List of functions called for marking diary file and included files. -As the files are processed for diary entries, these functions are used to cull -relevant entries. You can use either or both of `mark-hebrew-diary-entries' -and `mark-islamic-diary-entries'. The documentation for these functions -describes the style of such diary entries.") - -(defvar diary-list-include-blanks nil "\ -*If nil, do not include days with no diary entry in the list of diary entries. -Such days will then not be shown in the fancy diary buffer, even if they -are holidays.") - -(defvar holidays-in-diary-buffer t "\ -*Non-nil means include holidays in the diary display. -The holidays appear in the mode line of the diary buffer, or in the -fancy diary buffer next to the date. This slows down the diary functions -somewhat; setting it to nil makes the diary display faster.") - -(defvar general-holidays '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fool's Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving")) "\ -*General holidays. Default value is for the United States. -See the documentation for `calendar-holidays' for details.") +(defcustom calendar-week-start-day 0 "*The day of the week on which a week in the calendar begins.\n0 means Sunday (default), 1 means Monday, and so on." :type 'integer :group 'calendar) + +(defcustom calendar-offset 0 "*The offset of the principal month from the center of the calendar window.\n0 means the principal month is in the center (default), -1 means on the left,\n+1 means on the right. Larger (or smaller) values push the principal month off\nthe screen." :type 'integer :group 'calendar) + +(defcustom view-diary-entries-initially nil "*Non-nil means display current date's diary entries on entry.\nThe diary is displayed in another window when the calendar is first displayed,\nif the current date is visible. The number of days of diary entries displayed\nis governed by the variable `number-of-diary-entries'." :type 'boolean :group 'diary) + +(defcustom number-of-diary-entries 1 "*Specifies how many days of diary entries are to be displayed initially.\nThis variable affects the diary display when the command M-x diary is used,\nor if the value of the variable `view-diary-entries-initially' is t. For\nexample, if the default value 1 is used, then only the current day's diary\nentries will be displayed. If the value 2 is used, then both the current\nday's and the next day's entries will be displayed.\n\nThe value can also be a vector such as [0 2 2 2 2 4 1]; this value\nsays to display no diary entries on Sunday, the display the entries\nfor the current date and the day after on Monday through Thursday,\ndisplay Friday through Monday's entries on Friday, and display only\nSaturday's entries on Saturday.\n\nThis variable does not affect the diary display with the `d' command\nfrom the calendar; in that case, the prefix argument controls the\nnumber of days of diary entries displayed." :type 'integer :group 'diary) + +(defcustom mark-diary-entries-in-calendar nil "*Non-nil means mark dates with diary entries, in the calendar window.\nThe marking symbol is specified by the variable `diary-entry-marker'." :type 'boolean :group 'diary) + +(defcustom view-calendar-holidays-initially nil "*Non-nil means display holidays for current three month period on entry.\nThe holidays are displayed in another window when the calendar is first\ndisplayed." :type 'boolean :group 'holidays) + +(defcustom mark-holidays-in-calendar nil "*Non-nil means mark dates of holidays in the calendar window.\nThe marking symbol is specified by the variable `calendar-holiday-marker'." :type 'boolean :group 'holidays) + +(defcustom all-hebrew-calendar-holidays nil "*If nil, show only major holidays from the Hebrew calendar.\nThis means only those Jewish holidays that appear on secular calendars.\n\nIf t, show all the holidays that would appear in a complete Hebrew calendar." :type 'boolean :group 'holidays) + +(defcustom all-christian-calendar-holidays nil "*If nil, show only major holidays from the Christian calendar.\nThis means only those Christian holidays that appear on secular calendars.\n\nIf t, show all the holidays that would appear in a complete Christian\ncalendar." :type 'boolean :group 'holidays) + +(defcustom all-islamic-calendar-holidays nil "*If nil, show only major holidays from the Islamic calendar.\nThis means only those Islamic holidays that appear on secular calendars.\n\nIf t, show all the holidays that would appear in a complete Islamic\ncalendar." :type 'boolean :group 'holidays) + +(defcustom calendar-load-hook nil "*List of functions to be called after the calendar is first loaded.\nThis is the place to add key bindings to `calendar-mode-map'." :type 'hook :group 'calendar) + +(defcustom initial-calendar-window-hook nil "*List of functions to be called when the calendar window is first opened.\nThe functions invoked are called after the calendar window is opened, but\nonce opened is never called again. Leaving the calendar with the `q' command\nand reentering it will cause these functions to be called again." :type 'hook :group 'calendar) + +(defcustom today-visible-calendar-hook nil "*List of functions called whenever the current date is visible.\nThis can be used, for example, to replace today's date with asterisks; a\nfunction `calendar-star-date' is included for this purpose:\n (setq today-visible-calendar-hook 'calendar-star-date)\nIt can also be used to mark the current date with `calendar-today-marker';\na function is also provided for this:\n (setq today-visible-calendar-hook 'calendar-mark-today)\n\nThe corresponding variable `today-invisible-calendar-hook' is the list of\nfunctions called when the calendar function was called when the current\ndate is not visible in the window.\n\nOther than the use of the provided functions, the changing of any\ncharacters in the calendar buffer by the hooks may cause the failure of the\nfunctions that move by days and weeks." :type 'hook :group 'calendar) + +(defcustom today-invisible-calendar-hook nil "*List of functions called whenever the current date is not visible.\n\nThe corresponding variable `today-visible-calendar-hook' is the list of\nfunctions called when the calendar function was called when the current\ndate is visible in the window.\n\nOther than the use of the provided functions, the changing of any\ncharacters in the calendar buffer by the hooks may cause the failure of the\nfunctions that move by days and weeks." :type 'hook :group 'calendar) + +(defcustom diary-file "~/diary" "*Name of the file in which one's personal diary of dates is kept.\n\nThe file's entries are lines in any of the forms\n\n MONTH/DAY\n MONTH/DAY/YEAR\n MONTHNAME DAY\n MONTHNAME DAY, YEAR\n DAYNAME\n\nat the beginning of the line; the remainder of the line is the diary entry\nstring for that date. MONTH and DAY are one or two digit numbers, YEAR is\na number and may be written in full or abbreviated to the final two digits.\nIf the date does not contain a year, it is generic and applies to any year.\nDAYNAME entries apply to any date on which is on that day of the week.\nMONTHNAME and DAYNAME can be spelled in full, abbreviated to three\ncharacters (with or without a period), capitalized or not. Any of DAY,\nMONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year,\nrespectively.\n\nThe European style (in which the day precedes the month) can be used\ninstead, if you execute `european-calendar' when in the calendar, or set\n`european-calendar-style' to t in your .emacs file. The European forms are\n\n DAY/MONTH\n DAY/MONTH/YEAR\n DAY MONTHNAME\n DAY MONTHNAME YEAR\n DAYNAME\n\nTo revert to the default American style from the European style, execute\n`american-calendar' in the calendar.\n\nA diary entry can be preceded by the character\n`diary-nonmarking-symbol' (ordinarily `&') to make that entry\nnonmarking--that is, it will not be marked on dates in the calendar\nwindow but will appear in a diary window.\n\nMultiline diary entries are made by indenting lines after the first with\neither a TAB or one or more spaces.\n\nLines not in one the above formats are ignored. Here are some sample diary\nentries (in the default American style):\n\n 12/22/1988 Twentieth wedding anniversary!!\n &1/1. Happy New Year!\n 10/22 Ruth's birthday.\n 21: Payday\n Tuesday--weekly meeting with grad students at 10am\n Supowit, Shen, Bitner, and Kapoor to attend.\n 1/13/89 Friday the thirteenth!!\n &thu 4pm squash game with Lloyd.\n mar 16 Dad's birthday\n April 15, 1989 Income tax due.\n &* 15 time cards due.\n\nIf the first line of a diary entry consists only of the date or day name with\nno trailing blanks or punctuation, then that line is not displayed in the\ndiary window; only the continuation lines is shown. For example, the\nsingle diary entry\n\n 02/11/1989\n Bill Blattner visits Princeton today\n 2pm Cognitive Studies Committee meeting\n 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'\n 4:00pm Jamie Tappenden\n 7:30pm Dinner at George and Ed's for Alan Ryan\n 7:30-10:00pm dance at Stewart Country Day School\n\nwill appear in the diary window without the date line at the beginning. This\nfacility allows the diary window to look neater, but can cause confusion if\nused with more than one day's entries displayed.\n\nDiary entries can be based on Lisp sexps. For example, the diary entry\n\n %%(diary-block 11 1 1990 11 10 1990) Vacation\n\ncauses the diary entry \"Vacation\" to appear from November 1 through November\n10, 1990. Other functions available are `diary-float', `diary-anniversary',\n`diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date',\n`diary-hebrew-date', `diary-islamic-date', `diary-mayan-date',\n`diary-yahrzeit', `diary-sunrise-sunset', `diary-phases-of-moon',\n`diary-parasha', `diary-omer', `diary-rosh-hodesh', and\n`diary-sabbath-candles'. See the documentation for the function\n`list-sexp-diary-entries' for more details.\n\nDiary entries based on the Hebrew and/or the Islamic calendar are also\npossible, but because these are somewhat slow, they are ignored\nunless you set the `nongregorian-diary-listing-hook' and the\n`nongregorian-diary-marking-hook' appropriately. See the documentation\nfor these functions for details.\n\nDiary files can contain directives to include the contents of other files; for\ndetails, see the documentation for the variable `list-diary-entries-hook'." :type 'file :group 'diary) + +(defcustom diary-nonmarking-symbol "&" "*Symbol indicating that a diary entry is not to be marked in the calendar." :type 'string :group 'diary) + +(defcustom hebrew-diary-entry-symbol "H" "*Symbol indicating a diary entry according to the Hebrew calendar." :type 'string :group 'diary) + +(defcustom islamic-diary-entry-symbol "I" "*Symbol indicating a diary entry according to the Islamic calendar." :type 'string :group 'diary) + +(defcustom diary-include-string "#include" "*The string indicating inclusion of another file of diary entries.\nSee the documentation for the function `include-other-diary-files'." :type 'string :group 'diary) + +(defcustom sexp-diary-entry-symbol "%%" "*The string used to indicate a sexp diary entry in diary-file.\nSee the documentation for the function `list-sexp-diary-entries'." :type 'string :group 'diary) + +(defcustom abbreviated-calendar-year t "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.\nFor the Gregorian calendar; similarly for the Hebrew and Islamic calendars.\nIf this variable is nil, years must be written in full." :type 'boolean :group 'diary) + +(defcustom european-calendar-style nil "*Use the European style of dates in the diary and in any displays.\nIf this variable is t, a date 1/2/1990 would be interpreted as February 1,\n1990. The accepted European date styles are\n\n DAY/MONTH\n DAY/MONTH/YEAR\n DAY MONTHNAME\n DAY MONTHNAME YEAR\n DAYNAME\n\nNames can be capitalized or not, written in full, or abbreviated to three\ncharacters with or without a period." :type 'boolean :group 'diary) + +(defcustom american-date-diary-pattern '((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the American patterns of date used.\nSee the documentation of `diary-date-forms' for an explanation." :type '(repeat (choice (cons :tag "Backup" (const backup) (repeat (list :inline t :format "%v" (symbol :tag "Keyword") (choice symbol regexp)))) (repeat (list :inline t :format "%v" (symbol :tag "Keyword") (choice symbol regexp))))) :group 'diary) + +(defcustom european-date-diary-pattern '((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<[^*0-9]") (day " *" monthname " *" year "[^0-9]") (dayname "\\W")) "*List of pseudo-patterns describing the European patterns of date used.\nSee the documentation of `diary-date-forms' for an explanation." :type '(repeat (choice (cons :tag "Backup" (const backup) (repeat (list :inline t :format "%v" (symbol :tag "Keyword") (choice symbol regexp)))) (repeat (list :inline t :format "%v" (symbol :tag "Keyword") (choice symbol regexp))))) :group 'diary) + +(defcustom european-calendar-display-form '((if dayname (concat dayname ", ")) day " " monthname " " year) "*Pseudo-pattern governing the way a date appears in the European style.\nSee the documentation of calendar-date-display-form for an explanation." :type 'sexp :group 'calendar) + +(defcustom american-calendar-display-form '((if dayname (concat dayname ", ")) monthname " " day ", " year) "*Pseudo-pattern governing the way a date appears in the American style.\nSee the documentation of `calendar-date-display-form' for an explanation." :type 'sexp :group 'calendar) + +(defcustom print-diary-entries-hook 'lpr-buffer "*List of functions called after a temporary diary buffer is prepared.\nThe buffer shows only the diary entries currently visible in the diary\nbuffer. The default just does the printing. Other uses might include, for\nexample, rearranging the lines into order by day and time, saving the buffer\ninstead of deleting it, or changing the function used to do the printing." :type 'hook :group 'diary) + +(defcustom list-diary-entries-hook nil "*List of functions called after diary file is culled for relevant entries.\nIt is to be used for diary entries that are not found in the diary file.\n\nA function `include-other-diary-files' is provided for use as the value of\nthis hook. This function enables you to use shared diary files together\nwith your own. The files included are specified in the diary file by lines\nof the form\n\n #include \"filename\"\n\nThis is recursive; that is, #include directives in files thus included are\nobeyed. You can change the \"#include\" to some other string by changing\nthe variable `diary-include-string'. When you use `include-other-diary-files'\nas part of the list-diary-entries-hook, you will probably also want to use the\nfunction `mark-included-diary-files' as part of `mark-diary-entries-hook'.\n\nFor example, you could use\n\n (setq list-diary-entries-hook\n '(include-other-diary-files sort-diary-entries))\n (setq diary-display-hook 'fancy-diary-display)\n\nin your `.emacs' file to cause the fancy diary buffer to be displayed with\ndiary entries from various included files, each day's entries sorted into\nlexicographic order." :type 'hook :group 'diary) + +(defcustom diary-hook nil "*List of functions called after the display of the diary.\nCan be used for appointment notification." :type 'hook :group 'diary) + +(defcustom diary-display-hook nil "*List of functions that handle the display of the diary.\nIf nil (the default), `simple-diary-display' is used. Use `ignore' for no\ndiary display.\n\nOrdinarily, this just displays the diary buffer (with holidays indicated in\nthe mode line), if there are any relevant entries. At the time these\nfunctions are called, the variable `diary-entries-list' is a list, in order\nby date, of all relevant diary entries in the form of ((MONTH DAY YEAR)\nSTRING), where string is the diary entry for the given date. This can be\nused, for example, a different buffer for display (perhaps combined with\nholidays), or produce hard copy output.\n\nA function `fancy-diary-display' is provided as an alternative\nchoice for this hook; this function prepares a special noneditable diary\nbuffer with the relevant diary entries that has neat day-by-day arrangement\nwith headings. The fancy diary buffer will show the holidays unless the\nvariable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy\ndiary buffer will not show days for which there are no diary entries, even\nif that day is a holiday; if you want such days to be shown in the fancy\ndiary buffer, set the variable `diary-list-include-blanks' to t." :type 'hook :group 'diary) + +(defcustom nongregorian-diary-listing-hook nil "*List of functions called for listing diary file and included files.\nAs the files are processed for diary entries, these functions are used to cull\nrelevant entries. You can use either or both of `list-hebrew-diary-entries'\nand `list-islamic-diary-entries'. The documentation for these functions\ndescribes the style of such diary entries." :type 'hook :group 'diary) + +(defcustom mark-diary-entries-hook nil "*List of functions called after marking diary entries in the calendar.\n\nA function `mark-included-diary-files' is also provided for use as the\nmark-diary-entries-hook; it enables you to use shared diary files together\nwith your own. The files included are specified in the diary file by lines\nof the form\n #include \"filename\"\nThis is recursive; that is, #include directives in files thus included are\nobeyed. You can change the \"#include\" to some other string by changing the\nvariable `diary-include-string'. When you use `mark-included-diary-files' as\npart of the mark-diary-entries-hook, you will probably also want to use the\nfunction `include-other-diary-files' as part of `list-diary-entries-hook'." :type 'hook :group 'diary) + +(defcustom nongregorian-diary-marking-hook nil "*List of functions called for marking diary file and included files.\nAs the files are processed for diary entries, these functions are used to cull\nrelevant entries. You can use either or both of `mark-hebrew-diary-entries'\nand `mark-islamic-diary-entries'. The documentation for these functions\ndescribes the style of such diary entries." :type 'hook :group 'diary) + +(defcustom diary-list-include-blanks nil "*If nil, do not include days with no diary entry in the list of diary entries.\nSuch days will then not be shown in the fancy diary buffer, even if they\nare holidays." :type 'boolean :group 'diary) + +(defcustom holidays-in-diary-buffer t "*Non-nil means include holidays in the diary display.\nThe holidays appear in the mode line of the diary buffer, or in the\nfancy diary buffer next to the date. This slows down the diary functions\nsomewhat; setting it to nil makes the diary display faster." :type 'boolean :group 'diary) + +(defcustom general-holidays '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fool's Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving")) "*General holidays. Default value is for the United States.\nSee the documentation for `calendar-holidays' for details." :type 'sexp :group 'holidays) (put 'general-holidays 'risky-local-variable t) -(defvar local-holidays nil "\ -*Local holidays. -See the documentation for `calendar-holidays' for details.") +(defcustom local-holidays nil "*Local holidays.\nSee the documentation for `calendar-holidays' for details." :type 'sexp :group 'holidays :group 'local) (put 'local-holidays 'risky-local-variable t) -(defvar other-holidays nil "\ -*User defined holidays. -See the documentation for `calendar-holidays' for details.") +(defcustom other-holidays nil "*User defined holidays.\nSee the documentation for `calendar-holidays' for details." :type 'sexp :group 'holidays) (put 'other-holidays 'risky-local-variable t) @@ -999,11 +711,14 @@ ;;;*** -;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all custom-buffer-create customize-apropos customize-customized customize-face-other-window customize-face customize-variable-other-window customize-variable customize) "cus-edit" "custom/cus-edit.el") +;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all custom-buffer-create customize-apropos customize-customized customize-face-other-window customize-face customize-variable-other-window customize-variable customize-other-window customize) "cus-edit" "custom/cus-edit.el") (autoload 'customize "cus-edit" "\ Customize SYMBOL, which must be a customization group." t nil) +(autoload 'customize-other-window "cus-edit" "\ +Customize SYMBOL, which must be a customization group." t nil) + (autoload 'customize-variable "cus-edit" "\ Customize SYMBOL, which must be a variable." t nil) @@ -1069,7 +784,7 @@ ;;;*** -;;;### (autoloads (widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "custom/wid-browse.el") +;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "custom/wid-browse.el") (autoload 'widget-browse-at "wid-browse" "\ Browse the widget under point." t nil) @@ -1080,6 +795,10 @@ (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-apply) "wid-edit" "custom/wid-edit.el") @@ -3681,11 +3400,7 @@ ;;;### (autoloads (fortran-mode) "fortran" "modes/fortran.el") -(defvar fortran-tab-mode-default nil "\ -*Default tabbing/carriage control style for empty files in Fortran mode. -A value of t specifies tab-digit style of continuation control. -A value of nil specifies that continuation lines are marked -with a character in column 6.") +(defcustom fortran-tab-mode-default nil "*Default tabbing/carriage control style for empty files in Fortran mode.\nA value of t specifies tab-digit style of continuation control.\nA value of nil specifies that continuation lines are marked\nwith a character in column 6." :type 'boolean :group 'fortran-indent) (autoload 'fortran-mode "fortran" "\ Major mode for editing Fortran code. @@ -3922,7 +3637,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.22 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.23 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4587,30 +4302,17 @@ ;;;### (autoloads (resize-minibuffer-mode) "rsz-minibuf" "modes/rsz-minibuf.el") -(defvar resize-minibuffer-mode nil "\ -*If non-`nil', resize the minibuffer so its entire contents are visible.") - -(defvar resize-minibuffer-window-max-height nil "\ -*Maximum size the minibuffer window is allowed to become. -If less than 1 or not a number, the limit is the height of the frame in -which the active minibuffer window resides.") - -(defvar resize-minibuffer-window-exactly t "\ -*If non-`nil', make minibuffer exactly the size needed to display all its contents. -Otherwise, the minibuffer window can temporarily increase in size but -never get smaller while it is active.") - -(defvar resize-minibuffer-frame nil "\ -*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height.") - -(defvar resize-minibuffer-frame-max-height nil "\ -*Maximum size the minibuffer frame is allowed to become. -If less than 1 or not a number, there is no limit.") - -(defvar resize-minibuffer-frame-exactly nil "\ -*If non-`nil', make minibuffer frame exactly the size needed to display all its contents. -Otherwise, the minibuffer frame can temporarily increase in size but -never get smaller while it is active.") +(defgroup resize-minibuffer nil "Dynamically resize minibuffer to display entire contents" :group 'frames) + +(defcustom resize-minibuffer-window-max-height nil "*Maximum size the minibuffer window is allowed to become.\nIf less than 1 or not a number, the limit is the height of the frame in\nwhich the active minibuffer window resides." :type '(choice (const nil) integer) :group 'resize-minibuffer) + +(defcustom resize-minibuffer-window-exactly t "*If non-`nil', make minibuffer exactly the size needed to display all its contents.\nOtherwise, the minibuffer window can temporarily increase in size but\nnever get smaller while it is active." :type 'boolean :group 'resize-minibuffer) + +(defcustom resize-minibuffer-frame nil "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height." :type 'boolean :group 'resize-minibuffer) + +(defcustom resize-minibuffer-frame-max-height nil "*Maximum size the minibuffer frame is allowed to become.\nIf less than 1 or not a number, there is no limit.") + +(defcustom resize-minibuffer-frame-exactly nil "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.\nOtherwise, the minibuffer frame can temporarily increase in size but\nnever get smaller while it is active." :type 'boolean :group 'resize-minibuffer) (autoload 'resize-minibuffer-mode "rsz-minibuf" "\ Enable or disable resize-minibuffer mode. @@ -5229,13 +4931,23 @@ verilog-indent-level (default 3) Indentation of Verilog statements with respect to containing block. + verilog-indent-level-module (default 3) + Absolute indentation of Module level Verilog statements. + Set to 0 to get initial and always statements lined up + on the left side of your screen. + verilog-indent-level-declaration (default 3) + Indentation of declarations with respect to containing block. + Set to 0 to get them list right under containing block. + verilog-indent-level-behavorial (default 3) + Indentation of first begin in a task or function block + Set to 0 to get such code to linedup underneath the task or function keyword verilog-cexp-indent (default 1) Indentation of Verilog statements broken across lines. verilog-case-indent (default 2) Indentation for case statements. verilog-auto-newline (default nil) - Non-nil means automatically newline after semicolons and the punctuation mark - after an end. + Non-nil means automatically newline after semicolons and the punctation + mark after an end. verilog-auto-indent-on-newline (default t) Non-nil means automatically indent line after newline verilog-tab-always-indent (default t) @@ -5251,23 +4963,32 @@ if (a) begin verilog-auto-endcomments (default t) - Non-nil means a comment /* ... */ is set after the ends which ends cases, tasks, functions and modules. + Non-nil means a comment /* ... */ is set after the ends which ends + cases, tasks, functions and modules. The type and name of the object will be set between the braces. + verilog-minimum-comment-distance (default 40) + Minimum distance between begin and end required before a comment + will be inserted. Setting this variable to zero results in every + end aquiring a comment; the default avoids too many redundanet + comments in tight quarters. verilog-auto-lineup (default `(all)) List of contexts where auto lineup of :'s or ='s should be done. Turning on Verilog mode calls the value of the variable verilog-mode-hook with no args, if that value is non-nil. Other useful functions are: -\\[verilog-complete-word] -complete word with appropriate possibilities (functions, verilog keywords...) -\\[verilog-comment-area] - Put marked area in a comment, fixing nested comments. -\\[verilog-uncomment-area] - Uncomment an area commented with \\[verilog-comment-area]. +\\[verilog-complete-word] -complete word with appropriate possibilities + (functions, verilog keywords...) +\\[verilog-comment-region] - Put marked area in a comment, fixing + nested comments. +\\[verilog-uncomment-region] - Uncomment an area commented with \\[verilog-comment-region]. \\[verilog-insert-block] - insert begin ... end; \\[verilog-star-comment] - insert /* ... */ \\[verilog-mark-defun] - Mark function. \\[verilog-beg-of-defun] - Move to beginning of current function. \\[verilog-end-of-defun] - Move to end of current function. -\\[verilog-label-be] - Label matching begin ... end, fork ... join and case ... endcase statements; +\\[verilog-label-be] - Label matching begin ... end, fork ... join + and case ... endcase statements; " t nil) ;;;*** @@ -5276,7 +4997,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.22 $ +vhdl-mode $Revision: 1.23 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the @@ -6791,9 +6512,7 @@ ;;;### (autoloads (hypropos-popup-menu hypropos-set-variable hyper-set-variable hypropos-get-doc hypropos-read-variable-symbol hyper-describe-function hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos) "hyper-apropos" "packages/hyper-apropos.el") -(defvar hypropos-show-brief-docs t "\ -*If non-nil, `hyper-apropos' will display some documentation in the -\"*Hyper Apropos*\" buffer. Setting this to nil will speed up searches.") +(defcustom hypropos-show-brief-docs t "*If non-nil, `hyper-apropos' will display some documentation in the\n\"*Hyper Apropos*\" buffer. Setting this to nil will speed up searches." :type 'boolean :group 'hyper-apropos) (autoload 'hyper-apropos "hyper-apropos" "\ Display lists of functions and variables matching REGEXP @@ -7247,12 +6966,9 @@ ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer) "lpr" "packages/lpr.el") -(defvar lpr-switches nil "\ -*List of strings to pass as extra options for the printer program. -See `lpr-command'.") - -(defvar lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix)) "lp" "lpr") "\ -*Name of program for printing a file.") +(defcustom lpr-switches nil "*List of strings to pass as extra options for the printer program.\nSee `lpr-command'." :type '(repeat (string :tag "Argument")) :group 'lpr) + +(defcustom lpr-command (if (memq system-type '(usg-unix-v dgux hpux irix)) "lp" "lpr") "*Name of program for printing a file." :type 'string :group 'lpr) (autoload 'lpr-buffer "lpr" "\ Print buffer contents as with Unix command `lpr'. @@ -7706,16 +7422,11 @@ ;;;### (autoloads (ask-to-update-copyright update-copyright) "upd-copyr" "packages/upd-copyr.el") -(defvar copyright-do-not-disturb "Free Software Foundation, Inc." "\ -*If non-nil, the existing copyright holder is checked against this regexp. -If it does not match, then a new copyright line is added with the copyright -holder set to the value of `copyright-whoami'.") - -(defvar copyright-whoami nil "\ -*A string containing the name of the owner of new copyright notices.") - -(defvar copyright-notice-file nil "\ -*If non-nil, replace copying notices with this file.") +(defcustom copyright-do-not-disturb "Free Software Foundation, Inc." "*If non-nil, the existing copyright holder is checked against this regexp.\nIf it does not match, then a new copyright line is added with the copyright\nholder set to the value of `copyright-whoami'." :type '(choice (const nil) string) :group 'copyright) + +(defcustom copyright-whoami nil "*A string containing the name of the owner of new copyright notices." :type '(choice (const nil) string) :group 'copyright) + +(defcustom copyright-notice-file nil "*If non-nil, replace copying notices with this file." :type '(choice (const nil) file) :group 'copyright) (autoload 'update-copyright "upd-copyr" "\ Update the copyright notice at the beginning of the buffer @@ -8933,10 +8644,7 @@ ;;;### (autoloads (browse-url-lynx-emacs browse-url-lynx-xterm browse-url-w3 browse-url-iximosaic browse-url-grail browse-url-mosaic browse-url-netscape) "browse-url" "utils/browse-url.el") -(defvar browse-url-browser-function 'browse-url-w3 "\ -*Function to display the current buffer in a WWW browser. -Used by the `browse-url-at-point', `browse-url-at-mouse', and -`browse-url-of-file' commands.") +(defcustom browse-url-browser-function 'browse-url-w3 "*Function to display the current buffer in a WWW browser.\nUsed by the `browse-url-at-point', `browse-url-at-mouse', and\n`browse-url-of-file' commands." :type 'function :group 'browse-url) (autoload 'browse-url-netscape "browse-url" "\ Ask the Netscape WWW browser to load URL. @@ -9092,7 +8800,7 @@ Second argument NEED-VECTOR means to return an event vector always." t nil) (autoload 'kbd "edmacro" "\ -Convert KEYS to the internal Emacs key representation." nil 'macro) +Convert KEYS to the internal Emacs key representation." nil nil) (autoload 'format-kbd-macro "edmacro" "\ Return the keyboard macro MACRO as a human-readable string. @@ -9119,19 +8827,7 @@ ;;;### (autoloads (turn-on-eldoc-mode eldoc-mode) "eldoc" "utils/eldoc.el") -(defvar eldoc-mode nil "\ -*If non-nil, show the defined parameters for the elisp function near point. - -For the emacs lisp function at the beginning of the sexp which point is -within, show the defined parameters for the function in the echo area. -This information is extracted directly from the function or macro if it is -in pure lisp. If the emacs function is a subr, the parameters are obtained -from the documentation string if possible. - -If point is over a documented variable, print that variable's docstring -instead. - -This variable is buffer-local.") +(defcustom eldoc-mode nil "*If non-nil, show the defined parameters for the elisp function near point.\n\nFor the emacs lisp function at the beginning of the sexp which point is\nwithin, show the defined parameters for the function in the echo area.\nThis information is extracted directly from the function or macro if it is\nin pure lisp. If the emacs function is a subr, the parameters are obtained\nfrom the documentation string if possible.\n\nIf point is over a documented variable, print that variable's docstring\ninstead.\n\nThis variable is buffer-local." :type 'boolean :group 'eldoc) (autoload 'eldoc-mode "eldoc" "\ *Enable or disable eldoc mode. diff -r b27e67717092 -r 34a5b81f86ba lisp/prim/custom-load.el --- a/lisp/prim/custom-load.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,76 +1,97 @@ (put 'gnus-start 'custom-loads '("gnus-group" "gnus-int" "gnus-start" "gnus-util" "gnus")) -(put 'extensions 'custom-loads '("wid-edit" "tempo")) +(put 'extensions 'custom-loads '("wid-edit" "page-ext" "time-stamp" "tempo" "eldoc")) (put 'change-log 'custom-loads '("add-log")) (put 'message 'custom-loads '("message" "highlight-headers" "sendmail")) (put 'filladapt 'custom-loads '("filladapt")) (put 'psgml-dtd 'custom-loads '("psgml")) +(put 'copyright 'custom-loads '("upd-copyr")) (put 'gnus-score-expire 'custom-loads '("gnus-kill" "gnus-score")) (put 'gnus-score-kill 'custom-loads '("gnus-kill")) +(put 'eldoc 'custom-loads '("eldoc")) +(put 'prolog 'custom-loads '("prolog")) (put 'bookmark 'custom-loads '("bookmark")) +(put 'recent-files-menu 'custom-loads '("recent-files")) (put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url")) (put 'custom-faces 'custom-loads '("cus-edit")) (put 'abbrev-mode 'custom-loads '()) (put 'execute 'custom-loads '()) (put 'gnus-message 'custom-loads '("message")) -(put 'mouse 'custom-loads '("mouse" "outl-mouse")) +(put 'mouse 'custom-loads '("mouse" "outl-mouse" "avoid")) (put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) (put 'nnmail-procmail 'custom-loads '("nnmail")) +(put 'pascal 'custom-loads '("pascal")) (put 'tex 'custom-loads '("texnfo-tex")) (put 'ssl 'custom-loads '("ssl")) (put 'tcl 'custom-loads '("tcl")) (put 'limits 'custom-loads '()) +(put 'igrep 'custom-loads '("igrep")) (put 'telnet 'custom-loads '("telnet")) (put 'widgets 'custom-loads '("wid-browse" "wid-edit")) (put 'minibuffer 'custom-loads '("minibuf" "detached-minibuf")) -(put 'environment 'custom-loads '("minibuf" "modeline" "x-toolbar" "cus-edit" "dired-faces")) +(put 'environment 'custom-loads '("minibuf" "modeline" "x-toolbar" "cus-edit" "dired-faces" "sound")) +(put 'shell 'custom-loads '("shell")) +(put 'sound 'custom-loads '("sound")) (put 'gnus-article-buttons 'custom-loads '("gnus-art")) (put 'gnus-extract-archive 'custom-loads '("gnus-uu")) (put 'html 'custom-loads '("psgml-html")) (put 'cc-style 'custom-loads '("cc-mode")) (put 'gnus-article-headers 'custom-loads '("gnus-art" "gnus-sum")) +(put 'holidays 'custom-loads '("calendar")) (put 'texinfo 'custom-loads '("texinfo" "texnfo-tex")) (put 'gnus-score 'custom-loads '("gnus-nocem" "gnus")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) (put 'terminals 'custom-loads '("gnuserv")) (put 'gnus-topic 'custom-loads '("gnus-topic")) +(put 'comint-completion 'custom-loads '("comint")) (put 'gnus-article-emphasis 'custom-loads '("gnus-art")) (put 'earcon 'custom-loads '("earcon")) (put 'boolean 'custom-loads '("bookmark")) (put 'auto-save 'custom-loads '("auto-save")) (put 'gnus-group-foreign 'custom-loads '("gnus-group")) +(put 'xrdb 'custom-loads '("xrdb-mode")) (put 'gnus-article-washing 'custom-loads '("gnus-xmas" "gnus-art")) (put 'ispell 'custom-loads '("ispell")) -(put 'mail 'custom-loads '("gnus" "message" "mail-abbrevs" "supercite" "highlight-headers")) +(put 'mail 'custom-loads '("gnus" "message" "mh-e" "mail-abbrevs" "feedmail" "supercite" "highlight-headers" "smtpmail")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) +(put 'fortran-indent 'custom-loads '("fortran")) (put 'ps-print-face 'custom-loads '("ps-print")) (put 'gnus-article-saving 'custom-loads '("gnus-art")) (put 'gnus-extract-view 'custom-loads '("gnus-sum" "gnus-uu")) (put 'crypt 'custom-loads '("crypt")) -(put 'comint 'custom-loads '("comint-xemacs" "telnet")) +(put 'object 'custom-loads '("gopher")) +(put 'comint 'custom-loads '("comint-xemacs" "comint" "telnet")) (put 'gnus-group-listing 'custom-loads '("gnus-group")) (put 'man 'custom-loads '("man")) +(put 'lpr 'custom-loads '("lpr")) (put 'gnus-summary 'custom-loads '("gnus-sum" "gnus")) (put 'message-headers 'custom-loads '("message")) (put 'ps-print-header 'custom-loads '("ps-print")) -(put 'docs 'custom-loads '("texinfo" "makeinfo")) +(put 'docs 'custom-loads '("texinfo" "hyper-apropos" "makeinfo")) (put 'lisp-indent 'custom-loads '("cl-indent")) -(put 'tools 'custom-loads '("make-mode" "add-log" "diff")) +(put 'completion 'custom-loads '("completion")) +(put 'tools 'custom-loads '("ediff" "make-mode" "add-log" "diff" "func-menu" "generic-sc" "rcompile")) (put 'cc-comment 'custom-loads '("cc-mode")) (put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) +(put 'uniquify 'custom-loads '("uniquify")) +(put 'recent-files 'custom-loads '("recent-files")) (put 'editing-basics 'custom-loads '("simple")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'display-time-balloon 'custom-loads '("time")) (put 'internal 'custom-loads '("cus-edit")) +(put 'calendar 'custom-loads '("calendar")) (put 'dabbrev 'custom-loads '("dabbrev")) (put 'help-appearance 'custom-loads '("help")) (put 'display-time 'custom-loads '("time")) -(put 'hypermedia 'custom-loads '("wid-edit" "url-vars" "w3-cus")) +(put 'hypermedia 'custom-loads '("wid-edit" "gopher" "browse-url" "url-vars" "w3-cus")) +(put 'save-place 'custom-loads '("saveplace")) (put 'w3-advanced 'custom-loads '("w3-cus")) (put 'lisp 'custom-loads '("cl-indent" "elp")) (put 'jka-compr 'custom-loads '("jka-compr")) +(put 'rlogin 'custom-loads '("rlogin")) (put 'proces-basics 'custom-loads '()) (put 'diff 'custom-loads '("diff")) +(put 'shell-faces 'custom-loads '("shell")) (put 'sh-script 'custom-loads '("sh-script")) (put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) @@ -82,51 +103,66 @@ (put 'gnus-thread 'custom-loads '("gnus-sum")) (put 'gnus-nocem 'custom-loads '("gnus-nocem")) (put 'gnus-threading 'custom-loads '("gnus-sum")) -(put 'applications 'custom-loads '("cus-edit")) -(put 'outlines 'custom-loads '("outl-mouse")) +(put 'ediff-diff 'custom-loads '("ediff-diff")) +(put 'applications 'custom-loads '("cus-edit" "uniquify")) +(put 'outlines 'custom-loads '("outl-mouse" "whitespace-mode")) (put 'paren-matching 'custom-loads '("simple" "paren")) +(put 'time-stamp 'custom-loads '("time-stamp")) (put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) +(put 'avoid 'custom-loads '("avoid")) +(put 'f90 'custom-loads '("f90")) (put 'gnus-extract 'custom-loads '("gnus" "gnus-uu")) (put 'help 'custom-loads '("help" "cus-edit" "info" "man")) (put 'supercite 'custom-loads '("supercite")) +(put 'generic-sc 'custom-loads '("generic-sc")) +(put 'local 'custom-loads '("calendar" "gopher")) (put 'nnmail-split 'custom-loads '("nnmail")) (put 'keyboard 'custom-loads '()) (put 'minubuffer 'custom-loads '("minibuf")) +(put 'asm 'custom-loads '("asm-mode")) (put 'installation 'custom-loads '()) (put 'url-gateway 'custom-loads '("url-gw")) (put 'gnus-article-various 'custom-loads '("gnus-art" "gnus-sum")) +(put 'mh-hook 'custom-loads '("mh-e")) (put 'message-sending 'custom-loads '("message")) (put 'w3-files 'custom-loads '("w3-cus")) (put 'widget-browse 'custom-loads '("wid-browse")) -(put 'data 'custom-loads '("auto-save" "crypt" "jka-compr")) +(put 'data 'custom-loads '("auto-save" "crypt" "jka-compr" "recent-files" "saveplace" "time-stamp")) (put 'gnus-article 'custom-loads '("gnus-art" "gnus-cite")) (put 'ps-print 'custom-loads '("ps-print")) (put 'cc-indent 'custom-loads '("cc-mode")) (put 'compression 'custom-loads '("jka-compr")) (put 'comm 'custom-loads '("ssl")) +(put 'ediff-window 'custom-loads '()) (put 'gnus 'custom-loads '("gnus-art" "gnus-async" "gnus-cache" "gnus-demon" "gnus-dup" "gnus-eform" "gnus-uu" "gnus-win" "gnus-xmas" "gnus" "nnmail")) (put 'ps-print-font 'custom-loads '("ps-print")) (put 'id-select 'custom-loads '("id-select")) (put 'gnus-xmas 'custom-loads '("gnus-xmas")) +(put 'fortran-comment 'custom-loads '("fortran")) (put 'outl-mouse 'custom-loads '("outl-mouse")) (put 'gnus-treading 'custom-loads '("gnus-sum")) (put 'url-cache 'custom-loads '("url-cache" "url-vars")) -(put 'frames 'custom-loads '("detached-minibuf")) +(put 'frames 'custom-loads '("rsz-minibuf" "ediff-wind" "desktop" "detached-minibuf")) (put 'psgml-html 'custom-loads '("psgml-html")) (put 'nnmail 'custom-loads '("nnmail")) (put 'gnus-article-hiding 'custom-loads '("gnus-art" "gnus-sum")) -(put 'customize 'custom-loads '("wid-edit" "cus-face" "cus-edit")) +(put 'customize 'custom-loads '("cus-face" "wid-edit" "cus-edit")) (put 'w3-printing 'custom-loads '("w3-cus")) (put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'supercite-attr 'custom-loads '("supercite")) (put 'gnus-summary-visual 'custom-loads '("gnus-sum" "gnus")) (put 'w3-images 'custom-loads '("w3-cus")) +(put 'shell-directories 'custom-loads '("shell")) +(put 'desktop 'custom-loads '("desktop")) (put 'gnus-group-various 'custom-loads '("gnus-group")) (put 'abbrev 'custom-loads '("cus-edit" "dabbrev")) +(put 'f90-indent 'custom-loads '("f90")) (put 'nnmail-retrieve 'custom-loads '("nnmail")) +(put 'ediff-ptch 'custom-loads '()) (put 'url-history 'custom-loads '("url-vars")) (put 'message-interface 'custom-loads '("message")) (put 'gnus-group 'custom-loads '("gnus-topic" "gnus")) +(put 'remote-compile 'custom-loads '("rcompile")) (put 'programming 'custom-loads '("cus-edit" "compile")) (put 'gnus-article-signature 'custom-loads '("gnus-art")) (put 'toolbar 'custom-loads '("x-toolbar")) @@ -136,38 +172,49 @@ (put 'url-hairy 'custom-loads '("url-vars")) (put 'sgml 'custom-loads '("psgml-html" "psgml")) (put 'gnus-score-adapt 'custom-loads '("gnus-score")) +(put 'comint-source 'custom-loads '("comint")) (put 'makeinfo 'custom-loads '("makeinfo")) (put 'nnmail-various 'custom-loads '("nnmail")) +(put 'fume 'custom-loads '("func-menu")) (put 'cc-auto 'custom-loads '("cc-mode")) (put 'nnmail-files 'custom-loads '("nnmail")) (put 'gnus-asynchronous 'custom-loads '("gnus-async")) (put 'url-mime 'custom-loads '("url-vars")) (put 'gnus-visual 'custom-loads '("earcon" "gnus-art" "gnus-picon" "gnus" "smiley")) +(put 'c-macro 'custom-loads '("cmacexp")) (put 'message-forwarding 'custom-loads '("message")) (put 'killing 'custom-loads '("simple")) +(put 'smtpmail 'custom-loads '("smtpmail")) (put 'message-news 'custom-loads '("message")) (put 'paren-blinking 'custom-loads '("simple")) (put 'vrml-mode 'custom-loads '("vrml-mode")) (put 'vrml 'custom-loads '("vrml-mode")) (put 'games 'custom-loads '("xmine")) (put 'gnus-edit-form 'custom-loads '("gnus-eform")) +(put 'fast-lock 'custom-loads '("fast-lock")) (put 'external 'custom-loads '("cus-edit")) (put 'gnus-files 'custom-loads '("gnus" "nnmail")) +(put 'fortran 'custom-loads '("f90" "fortran")) +(put 'ediff-merge 'custom-loads '("ediff-merg")) (put 'gnus-cite 'custom-loads '("gnus-cite")) (put 'gnus-demon 'custom-loads '("gnus-demon")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) (put 'cc-mode 'custom-loads '("cc-mode")) (put 'development 'custom-loads '("cus-edit")) +(put 'mh-buffer 'custom-loads '("mh-utils")) (put 'tempo 'custom-loads '("tempo")) (put 'gnuserv 'custom-loads '("gnuserv")) (put 'ps-print-horizontal 'custom-loads '("ps-print")) (put 'gnus-windows 'custom-loads '("gnus-win")) +(put 'maint 'custom-loads '("upd-copyr")) (put 'detached-minibuf 'custom-loads '("detached-minibuf")) (put 'message-mail 'custom-loads '("message")) +(put 'ediff-mult 'custom-loads '("ediff-mult")) (put 'windows 'custom-loads '()) (put 'message-various 'custom-loads '("message")) +(put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) (put 'gnus-group-levels 'custom-loads '("gnus-group")) -(put 'languages 'custom-loads '("cus-edit" "sh-script" "tcl" "vrml-mode" "psgml")) +(put 'languages 'custom-loads '("cus-edit" "asm-mode" "fortran" "pascal" "prolog" "rexx-mode" "sh-script" "tcl" "verilog-mode" "vrml-mode" "xrdb-mode" "psgml")) (put 'gnus-summary-format 'custom-loads '("gnus-sum")) (put 'gnus-score-decay 'custom-loads '("gnus-score")) (put 'fill 'custom-loads '()) @@ -176,22 +223,33 @@ (put 'supercite-hooks 'custom-loads '("supercite")) (put 'display 'custom-loads '()) (put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message" "ps-print" "highlight-headers")) +(put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message" "fast-lock" "ps-print" "highlight-headers")) (put 'passwd 'custom-loads '("passwd")) +(put 'pages 'custom-loads '("page-ext")) +(put 'diary 'custom-loads '("calendar")) (put 'gnus-various 'custom-loads '("gnus-sum")) (put 'cc-syntax 'custom-loads '("cc-mode")) +(put 'smiley 'custom-loads '()) +(put 'mh-compose 'custom-loads '("mh-comp")) (put 'xmine 'custom-loads '("xmine")) (put 'supercite-frames 'custom-loads '("supercite")) +(put 'browse-url 'custom-loads '("browse-url")) +(put 'feedmail 'custom-loads '("feedmail")) +(put 'enriched 'custom-loads '("enriched")) (put 'gnus-article-highlight 'custom-loads '("gnus-art")) (put 'emacs 'custom-loads '("cus-edit")) -(put 'processes 'custom-loads '("comint-xemacs" "cus-edit" "executable" "gnuserv" "ispell" "passwd")) +(put 'processes 'custom-loads '("background" "comint" "rlogin" "shell" "cus-edit" "executable" "gnuserv" "igrep" "ispell" "rcompile" "passwd")) (put 'news 'custom-loads '("gnus" "message" "supercite" "highlight-headers")) +(put 'rexx 'custom-loads '("rexx-mode")) (put 'w3-hooks 'custom-loads '("w3-cus")) (put 'executable 'custom-loads '("executable")) (put 'highlight-headers 'custom-loads '("highlight-headers")) +(put 'gnus-cache 'custom-loads '()) (put 'message-insertion 'custom-loads '("message")) +(put 'hyper-apropos 'custom-loads '("hyper-apropos")) (put 'psgml-insert 'custom-loads '("psgml")) -(put 'wp 'custom-loads '("cus-edit" "ps-print")) +(put 'wp 'custom-loads '("cus-edit" "enriched" "lpr" "ps-print")) +(put 'background 'custom-loads '("background")) (put 'message-faces 'custom-loads '("message")) (put 'w3 'custom-loads '("w3-cus" "w3-script")) (put 'sh 'custom-loads '("sh-script")) @@ -199,22 +257,28 @@ (put 'url-file 'custom-loads '("url-cache" "url-vars")) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '("isearch-mode")) +(put 'mh 'custom-loads '("mh-comp" "mh-e" "mh-utils")) (put 'gnus-score-files 'custom-loads '("gnus-score")) +(put 'gopher 'custom-loads '("gopher")) (put 'modeline 'custom-loads '("modeline")) (put 'makefile-mode 'custom-loads '("make-mode")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) +(put 'appt 'custom-loads '("appt")) (put 'picons 'custom-loads '("gnus-picon")) (put 'nnmail-prepare 'custom-loads '("nnmail")) +(put 'whitespace 'custom-loads '("whitespace-mode")) (put 'w3-display 'custom-loads '("w3-cus")) (put 'w3-parsing 'custom-loads '("w3-cus")) (put 'message-buffers 'custom-loads '("message")) (put 'editing 'custom-loads '("simple" "cus-edit" "filladapt")) -(put 'matching 'custom-loads '("simple" "isearch-mode" "bookmark")) +(put 'matching 'custom-loads '("simple" "isearch-mode" "whitespace-mode" "bookmark" "completion")) +(put 'ediff 'custom-loads '("ediff-diff" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff")) (put 'gnus-article-mime 'custom-loads '("gnus-art" "gnus-sum")) (put 'i18n 'custom-loads '("url-vars")) (put 'ps-print-color 'custom-loads '("ps-print")) (put 'info 'custom-loads '("info")) (put 'w3-scripting 'custom-loads '("w3-script")) -(put 'unix 'custom-loads '("sh-script")) +(put 'unix 'custom-loads '("rlogin" "shell" "sh-script")) (put 't 'custom-loads '("ps-print")) -(put 'c 'custom-loads '("cc-mode")) +(put 'c 'custom-loads '("cc-mode" "cmacexp")) +(put 'verilog-mode 'custom-loads '("verilog-mode")) diff -r b27e67717092 -r 34a5b81f86ba lisp/prim/sound.el --- a/lisp/prim/sound.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/prim/sound.el Mon Aug 13 09:30:11 2007 +0200 @@ -21,6 +21,94 @@ ;; Boston, MA 02111-1307, USA. ;;; Synched up with: Not in FSF. +(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 it's 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-alist + '((load-sound-file "sounds/drum-beep.au" 'drum) + (load-sound-file "sounds/quiet-beep.au" 'quiet) + (load-sound-file "sounds/bass-snap.au" 'bass 80) + (load-sound-file "sounds/whip.au" 'whip 70) + (load-sound-file "sounds/cuckoo.au" 'cuckoo) + (load-sound-file "sounds/yeep.au" 'yeep) + (load-sound-file "sounds/hype.au" '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 data-directory + "Default directory to load a sound file from." + :group 'sound + :type 'directory + ) + +(defcustom sound-ext "" + "Filename extensions to complet 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 ( list default-sound-directory ) + "List of directories which to search for sound files" + :group 'sound + :type '(repeat directory ) + ) ;;;###autoload (or sound-alist @@ -48,7 +136,8 @@ (set-buffer (setq buf (get-buffer-create " *sound-tmp*"))) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents filename) + (insert-file-contents + (locate-file filename default-sound-directory-list sound-ext )) (setq data (buffer-string)) (erase-buffer)) (and buf (kill-buffer buf))) @@ -74,46 +163,11 @@ ;; #### - this should do NOTHING if the sounds can't be played. (message "Loading sounds...") (setq sound-alist nil) - (let ((default-directory data-directory)) - (load-sound-file "sounds/drum-beep.au" 'drum) - (load-sound-file "sounds/quiet-beep.au" 'quiet) - (load-sound-file "sounds/bass-snap.au" 'bass 80) - (load-sound-file "sounds/whip.au" 'whip 70) - (load-sound-file "sounds/cuckoo.au" 'cuckoo) - (load-sound-file "sounds/yeep.au" 'yeep) - (load-sound-file "sounds/hype.au" 'hype 100) - ) + ;; this is where the calls to load-sound-file get done + (mapc 'eval sound-load-alist) (setq sound-alist - (append - '((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 it's 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) - ) - sound-alist)) + (append sound-default-alist + sound-alist)) (message "Loading sounds...done") ;; (beep nil 'quiet) ) diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/browse-url.el --- a/lisp/utils/browse-url.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/browse-url.el Mon Aug 13 09:30:11 2007 +0200 @@ -348,6 +348,11 @@ (eval-when-compile (require 'dired)) +(defgroup browse-url nil + "Ask a WWW browser to load a URL." + :group 'hypermedia) + + (defvar browse-url-path-regexp "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" "A regular expression probably matching the host, path or e-mail @@ -367,25 +372,35 @@ ;;;###autoload -(defvar browse-url-browser-function 'browse-url-w3 +(defcustom browse-url-browser-function 'browse-url-w3 "*Function to display the current buffer in a WWW browser. Used by the `browse-url-at-point', `browse-url-at-mouse', and -`browse-url-of-file' commands.") - -(defvar browse-url-netscape-command "netscape" - "*The name by which to invoke Netscape.") +`browse-url-of-file' commands." + :type 'function + :group 'browse-url) -(defvar browse-url-netscape-arguments nil - "*A list of strings to pass to Netscape as arguments.") +(defcustom browse-url-netscape-command "netscape" + "*The name by which to invoke Netscape." + :type 'string + :group 'browse-url) -(defvar browse-url-new-window-p nil +(defcustom browse-url-netscape-arguments nil + "*A list of strings to pass to Netscape as arguments." + :type '(repeat (string :tag "Argument")) + :group 'browse-url) + +(defcustom browse-url-new-window-p nil "*If non-nil, always open a new browser window. Passing an interactive argument to \\[browse-url-netscape] or \\[browse-url-cci] reverses the effect of this variable. Requires -Netscape version 1.1N or later or XMosaic version 2.5 or later.") +Netscape version 1.1N or later or XMosaic version 2.5 or later." + :type 'boolean + :group 'browse-url) -(defvar browse-url-mosaic-arguments nil - "*A list of strings to pass to Mosaic as arguments.") +(defcustom browse-url-mosaic-arguments nil + "*A list of strings to pass to Mosaic as arguments." + :type '(repeat (string :tag "Argument")) + :group 'browse-url) (defvar browse-url-filename-alist '(("^/+" . "file:/")) diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/edmacro.el --- a/lisp/utils/edmacro.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/edmacro.el Mon Aug 13 09:30:11 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Dave Gillespie ;; Hrvoje Niksic -- XEmacs port ;; Maintainer: Hrvoje Niksic -;; Version: 3.07 +;; Version: 3.09 ;; Keywords: abbrev ;; This file is part of XEmacs. @@ -54,14 +54,16 @@ ;; This and `format-kbd-macro' can also be called directly as ;; Lisp functions. -;; The `kbd' macro calls `read-kbd-macro', but it is evaluated at -;; compile-time. It is good to use in your programs and -;; initializations, as you needn't know the internal keysym -;; representation. For example: +;; The `kbd' function is a shorter name for `read-kbd-macro'. It is +;; good to use in your programs and initializations, as you needn't +;; know the internal keysym representation. For example: ;; ;; (define-key foo-mode-map (kbd "C-c ") 'foo-up) +;; ;; is the equivalent of +;; ;; (define-key foo-mode-map [(control ?c) up] 'foo-up) +;; ;; Type `C-h m', or see the documentation for `edmacro-mode' below, ;; for information about the format of written keyboard macros. @@ -80,7 +82,7 @@ ;; Emacs 19.18.) This package does not work with Emacs 18 or ;; Lucid Emacs. -;; But it works with XEmacs. At least the modified version. -hniksic +;; Ported to XEmacs. -hniksic ;;; Code: @@ -96,6 +98,11 @@ "*Non-nil if edit-kbd-macro should leave 8-bit characters intact. Default nil means to write characters above \\177 in octal notation.") +(if (fboundp 'mapvector) + (defalias 'edmacro-mapvector 'mapvector) + (defun edmacro-mapvector (fun seq) + (map 'vector fun seq))) + (defvar edmacro-mode-map nil) (unless edmacro-mode-map (setq edmacro-mode-map (make-sparse-keymap)) @@ -106,6 +113,8 @@ (defvar edmacro-finish-hook) (defvar edmacro-original-buffer) +;; A lot of cruft here, but I got it to work eventually. Could use +;; some cleaning up. ;;;###autoload (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) "Edit a keyboard macro. @@ -217,10 +226,9 @@ (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) ;;;###autoload -(defmacro kbd (keys) +(defun kbd (keys) "Convert KEYS to the internal Emacs key representation." - `(eval-when-compile - (read-kbd-macro ,keys))) + (read-kbd-macro keys)) ;;;###autoload (defun format-kbd-macro (&optional macro verbose) @@ -421,52 +429,53 @@ ;; accepts a vector (but works with a string too). Vector may contain ;; keypress events. -hniksic (defun edmacro-parse-keys (string &optional ignored) - (let ((pos 0) - (case-fold-search nil) - (word-to-sym '(("NUL" . (control space)) - ("RET" . return) - ("LFD" . linefeed) - ("TAB" . tab) - ("ESC" . escape) - ("SPC" . space) - ("BS" . backspace) - ("DEL" . delete))) - (char-to-word '((?\0 . "NUL") - (?\r . "RET") - (?\n . "LFD") - (?\t . "TAB") - (?\e . "ESC") - (?\ . "SPC") - (?\C-? . "DEL"))) - (modifier-prefix-alist '(("C" . control) - ("M" . meta) - ("S" . shift) - ("Sh" . shift) - ("A" . alt) - ("H" . hyper) - ("s" . super))) - ;; string-to-symbol-or-char converter - (conv #'(lambda (arg) - (if (= (length arg) 1) - (aref arg 0) - (if (string-match "^<\\([^>]+\\)>$" arg) - (setq arg (match-string 1 arg))) - (let ((match (assoc arg word-to-sym))) - (if match - (cdr match) - (intern arg)))))) - (conv-chars #'(lambda (arg) - (let ((match (assoc arg char-to-word))) - (if match - (cdr (assoc (cdr match) word-to-sym)) - arg)))) - res) + (let* ((pos 0) + (case-fold-search nil) + (word-to-sym '(("NUL" . (control space)) + ("RET" . return) + ("LFD" . linefeed) + ("TAB" . tab) + ("ESC" . escape) + ("SPC" . space) + ("BS" . backspace) + ("DEL" . delete))) + (char-to-word '((?\0 . "NUL") + (?\r . "RET") + (?\n . "LFD") + (?\t . "TAB") + (?\e . "ESC") + (?\ . "SPC") + (?\C-? . "DEL"))) + (modifier-prefix-alist '(("C" . control) + ("M" . meta) + ("S" . shift) + ("Sh" . shift) + ("A" . alt) + ("H" . hyper) + ("s" . super))) + ;; string-to-symbol-or-char converter + (conv (lambda (arg) + (if (= (length arg) 1) + (aref arg 0) + (if (string-match "^<\\([^>]+\\)>$" arg) + (setq arg (match-string 1 arg))) + (let ((match (assoc arg word-to-sym))) + (if match + (cdr match) + (intern arg)))))) + (conv-chars (lambda (arg) + (let ((match (assoc arg char-to-word))) + (if match + (cdr (assoc (cdr match) word-to-sym)) + arg)))) + res) (while (and (< pos (length string)) (string-match "[^ \t\n\f]+" string pos)) (let ((word (substring string (match-beginning 0) (match-end 0))) (times 1) (force-sym nil) - (add nil)) + (add nil) + match) (setq pos (match-end 0)) (when (string-match "\\([0-9]+\\)\\*." word) (setq times (string-to-int (substring word 0 (match-end 1)))) @@ -475,7 +484,8 @@ (setq word (match-string 1 word)) (setq force-sym t)) (setq match (assoc word word-to-sym)) - ;; Add an element. + ;; Add an element; `add' holds the list of elements to be + ;; added. (cond ((string-match "^\\\\[0-7]+" word) ;; Octal value of character. (setq add @@ -496,7 +506,7 @@ (mapcar conv-chars (concat (substring word 2 -2) "\r"))) )) ((or (equal word "REM") (string-match "^;;" word)) - ;; Comment. + ;; Comment (discard to EOL) . (setq pos (string-match "$" string pos))) (match ;; Convert to symbol. @@ -536,7 +546,7 @@ (loop repeat times do (setq new (append new add))) (setq add new)) (setq res (nconc res add)))) - (mapvector 'identity res))) + (edmacro-mapvector 'identity res))) (defun edmacro-conv (char-or-sym add-<>) (let ((char-to-word '((?\0 . "NUL") @@ -569,6 +579,9 @@ (cdr found)) ((< char-or-sym 128) (single-key-description char-or-sym)) + ((and edmacro-eight-bits + (>= char-or-sym 128)) + (char-to-string char-or-sym)) (t (format "\\%o" (edmacro-int-char char-or-sym))))))))) @@ -638,15 +651,15 @@ (if el (setq new (nconc new (list el)))) (incf cnt)) - (mapvector 'identity new)))) + (edmacro-mapvector 'identity new)))) ;; Collapse a list of keys into a list of function keys, where ;; applicable. (defun edmacro-fkeys (keys) - (let (new k) + (let (new k lookup) (while keys (setq k (nconc k (list (car keys)))) - (setq lookup (lookup-key function-key-map (mapvector 'identity k))) + (setq lookup (lookup-key function-key-map (edmacro-mapvector 'identity k))) (cond ((vectorp lookup) (setq new (nconc new (mapcar 'identity lookup))) (setq k nil)) @@ -674,7 +687,7 @@ (and (eq verbose 1) (setq verbose nil)) - ;; Oh come on -- I want a list! Much easier to process... + ;; We prefer a list -- much easier to process... (setq macro (mapcar 'identity macro)) (setq macro (edmacro-fkeys macro)) (while macro @@ -682,10 +695,11 @@ (loop do (setq key (nconc key (list (car macro))) macro (cdr macro) - lookup (lookup-key global-map (mapvector 'identity key))) + lookup (lookup-key global-map (edmacro-mapvector + 'identity key))) while - (and lookup (not (commandp lookup)))) - ;; (lookup-key [?\C-x ?e]) seems to return a vector! + (and macro lookup (not (commandp lookup)))) + ;; keyboard macro (if (vectorp lookup) (setq lookup nil)) (if (and (eq lookup 'self-insert-command) @@ -751,7 +765,7 @@ (while (< i (length macro)) (when (and (consp (setq ev (aref macro i))) (not (memq (car ev) ; ha ha - '(hyper super control meta alt control shift)))) + '(hyper super meta alt control shift)))) (cond ((equal (cadadr ev) '(menu-bar)) (setq macro (vconcat (edmacro-subseq macro 0 i) (vector 'menu-bar (car ev)) diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/eldoc.el --- a/lisp/utils/eldoc.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/eldoc.el Mon Aug 13 09:30:11 2007 +0200 @@ -7,7 +7,7 @@ ;; Keywords: extensions ;; Created: 1995-10-06 -;; $Id: eldoc.el,v 1.4 1997/03/18 03:27:00 steve Exp $ +;; $Id: eldoc.el,v 1.5 1997/04/19 23:21:17 steve Exp $ ;; This file is part of GNU Emacs. @@ -54,8 +54,12 @@ (or (featurep 'timer) (load "timer" t)) +(defgroup eldoc nil + "Show function arglist or variable docstring in echo area." + :group 'extensions) + ;;;###autoload -(defvar eldoc-mode nil +(defcustom eldoc-mode nil "*If non-nil, show the defined parameters for the elisp function near point. For the emacs lisp function at the beginning of the sexp which point is @@ -67,18 +71,24 @@ If point is over a documented variable, print that variable's docstring instead. -This variable is buffer-local.") +This variable is buffer-local." + :type 'boolean + :group 'eldoc) (make-variable-buffer-local 'eldoc-mode) -(defconst eldoc-idle-delay 0.50 +(defcustom eldoc-idle-delay 0.50 "*Number of seconds of idle time to wait before printing. If user input arrives before this interval of time has elapsed after the last input, no documentation will be printed. -If this variable is set to 0, no idle time is required.") +If this variable is set to 0, no idle time is required." + :type 'number + :group 'eldoc) -(defconst eldoc-minor-mode-string " ElDoc" - "*String to display in mode line when Eldoc Mode is enabled.") +(defcustom eldoc-minor-mode-string " ElDoc" + "*String to display in mode line when Eldoc Mode is enabled." + :type 'string + :group 'eldoc) ;; Put this minor mode on the global minor-mode-alist. (or (assq 'eldoc-mode (default-value 'minor-mode-alist)) @@ -86,11 +96,13 @@ (append (default-value 'minor-mode-alist) '((eldoc-mode eldoc-minor-mode-string))))) -(defconst eldoc-argument-case 'upcase +(defcustom eldoc-argument-case 'upcase "Case to display argument names of functions, as a symbol. This has two preferred values: `upcase' or `downcase'. Actually, any name of a function which takes a string as an argument and -returns another string is acceptable.") +returns another string is acceptable." + :type '(choice (const upcase) (const downcase)) + :group 'eldoc) ;; No user options below here. diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/live-icon.el --- a/lisp/utils/live-icon.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/live-icon.el Mon Aug 13 09:30:11 2007 +0200 @@ -6,7 +6,11 @@ ;; Authors: Rich Williams ;; Jamie Zawinski -;; Version 1.2 +;; Minor cleanups and conversion from obsolete functions by +;; Karl M. Hegbloom + +;; Version 1.3 + ;; This file is part of XEmacs. @@ -29,33 +33,6 @@ ;; Generates little pixmaps representing the contents of your frames. -;; #### This thing is somewhat of a mess and could stand some clean-up. - -(defun live-icon-colour-name-from-face (face &optional bg-p) - "Do backward compatible things to faces and colours" - (if (and (boundp 'emacs-major-version) - (or (> emacs-major-version 19) - (and (= emacs-major-version 19) - (>= emacs-minor-version 12)))) - (let* ((face (if (consp face) (car face) face)) - (colour (if bg-p - (face-background face) - (face-foreground face)))) - (if (consp colour) - (setq colour (cdr (car colour)))) - (if (color-instance-p colour) - (setq colour (color-instance-name colour))) - (if (specifierp colour) - (setq colour (color-name colour))) - (if colour - (let ((hack (format "%s" colour))) - (if (string-match "(?\\([^)]*\\))?" hack) - (substring hack (match-beginning 1) (match-end 1)) - hack)))) - (let ((p (if bg-p (face-background face) (face-foreground face)))) - (and (pixelp p) - (pixel-name p))))) - (defun live-icon-alloc-colour (cmv colour) "Allocate a colour and a char from the magic vector" (let ((bob (assoc colour (aref cmv 0))) @@ -70,20 +47,20 @@ (defun live-icon-from-frame (&optional frame) "Calculates the live-icon XPM of FRAME." (if (not frame) - (setq frame (selected-screen))) + (setq frame (selected-frame))) (save-excursion - (select-screen frame) - (let* ((w (screen-width)) - (h (screen-height)) + (select-frame frame) + (let* ((w (frame-width)) + (h (frame-height)) (pix (make-vector h nil)) (ny 0) (cmv (vector nil 0 ?A)) (d (live-icon-alloc-colour - cmv (pixel-name (face-background 'default)))) + cmv (color-name (face-background 'default)))) (m (live-icon-alloc-colour - cmv (pixel-name (face-background 'modeline)))) + cmv (color-name (face-background 'modeline)))) (x (live-icon-alloc-colour - cmv (pixel-name (face-foreground 'default)))) + cmv (color-name (face-foreground 'default)))) y) (let ((loop 0)) (while (< loop h) @@ -108,8 +85,11 @@ (< (current-column) w)) (if (> (char-after (point)) 32) (let* ((ex (extent-at (point) (current-buffer) 'face)) - (f (if ex (extent-face ex))) - (z (if f (live-icon-colour-name-from-face f))) + (f (if ex (let ((f (extent-face ex))) + (if (not (consp f)) + f + (car f))))) + (z (if f (color-name (face-foreground f)))) (c (if z (live-icon-alloc-colour cmv z) x))) (aset (aref pix y) (current-column) c))) (forward-char 1)) @@ -117,18 +97,14 @@ (forward-line 1)))))) (sort (if (fboundp 'window-list) (window-list) - (let* ((w (screen-root-window)) + (let* ((w (frame-root-window)) (ws nil)) (while (not (memq (setq w (next-window w)) ws)) (setq ws (cons w ws))) ws)) - (if (fboundp 'window-pixel-edges) #'(lambda (won woo) (< (nth 1 (window-pixel-edges won)) - (nth 1 (window-pixel-edges woo)))) - #'(lambda (won woo) - (< (nth 1 (window-edges won)) - (nth 1 (window-edges woo))))))) + (nth 1 (window-pixel-edges woo)))))) (concat "/* XPM */\nstatic char icon[] = {\n" (format "\"%d %d %d 1\",\n" w (* h 2) (aref cmv 1)) (mapconcat #'(lambda (colour-entry) @@ -140,189 +116,212 @@ ",\n" (mapconcat #'(lambda (scan-line) (concat "\"" scan-line "\"," "\n" -;; "\"" scan-line "\"" "\"" (make-string w d) "\"," )) pix ",\n") "};\n")))) - -(defun live-icon-start-ppm-stuff (&optional frame) - "Start a live icon conversion going" - (interactive) - (if (not frame) - (setq frame (selected-screen))) - (let ((buf (get-buffer-create " *live-icon*"))) - (message "live-icon...(backgrounding)") - (save-excursion - (set-buffer buf) - (erase-buffer)) - (set-process-sentinel - (start-process-shell-command "live-icon" - buf - "xwd" - "-id" (format "%s" (x-window-id frame)) "|" - "xwdtopnm" "|" - "pnmscale" "-xysize" "64" "64" "|" - "ppmquant" "256" "|" - "ppmtoxpm") - #'(lambda (p s) - (message "live-icon...(munching)") - (save-excursion - (set-buffer " *live-icon*") - (goto-char (point-min)) - (search-forward "/* XPM */") - (x-set-screen-icon-pixmap frame - (make-pixmap - (buffer-substring - (match-beginning 0) (point-max))))) - (message "live-icon...... done")))) - nil) - - (defun live-icon-one-frame (&optional frame) "Gives FRAME (defaulting to (selected-frame)) a live icon." (interactive) -; (message "Updating live icon...") (if (not frame) - (setq frame (selected-screen))) - (x-set-screen-icon-pixmap frame (make-pixmap (live-icon-from-frame frame))) -; (message "Updating live icon... done") - ) + (setq frame (selected-frame))) + (set-glyph-image frame-icon-glyph (live-icon-from-frame frame) frame)) -(defun live-icon-all-frames () - "Gives all your frames live-icons." - (interactive) - (message "Updating live icons...") - (mapcar #'(lambda (fr) - (x-set-screen-icon-pixmap - fr (make-pixmap (live-icon-from-frame fr)))) - (screen-list)) - (message "Updating live icons... done")) +;;(defun live-icon-all-frames () +;; "Gives all your frames live-icons." +;; (interactive) +;; (mapcar #'(lambda (fr) +;; (set-glyph-image frame-icon-glyph +;; (live-icon-from-frame fr) +;; fr)) +;; (frame-list))) (add-hook 'unmap-screen-hook 'live-icon-one-frame) ;;(start-itimer "live-icon" 'live-icon-all-frames 120 120) +(provide 'live-icon) +;;; live-icon.el ends here + -(defun live-icon-goto-position (x y) - (let (window edges) - (catch 'done - (walk-windows - #'(lambda (w) - (setq edges (window-edges w)) - (if (and (>= x (nth 0 edges)) - (<= x (nth 2 edges)) - (>= y (nth 1 edges)) - (<= y (nth 3 edges))) - (throw 'done (setq window w)))) - nil t)) - (if (not window) - nil - (select-window window) - (move-to-window-line (- y (nth 1 edges))) - (move-to-column (- x (nth 0 edges))) - ))) +;;;; Spare parts and leftovers department: + +;; #### This thing is somewhat of a mess and could stand some clean-up. + +;;(defun live-icon-colour-name-from-face (face &optional bg-p) +;; "Do backward compatible things to faces and colours" +;; (if (and (boundp 'emacs-major-version) +;; (or (> emacs-major-version 19) +;; (and (= emacs-major-version 19) +;; (>= emacs-minor-version 12)))) +;; (let* ((face (if (consp face) (car face) face)) +;; (colour (if bg-p +;; (face-background face) +;; (face-foreground face)))) +;; (if (consp colour) +;; (setq colour (cdr (car colour)))) +;; (if (color-instance-p colour) +;; (setq colour (color-instance-name colour))) +;; (if (specifierp colour) +;; (setq colour (color-name colour))) +;; (if colour +;; (let ((hack (format "%s" colour))) +;; (if (string-match "(?\\([^)]*\\))?" hack) +;; (substring hack (match-beginning 1) (match-end 1)) +;; hack)))) +;; (let ((p (if bg-p (face-background face) (face-foreground face)))) +;; (and (pixelp p) +;; ;; ** The following functions are not known to be defined: pixelp +;; (pixel-name p))))) +;;;; ** pixel-name is an obsolete function; use color-name instead. + +;;(defun live-icon-start-ppm-stuff (&optional frame) +;; "Start a live icon conversion going" +;; (interactive) +;; (if (not frame) +;; (setq frame (selected-frame))) +;; (let ((buf (get-buffer-create " *live-icon*"))) +;; (message "live-icon...(backgrounding)") +;; (save-excursion +;; (set-buffer buf) +;; (erase-buffer)) +;; (set-process-sentinel +;; (start-process-shell-command "live-icon" +;; buf +;; "xwd" +;; "-id" (format "%s" (x-window-id frame)) "|" +;; "xwdtopnm" "|" +;; "pnmscale" "-xysize" "64" "64" "|" +;; "ppmquant" "256" "|" +;; "ppmtoxpm") +;; #'(lambda (p s) +;; (message "live-icon...(munching)") +;; (save-excursion +;; (set-buffer " *live-icon*") +;; (goto-char (point-min)) +;; (search-forward "/* XPM */") +;; (set-glyph-image frame-icon-glyph +;; (buffer-substring (match-beginning 0) (point-max)) +;; frame)) +;; (message "live-icon...... done")))) +;; nil) + +;;(defun live-icon-goto-position (x y) +;; (let (window edges) +;; (catch 'done +;; (walk-windows +;; #'(lambda (w) +;; (setq edges (window-edges w)) +;; (if (and (>= x (nth 0 edges)) +;; (<= x (nth 2 edges)) +;; (>= y (nth 1 edges)) +;; (<= y (nth 3 edges))) +;; (throw 'done (setq window w)))) +;; nil t)) +;; (if (not window) +;; nil +;; (select-window window) +;; (move-to-window-line (- y (nth 1 edges))) +;; (move-to-column (- x (nth 0 edges))) +;; ))) -(defun live-icon-make-image (width height) - (let* ((text-aspect 1.5) - (xscale (/ (/ (* (screen-width) 1.0) width) text-aspect)) - (yscale (/ (* (screen-height) 1.0) height)) - (x 0) - (y 0) - (cmv (vector nil 0 ?A)) - (default-fg (live-icon-alloc-colour - cmv (pixel-name (face-foreground 'default)))) - (default-bg (live-icon-alloc-colour - cmv (pixel-name (face-background 'default)))) - (modeline-bg (live-icon-alloc-colour - cmv (pixel-name (face-background 'modeline)))) - (lines (make-vector height nil))) - ;; - ;; Put in the text. - ;; - (save-excursion - (save-window-excursion - (while (< y height) - (aset lines y (make-string width default-bg)) - (setq x 0) - (while (< x width) - (let ((sx (floor (* x xscale))) - (sy (floor (* y yscale)))) - (live-icon-goto-position sx sy) - (let* ((extent (extent-at (point) (current-buffer) 'face)) - (face (if extent (extent-face extent))) - (name (if face (live-icon-colour-name-from-face - face (<= (char-after (point)) 32)))) - (color (if name - (live-icon-alloc-colour cmv name) - (if (<= (or (char-after (point)) 0) 32) - default-bg default-fg)))) - (aset (aref lines y) x color))) - (setq x (1+ x))) - (setq y (1+ y))))) - ;; - ;; Now put in the modelines. - ;; - (let (sx sy) - (walk-windows - #'(lambda (w) - (let ((edges (window-edges w))) - (setq x (nth 0 edges) - y (nth 3 edges) - sx (floor (/ x xscale)) - sy (floor (/ y yscale))) - (while (and (< x (1- (nth 2 edges))) - (< sx (length (aref lines 0)))) - (aset (aref lines sy) sx modeline-bg) - (if (> sy 0) - (aset (aref lines (1- sy)) sx modeline-bg)) - (setq x (1+ x) - sx (floor (/ x xscale)))) - (if (>= sx (length (aref lines 0))) - (setq sx (1- sx))) - (while (>= y (nth 1 edges)) - (aset (aref lines sy) sx modeline-bg) - (setq y (1- y) - sy (floor (/ y yscale)))))) - nil nil)) - ;; - ;; Now put in the top and left edges - ;; - (setq x 0) - (while (< x width) - (aset (aref lines 0) x modeline-bg) - (setq x (1+ x))) - (setq y 0) - (while (< y height) - (aset (aref lines y) 0 modeline-bg) - (setq y (1+ y))) - ;; - ;; Now make the XPM - ;; - (concat "/* XPM */\nstatic char icon[] = {\n" - (format "\"%d %d %d 1\",\n" - width -;; (* height 2) - height - (aref cmv 1)) - (mapconcat #'(lambda (colour-entry) - (format "\"%c c %s\"" - (cdr colour-entry) - (car colour-entry))) - (aref cmv 0) - ",\n") - ",\n" - (mapconcat #'(lambda (scan-line) - (concat "\"" scan-line "\"," "\n" -;; "\"" scan-line "\"" -;; "\"" (make-string width default-bg) -;; "\"," - )) - lines - ",\n") - "};\n"))) - -(provide 'live-icon) -;;; live-icon.el ends here +;;(defun live-icon-make-image (width height) +;; (let* ((text-aspect 1.5) +;; (xscale (/ (/ (* (frame-width) 1.0) width) text-aspect)) +;; (yscale (/ (* (frame-height) 1.0) height)) +;; (x 0) +;; (y 0) +;; (cmv (vector nil 0 ?A)) +;; (default-fg (live-icon-alloc-colour +;; cmv (color-name (face-foreground 'default)))) +;; (default-bg (live-icon-alloc-colour +;; cmv (color-name (face-background 'default)))) +;; (modeline-bg (live-icon-alloc-colour +;; cmv (color-name (face-background 'modeline)))) +;; (lines (make-vector height nil))) +;; ;; +;; ;; Put in the text. +;; ;; +;; (save-excursion +;; (save-window-excursion +;; (while (< y height) +;; (aset lines y (make-string width default-bg)) +;; (setq x 0) +;; (while (< x width) +;; (let ((sx (floor (* x xscale))) +;; (sy (floor (* y yscale)))) +;; (live-icon-goto-position sx sy) +;; (let* ((extent (extent-at (point) (current-buffer) 'face)) +;; (face (if extent (extent-face extent))) +;; (name (if face (live-icon-colour-name-from-face +;; face (<= (char-after (point)) 32)))) +;; (color (if name +;; (live-icon-alloc-colour cmv name) +;; (if (<= (or (char-after (point)) 0) 32) +;; default-bg default-fg)))) +;; (aset (aref lines y) x color))) +;; (setq x (1+ x))) +;; (setq y (1+ y))))) +;; ;; +;; ;; Now put in the modelines. +;; ;; +;; (let (sx sy) +;; (walk-windows +;; #'(lambda (w) +;; (let ((edges (window-edges w))) +;; (setq x (nth 0 edges) +;; y (nth 3 edges) +;; sx (floor (/ x xscale)) +;; sy (floor (/ y yscale))) +;; (while (and (< x (1- (nth 2 edges))) +;; (< sx (length (aref lines 0)))) +;; (aset (aref lines sy) sx modeline-bg) +;; (if (> sy 0) +;; (aset (aref lines (1- sy)) sx modeline-bg)) +;; (setq x (1+ x) +;; sx (floor (/ x xscale)))) +;; (if (>= sx (length (aref lines 0))) +;; (setq sx (1- sx))) +;; (while (>= y (nth 1 edges)) +;; (aset (aref lines sy) sx modeline-bg) +;; (setq y (1- y) +;; sy (floor (/ y yscale)))))) +;; nil nil)) +;; ;; +;; ;; Now put in the top and left edges +;; ;; +;; (setq x 0) +;; (while (< x width) +;; (aset (aref lines 0) x modeline-bg) +;; (setq x (1+ x))) +;; (setq y 0) +;; (while (< y height) +;; (aset (aref lines y) 0 modeline-bg) +;; (setq y (1+ y))) +;; ;; +;; ;; Now make the XPM +;; ;; +;; (concat "/* XPM */\nstatic char icon[] = {\n" +;; (format "\"%d %d %d 1\",\n" +;; width +;;;; (* height 2) +;; height +;; (aref cmv 1)) +;; (mapconcat #'(lambda (colour-entry) +;; (format "\"%c c %s\"" +;; (cdr colour-entry) +;; (car colour-entry))) +;; (aref cmv 0) +;; ",\n") +;; ",\n" +;; (mapconcat #'(lambda (scan-line) +;; (concat "\"" scan-line "\"," "\n" +;;;; "\"" scan-line "\"" +;;;; "\"" (make-string width default-bg) +;;;; "\"," +;; )) +;; lines +;; ",\n") +;; "};\n"))) diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/skeleton.el --- a/lisp/utils/skeleton.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/skeleton.el Mon Aug 13 09:30:11 2007 +0200 @@ -165,6 +165,7 @@ (and skeleton-autowrap (or (eq last-command 'mouse-drag-region) (and (boundp 'transient-mark-mode) + (boundp 'mark-active) transient-mark-mode mark-active)) -1))) (if (stringp str) @@ -211,6 +212,7 @@ (and skeleton-autowrap (or (eq last-command 'mouse-drag-region) (and (boundp 'transient-mark-mode) + (boundp 'mark-active) transient-mark-mode mark-active)) -1))) (if (stringp str) @@ -518,6 +520,7 @@ (let ((mark (and skeleton-autowrap (or (eq last-command 'mouse-drag-region) (and (boundp 'transient-mark-mode) + (boundp 'mark-active) transient-mark-mode mark-active)))) (skeleton-end-hook)) (if (or arg diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/smtpmail.el --- a/lisp/utils/smtpmail.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/smtpmail.el Mon Aug 13 09:30:11 2007 +0200 @@ -45,26 +45,43 @@ (require 'sendmail) ;;; -(defvar smtpmail-default-smtp-server nil - "*Specify default SMTP server.") +(defgroup smtpmail nil + "SMTP protocol for sending mail." + :group 'mail) + -(defvar smtpmail-smtp-server +(defcustom smtpmail-default-smtp-server nil + "*Specify default SMTP server." + :type '(choice (const nil) string) + :group 'smtpmail) + +(defcustom smtpmail-smtp-server (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) - "*The name of the host running SMTP server.") + "*The name of the host running SMTP server." + :type '(choice (const nil) string) + :group 'smtpmail) -(defvar smtpmail-smtp-service 25 - "*SMTP service port number. smtp or 25 .") +(defcustom smtpmail-smtp-service 25 + "*SMTP service port number. smtp or 25 ." + :type '(choice (integer :tag "Port") (string :tag "Service")) + :group 'smtpmail) -(defvar smtpmail-local-domain nil +(defcustom smtpmail-local-domain nil "*Local domain name without a host name. If the function (system-name) returns the full internet address, -don't define this value.") +don't define this value." + :type '(choice (const nil) string) + :group 'smtpmail) -(defvar smtpmail-debug-info nil - "*smtpmail debug info printout. messages and process buffer.") +(defcustom smtpmail-debug-info nil + "*smtpmail debug info printout. messages and process buffer." + :type 'boolean + :group 'smtpmail) -(defvar smtpmail-code-conv-from nil ;; *junet* - "*smtpmail code convert from this code to *internal*..for tiny-mime..") +(defcustom smtpmail-code-conv-from nil ;; *junet* + "*smtpmail code convert from this code to *internal*..for tiny-mime.." + :type 'boolean + :group 'smtpmail) ;;; ;;; diff -r b27e67717092 -r 34a5b81f86ba lisp/utils/uniquify.el --- a/lisp/utils/uniquify.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/utils/uniquify.el Mon Aug 13 09:30:11 2007 +0200 @@ -83,7 +83,12 @@ ;;; User-visible variables -(defvar uniquify-buffer-name-style 'post-forward +(defgroup uniquify nil + "Unique buffer names dependent on file name" + :group 'applications) + + +(defcustom uniquify-buffer-name-style 'post-forward "*If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of `forward', `reverse', `post-forward' (the default), or `post-forward-angle-brackets'. @@ -93,33 +98,49 @@ reverse name\\mumble\\bar name\\mumble\\quux post-forward name|bar/mumble name|quux/mumble post-forward-angle-brackets name name - nil name name<2>") + nil name name<2>" + :type '(radio (const forward) + (const reverse) + (const post-forward) + (const podt-forward-angle-brackets) + (const nil)) + :group 'uniquify) -(defvar uniquify-after-kill-buffer-p nil +(defcustom uniquify-after-kill-buffer-p nil "*If non-nil, rerationalize buffer names after a buffer has been killed. This can be dangerous if Emacs Lisp code is keeping track of buffers by their -names (rather than keeping pointers to the buffers themselves).") +names (rather than keeping pointers to the buffers themselves)." + :type 'boolean + :group 'uniquify) -(defconst uniquify-ask-about-buffer-names-p nil +(defcustom uniquify-ask-about-buffer-names-p nil "*If non-nil, permit user to choose names for buffers with same base file. If the user chooses to name a buffer, uniquification is preempted and no -other buffer names are changed.") +other buffer names are changed." + :type 'boolean + :group 'uniquify) -(defvar uniquify-min-dir-content 0 - "*Minimum parts of directory name included in buffer name.") +(defcustom uniquify-min-dir-content 0 + "*Minimum parts of directory name included in buffer name." + :type 'integer + :group 'uniquify) -(defvar uniquify-separator nil +(defcustom uniquify-separator nil "*String separator for buffer name components. When `uniquify-buffer-name-style' is `post-forward', separates base file name from directory part in buffer names (default \"|\"). When `uniquify-buffer-name-style' is `reverse', separates all -file name components (default \"\\\").") +file name components (default \"\\\")." + :type '(choice (const nil) string) + :group 'uniquify) -(defvar uniquify-trailing-separator-p nil +(defcustom uniquify-trailing-separator-p nil "*If non-nil, add a file name separator to dired buffer names. If `uniquify-buffer-name-style' is `forward', add the separator at the end; if it is `reverse', add the separator at the beginning; otherwise, this -variable is ignored.") +variable is ignored." + :type 'boolean + :group 'uniquify) ;;; Utilities diff -r b27e67717092 -r 34a5b81f86ba lisp/version.el --- a/lisp/version.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:30:11 2007 +0200 @@ -22,10 +22,10 @@ ;;; Code: -(defconst emacs-version "20.1" +(defconst emacs-version "20.2" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta1)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/ChangeLog --- a/lisp/w3/ChangeLog Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:30:11 2007 +0200 @@ -2,8 +2,48 @@ * Makefile (xemacs-w3): Special target for XEmacs Build. +Fri Apr 18 13:09:31 1997 William M. Perry + +* Synch'd up to Widget 1.89 + +Thu Apr 17 06:20:56 1997 "T. V. Raman" + +* default.css (pre/xmp/plaintext/key/code/tt): Changes to default + stylesheet for spoken output of normally `monospaced' text. + +Tue Apr 15 16:28:11 1997 William M. Perry + +* w3.el (w3-find-specific-link): Don't signal an error in a target anchor + (#foo) is not found. + +Tue Apr 15 08:22:37 1997 John Palmieri + +* w3.el (w3-complete-link): protect against errors when hitting return + when point isn't on a link + +Mon Apr 14 16:18:43 1997 William M. Perry + +* mm.el (mm-parse-mailcaps): Moved ~/.mailcap to the front of the list so + that it gets parsed last, and has the highest priority. + +Sun Apr 13 20:28:30 1997 William M. Perry + +* w3.el (w3-complete-link): now correctly defaults to following the link + at point. + +Sat Apr 12 19:35:26 1997 William M. Perry + +* w3-speak.el: use widget-at instead of emacspeak-widget-at + Fri Apr 11 07:39:26 1997 William M. Perry +* w3-menu.el (w3-menu-edit-menu): Addded a preferences submenu with all + the W3 & URL customization items underneat it. + +* css.el (css-split-font-shorthand): Handle bad lists better + +* Emacs/W3 3.0.82 released + * Synch'd up with Widget 1.78 * w3-display.el (w3-get-face-info): Don't look for face attributes on tags diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/FAQ --- a/lisp/w3/FAQ Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/FAQ Mon Aug 13 09:30:11 2007 +0200 @@ -16,6 +16,24 @@ emacs. Set the environment variable WIDGETDIR to where your custom library lives (ie: ~/lisp/gnus/lisp) +Q: I like being warned about invalid HTML on my own pages, but how can + I make Emacs/W3 stop telling me almost everything on the Web is + invalid? +A: You can use the 'file preparation hook', which is run before any + parsing is done. + + (defun my-w3-file-prepare-hook () + (setq w3-debug-html + (if (or (string= (url-type url-current-object) "file") + (string-match ".*\\.some\\.domain\\.name" + (or (url-host url-current-object) ""))) + 'style + nil))) + (add-hook 'w3-file-prepare-hook 'my-w3-file-prepare-hook) + + This will turn on stylistic warnings for any local HTML files or + files loaded from the `*.some.domain.name' domain. + Courtesy of greg stark Q: How do i get Shift-Tab to go backwards on a text terminal or XTerm? aka: I hate the new text widgets, I can't go through the links with n and b diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/Makefile --- a/lisp/w3/Makefile Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:30:11 2007 +0200 @@ -49,7 +49,7 @@ w3-auto.el w3-menu.el w3-mouse.el w3-toolbar.el w3-prefs.el \ w3-speak.el w3-latex.el w3-parse.el w3-display.el w3-print.el \ w3-about.el w3-hot.el w3-e19.el w3-xemac.el w3.el w3-script.el \ - w3-jscript.el w3-elisp.el + w3-jscript.el w3-elisp.el dsssl-flow.el OBJECTS = $(SOURCES:.el=.elc) @@ -104,3 +104,4 @@ w3-display.elc: w3-display.el css.el font.el w3-imap.el css.elc: css.el font.el w3.elc: css.el w3-vars.el w3.el +dsssl.elc: dsssl.el dsssl-flow.el diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/css.el --- a/lisp/w3/css.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/04/01 19:21:41 -;; Version: 1.34 +;; Created: 1997/04/17 13:50:34 +;; Version: 1.36 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -143,7 +143,7 @@ ;; These are for specifying speech properties (Raman-style) [voice-family t string] - [gain t integer] + [gain t symbol] [left-volume t integer] [right-volume t integer] [pitch t integer] @@ -344,27 +344,29 @@ ;; [ || ]? [ / ]? (let (weight size height family retval) (if (not (string-match " *\\([0-9.]+[^ /]+\\)" font)) - (error "Malformed font shorthand: %s" font)) - (setq weight (if (/= 0 (match-beginning 0)) - (substring font 0 (match-beginning 0))) - size (match-string 1 font) - font (substring font (match-end 0) nil)) - (if (string-match " */ *\\([^ ]+\\) *" font) - ;; they specified a line-height as well - (setq height (match-string 1 font) - family (substring font (match-end 0) nil)) - (if (string-match "^[ \t]+" font) - (setq family (substring font (match-end 0) nil)) - (setq family font))) - (if weight - (push (cons 'font-weight (css-expand-value 'weight weight)) retval)) - (if size - (push (cons 'font-size (css-expand-length size)) retval)) - (if height - (push (cons 'line-height (css-expand-length height t)) retval)) - (if family - (push (cons 'font-family (css-expand-value 'string-list family)) retval)) - retval)) + (progn + (message "Malformed font shorthand: %s" font) + nil) + (setq weight (if (/= 0 (match-beginning 0)) + (substring font 0 (match-beginning 0))) + size (match-string 1 font) + font (substring font (match-end 0) nil)) + (if (string-match " */ *\\([^ ]+\\) *" font) + ;; they specified a line-height as well + (setq height (match-string 1 font) + family (substring font (match-end 0) nil)) + (if (string-match "^[ \t]+" font) + (setq family (substring font (match-end 0) nil)) + (setq family font))) + (if weight + (push (cons 'font-weight (css-expand-value 'weight weight)) retval)) + (if size + (push (cons 'font-size (css-expand-length size)) retval)) + (if height + (push (cons 'line-height (css-expand-length height t)) retval)) + (if family + (push (cons 'font-family (css-expand-value 'string-list family)) retval)) + retval))) (if (not (fboundp 'frame-char-height)) (defun frame-char-height (&optional frame) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/docomp.el --- a/lisp/w3/docomp.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 09:30:11 2007 +0200 @@ -62,8 +62,6 @@ ;; Emacs 19 byte compiler complains about too much stuff by default. ;; Turn off most of the warnings here. (setq byte-compile-warnings '(free-vars) - byte-compile-dynamic t - byte-compile-dynamic-docstrings t byte-optimize t ) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/dsssl-flow.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/dsssl-flow.el Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,119 @@ +;;; dsssl-flow.el --- DSSSL flow objects +;; Author: wmperry +;; Created: 1997/04/18 13:48:10 +;; Version: 1.2 +;; Keywords: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1997 by 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defstruct flow-object + (type 'unknown :read-only t) ; Name of this flow object + (properties nil) + (children nil) + (parent nil) + ) + +(defstruct dsssl-flow-processor + (name 'unknown :read-only t) ; Name of this processing backend + (init nil) ; initialize the backend + (handler nil) ; handle a single flow object + (sizeof nil) ; get size of a single flow object + (clean nil) ; cleanup instance of backend + ) + +(defun dsssl-flow-display (flows processor) + (let ((handler (dsssl-flow-processor-handler processor)) + (flow-stack (list flows)) + (content nil) + (node nil) + (last-object nil) + ) + (while flow-stack + (setq content (pop flow-stack)) + (dsssl-flow-progress-meter) + ;; Handle the element's content + (while content + (dsssl-flow-progress-meter) + (if (stringp (car content)) + (dsssl-flow-handle-string-content (pop content)) + (setq node (pop content)) + ;; todo: collect all information about this flow object for faster + ;; lookup later. + (push (dsssl-flow-face-for-element node) dsssl-flow-active-faces) + (push (dsssl-flow-voice-for-element node) dsssl-flow-active-voices)) + (case (flow-object-type node) + ;; Core DSSL components basic flow object classes + (sequence ; 12.6.1 + ) + (display-group ; 12.6.2 + ) + (paragraph ; 12.6.6 + ) + (paragraph-break ; 12.6.7 + ) + (external-graphic ; 12.6.15 + ) + ;; DSSSL options required in DSSSL online + ;; Simple page flow object class + (simple-page-sequence ; 12.6.3 + ) + ;; Table flow object classes + (table ; 12.6.27.1 + ) + (table-part ; 12.6.27.2 + ) + (table-column ; 12.6.27.3 + ) + (table-row ; 12.6.27.5 + ) + (table-border ; 12.6.27.7 + ) + (table-cell ; 12.6.27.6 + ;; Do we need to handle table-cell at this level, or is that + ;; something that the display backend needs to handle, and we + ;; just query that in the `table-row' processor? + ) + ;; Online display flow object classes + (vertical-scroll ; 12.6.28.1 + ) + (multi-mode ; 12.6.28.2 + ) + (marginalia ; 12.6.28.4 + ) + ;; Emacs/W3 specific flow objects + (applet ; Wow, Java + ) + (script ; Scripts + (w3-handle-empty-tag)) + (form-element ; Any form element + ) + ;; pinhead, flame, and cookie can now all be handled by + ;; a stud-muffing DSSSL stylesheet - hooray! + + ;; Generic formatting - all things that can be fully specified + ;; by a CSS stylesheet. + (otherwise + ;; handle the content + (dsssl-flow-handle-content node))))))) + +(provide 'dsssl-flow) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/dsssl.el --- a/lisp/w3/dsssl.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/dsssl.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; dsssl.el --- DSSSL parser ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.12 +;; Created: 1997/04/18 15:44:22 +;; Version: 1.14 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,21 +27,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'cl) +(require 'dsssl-flow) (if (not (fboundp 'cl-copy-hashtable)) (defun cl-copy-hashtable (h) (let ((new (make-hash-table))) (cl-maphash (function (lambda (k v) (cl-puthash k v new))) h) new))) - -;; We need to have this up at the top to avoid compilation warnings in -;; 'make' in dsssl-eval. Call me anal. -(defstruct flow-object - (name 'unknown :read-only t) ; Name of this flow object - (properties nil) - (children nil) - (parent nil) - ) (defconst dsssl-builtin-functions '(not boolean\? case equal\? null\? list\? list length append @@ -331,7 +323,7 @@ (setq temp (- temp 2))) ;; Create the actual flow object - (make-flow-object :name type + (make-flow-object :type type :children children :properties props) ) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/html32.dsl --- a/lisp/w3/html32.dsl Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/html32.dsl Mon Aug 13 09:30:11 2007 +0200 @@ -1,888 +1,888 @@ - - -;; ###################################################################### -;; -;; DSSSL style sheet for HTML 3.2 print output -;; -;; 1996.11.17 -;; -;; Base version, August 1996: Jon Bosak, Sun Microsystems, based on work -;; by Anders Berglund, EBT, with critical assistance from James Clark -;; TOC section and recto/verso page treatments based on models by James -;; Clark, October 1996 -;; -;; ###################################################################### - -;; Features in HTML 3.2 that are not implemented in the style sheet: -;; -;; automatic table column widths -;; % on width attribute for TABLE -;; attributes on TH and TD: align, valign, rowspan, colspan -;; attributes on TABLE: width, align, border, cellspacing, cellpadding -;; start attribute on OL -;; value attribute on LI -;; noshade attribute on HR -;; -;; See also "Non-Printing Elements" below -;; -;; Features in the style sheet that are not in HTML 3.2: -;; -;; page headers that display the HEAD TITLE content -;; page footers that display the page number -;; autonumbering of heads and table captions -;; support for named units (pt, pi, cm, mm) in size attributes -;; automatic TOC generation - -;; ============================== UNITS ================================ - -(define-unit pi (/ 1in 6)) -(define-unit pt (/ 1in 72)) -(define-unit px (/ 1in 96)) - -;; see below for definition of "em" - - -;; ============================ PARAMETERS ============================== - -;; ........................... Basic "look" ............................. - -;; Visual acuity levels are "normal", "presbyopic", and -;; "large-type"; set the line following to choose the level - -(define %visual-acuity% "normal") -;; (define %visual-acuity% "presbyopic") -;; (define %visual-acuity% "large-type") - -(define %bf-size% - (case %visual-acuity% - (("normal") 11pt) - (("presbyopic") 12pt) - (("large-type") 24pt))) -(define %mf-size% (- %bf-size% 1pt)) -(define %hf-size% %bf-size%) - -(define-unit em %bf-size%) - -(define %autonum-level% 6) ;; zero disables autonumbering -(define %flushtext-headlevel% ;; heads above this hang out on the left - (if (equal? %visual-acuity% "large-type") 6 4)) -(define %body-start-indent% ;; sets the white space on the left - (if (equal? %visual-acuity% "large-type") 0pi 4pi)) -(define %toc?% #t) ;; enables TOC after H1 - -;; ........................ Basic page geometry ......................... - -(define %page-width% 8.5in) -(define %page-height% 11in) - -(define %left-right-margin% 6pi) -(define %top-margin% - (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) -(define %bottom-margin% - (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) -(define %header-margin% - (if (equal? %visual-acuity% "large-type") 4.5pi 3pi)) -(define %footer-margin% 3.5pi) - -(define %text-width% (- %page-width% (* %left-right-margin% 2))) -(define %body-width% (- %text-width% %body-start-indent%)) - -;; .......................... Spacing factors ........................... - -(define %para-sep% (/ %bf-size% 2.0)) -(define %block-sep% (* %para-sep% 2.0)) - -(define %line-spacing-factor% 1.2) -(define %bf-line-spacing% (* %bf-size% %line-spacing-factor%)) -(define %mf-line-spacing% (* %mf-size% %line-spacing-factor%)) -(define %hf-line-spacing% (* %hf-size% %line-spacing-factor%)) - -(define %head-before-factor% 1.0) -(define %head-after-factor% 0.6) -(define %hsize-bump-factor% 1.2) - -(define %ss-size-factor% 0.6) -(define %ss-shift-factor% 0.4) -(define %smaller-size-factor% 0.9) -(define %bullet-size-factor% 0.8) - -;; ......................... Fonts and bullets .......................... - -;; these font selections are for Windows 95 - -(define %title-font-family% "Arial") -(define %body-font-family% "Times New Roman") -(define %mono-font-family% "Courier New") -(define %dingbat-font-family% "Wingdings") - -;; these "bullet strings" are a hack that is completely dependent on -;; the Wingdings font family selected above; consider this a -;; placeholder for suitable ISO 10646 characters - -(define %disk-bullet% "l") -(define %circle-bullet% "¡") -(define %square-bullet% "o") - -(define %bullet-size% (* %bf-size% %bullet-size-factor%)) - - -;; ========================== COMMON FUNCTIONS ========================== - -(define (expt b n) - (if (= n 0) - 1 - (* b (expt b (- n 1))))) - -;; per ISO/IEC 10179 -(define (node-list-reduce nl proc init) - (if (node-list-empty? nl) - init - (node-list-reduce (node-list-rest nl) - proc - (proc init (node-list-first nl))))) - -;; per ISO/IEC 10179 -(define (node-list-length nl) - (node-list-reduce nl - (lambda (result snl) - (+ result 1)) - 0)) - -(define if-front-page - (external-procedure "UNREGISTERED::James Clark//Procedure::if-front-page")) - -(define if-first-page - (external-procedure "UNREGISTERED::James Clark//Procedure::if-first-page")) - -(define upperalpha - '(#\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)) - -(define loweralpha - '(#\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)) - -(define (char-downcase ch) - (case ch - ((#\A) #\a) ((#\B) #\b) ((#\C) #\c) ((#\D) #\d) ((#\E) #\e) - ((#\F) #\f) ((#\G) #\g) ((#\H) #\h) ((#\I) #\i) ((#\J) #\j) - ((#\K) #\k) ((#\L) #\l) ((#\M) #\m) ((#\N) #\n) ((#\O) #\o) - ((#\P) #\p) ((#\Q) #\q) ((#\R) #\r) ((#\S) #\s) ((#\T) #\t) - ((#\U) #\u) ((#\V) #\v) ((#\W) #\w) ((#\X) #\x) ((#\Y) #\y) - ((#\Z) #\z) (else ch))) - -(define (LOCASE slist) - (if (null? slist) - '() - (cons (char-downcase (car slist)) (LOCASE (cdr slist))))) - -(define (STR2LIST s) - (let ((len (string-length s))) - (let loop ((i 0) (ln len)) - (if (= i len) - '() - (cons (string-ref s i) (loop (+ i 1) ln)))))) - -(define (STRING-DOWNCASE s) - (apply string (LOCASE (STR2LIST s)))) - -(define (UNAME-START-INDEX u last) - (let ((c (string-ref u last))) - (if (or (member c upperalpha) (member c loweralpha)) - (if (= last 0) - 0 - (UNAME-START-INDEX u (- last 1))) - (+ last 1)))) - -(define (PARSEDUNIT u) ;; this doesn't deal with "%" yet - (if (string? u) - (let ((strlen (string-length u))) - (if (> strlen 2) - (let ((u-s-i (UNAME-START-INDEX u (- strlen 1)))) - (if (= u-s-i 0) ;; there's no number here - 1pi ;; so return something that might work - (if (= u-s-i strlen) ;; there's no unit name here - (* (string->number u) 1px) ;; so default to pixels (3.2) - (let* ((unum (string->number - (substring u 0 u-s-i))) - (uname (STRING-DOWNCASE - (substring u u-s-i strlen)))) - (case uname - (("mm") (* unum 1mm)) - (("cm") (* unum 1cm)) - (("in") (* unum 1in)) - (("pi") (* unum 1pi)) - (("pc") (* unum 1pi)) - (("pt") (* unum 1pt)) - (("px") (* unum 1px)) - (("barleycorn") (* unum 2pi)) ;; extensible! - (else - (cond - ((number? unum) - (* unum 1px)) - ((number? (string->number u)) - (* (string->number u) 1px)) - (else u)))))))) - (if (number? (string->number u)) - (* (string->number u) 1px) - 1pi))) - 1pi)) - -(define (INLIST?) - (or - (have-ancestor? "OL") - (have-ancestor? "UL") - (have-ancestor? "DIR") - (have-ancestor? "MENU") - (have-ancestor? "DL"))) - -(define (INHEAD?) - (or - (have-ancestor? "H1") - (have-ancestor? "H2") - (have-ancestor? "H3") - (have-ancestor? "H4") - (have-ancestor? "H5") - (have-ancestor? "H6"))) - -(define (HSIZE n) - (* %bf-size% - (expt %hsize-bump-factor% n))) - -(define (OLSTEP) - (case (modulo (length (hierarchical-number-recursive "OL")) 4) - ((1) 1.2em) - ((2) 1.2em) - ((3) 1.6em) - ((0) 1.4em))) - -(define (ULSTEP) 1em) - -(define (PQUAD) - (case (attribute-string "align") - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else (inherited-quadding)))) - -(define (HQUAD) - (cond - ((string? (attribute-string "align")) (PQUAD)) - ((have-ancestor? "CENTER") 'center) - ((have-ancestor? "DIV") (inherited-quadding)) - (else 'start))) - -(define (BULLSTR sty) - (case sty - (("circle") %circle-bullet%) - (("square") %square-bullet%) - (else %disk-bullet%))) - - -;; ======================= NON-PRINTING ELEMENTS ======================== - -;; Note that HEAD includes TITLE, ISINDEX, BASE, META, STYLE, -;; SCRIPT, and LINK as possible children - -(element HEAD (empty-sosofo)) -(element FORM (empty-sosofo)) -(element APPLET (empty-sosofo)) -(element PARAM (empty-sosofo)) -(element TEXTFLOW (empty-sosofo)) -(element MAP (empty-sosofo)) -(element AREA (empty-sosofo)) - - -;; ========================== TABLE OF CONTENTS ========================= - -;; Container elements in which to look for headings -(define %clist% '("BODY" "DIV" "CENTER" "BLOCKQUOTE" "FORM")) - -(mode toc - (element h1 (empty-sosofo)) - (element h2 ($toc-entry$ 2)) - (element h3 ($toc-entry$ 3)) - (element h4 ($toc-entry$ 4)) - (element h5 ($toc-entry$ 5)) - (element h6 ($toc-entry$ 6)) - (default (apply process-matching-children - (append %hlist% %clist%))) -) - -(define %toc-indent% 1em) - -(define ($toc-entry$ level) - (make paragraph - use: para-style - start-indent: (+ %body-start-indent% - (* %toc-indent% (+ 1 level))) - first-line-start-indent: (* -3 %toc-indent%) - quadding: 'start - (literal (NUMLABEL level)) - (make link - destination: (current-node-address) - (with-mode #f (process-children-trim))) - (make leader (literal ".")) - (current-node-page-number-sosofo))) - -(define (MAKEBODYRULE) - (make rule - orientation: 'horizontal - space-before: (* 2 %block-sep%) - space-after: (* 2 %block-sep%) - line-thickness: 1pt - length: %body-width% - start-indent: %body-start-indent% - display-alignment: 'start)) - -(define (MAKETOC) - (if %toc?% - (sosofo-append - (MAKEBODYRULE) - (make paragraph - font-family-name: %title-font-family% - font-weight: 'bold - font-posture: 'upright - font-size: (HSIZE 2) - line-spacing: (* (HSIZE 2) %line-spacing-factor%) - space-before: (* (HSIZE 2) %head-before-factor%) - space-after: (* (HSIZE 2) %head-after-factor%) - start-indent: %body-start-indent% - quadding: 'start - keep-with-next?: #t - (literal "Table of Contents")) - (with-mode toc - (process-node-list (ancestor "BODY"))) - (MAKEBODYRULE)) - (empty-sosofo))) - -;; ============================ TOP LEVEL =============================== - -(define page-style - (style - page-width: %page-width% - page-height: %page-height% - left-margin: %left-right-margin% - right-margin: %left-right-margin% - top-margin: %top-margin% - bottom-margin: %bottom-margin% - header-margin: %header-margin% - footer-margin: %footer-margin% - font-family-name: %body-font-family% - font-size: %bf-size% - line-spacing: %bf-line-spacing%)) - -(element HTML - (let ((page-footer - (make sequence - font-size: %hf-size% - line-spacing: %hf-line-spacing% - font-posture: 'italic - (literal "Page ") - (page-number-sosofo))) - (page-header - (make sequence - font-size: %hf-size% - line-spacing: %hf-line-spacing% - font-posture: 'italic - (process-first-descendant "TITLE")))) - (make simple-page-sequence - use: page-style - left-header: (if-first-page - (empty-sosofo) - (if-front-page (empty-sosofo) page-header)) - right-header: (if-first-page - (empty-sosofo) - (if-front-page page-header (empty-sosofo))) - left-footer: (if-first-page - (empty-sosofo) - (if-front-page (empty-sosofo) page-footer)) - right-footer: (if-first-page - (empty-sosofo) - (if-front-page page-footer (empty-sosofo))) - input-whitespace-treatment: 'collapse - quadding: 'justify - (process-children-trim)))) - -(element BODY (process-children-trim)) - -;; ========================== BLOCK ELEMENTS ============================ - -;; ............................ Generic DIV ............................. - -(element DIV - (let ((align (attribute-string "align"))) - (make display-group - quadding: - (case align - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else 'justify)) - (process-children-trim)))) - -(element CENTER - (make display-group - quadding: 'center - (process-children-trim))) - - -;; .............................. Headings .............................. - -(define %hlist% '("H1" "H2" "H3" "H4" "H5" "H6")) - -(define (NUMLABEL hlvl) - (let ((enl (element-number-list - (reverse (list-tail (reverse %hlist%) (- 6 hlvl)))))) - (let loop ((idx 1)) - (if (or (= idx %autonum-level%) (= idx hlvl)) - (if (= idx 2) ". " " ") - (let ((thisnum (list-ref enl idx))) - (string-append - (if (> idx 1) "." "") - (format-number thisnum "1") - (loop (+ idx 1)))))))) - -(define ($heading$ headlevel) - (let ((headsize (if (= headlevel 6) 0 (- 5 headlevel)))) - (make paragraph - font-family-name: %title-font-family% - font-weight: (if (< headlevel 6) 'bold 'medium) - font-posture: (if (< headlevel 6) 'upright 'italic) - font-size: (HSIZE headsize) - line-spacing: (* (HSIZE headsize) %line-spacing-factor%) - space-before: (* (HSIZE headsize) %head-before-factor%) - space-after: (if (and %toc?% (= headlevel 1)) - 4em ;; space if H1 before TOC - (* (HSIZE headsize) %head-after-factor%)) - start-indent: - (if (< headlevel %flushtext-headlevel%) - 0pt - %body-start-indent%) - quadding: (HQUAD) - keep-with-next?: #t - break-before: (if (and - %toc?% - (= headlevel 2) - (= (child-number) 1)) - 'page #f) ;; if TOC on, break before first H2 - (literal - (if (and (<= headlevel %autonum-level%) (> headlevel 1)) - (NUMLABEL headlevel) - (string-append ""))) - (process-children-trim)))) - -(element H1 - (sosofo-append - ($heading$ 1) - (MAKETOC))) - -(element H2 ($heading$ 2)) -(element H3 ($heading$ 3)) -(element H4 ($heading$ 4)) -(element H5 ($heading$ 5)) -(element H6 ($heading$ 6)) - - -;; ............................ Paragraphs .............................. - -(define para-style - (style - font-size: %bf-size% - font-weight: 'medium - font-posture: 'upright - font-family-name: %body-font-family% - line-spacing: %bf-line-spacing%)) - -(element P - (make paragraph - use: para-style - space-before: %para-sep% - start-indent: %body-start-indent% - quadding: (PQUAD) - (process-children-trim))) - -(element ADDRESS - (make paragraph - use: para-style - font-posture: 'italic - space-before: %para-sep% - start-indent: %body-start-indent% - (process-children-trim))) - -(element BLOCKQUOTE - (make paragraph - font-size: (- %bf-size% 1pt) - line-spacing: (- %bf-line-spacing% 1pt) - space-before: %para-sep% - start-indent: (+ %body-start-indent% 1em) - end-indent: 1em - (process-children-trim))) - -(define ($monopara$) - (make paragraph - use: para-style - space-before: %para-sep% - start-indent: %body-start-indent% - lines: 'asis - font-family-name: %mono-font-family% - font-size: %mf-size% - input-whitespace-treatment: 'preserve - quadding: 'start - (process-children-trim))) - -(element PRE ($monopara$)) -(element XMP ($monopara$)) -(element LISTING ($monopara$)) -(element PLAINTEXT ($monopara$)) - -(element BR - (make display-group - (empty-sosofo))) - - -;; ................... Lists: UL, OL, DIR, MENU, DL ..................... - -(define ($list-container$) - (make display-group - space-before: (if (INLIST?) %para-sep% %block-sep%) - space-after: (if (INLIST?) %para-sep% %block-sep%) - start-indent: (if (INLIST?) - (inherited-start-indent) - %body-start-indent%))) - -(define ($li-para$) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (OLSTEP)) - first-line-start-indent: (- (OLSTEP)) - (process-children-trim))) - -(element UL ($list-container$)) - -(element (UL LI) - (let ((isnested (> (length (hierarchical-number-recursive "UL")) 1))) - (make paragraph - use: para-style - space-before: - (if (attribute-string "compact" (ancestor "UL")) 0pt %para-sep%) - start-indent: (+ (inherited-start-indent) (ULSTEP)) - first-line-start-indent: (- (ULSTEP)) - (make line-field - font-family-name: %dingbat-font-family% - font-size: (if isnested - (* %bullet-size% %bullet-size-factor%) - %bullet-size%) - field-width: (ULSTEP) - (literal - (let - ((litype - (attribute-string "type")) - (ultype - (attribute-string "type" (ancestor "UL")))) - (cond - ((string? litype) (BULLSTR (STRING-DOWNCASE litype))) - ((string? ultype) (BULLSTR (STRING-DOWNCASE ultype))) - (else %disk-bullet%))))) - (process-children-trim)))) - -(element (UL LI P) ($li-para$)) - -(element OL ($list-container$)) - -(element (OL LI) - (make paragraph - use: para-style - space-before: - (if (attribute-string "compact" (ancestor "OL")) 0pt %para-sep%) - start-indent: (+ (inherited-start-indent) (OLSTEP)) - first-line-start-indent: (- (OLSTEP)) - (make line-field - field-width: (OLSTEP) - (literal - (case (modulo - (length (hierarchical-number-recursive "OL")) 4) - ((1) (string-append - (format-number (child-number) "1") ".")) - ((2) (string-append - (format-number (child-number) "a") ".")) - ((3) (string-append - "(" (format-number (child-number) "i") ")")) - ((0) (string-append - "(" (format-number (child-number) "a") ")"))))) - (process-children-trim))) - -(element (OL LI P) ($li-para$)) - -;; Note that DIR cannot properly have block children. Here DIR is -;; interpreted as an unmarked list without extra vertical -;; spacing. - -(element DIR ($list-container$)) - -(element (DIR LI) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (* 2.0 (ULSTEP))) - first-line-start-indent: (- (ULSTEP)) - (process-children-trim))) - -;; Note that MENU cannot properly have block children. Here MENU is -;; interpreted as a small-bulleted list with no extra vertical -;; spacing. - -(element MENU ($list-container$)) - -(element (MENU LI) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (ULSTEP)) - first-line-start-indent: (- (ULSTEP)) - (make line-field - font-family-name: %dingbat-font-family% - font-size: %bullet-size% - field-width: (ULSTEP) - (literal %disk-bullet%)) - (process-children-trim))) - -;; This treatment of DLs doesn't apply a "compact" attribute set at one -;; level to any nested DLs. To change this behavior so that nested -;; DLs inherit the "compact" attribute from an ancestor DL, substitute -;; "inherited-attribute-string" for "attribute-string" in the -;; construction rules for DT and DD. - - -(element DL - (make display-group - space-before: (if (INLIST?) %para-sep% %block-sep%) - space-after: (if (INLIST?) %para-sep% %block-sep%) - start-indent: (if (INLIST?) - (+ (inherited-start-indent) 2em) - (+ %body-start-indent% 2em)) - (make paragraph))) - -(element DT - (let ((compact (attribute-string "compact" (ancestor "DL")))) - (if compact - (make line-field - field-width: 3em - (process-children-trim)) - (make paragraph - use: para-style - space-before: %para-sep% - first-line-start-indent: -1em - (process-children-trim))))) - -(element DD - (let ((compact (attribute-string "compact" (ancestor "DL")))) - (if compact - (sosofo-append - (process-children-trim) - (make paragraph-break)) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) 2em) - (process-children-trim))))) - - -;; ========================== INLINE ELEMENTS =========================== - -(define ($bold-seq$) - (make sequence - font-weight: 'bold - (process-children-trim))) - -(element B ($bold-seq$)) -(element EM ($bold-seq$)) -(element STRONG ($bold-seq$)) - -;; ------------ - -(define ($italic-seq$) - (make sequence - font-posture: 'italic - (process-children-trim))) - -(element I ($italic-seq$)) -(element CITE ($italic-seq$)) -(element VAR ($italic-seq$)) - -;; ------------ - -(define ($bold-italic-seq$) - (make sequence - font-weight: 'bold - font-posture: 'italic - (process-children-trim))) - -(element DFN ($bold-italic-seq$)) -(element A - (if (INHEAD?) - (process-children-trim) - ($bold-italic-seq$))) - -;; ------------ - -(define ($mono-seq$) - (make sequence - font-family-name: %mono-font-family% - font-size: %mf-size% - (process-children-trim))) - -(element TT ($mono-seq$)) -(element CODE ($mono-seq$)) -(element KBD ($mono-seq$)) -(element SAMP ($mono-seq$)) - -;; ------------ - -(define ($score-seq$ stype) - (make score - type: stype - (process-children-trim))) - -(element STRIKE ($score-seq$ 'through)) -(element U ($score-seq$ 'after)) - -;; ------------ - -(define ($ss-seq$ plus-or-minus) - (make sequence - font-size: - (* (inherited-font-size) %ss-size-factor%) - position-point-shift: - (plus-or-minus (* (inherited-font-size) %ss-shift-factor%)) - (process-children-trim))) - -(element SUP ($ss-seq$ +)) -(element SUB ($ss-seq$ -)) - -;; ------------ - -(define ($bs-seq$ div-or-mult) - (make sequence - font-size: - (div-or-mult (inherited-font-size) %smaller-size-factor%) - line-spacing: - (div-or-mult (inherited-line-spacing) %smaller-size-factor%))) - -(element BIG ($bs-seq$ /)) -(element SMALL ($bs-seq$ *)) - -;; ------------ - -(element FONT - (let ((fsize (attribute-string "SIZE"))) - (make sequence - font-size: - (if fsize (PARSEDUNIT fsize) (inherited-font-size))))) - - -;; ============================== RULES ================================= - -(element HR - (let ((align (attribute-string "ALIGN")) - (noshade (attribute-string "NOSHADE")) - (size (attribute-string "SIZE")) - (width (attribute-string "WIDTH"))) - (make rule - orientation: 'horizontal - space-before: %block-sep% - space-after: %block-sep% - line-thickness: (if size (PARSEDUNIT size) 1pt) - length: (if width (PARSEDUNIT width) %body-width%) - display-alignment: - (case align - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else 'end))))) - - -;; ============================= GRAPHICS =============================== - -;; Note that DSSSL does not currently support text flowed around an -;; object, so the action of the ALIGN attribute is merely to shift the -;; image to the left or right. An extension to add runarounds to DSSSL -;; has been proposed and should be incorporated here when it becomes -;; final. - -(element IMG - (make external-graphic - entity-system-id: (attribute-string "src") - display?: #t - space-before: 1em - space-after: 1em - display-alignment: - (case (attribute-string "align") - (("LEFT") 'start) - (("RIGHT") 'end) - (else 'center)))) - -;; ============================== TABLES ================================ - -(element TABLE -;; number-of-columns is for future use - (let ((number-of-columns - (node-list-reduce (node-list-rest (children (current-node))) - (lambda (cols nd) - (max cols - (node-list-length (children nd)))) - 0))) - (make display-group - space-before: %block-sep% - space-after: %block-sep% - start-indent: %body-start-indent% -;; for debugging: -;; (make paragraph -;; (literal -;; (string-append -;; "Number of columns: " -;; (number->string number-of-columns)))) - (with-mode table-caption-mode (process-first-descendant "CAPTION")) - (make table - (process-children))))) - -(mode table-caption-mode - (element CAPTION - (make paragraph - use: para-style - font-weight: 'bold - space-before: %block-sep% - space-after: %para-sep% - start-indent: (inherited-start-indent) - (literal - (string-append - "Table " - (format-number - (element-number) "1") ". ")) - (process-children-trim)))) - -(element CAPTION (empty-sosofo)) ; don't show caption inside the table - -(element TR - (make table-row - (process-children-trim))) - -(element TH - (make table-cell - n-rows-spanned: (string->number (attribute-string "COLSPAN")) - (make paragraph - font-weight: 'bold - space-before: 0.25em - space-after: 0.25em - start-indent: 0.25em - end-indent: 0.25em - quadding: 'start - (process-children-trim)))) - -(element TD - (make table-cell - n-rows-spanned: (string->number (attribute-string "COLSPAN")) - (make paragraph - space-before: 0.25em - space-after: 0.25em - start-indent: 0.25em - end-indent: 0.25em - quadding: 'start - (process-children-trim)))) + + +;; ###################################################################### +;; +;; DSSSL style sheet for HTML 3.2 print output +;; +;; 1996.11.17 +;; +;; Base version, August 1996: Jon Bosak, Sun Microsystems, based on work +;; by Anders Berglund, EBT, with critical assistance from James Clark +;; TOC section and recto/verso page treatments based on models by James +;; Clark, October 1996 +;; +;; ###################################################################### + +;; Features in HTML 3.2 that are not implemented in the style sheet: +;; +;; automatic table column widths +;; % on width attribute for TABLE +;; attributes on TH and TD: align, valign, rowspan, colspan +;; attributes on TABLE: width, align, border, cellspacing, cellpadding +;; start attribute on OL +;; value attribute on LI +;; noshade attribute on HR +;; +;; See also "Non-Printing Elements" below +;; +;; Features in the style sheet that are not in HTML 3.2: +;; +;; page headers that display the HEAD TITLE content +;; page footers that display the page number +;; autonumbering of heads and table captions +;; support for named units (pt, pi, cm, mm) in size attributes +;; automatic TOC generation + +;; ============================== UNITS ================================ + +(define-unit pi (/ 1in 6)) +(define-unit pt (/ 1in 72)) +(define-unit px (/ 1in 96)) + +;; see below for definition of "em" + + +;; ============================ PARAMETERS ============================== + +;; ........................... Basic "look" ............................. + +;; Visual acuity levels are "normal", "presbyopic", and +;; "large-type"; set the line following to choose the level + +(define %visual-acuity% "normal") +;; (define %visual-acuity% "presbyopic") +;; (define %visual-acuity% "large-type") + +(define %bf-size% + (case %visual-acuity% + (("normal") 11pt) + (("presbyopic") 12pt) + (("large-type") 24pt))) +(define %mf-size% (- %bf-size% 1pt)) +(define %hf-size% %bf-size%) + +(define-unit em %bf-size%) + +(define %autonum-level% 6) ;; zero disables autonumbering +(define %flushtext-headlevel% ;; heads above this hang out on the left + (if (equal? %visual-acuity% "large-type") 6 4)) +(define %body-start-indent% ;; sets the white space on the left + (if (equal? %visual-acuity% "large-type") 0pi 4pi)) +(define %toc?% #t) ;; enables TOC after H1 + +;; ........................ Basic page geometry ......................... + +(define %page-width% 8.5in) +(define %page-height% 11in) + +(define %left-right-margin% 6pi) +(define %top-margin% + (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) +(define %bottom-margin% + (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) +(define %header-margin% + (if (equal? %visual-acuity% "large-type") 4.5pi 3pi)) +(define %footer-margin% 3.5pi) + +(define %text-width% (- %page-width% (* %left-right-margin% 2))) +(define %body-width% (- %text-width% %body-start-indent%)) + +;; .......................... Spacing factors ........................... + +(define %para-sep% (/ %bf-size% 2.0)) +(define %block-sep% (* %para-sep% 2.0)) + +(define %line-spacing-factor% 1.2) +(define %bf-line-spacing% (* %bf-size% %line-spacing-factor%)) +(define %mf-line-spacing% (* %mf-size% %line-spacing-factor%)) +(define %hf-line-spacing% (* %hf-size% %line-spacing-factor%)) + +(define %head-before-factor% 1.0) +(define %head-after-factor% 0.6) +(define %hsize-bump-factor% 1.2) + +(define %ss-size-factor% 0.6) +(define %ss-shift-factor% 0.4) +(define %smaller-size-factor% 0.9) +(define %bullet-size-factor% 0.8) + +;; ......................... Fonts and bullets .......................... + +;; these font selections are for Windows 95 + +(define %title-font-family% "Arial") +(define %body-font-family% "Times New Roman") +(define %mono-font-family% "Courier New") +(define %dingbat-font-family% "Wingdings") + +;; these "bullet strings" are a hack that is completely dependent on +;; the Wingdings font family selected above; consider this a +;; placeholder for suitable ISO 10646 characters + +(define %disk-bullet% "l") +(define %circle-bullet% "¡") +(define %square-bullet% "o") + +(define %bullet-size% (* %bf-size% %bullet-size-factor%)) + + +;; ========================== COMMON FUNCTIONS ========================== + +(define (expt b n) + (if (= n 0) + 1 + (* b (expt b (- n 1))))) + +;; per ISO/IEC 10179 +(define (node-list-reduce nl proc init) + (if (node-list-empty? nl) + init + (node-list-reduce (node-list-rest nl) + proc + (proc init (node-list-first nl))))) + +;; per ISO/IEC 10179 +(define (node-list-length nl) + (node-list-reduce nl + (lambda (result snl) + (+ result 1)) + 0)) + +(define if-front-page + (external-procedure "UNREGISTERED::James Clark//Procedure::if-front-page")) + +(define if-first-page + (external-procedure "UNREGISTERED::James Clark//Procedure::if-first-page")) + +(define upperalpha + '(#\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)) + +(define loweralpha + '(#\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)) + +(define (char-downcase ch) + (case ch + ((#\A) #\a) ((#\B) #\b) ((#\C) #\c) ((#\D) #\d) ((#\E) #\e) + ((#\F) #\f) ((#\G) #\g) ((#\H) #\h) ((#\I) #\i) ((#\J) #\j) + ((#\K) #\k) ((#\L) #\l) ((#\M) #\m) ((#\N) #\n) ((#\O) #\o) + ((#\P) #\p) ((#\Q) #\q) ((#\R) #\r) ((#\S) #\s) ((#\T) #\t) + ((#\U) #\u) ((#\V) #\v) ((#\W) #\w) ((#\X) #\x) ((#\Y) #\y) + ((#\Z) #\z) (else ch))) + +(define (LOCASE slist) + (if (null? slist) + '() + (cons (char-downcase (car slist)) (LOCASE (cdr slist))))) + +(define (STR2LIST s) + (let ((len (string-length s))) + (let loop ((i 0) (ln len)) + (if (= i len) + '() + (cons (string-ref s i) (loop (+ i 1) ln)))))) + +(define (STRING-DOWNCASE s) + (apply string (LOCASE (STR2LIST s)))) + +(define (UNAME-START-INDEX u last) + (let ((c (string-ref u last))) + (if (or (member c upperalpha) (member c loweralpha)) + (if (= last 0) + 0 + (UNAME-START-INDEX u (- last 1))) + (+ last 1)))) + +(define (PARSEDUNIT u) ;; this doesn't deal with "%" yet + (if (string? u) + (let ((strlen (string-length u))) + (if (> strlen 2) + (let ((u-s-i (UNAME-START-INDEX u (- strlen 1)))) + (if (= u-s-i 0) ;; there's no number here + 1pi ;; so return something that might work + (if (= u-s-i strlen) ;; there's no unit name here + (* (string->number u) 1px) ;; so default to pixels (3.2) + (let* ((unum (string->number + (substring u 0 u-s-i))) + (uname (STRING-DOWNCASE + (substring u u-s-i strlen)))) + (case uname + (("mm") (* unum 1mm)) + (("cm") (* unum 1cm)) + (("in") (* unum 1in)) + (("pi") (* unum 1pi)) + (("pc") (* unum 1pi)) + (("pt") (* unum 1pt)) + (("px") (* unum 1px)) + (("barleycorn") (* unum 2pi)) ;; extensible! + (else + (cond + ((number? unum) + (* unum 1px)) + ((number? (string->number u)) + (* (string->number u) 1px)) + (else u)))))))) + (if (number? (string->number u)) + (* (string->number u) 1px) + 1pi))) + 1pi)) + +(define (INLIST?) + (or + (have-ancestor? "OL") + (have-ancestor? "UL") + (have-ancestor? "DIR") + (have-ancestor? "MENU") + (have-ancestor? "DL"))) + +(define (INHEAD?) + (or + (have-ancestor? "H1") + (have-ancestor? "H2") + (have-ancestor? "H3") + (have-ancestor? "H4") + (have-ancestor? "H5") + (have-ancestor? "H6"))) + +(define (HSIZE n) + (* %bf-size% + (expt %hsize-bump-factor% n))) + +(define (OLSTEP) + (case (modulo (length (hierarchical-number-recursive "OL")) 4) + ((1) 1.2em) + ((2) 1.2em) + ((3) 1.6em) + ((0) 1.4em))) + +(define (ULSTEP) 1em) + +(define (PQUAD) + (case (attribute-string "align") + (("LEFT") 'start) + (("CENTER") 'center) + (("RIGHT") 'end) + (else (inherited-quadding)))) + +(define (HQUAD) + (cond + ((string? (attribute-string "align")) (PQUAD)) + ((have-ancestor? "CENTER") 'center) + ((have-ancestor? "DIV") (inherited-quadding)) + (else 'start))) + +(define (BULLSTR sty) + (case sty + (("circle") %circle-bullet%) + (("square") %square-bullet%) + (else %disk-bullet%))) + + +;; ======================= NON-PRINTING ELEMENTS ======================== + +;; Note that HEAD includes TITLE, ISINDEX, BASE, META, STYLE, +;; SCRIPT, and LINK as possible children + +(element HEAD (empty-sosofo)) +(element FORM (empty-sosofo)) +(element APPLET (empty-sosofo)) +(element PARAM (empty-sosofo)) +(element TEXTFLOW (empty-sosofo)) +(element MAP (empty-sosofo)) +(element AREA (empty-sosofo)) + + +;; ========================== TABLE OF CONTENTS ========================= + +;; Container elements in which to look for headings +(define %clist% '("BODY" "DIV" "CENTER" "BLOCKQUOTE" "FORM")) + +(mode toc + (element h1 (empty-sosofo)) + (element h2 ($toc-entry$ 2)) + (element h3 ($toc-entry$ 3)) + (element h4 ($toc-entry$ 4)) + (element h5 ($toc-entry$ 5)) + (element h6 ($toc-entry$ 6)) + (default (apply process-matching-children + (append %hlist% %clist%))) +) + +(define %toc-indent% 1em) + +(define ($toc-entry$ level) + (make paragraph + use: para-style + start-indent: (+ %body-start-indent% + (* %toc-indent% (+ 1 level))) + first-line-start-indent: (* -3 %toc-indent%) + quadding: 'start + (literal (NUMLABEL level)) + (make link + destination: (current-node-address) + (with-mode #f (process-children-trim))) + (make leader (literal ".")) + (current-node-page-number-sosofo))) + +(define (MAKEBODYRULE) + (make rule + orientation: 'horizontal + space-before: (* 2 %block-sep%) + space-after: (* 2 %block-sep%) + line-thickness: 1pt + length: %body-width% + start-indent: %body-start-indent% + display-alignment: 'start)) + +(define (MAKETOC) + (if %toc?% + (sosofo-append + (MAKEBODYRULE) + (make paragraph + font-family-name: %title-font-family% + font-weight: 'bold + font-posture: 'upright + font-size: (HSIZE 2) + line-spacing: (* (HSIZE 2) %line-spacing-factor%) + space-before: (* (HSIZE 2) %head-before-factor%) + space-after: (* (HSIZE 2) %head-after-factor%) + start-indent: %body-start-indent% + quadding: 'start + keep-with-next?: #t + (literal "Table of Contents")) + (with-mode toc + (process-node-list (ancestor "BODY"))) + (MAKEBODYRULE)) + (empty-sosofo))) + +;; ============================ TOP LEVEL =============================== + +(define page-style + (style + page-width: %page-width% + page-height: %page-height% + left-margin: %left-right-margin% + right-margin: %left-right-margin% + top-margin: %top-margin% + bottom-margin: %bottom-margin% + header-margin: %header-margin% + footer-margin: %footer-margin% + font-family-name: %body-font-family% + font-size: %bf-size% + line-spacing: %bf-line-spacing%)) + +(element HTML + (let ((page-footer + (make sequence + font-size: %hf-size% + line-spacing: %hf-line-spacing% + font-posture: 'italic + (literal "Page ") + (page-number-sosofo))) + (page-header + (make sequence + font-size: %hf-size% + line-spacing: %hf-line-spacing% + font-posture: 'italic + (process-first-descendant "TITLE")))) + (make simple-page-sequence + use: page-style + left-header: (if-first-page + (empty-sosofo) + (if-front-page (empty-sosofo) page-header)) + right-header: (if-first-page + (empty-sosofo) + (if-front-page page-header (empty-sosofo))) + left-footer: (if-first-page + (empty-sosofo) + (if-front-page (empty-sosofo) page-footer)) + right-footer: (if-first-page + (empty-sosofo) + (if-front-page page-footer (empty-sosofo))) + input-whitespace-treatment: 'collapse + quadding: 'justify + (process-children-trim)))) + +(element BODY (process-children-trim)) + +;; ========================== BLOCK ELEMENTS ============================ + +;; ............................ Generic DIV ............................. + +(element DIV + (let ((align (attribute-string "align"))) + (make display-group + quadding: + (case align + (("LEFT") 'start) + (("CENTER") 'center) + (("RIGHT") 'end) + (else 'justify)) + (process-children-trim)))) + +(element CENTER + (make display-group + quadding: 'center + (process-children-trim))) + + +;; .............................. Headings .............................. + +(define %hlist% '("H1" "H2" "H3" "H4" "H5" "H6")) + +(define (NUMLABEL hlvl) + (let ((enl (element-number-list + (reverse (list-tail (reverse %hlist%) (- 6 hlvl)))))) + (let loop ((idx 1)) + (if (or (= idx %autonum-level%) (= idx hlvl)) + (if (= idx 2) ". " " ") + (let ((thisnum (list-ref enl idx))) + (string-append + (if (> idx 1) "." "") + (format-number thisnum "1") + (loop (+ idx 1)))))))) + +(define ($heading$ headlevel) + (let ((headsize (if (= headlevel 6) 0 (- 5 headlevel)))) + (make paragraph + font-family-name: %title-font-family% + font-weight: (if (< headlevel 6) 'bold 'medium) + font-posture: (if (< headlevel 6) 'upright 'italic) + font-size: (HSIZE headsize) + line-spacing: (* (HSIZE headsize) %line-spacing-factor%) + space-before: (* (HSIZE headsize) %head-before-factor%) + space-after: (if (and %toc?% (= headlevel 1)) + 4em ;; space if H1 before TOC + (* (HSIZE headsize) %head-after-factor%)) + start-indent: + (if (< headlevel %flushtext-headlevel%) + 0pt + %body-start-indent%) + quadding: (HQUAD) + keep-with-next?: #t + break-before: (if (and + %toc?% + (= headlevel 2) + (= (child-number) 1)) + 'page #f) ;; if TOC on, break before first H2 + (literal + (if (and (<= headlevel %autonum-level%) (> headlevel 1)) + (NUMLABEL headlevel) + (string-append ""))) + (process-children-trim)))) + +(element H1 + (sosofo-append + ($heading$ 1) + (MAKETOC))) + +(element H2 ($heading$ 2)) +(element H3 ($heading$ 3)) +(element H4 ($heading$ 4)) +(element H5 ($heading$ 5)) +(element H6 ($heading$ 6)) + + +;; ............................ Paragraphs .............................. + +(define para-style + (style + font-size: %bf-size% + font-weight: 'medium + font-posture: 'upright + font-family-name: %body-font-family% + line-spacing: %bf-line-spacing%)) + +(element P + (make paragraph + use: para-style + space-before: %para-sep% + start-indent: %body-start-indent% + quadding: (PQUAD) + (process-children-trim))) + +(element ADDRESS + (make paragraph + use: para-style + font-posture: 'italic + space-before: %para-sep% + start-indent: %body-start-indent% + (process-children-trim))) + +(element BLOCKQUOTE + (make paragraph + font-size: (- %bf-size% 1pt) + line-spacing: (- %bf-line-spacing% 1pt) + space-before: %para-sep% + start-indent: (+ %body-start-indent% 1em) + end-indent: 1em + (process-children-trim))) + +(define ($monopara$) + (make paragraph + use: para-style + space-before: %para-sep% + start-indent: %body-start-indent% + lines: 'asis + font-family-name: %mono-font-family% + font-size: %mf-size% + input-whitespace-treatment: 'preserve + quadding: 'start + (process-children-trim))) + +(element PRE ($monopara$)) +(element XMP ($monopara$)) +(element LISTING ($monopara$)) +(element PLAINTEXT ($monopara$)) + +(element BR + (make display-group + (empty-sosofo))) + + +;; ................... Lists: UL, OL, DIR, MENU, DL ..................... + +(define ($list-container$) + (make display-group + space-before: (if (INLIST?) %para-sep% %block-sep%) + space-after: (if (INLIST?) %para-sep% %block-sep%) + start-indent: (if (INLIST?) + (inherited-start-indent) + %body-start-indent%))) + +(define ($li-para$) + (make paragraph + use: para-style + start-indent: (+ (inherited-start-indent) (OLSTEP)) + first-line-start-indent: (- (OLSTEP)) + (process-children-trim))) + +(element UL ($list-container$)) + +(element (UL LI) + (let ((isnested (> (length (hierarchical-number-recursive "UL")) 1))) + (make paragraph + use: para-style + space-before: + (if (attribute-string "compact" (ancestor "UL")) 0pt %para-sep%) + start-indent: (+ (inherited-start-indent) (ULSTEP)) + first-line-start-indent: (- (ULSTEP)) + (make line-field + font-family-name: %dingbat-font-family% + font-size: (if isnested + (* %bullet-size% %bullet-size-factor%) + %bullet-size%) + field-width: (ULSTEP) + (literal + (let + ((litype + (attribute-string "type")) + (ultype + (attribute-string "type" (ancestor "UL")))) + (cond + ((string? litype) (BULLSTR (STRING-DOWNCASE litype))) + ((string? ultype) (BULLSTR (STRING-DOWNCASE ultype))) + (else %disk-bullet%))))) + (process-children-trim)))) + +(element (UL LI P) ($li-para$)) + +(element OL ($list-container$)) + +(element (OL LI) + (make paragraph + use: para-style + space-before: + (if (attribute-string "compact" (ancestor "OL")) 0pt %para-sep%) + start-indent: (+ (inherited-start-indent) (OLSTEP)) + first-line-start-indent: (- (OLSTEP)) + (make line-field + field-width: (OLSTEP) + (literal + (case (modulo + (length (hierarchical-number-recursive "OL")) 4) + ((1) (string-append + (format-number (child-number) "1") ".")) + ((2) (string-append + (format-number (child-number) "a") ".")) + ((3) (string-append + "(" (format-number (child-number) "i") ")")) + ((0) (string-append + "(" (format-number (child-number) "a") ")"))))) + (process-children-trim))) + +(element (OL LI P) ($li-para$)) + +;; Note that DIR cannot properly have block children. Here DIR is +;; interpreted as an unmarked list without extra vertical +;; spacing. + +(element DIR ($list-container$)) + +(element (DIR LI) + (make paragraph + use: para-style + start-indent: (+ (inherited-start-indent) (* 2.0 (ULSTEP))) + first-line-start-indent: (- (ULSTEP)) + (process-children-trim))) + +;; Note that MENU cannot properly have block children. Here MENU is +;; interpreted as a small-bulleted list with no extra vertical +;; spacing. + +(element MENU ($list-container$)) + +(element (MENU LI) + (make paragraph + use: para-style + start-indent: (+ (inherited-start-indent) (ULSTEP)) + first-line-start-indent: (- (ULSTEP)) + (make line-field + font-family-name: %dingbat-font-family% + font-size: %bullet-size% + field-width: (ULSTEP) + (literal %disk-bullet%)) + (process-children-trim))) + +;; This treatment of DLs doesn't apply a "compact" attribute set at one +;; level to any nested DLs. To change this behavior so that nested +;; DLs inherit the "compact" attribute from an ancestor DL, substitute +;; "inherited-attribute-string" for "attribute-string" in the +;; construction rules for DT and DD. + + +(element DL + (make display-group + space-before: (if (INLIST?) %para-sep% %block-sep%) + space-after: (if (INLIST?) %para-sep% %block-sep%) + start-indent: (if (INLIST?) + (+ (inherited-start-indent) 2em) + (+ %body-start-indent% 2em)) + (make paragraph))) + +(element DT + (let ((compact (attribute-string "compact" (ancestor "DL")))) + (if compact + (make line-field + field-width: 3em + (process-children-trim)) + (make paragraph + use: para-style + space-before: %para-sep% + first-line-start-indent: -1em + (process-children-trim))))) + +(element DD + (let ((compact (attribute-string "compact" (ancestor "DL")))) + (if compact + (sosofo-append + (process-children-trim) + (make paragraph-break)) + (make paragraph + use: para-style + start-indent: (+ (inherited-start-indent) 2em) + (process-children-trim))))) + + +;; ========================== INLINE ELEMENTS =========================== + +(define ($bold-seq$) + (make sequence + font-weight: 'bold + (process-children-trim))) + +(element B ($bold-seq$)) +(element EM ($bold-seq$)) +(element STRONG ($bold-seq$)) + +;; ------------ + +(define ($italic-seq$) + (make sequence + font-posture: 'italic + (process-children-trim))) + +(element I ($italic-seq$)) +(element CITE ($italic-seq$)) +(element VAR ($italic-seq$)) + +;; ------------ + +(define ($bold-italic-seq$) + (make sequence + font-weight: 'bold + font-posture: 'italic + (process-children-trim))) + +(element DFN ($bold-italic-seq$)) +(element A + (if (INHEAD?) + (process-children-trim) + ($bold-italic-seq$))) + +;; ------------ + +(define ($mono-seq$) + (make sequence + font-family-name: %mono-font-family% + font-size: %mf-size% + (process-children-trim))) + +(element TT ($mono-seq$)) +(element CODE ($mono-seq$)) +(element KBD ($mono-seq$)) +(element SAMP ($mono-seq$)) + +;; ------------ + +(define ($score-seq$ stype) + (make score + type: stype + (process-children-trim))) + +(element STRIKE ($score-seq$ 'through)) +(element U ($score-seq$ 'after)) + +;; ------------ + +(define ($ss-seq$ plus-or-minus) + (make sequence + font-size: + (* (inherited-font-size) %ss-size-factor%) + position-point-shift: + (plus-or-minus (* (inherited-font-size) %ss-shift-factor%)) + (process-children-trim))) + +(element SUP ($ss-seq$ +)) +(element SUB ($ss-seq$ -)) + +;; ------------ + +(define ($bs-seq$ div-or-mult) + (make sequence + font-size: + (div-or-mult (inherited-font-size) %smaller-size-factor%) + line-spacing: + (div-or-mult (inherited-line-spacing) %smaller-size-factor%))) + +(element BIG ($bs-seq$ /)) +(element SMALL ($bs-seq$ *)) + +;; ------------ + +(element FONT + (let ((fsize (attribute-string "SIZE"))) + (make sequence + font-size: + (if fsize (PARSEDUNIT fsize) (inherited-font-size))))) + + +;; ============================== RULES ================================= + +(element HR + (let ((align (attribute-string "ALIGN")) + (noshade (attribute-string "NOSHADE")) + (size (attribute-string "SIZE")) + (width (attribute-string "WIDTH"))) + (make rule + orientation: 'horizontal + space-before: %block-sep% + space-after: %block-sep% + line-thickness: (if size (PARSEDUNIT size) 1pt) + length: (if width (PARSEDUNIT width) %body-width%) + display-alignment: + (case align + (("LEFT") 'start) + (("CENTER") 'center) + (("RIGHT") 'end) + (else 'end))))) + + +;; ============================= GRAPHICS =============================== + +;; Note that DSSSL does not currently support text flowed around an +;; object, so the action of the ALIGN attribute is merely to shift the +;; image to the left or right. An extension to add runarounds to DSSSL +;; has been proposed and should be incorporated here when it becomes +;; final. + +(element IMG + (make external-graphic + entity-system-id: (attribute-string "src") + display?: #t + space-before: 1em + space-after: 1em + display-alignment: + (case (attribute-string "align") + (("LEFT") 'start) + (("RIGHT") 'end) + (else 'center)))) + +;; ============================== TABLES ================================ + +(element TABLE +;; number-of-columns is for future use + (let ((number-of-columns + (node-list-reduce (node-list-rest (children (current-node))) + (lambda (cols nd) + (max cols + (node-list-length (children nd)))) + 0))) + (make display-group + space-before: %block-sep% + space-after: %block-sep% + start-indent: %body-start-indent% +;; for debugging: +;; (make paragraph +;; (literal +;; (string-append +;; "Number of columns: " +;; (number->string number-of-columns)))) + (with-mode table-caption-mode (process-first-descendant "CAPTION")) + (make table + (process-children))))) + +(mode table-caption-mode + (element CAPTION + (make paragraph + use: para-style + font-weight: 'bold + space-before: %block-sep% + space-after: %para-sep% + start-indent: (inherited-start-indent) + (literal + (string-append + "Table " + (format-number + (element-number) "1") ". ")) + (process-children-trim)))) + +(element CAPTION (empty-sosofo)) ; don't show caption inside the table + +(element TR + (make table-row + (process-children-trim))) + +(element TH + (make table-cell + n-rows-spanned: (string->number (attribute-string "COLSPAN")) + (make paragraph + font-weight: 'bold + space-before: 0.25em + space-after: 0.25em + start-indent: 0.25em + end-indent: 0.25em + quadding: 'start + (process-children-trim)))) + +(element TD + (make table-cell + n-rows-spanned: (string->number (attribute-string "COLSPAN")) + (make paragraph + space-before: 0.25em + space-after: 0.25em + start-indent: 0.25em + end-indent: 0.25em + quadding: 'start + (process-children-trim)))) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/mm.el --- a/lisp/w3/mm.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/mm.el Mon Aug 13 09:30:11 2007 +0200 @@ -427,14 +427,15 @@ ((memq system-type '(ms-dos ms-windows windows-nt)) (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap") ";"))) - (t (setq path (concat "/etc/mailcap:/usr/etc/mailcap:" - "/usr/local/etc/mailcap:" - (expand-file-name "~/.mailcap"))))) + (t (setq path (mapconcat 'expand-file-name + '("~/.mailcap" + "/etc/mailcap:/usr/etc/mailcap" + "/usr/local/etc/mailcap") ":")))) (let ((fnames (reverse (mm-string-to-tokens path (if (memq system-type '(ms-dos ms-windows windows-nt)) - ? ; + ?; ?:)))) fname) (while fnames @@ -973,15 +974,16 @@ ((memq system-type '(ms-dos ms-windows windows-nt)) (setq path (mapconcat 'expand-file-name '("~/mime.typ" "~/etc/mime.typ") ";"))) - (t (setq path (concat (expand-file-name "~/.mime-types") ":" - "/etc/mime-types:/usr/etc/mime-types:" - "/usr/local/etc/mime-types:" - "/usr/local/www/conf/mime-types")))) + (t (setq path (mapconcat 'expand-file-name + '("~/.mime-types" + "/etc/mime-types:/usr/etc/mime-types" + "/usr/local/etc/mime-types" + "/usr/local/www/conf/mime-types") ":")))) (let ((fnames (reverse (mm-string-to-tokens path (if (memq system-type '(ms-dos ms-windows windows-nt)) - ? ; + ?; ?:)))) fname) (while fnames diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/url-misc.el --- a/lisp/w3/url-misc.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/url-misc.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/04/07 13:24:49 -;; Version: 1.14 +;; Created: 1997/04/16 05:11:58 +;; Version: 1.16 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -137,6 +137,36 @@ (proxyobj (url-generic-parse-url url-using-proxy))) (url-http url-using-proxy url))) +(defvar url-webmail-gateway "w3mail@gmd.de" + "*Where to send webmail requests") + +(defvar url-webmail-switches '(" " "-uu -z" "-uu -z -s 100")) + +(defun url-proxy-via-mail (url) + ;; Return URL from a web->mail gateway + (let ((urlobj (url-generic-parse-url url))) + (funcall url-mail-command) + (set (make-local-variable 'inhibit-read-only) t) + (goto-char (point-min)) + (if (search-forward mail-header-separator nil t) + (progn + (forward-char 1) + (delete-region (point) (point-max))) + (goto-char (point-max))) + (if (fboundp 'widget-minor-mode) + (widget-minor-mode 1)) + (apply 'widget-create 'menu-choice + :value " " + :format "%[%t%] %v" + :tag "get" + (mapcar (lambda (x) (list 'choice-item :format "%v" x)) + url-webmail-switches)) + (insert " " url) + (if url-request-data + (insert "?" url-request-data)) + (url-mail-goto-field "To") + (insert url-webmail-gateway))) + ;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt (defun url-data (url) (set-buffer (get-buffer-create url-working-buffer)) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/url-vars.el --- a/lisp/w3/url-vars.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/04/11 14:49:23 -;; Version: 1.52 +;; Created: 1997/04/18 20:28:20 +;; Version: 1.54 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,7 +38,7 @@ (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) -(defconst url-version (let ((x "p3.0.82")) +(defconst url-version (let ((x "p3.0.83")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -261,9 +261,7 @@ Looks like ((\"http\" . \"hostname:portnumber\") ....) This is set up from the ACCESS_proxy environment variables in url-do-setup." :type '(repeat (cons (string :tag "Protocol") - (string :tag "Proxy" - :validate widget-field-validate - :valid-regexp "^[a-z.0-9-:]+$"))) + (string :tag "Proxy"))) :group 'url) (defcustom url-global-history-file nil diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/url.el --- a/lisp/w3/url.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/04/11 14:41:10 -;; Version: 1.74 +;; Created: 1997/04/16 05:08:07 +;; Version: 1.75 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/04/11 14:41:10|1.74|Location Undetermined +;;; 1997/04/16 05:08:07|1.75|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -88,6 +88,7 @@ (autoload 'url-nfs "url-nfs") (autoload 'url-mailserver "url-mail") (autoload 'url-mailto "url-mail") +(autoload 'url-mail "url-mail") (autoload 'url-info "url-misc") (autoload 'url-shttp "url-http") (autoload 'url-https "url-http") diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/w3-menu.el --- a/lisp/w3/w3-menu.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/22 17:31:47 -;; Version: 1.35 +;; Created: 1997/04/17 15:50:07 +;; Version: 1.37 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -261,6 +261,16 @@ "----" ["Search..." w3-search-forward t] ["Search Again..." w3-search-again w3-last-search-item] + "----" + (list + "Preferences" + (if (fboundp 'custom-menu-create) + (custom-menu-create 'w3) + ["W3" ignore nil]) + (if (fboundp 'custom-menu-create) + (custom-menu-create 'url) + ["URL" ignore nil]) + ) ) "W3 edit menu list.") diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/w3-speak.el --- a/lisp/w3/w3-speak.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/w3-speak.el Mon Aug 13 09:30:11 2007 +0200 @@ -75,13 +75,12 @@ (defadvice w3-widget-forward (after emacspeak pre act comp) (when (interactive-p) (emacspeak-auditory-icon 'large-movement) - (emacspeak-widget-summarize (emacspeak-widget-at (point ))))) - + (emacspeak-widget-summarize (widget-at (point ))))) (defadvice w3-widget-backward (after emacspeak pre act comp) (when (interactive-p) (emacspeak-auditory-icon 'large-movement) - (emacspeak-widget-summarize (emacspeak-widget-at (point ))))) + (emacspeak-widget-summarize (widget-at (point ))))) (defadvice w3-scroll-up (after emacspeak pre act comp) "Provide auditory feedback" diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/w3-vars.el --- a/lisp/w3/w3-vars.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/11 14:49:22 -;; Version: 1.124 +;; Created: 1997/04/18 20:28:20 +;; Version: 1.125 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +33,7 @@ (require 'w3-cus) ; Grab everything that is customized (defconst w3-version-number - (let ((x "p3.0.82")) + (let ((x "p3.0.83")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -41,7 +41,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/04/11 14:49:22")) +(defconst w3-version-date (let ((x "1997/04/18 20:28:20")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) diff -r b27e67717092 -r 34a5b81f86ba lisp/w3/w3.el --- a/lisp/w3/w3.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:30:11 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/04/07 15:59:56 -;; Version: 1.108 +;; Created: 1997/04/15 23:28:10 +;; Version: 1.111 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1629,9 +1629,9 @@ (goto-char (cdr pos)) (if (and (eolp) (not (eobp))) (forward-char 1))) - (error "Link #%s not found." link)))) + (message "Link #%s not found." link)))) - (defun w3-force-reload-document () +(defun w3-force-reload-document () "Reload the current document. Take it from the network, even if cached and in local mode." (let ((url-standalone-mode nil)) @@ -2192,6 +2192,8 @@ (substring link-at-point 0 17) "...")) "): ") "Link: ") links-alist nil t)) + (if (and (string= choice "") link-at-point) + (setq choice link-at-point)) (let ((match (try-completion choice links-alist))) (cond ((eq t match) ; We have an exact match diff -r b27e67717092 -r 34a5b81f86ba man/custom.texi --- a/man/custom.texi Mon Aug 13 09:29:37 2007 +0200 +++ b/man/custom.texi Mon Aug 13 09:30:11 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.84 +Version: 1.89 @menu * Introduction:: @@ -492,9 +492,50 @@ @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 +after initialization, of the the user have saved this option. + @end table @xref{Sexp Types,,,widget,The Widget Library}, for information about @@ -565,7 +606,7 @@ Internally, custom uses the symbol property @code{factory-face} for the program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-doc-string} for the +properties saved by the user, and @code{face-documentation} for the documentation string.@refill @end defun @@ -634,11 +675,6 @@ @section Wishlist @itemize @bullet -@item -The menu items should be grayed out when the information is -missing. I.e. if a variable doesn't have a factory setting, the user -should not be allowed to select the @samp{Factory} menu item. - @item Better support for keyboard operations in the customize buffer. @@ -663,10 +699,6 @@ Make it possible to append to `choice', `radio', and `set' options. @item -Make it possible to customize code, for example to enable or disable a -global minor mode. - -@item Ask whether set or modified variables should be saved in @code{kill-buffer-hook}. @@ -689,6 +721,32 @@ 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}. + @end itemize @contents diff -r b27e67717092 -r 34a5b81f86ba man/widget.texi --- a/man/widget.texi Mon Aug 13 09:29:37 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:30:11 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.84 +Version: 1.89 @menu * Introduction:: @@ -24,6 +24,8 @@ * Sexp Types:: * Widget Properties:: * Defining New Widgets:: +* Widget Browser:: +* Widget Minor Mode:: * Widget Wishlist.:: @end menu @@ -229,9 +231,10 @@ 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 push one of the unselected radio buttons, it will be -selected and the previous selected radio button will become unselected. +Only one radio button in a @code{radio-button-choice} widget can be +selected at any time. When you push 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 @@ -585,6 +588,7 @@ * checkbox:: * checklist:: * editable-list:: +* group:: @end menu @node link, url-link, Basic Types, Basic Types @@ -921,6 +925,13 @@ 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. @@ -935,7 +946,7 @@ The list of types. @end table -@node editable-list, , checklist, Basic Types +@node editable-list, group, checklist, Basic Types @comment node-name, next, previous, up @subsection The @code{editable-list} Widget @@ -945,7 +956,7 @@ TYPE ::= (editable-list [KEYWORD ARGUMENT]... TYPE) @end example -The value is a list, where each member represent one widget of type +The value is a list, where each member represents one widget of type @var{type}. The following extra properties are recognized. @@ -987,30 +998,43 @@ @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 three categories: @dfn{atoms}, -@dfn{composite types}, and @dfn{generic}. +available. These basically fall in the following categories. @menu +* constants:: * generic:: * atoms:: * composite:: @end menu -@node generic, atoms, Sexp Types, Sexp Types +@node constants, generic, Sexp Types, Sexp Types @comment node-name, next, previous, up -@subsection The Generic Widget. +@subsection The Constant Widgets. -The @code{const} and @code{sexp} widgets can contain any lisp -expression. In the case of the @code{const} widget the user is +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 generic widgets is +The syntax for the @code{const} widget is @example TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) @@ -1024,6 +1048,33 @@ 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{const} widget is + +@example +TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) +@end example + @deffn Widget sexp This will allow you to edit any valid s-expression in an editable buffer field. @@ -1116,8 +1167,8 @@ component. There must be exactly two components. @end deffn -@deffn Widget lisp -The value of a @code{lisp} widget is a list containing the value of +@deffn Widget list +The value of a @code{list} widget is a list containing the value of each of its component. @end deffn @@ -1258,7 +1309,7 @@ @code{:deactivated} keywords instead. -@node Defining New Widgets, Widget Wishlist., Widget Properties, Top +@node Defining New Widgets, Widget Browser, Widget Properties, Top @comment node-name, next, previous, up @section Defining New Widgets @@ -1362,7 +1413,48 @@ default'' in this text. @end deffn -@node Widget Wishlist., , Defining New Widgets, Top +@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, Widget Wishlist., 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 +Togle 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 Widget Wishlist., , Widget Minor Mode, Top @comment node-name, next, previous, up @section Wishlist. @@ -1390,7 +1482,7 @@ specific to the first widget where I happended to use them. @item -Flag to make @code{widget-move} skip a specified button. +Finish @code{:tab-order}. @item Document `helper' functions for defining new widgets. @@ -1422,13 +1514,27 @@ Perhaps the correct model is delegation? @item -Document @code{widget-browse}. - -@item Make indentation work with glyphs and propertional fonts. @item -Add object and class hierarchies to the browser. +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 +Add @code{property-list} widget. + +@item +Add @code{association-list} widget. + +@item +Add @code{key-binding} widget. + +@item +Find clean way to implement variable length list. +See @code{TeX-printer-list} for an explanation. @end itemize diff -r b27e67717092 -r 34a5b81f86ba src/ChangeLog --- a/src/ChangeLog Mon Aug 13 09:29:37 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:30:11 2007 +0200 @@ -1,3 +1,11 @@ +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 diff -r b27e67717092 -r 34a5b81f86ba src/Makefile.in.in --- a/src/Makefile.in.in Mon Aug 13 09:29:37 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:30:11 2007 +0200 @@ -526,7 +526,8 @@ #define XOBJS console-x.o device-x.o DIALOG_X_OBJS event-Xt.o frame-x.o \ glyphs-x.o GUI_X_OBJS MENUBAR_X_OBJS objects-x.o redisplay-x.o \ SCROLLBAR_X_OBJS TOOLBAR_X_OBJS INPUT_METHOD_X_OBJS xgccache.o \ - xselect.o + xselect.o \ + balloon_help.o balloon-x.o #ifdef HAVE_XMU #define XMU_OBJS diff -r b27e67717092 -r 34a5b81f86ba src/balloon-x.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/balloon-x.c Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,135 @@ +#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 = DefaultColormap( dpy, DefaultScreen(dpy) ); + 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; + + if( !init ) + { + 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 = 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, /* +Hide balloon help. +*/ + ()) +{ + 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 ("balloon-help")); +} diff -r b27e67717092 -r 34a5b81f86ba src/balloon_help.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/balloon_help.c Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,613 @@ +/* + * Balloon Help + * + * Version: 1.337 (Sun Apr 13 04:52:10 1997) + * + * Written by Douglas Keller + * + * + */ + +#include +#include +#include +#include + +#include +#include +#include + +#include + +#include "balloon_help.h" + +#define max(x,y) (x>y?x:y) + +#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 int b_lastX, b_lastY; + +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( SHAPE_CONE_TOP_LEFT == last_shape ) + { + if( (x + width < screen_width) && (y + height < screen_height) ) + { + return last_shape; + } + } + else if( SHAPE_CONE_TOP_RIGHT == last_shape ) + { + if( (x - width > 0) && (y + height < screen_height) ) + { + return last_shape; + } + } + else if( SHAPE_CONE_BOTTOM_LEFT == last_shape ) + { + if( (x + width < screen_width) && (y - height > 0) ) + { + return last_shape; + } + } + else if( SHAPE_CONE_BOTTOM_RIGHT == last_shape ) + { + if( (x - width > 0) && (y - height > 0) ) + { + return last_shape; + } + } + + /* Try to pick a shape that will not get changed, ie if top left quadrant, top_left */ + if( x < screen_width / 2 ) + { + if( y < screen_height / 2 ) + { + return SHAPE_CONE_TOP_LEFT; + } + else + { + return SHAPE_CONE_BOTTOM_LEFT; + } + } + else + { + if( y < screen_height / 2 ) + { + return SHAPE_CONE_TOP_RIGHT; + } + else + { + return SHAPE_CONE_BOTTOM_RIGHT; + } + } + + /* ### if width or height is greater than 1/2 the width or height then we might + run off the screen */ + + abort(); + + return 0; +} + +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_lastX = x; + b_lastY = y; + 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); + } + } + +} + +/*============================================================================ + +============================================================================*/ + +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_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_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 ) + { + b_lastX = x; + b_lastY = y; + + 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 -r b27e67717092 -r 34a5b81f86ba src/balloon_help.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/balloon_help.h Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,15 @@ +#ifndef BALLOON_HELP_H +#define BALLOON_HELP_H + +#include + +void balloon_help_create( Display* dpy, + Pixel fg, Pixel bg, Pixel shine, Pixel shadow, + XFontStruct* font ); +void balloon_help_destroy( void ); +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 -r b27e67717092 -r 34a5b81f86ba src/mule-wnnfns.c --- a/src/mule-wnnfns.c Mon Aug 13 09:29:37 2007 +0200 +++ b/src/mule-wnnfns.c Mon Aug 13 09:30:11 2007 +0200 @@ -542,6 +542,7 @@ jl_env_set (wnnfns_buf[snum], wnnfns_env_rev[snum]); wnnfns_norm = 0; } + return Qt; } DEFUN ("wnn-server-henkan-begin", Fwnn_begin_henkan, 1, 1, 0, /* @@ -2057,7 +2058,6 @@ static int yes_or_no (unsigned char *s) { - extern Lisp_Object Fy_or_n_p(); unsigned char mbuf[512]; unsigned char lb; int len; @@ -2073,9 +2073,12 @@ for (; (mbuf[len] != '(') && (len > 0); len--); { Lisp_Object yes, str; + struct gcpro gcpro1; str = make_string (mbuf, len); + GCPRO1 (str); yes = call1(Qyes_or_no_p, str); + UNGCPRO; if (NILP (yes)) return 0; else return (1); } @@ -2084,6 +2087,7 @@ static void puts2 (char *s) { +#if 0 /* jhod: We don't really need this echoed... */ #if 0 Lisp_Object args[1]; char mbuf[512]; @@ -2097,7 +2101,8 @@ Fmessage (1, args); #else message("%s",s); -#endif +#endif +#endif } int diff -r b27e67717092 -r 34a5b81f86ba src/s/decosf4-0-static.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/s/decosf4-0-static.h Mon Aug 13 09:30:11 2007 +0200 @@ -0,0 +1,13 @@ +/* Synched up with: Not in FSF. */ + +#include "decosf4-0.h" + +#ifdef NOT_C_CODE +/* This is to get rid of the definition that selects dynamic linking. */ +#undef LD_SWITCH_CALL_SHARED +#ifdef USE_GCC +#define LD_SWITCH_CALL_SHARED -static -Xlinker -non_shared +#else +#define LD_SWITCH_CALL_SHARED -non_shared +#endif /* USE_GCC */ +#endif /* NOT_C_CODE */ diff -r b27e67717092 -r 34a5b81f86ba src/s/decosf4.0-static.h --- a/src/s/decosf4.0-static.h Mon Aug 13 09:29:37 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -/* Synched up with: Not in FSF. */ - -#include "decosf4-0.h" - -#ifdef NOT_C_CODE -/* This is to get rid of the definition that selects dynamic linking. */ -#undef LD_SWITCH_CALL_SHARED -#ifdef USE_GCC -#define LD_SWITCH_CALL_SHARED -static -Xlinker -non_shared -#else -#define LD_SWITCH_CALL_SHARED -non_shared -#endif /* USE_GCC */ -#endif /* NOT_C_CODE */