Mercurial > emacs
changeset 90044:cb7f41387eb3
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-70
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-669
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71
Update from CVS
line wrap: on
line diff
--- a/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,15 @@ +2004-11-08 Kim F. Storm <storm@cua.dk> + + * Makefile.in (bootstrap, bootstrap-clean-before): Remove .elc + files before building. + (bootfast, bootstrap-clean-before-fast): New targets, like + bootstrap but don't remove .elc files. + +2004-11-06 Lars Brinkhoff <lars@nocrew.org> + + * configure.in: Add check for getrusage. + * configure: Regenerate. + 2004-11-02 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New
--- a/Makefile.in Thu Nov 04 08:55:40 2004 +0000 +++ b/Makefile.in Fri Nov 12 02:53:04 2004 +0000 @@ -51,6 +51,15 @@ # # make extraclean # Still more severe - delete backup and autosave files, too. +# +# make bootstrap +# Recompiles all the Emacs Lisp files using the latest source, +# then rebuilds Emacs. +# +# make bootfast +# Recompiles changed Emacs Lisp files using the latest C source, +# then rebuilds Emacs. This is faster than `make bootstrap' +# but once in a while an old .elc file can cause trouble. SHELL = /bin/sh @@ -726,6 +735,8 @@ ### used to compile Lisp files. The last step is a "normal" make. .PHONY: bootstrap +.PHONY: bootstrap-build +.PHONY: bootfast .PHONY: maybe_bootstrap maybe_bootstrap: @@ -737,7 +748,11 @@ exit 1;\ fi -bootstrap: bootstrap-clean-before info FRC +bootstrap: bootstrap-clean-before info bootstrap-build FRC + +bootfast: bootstrap-clean-before-fast info bootstrap-build FRC + +bootstrap-build: FRC (cd lisp; $(MAKE) $(MFLAGS) bootstrap-prepare) (cd src; $(MAKE) $(MFLAGS) bootstrap) (cd lisp; $(MAKE) $(MFLAGS) bootstrap EMACS=../src/bootstrap-emacs${EXEEXT}) @@ -746,7 +761,12 @@ (cd lisp; $(MAKE) $(MFLAGS) bootstrap-after) ### Used for `bootstrap' to avoid deleting existing dumped Emacs executables. -bootstrap-clean-before: FRC +bootstrap-clean-before: bootstrap-clean-before-fast FRC + (cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean) + +### Used for `bootfast' to avoid deleting existing dumped Emacs executables +### and compiled .elc files. +bootstrap-clean-before-fast: FRC (cd src; $(MAKE) $(MFLAGS) mostlyclean) (cd oldXMenu; $(MAKE) $(MFLAGS) clean) (cd lwlib; $(MAKE) $(MFLAGS) clean)
--- a/admin/FOR-RELEASE Thu Nov 04 08:55:40 2004 +0000 +++ b/admin/FOR-RELEASE Fri Nov 12 02:53:04 2004 +0000 @@ -10,6 +10,12 @@ ** Let mouse-1 follow links. +** Make Rmail find the best version of movemail. +To be done by Sergey Poznyakoff <gray@Mirddin.farlep.net>. + +** Make VC-over-Tramp work where possible, or at least fail +gracefully if something isn't supported over Tramp. +To be done by Andre Spiegel <spiegel@gnu.org>. * FATAL ERRORS @@ -30,7 +36,6 @@ ** Clean up flymake.el to follow Emacs Lisp conventions. - * GTK RELATED BUGS ** Make GTK scrollbars behave like others w.r.t. overscrolling. @@ -103,50 +108,6 @@ Update: Maybe only reveals itself when compiled with GTK+ -** Mouse-face overlay bleeds into header line - -From: Stephen Berman <Stephen.Berman@gmx.net> -Date: Thu, 21 Oct 2004 18:11:01 +0200 - -Mouse-face overlays bleed into the header line when the beginning of -the overlay is above (point-min). To reproduce: - -1. Start Emacs with -q -no-site-file. - -2. In *scratch* eval (setq ov (make-overlay 66 92)), (overlay-put ov -'mouse-face 'highlight), and (setq header-line-format "test"). - -3. Drag the mouse over the string "evaluation.\n;; If you want" and -notice the highlighting of only this string. - -4. Now click on the down arrow in the scroll bar until the line -beginning ";; If you want" is directly below the header line. - -5. Drag the mouse over ";; If you want" and notice that not only it -but also the header line are highlighted. - - -** scroll-preserve-screen-position doesn't work with a header-line-format - -From: jbyler+emacs-lists@anon41.eml.cc -Date: Tue, 17 Aug 2004 17:10:14 -0400 - -There seems to be an off-by-one error triggered by using a header line -together with scroll-preserve-screen-position. The symptom: instead of -staying in the same position on the screen when scrolling, the cursor -moves one screen line down each time the buffer is scrolled. Put -another way: repeatedly typing C-v M-v or using a mouse scroll wheel to -scroll up and down causes the cursor to migrate slowly down the screen -instead of staying put as it should. - -To reproduce: - -emacs -q --no-site-file -(setq scroll-preserve-screen-position t) -(setq header-line-format "") -C-v M-v C-v M-v C-v M-v etc. - - ** Clicking on partially visible lines fails From: David Kastrup <dak@gnu.org> @@ -200,32 +161,6 @@ But point should be displayed at the bottom of the window like Emacs-21.3. -** line-spacing and garbage in fringe - -From: SAITO Takuya <tabmore@rivo.mediatti.net> -Date: Mon, 31 May 2004 02:08:05 +0900 (JST) - -Start emacs -Q and evaluate below with C-xC-e: - -(let ((lines 2) - (spacing 1)) - (setq line-spacing spacing - indicate-buffer-boundaries t) - (insert (make-string (window-height) ?\n)) - (goto-char (point-min)) - (message (make-string (* (window-width) lines) ?.)) - (scroll-up 1)) - -then, garbage is displayed in right fringe. - -Above code reproduces this bug with -(frame-parameter nil 'font) -=> "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" - -If you use different font, you may need different value of -`lines' and/or `spacing'. - - ** line-spacing and Electric-pop-up-window From: SAITO Takuya <tabmore@rivo.mediatti.net> @@ -244,6 +179,8 @@ * DOCUMENTATION +** Document Custom Themes. + ** Finish updating the Emacs Lisp manual. ** Update the Emacs manual. @@ -318,11 +255,11 @@ SECTION READERS ---------------------------------- lispref/abbrevs.texi "Luc Teirlinck" -lispref/advice.texi +lispref/advice.texi Joakim Verona <joakim@verona.se> lispref/anti.texi lispref/backups.texi "Luc Teirlinck" lispref/buffers.texi "Luc Teirlinck" -lispref/calendar.texi +lispref/calendar.texi Joakim Verona <joakim@verona.se> lispref/commands.texi "Luc Teirlinck" lispref/compile.texi "Luc Teirlinck" lispref/control.texi "Luc Teirlinck"
--- a/configure Thu Nov 04 08:55:40 2004 +0000 +++ b/configure Fri Nov 12 02:53:04 2004 +0000 @@ -13704,8 +13704,9 @@ + for ac_func in gethostname getdomainname dup2 \ -rename closedir mkdir rmdir sysinfo \ +rename closedir mkdir rmdir sysinfo getrusage \ random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \ strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \ utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
--- a/configure.in Thu Nov 04 08:55:40 2004 +0000 +++ b/configure.in Fri Nov 12 02:53:04 2004 +0000 @@ -2370,7 +2370,7 @@ AC_CHECK_HEADERS(maillock.h) AC_CHECK_FUNCS(gethostname getdomainname dup2 \ -rename closedir mkdir rmdir sysinfo \ +rename closedir mkdir rmdir sysinfo getrusage \ random lrand48 bcopy bcmp logb frexp fmod rint cbrt ftime res_init setsid \ strerror fpathconf select mktime euidaccess getpagesize tzset setlocale \ utimes setrlimit setpgid getcwd getwd shutdown getaddrinfo \
--- a/etc/NEWS Thu Nov 04 08:55:40 2004 +0000 +++ b/etc/NEWS Fri Nov 12 02:53:04 2004 +0000 @@ -173,11 +173,16 @@ * Changes in Emacs 21.4 +** line-move-ignore-invisible now defaults to t. + +** In Outline mode, hide-body no longer hides lines at the top +of the file that precede the first header line. + +++ ** `set-auto-mode' now gives the interpreter magic line (if present) precedence over the file name. Likewise an <?xml or <!DOCTYPE declaration -will give the buffer XML or SGML mode, unless the file name leads to a mode in -`xml-based-modes'. +will give the buffer XML or SGML mode, based on the new var +`magic-mode-alist'. +++ ** New function `looking-back' checks whether a regular expression matches @@ -1006,13 +1011,19 @@ --- ** The pop up menus for Lucid now stay up if you do a fast click and can -be navigated with the arrow keys (like Gtk+ and W32). - ---- -** Dialogs for Lucid/Athena and Lesstif/Motif pops down when pressing ESC. - -+++ -** The file selection dialog for Gtk+, W32 and Motif/Lesstif can be +be navigated with the arrow keys (like Gtk+, Mac and W32). + +--- +** Dialogs for Lucid/Athena and Lesstif/Motif now pops down when pressing +ESC, like they do for Gtk+, Mac and W32. + +--- +** The menu item "Open File..." has been split into two items, "New File..." +and "Open File...". "Open File..." now opens only existing files. This is +to support existing GUI file selection dialogs better. + ++++ +** The file selection dialog for Gtk+, Mac, W32 and Motif/Lesstif can be disabled by customizing the variable `use-file-dialog'. +++ @@ -2155,6 +2166,13 @@ * New modes and packages in Emacs 21.4 +** The new package conf-mode.el handles thousands of configuration files, with +varying syntaxes for comments (;, #, //, /* */ or !), assignment (var = value, +var : value, var value or keyword var value) and sections ([section] or +section { }). Many files under /etc/, or with suffixes like .cf through +.config, .properties (Java), .desktop (KDE/Gnome), .ini and many others are +recognized. + ** The new package password.el provide a password cache and expiring mechanism. ** The new package dns-mode.el add syntax highlight of DNS master files. @@ -2393,6 +2411,18 @@ * Lisp Changes in Emacs 21.4 +++ +** The new function syntax-after returns the syntax code +of the character after a specified buffer position, taking account +of text properties as well as the character code. +It returns the value compatibly with char-syntax, except +that the value can be a list (SYNTAX . MATCHER) which says +what the matching character is. + ++++ +** The new primitive `get-internal-run-time' returns the processor +run time used by Emacs since start-up. + ++++ ** The new function `called-interactively-p' does what many people have mistakenly believed `interactively-p' did: it returns t if the calling function was called through `call-interactively'.
--- a/lib-src/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/lib-src/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,18 @@ +2004-11-09 Kim F. Storm <storm@cua.dk> + + * make-docfile.c (scan_c_file): Set defvarperbufferflag to + silence compiler. + + * hexl.c (main): Init local var c to silence compiler. + + * etags.c (main, consider_token, C_entries): Add misc switch + default targets to silence compiler. + +2004-11-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * makefile.w32-in (obj): Add all files (X and Mac) to doc so the + resulting DOC file can be used on Unix/Mac also. + 2004-09-13 Francesco Potort,Al(B <pot@gnu.org> * etags.c (main): When relative file names are given as argument,
--- a/lib-src/etags.c Thu Nov 04 08:55:40 2004 +0000 +++ b/lib-src/etags.c Fri Nov 12 02:53:04 2004 +0000 @@ -1400,6 +1400,8 @@ this_file = argbuffer[i].what; process_file (stdin, this_file, lang); break; + case at_end: + break; } } @@ -2900,6 +2902,8 @@ case tkeyseen: switch (toktype) { + default: + break; case st_none: case st_C_class: case st_C_struct: @@ -2917,12 +2921,16 @@ case tend: switch (toktype) { + default: + break; case st_C_class: case st_C_struct: case st_C_enum: return FALSE; } return TRUE; + default: + break; } /* @@ -2960,6 +2968,8 @@ fvdef = fvnone; } return FALSE; + default: + break; } if (structdef == skeyseen) @@ -2983,6 +2993,8 @@ case st_C_objimpl: objdef = oimplementation; return FALSE; + default: + break; } break; case oimplementation: @@ -3039,6 +3051,8 @@ objdef = onone; } return FALSE; + default: + break; } /* A function, variable or enum constant? */ @@ -3091,6 +3105,8 @@ return FALSE; } break; + default: + break; } /* FALLTHRU */ case fvnameseen: @@ -3107,8 +3123,12 @@ fvdef = fvnameseen; /* function or variable */ *is_func_or_var = TRUE; return TRUE; + default: + break; } break; + default: + break; } return FALSE; @@ -3584,6 +3604,8 @@ fvdef = fignore; } break; + default: + break; } if (structdef == stagseen && !cjava) { @@ -3594,6 +3616,8 @@ case dsharpseen: savetoken = token; break; + default: + break; } if (!yacc_rules || lp == newlb.buffer + 1) { @@ -3632,6 +3656,8 @@ linebuffer_setlen (&token_name, token_name.len + 1); strcat (token_name.buffer, ":"); break; + default: + break; } if (structdef == stagseen) { @@ -3709,6 +3735,8 @@ make_C_tag (TRUE); /* an Objective C method */ objdef = oinbody; break; + default: + break; } switch (fvdef) { @@ -3779,6 +3807,8 @@ fvdef = fvnone; } break; + default: + break; } break; case '(': @@ -3812,6 +3842,8 @@ case flistseen: fvdef = finlist; break; + default: + break; } parlev++; break; @@ -3837,6 +3869,8 @@ case finlist: fvdef = flistseen; break; + default: + break; } if (!instruct && (typdef == tend @@ -3886,6 +3920,8 @@ bracelev = -1; } break; + default: + break; } switch (structdef) { @@ -3899,6 +3935,8 @@ structdef = snone; make_C_tag (FALSE); /* a struct or enum */ break; + default: + break; } bracelev++; break;
--- a/lib-src/hexl.c Thu Nov 04 08:55:40 2004 +0000 +++ b/lib-src/hexl.c Fri Nov 12 02:53:04 2004 +0000 @@ -173,7 +173,7 @@ #endif for (;;) { - register int i, c, d; + register int i, c = 0, d; #define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10) @@ -225,7 +225,7 @@ string[17] = '\0'; for (;;) { - register int i, c; + register int i, c = 0; for (i=0; i < 16; ++i) {
--- a/lib-src/make-docfile.c Thu Nov 04 08:55:40 2004 +0000 +++ b/lib-src/make-docfile.c Fri Nov 12 02:53:04 2004 +0000 @@ -617,6 +617,7 @@ c = getc (infile); defunflag = c == 'U'; defvarflag = 0; + defvarperbufferflag = 0; } else continue;
--- a/lib-src/makefile.w32-in Thu Nov 04 08:55:40 2004 +0000 +++ b/lib-src/makefile.w32-in Fri Nov 12 02:53:04 2004 +0000 @@ -124,9 +124,30 @@ # $(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O) # -# From ..\src\makefile.nt. +# From ..\src\Makefile.in +# It doesn't matter if the real name is *.obj for the files in this list, +# make-docfile blindly replaces .o with .c anyway. Keep .o in this list +# as it is required by code in doc.c. # -obj = abbrev.c alloc.c alloca.c buffer.c bytecode.c callint.c callproc.c casefiddle.c casetab.c category.c ccl.c charset.c cm.c cmds.c coding.c data.c dired.c dispnew.c doc.c doprnt.c editfns.c emacs.c eval.c fileio.c filelock.c filemode.c floatfns.c fns.c fontset.c frame.c fringe.c gmalloc.c image.c indent.c insdel.c intervals.c keyboard.c keymap.c lastfile.c lread.c macros.c marker.c minibuf.c print.c process.c ralloc.c regex.c region-cache.c scroll.c search.c sound.c strftime.c syntax.c sysdep.c term.c termcap.c textprop.c tparam.c undo.c unexw32.c vm-limit.c w32.c w32console.c w32fns.c w32heap.c w32inevt.c w32menu.c w32proc.c w32reg.c w32select.c w32term.c w32xfns.c window.c xdisp.c xfaces.c xfaces.c +obj= sunfns.o dosfns.o msdos.o \ + xterm.o xfns.o xmenu.o xselect.o xrdb.o fringe.o image.o \ + mac.o macterm.o macfns.o macmenu.o fontset.o \ + w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \ + w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ + dispnew.o frame.o scroll.o xdisp.o window.o \ + charset.o coding.o category.o ccl.o \ + cm.o term.o xfaces.o \ + emacs.o keyboard.o macros.o keymap.o sysdep.o \ + buffer.o filelock.o insdel.o marker.o \ + minibuf.o fileio.o dired.o filemode.o \ + cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ + alloc.o data.o doc.o editfns.o callint.o \ + eval.o floatfns.o fns.o print.o lread.o \ + abbrev.o syntax.o bytecode.o \ + process.o callproc.o \ + region-cache.o sound.o atimer.o \ + doprnt.o strftime.o intervals.o textprop.o composite.o md5.o + # # These are the lisp files that are loaded up in loadup.el #
--- a/lisp/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,437 @@ +2004-11-12 Nick Roberts <nickrob@snap.net.nz> + + * tooltip.el (require): Explain why CL is needed. + +2004-11-11 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * printing.el: Insert :version into defgroup (printing). All reference + to Files option in menubar were changed to File. + (pr-version): New version number (6.8.2). + (pr-get-symbol): Call easy-menu-intern. + (pr-region-active-p): Now is a fun (it was defsubst). To avoid + compilation gripes. + +2004-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/iso-cvt.el (iso-cvt-define-menu): Fix typo. + + * tooltip.el: Require CL. + + * emacs-lisp/bytecomp.el: Use push. + (byte-compile-file-form-defalias): Rename from byte-compile-defalias. + (defalias): Remove the `byte-compile' property and add + a `byte-hunk-handler'. + +2004-11-11 Juri Linkov <juri@jurta.org> + + * info.el (Info-search): Save match data for isearch. + Skip Tag Table node. + + * descr-text.el (describe-char): Replace syntax-after with code + from its previous version. + + * files.el (magic-mode-alist): Use optimization for SGML mode too. + (set-auto-mode): Doc fix. Remove unused variable `xml'. + + * international/mule.el (sgml-html-meta-auto-coding-function): + Remove > after <html to allow HTML attributes. + +2004-11-11 Jay Belanger <belanger@truman.edu> + + * calc/calc-comb.el (math-prime-factors-finished): Declare it as + a variable. + (calcFunc-dfac): Replace unbound max by n. + (math-stirling-local-cache): New variable. + (math-stirling-number, math-stirling-1, math-stirling-2): + Replace the variable `cache' by the declared variable + math-stirling-local-cache. + (var-RandSeed): Declare it as a variable. + (math-init-random-base, math-random-digit): Don't check to see if + var-RandSeed is bound. + (math-random-cache, math-gaussian-cache, calc-verbose-nextprime): + Declare them instead of just setting them. + (math-init-random-base): Made i a local variable. + (math-random-digit): Made math-random-last a local variable. + (math-prime-test-cache): Move declaration to before it is used. + (math-prime-test-cache-k, math-prime-test-cache-q) + (math-prime-test-cache-nm1, math-prime-factors-finished): + Declare them as variables. + +2004-11-11 Jay Belanger <belanger@truman.edu> + + * calc/calc-ext.el (math-defcache): Use defvar for the new + variables it creates. + +2004-11-11 Lars Hansen <larsh@math.ku.dk> + + * desktop.el (desktop-buffer-mode-handlers, desktop-after-read-hook) + (desktop-clear-preserve-buffers-regexp, desktop-file-name-format) + (desktop-globals-to-clear, desktop-no-desktop-file-hook, desktop-path) + (desktop-save): Add :version. + +2004-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * printing.el (pr-get-symbol): Don't downcase. + +2004-11-10 Jay Belanger <belanger@truman.edu> + + * calc/calc-aent.el (calc-do-quick-calc): Use kill-new to append + string to kill-ring. + + * calc/calc-aent.el (calc-alg-exp, math-toks) + (math-exp-pos,math-exp-old-pos, math-exp-token) + (math-exp-keep-spaces, math-exp-str): New variables. + (calc-do-alg-entry, calcAlg-equals, calcAlg-edit) + (calcAlg-enter): Use declared variable calc-alg-exp. + (math-build-parse-table, math-find-user-token): Use declared + variable math-toks. + (math-read-exprs, math-read-token, calc-check-user-syntax) + (calc-match-user-syntax, match-factor-after, math-read-factor): + Use declared variables math-exp-pos math-exp-old-pos. + (math-read-exprs, math-read-token, math-read-expr-level) + (calc-check-user-syntax, calc-match-user-syntax) + (match-factor-after, math-read-factor): Use declared variable + math-exp-token. + (math-read-exprs, math-read-expr-list, math-read-token) + (math-read-factor): Use declared variable math-exp-keep-spaces. + (math-read-exprs, math-read-token): Use declared variable + math-exp-str. + (calc-match-user-syntax): Made m a local variable. + + * calc/calc-ext.el (math-read-expr): Use declared variables + math-exp-pos, math-exp-old-pos, math-exp-str, math-exp-token, + math-exp-keep-spaces. + + * calc/calc-forms.el (math-read-angle-bracket): Use declared + variables math-exp-pos, math-exp-str. + + * calc/calc-lang.el (math-parse-tex-sum): Use declared variable + math-exp-old-pos. + (math-parse-fortran-vector, math-parse-fortran-vector-end) + (math-parse-eqn-prime): Use declared variable math-exp-token. + + * calc/calc-vec.el (math-read-brackets, math-check-for-commas): + Use declared variable math-exp-pos. + (math-check-for-commas): Use declared variable math-exp-str. + (math-read-brackets): Use declared variables math-exp-old-pos, + math-exp-keep-spaces. + (math-read-brackets, math-read-vector, math-read-matrix): + Use declared variable math-exp-token. + +2004-11-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (magic-mode-alist): Reduce backtracking in the HTML regexp. + + * textmodes/sgml-mode.el (sgml-tag-text-p): New fun. + (sgml-parse-tag-backward): Use it to skip spurious < or >. + +2004-11-10 Thien-Thi Nguyen <ttn@gnu.org> + + * ebuff-menu.el: Doc fixes throughout. + (electric-buffer-menu-mode-hook): New defvar. + +2004-11-10 Nick Roberts <nickrob@snap.net.nz> + + * tooltip.el: Don't require cl, comint, gud, gdb-ui for + compilation. The resulting compiler warnings appear to be harmless. + +2004-11-10 Daniel Pfeiffer <occitan@esperanto.org> + + * textmodes/conf-mode.el: New file. + + * files.el (auto-mode-alist, magic-mode-alist): Use it. + +2004-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/iso-cvt.el (iso-cvt-define-menu): Clean up namespace. + +2004-11-09 Jay Belanger <belanger@truman.edu> + + * calc/calc-ext.el (calc-init-extensions): Remove old code. + + * calc/calc-ext.el (math-expr-data, math-mt-many, math-mt-func) + (calc-z-prefix-buf, calc-z-prefix-msgs): New variables. + (calc-z-prefix-help, calc-user-function-list): Use declared + variables calc-z-prefix-buf, calc-z-prefix-msgs. + (math-map-tree, math-map-tree-rec): Use declared variables + math-mt-many, math-mt-func. + (math-read-expression, math-read-string): Use declared variable + math-expr-data. + + * calc/calc-ext.el (math-normalize-nonstandard): Use declared + variable math-normalize-a. + + * calc/calc.el (math-normalize-a): New variable. + (math-normalize): Use declared variable math-normalize-a. + + * calc/calc-poly.el (math-expand-form): Use declared variable + math-mt-many. + + * calc/calc-rewr.el (math-rewrite, math-rewrite-phase): + Use declared variable math-mt-many. + (math-rewrite): Use declared variable math-mt-func. + + * calc/calc-vec.el (math-read-brackets, math-read-vector) + (math-read-matrix): Use declared variable math-expr-data. + + * calc/calc-lang.el (math-parse-fortran-vector) + (math-parse-fortran-vector-end, math-parse-tex-sum) + (math-parse-eqn-matrix, math-parse-eqn-prime) + (math-read-math-subscr): Use declared variable math-expr-data. + + * calc/calc-aent.el (math-read-exprs, math-read-expr-list) + (math-read-expr-level, math-read-token, calc-check-user-syntax) + (calc-match-user-syntax, math-read-if, math-factor-after) + (math-read-factor): Use declared variable math-expr-data. + +2004-11-09 Glenn Morris <gmorris@ast.cam.ac.uk> + + * calendar/diary-lib.el (diary-from-outlook) + (diary-from-outlook-gnus, diary-from-outlook-rmail): Do not use + interactive-p; but rather new optional argument NOCONFIRM. + +2004-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/easymenu.el (easy-menu-intern): Revert to no-downcasing. + (easy-menu-name-match): Revert correspondingly. + +2004-11-09 Richard M. Stallman <rms@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-defalias): + Turn off warnings for the new function even if definition not constant. + If the definition isn't a quoted symbol, record (FUNCTION . t). + (byte-compile-function-environment): Now allow (FUNCTION . t) as elt. + (byte-compile-callargs-warn): Handle (FUNCTION . t). + (display-call-tree, byte-compile-arglist-warn): + Handle t returned by byte-compile-fdefinition. + +2004-11-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * Makefile.in (maintainer-clean): Depend on distclean. + + * help-fns.el (help-C-file-name): File name must be in build-files + to be returned. + +2004-11-09 Jay Belanger <belanger@truman.edu> + + * calc/calc.el (calc-mode-hook, calc-trail-mode-hook) + (calc-start-hook, calc-end-hook, calc-load-hook): New variables. + + * calc/calc.el (calc, calc-trail-display, calc-mode): + Remove obsolete sections. + + * calc/calc.el (calc-x-paste-text): Remove. + + * calc/calc-ext.el (calc-init-extensions): Bind calc-yank to + mouse-2. + +2004-11-09 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-current-stack-level): New variable. + (gdb-info-frames-custom, gdb-frame-handler): Use it to find + current frame (in case of recursive calls). + (gdb-show-changed-values): Add :version keyword. + +2004-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-cmds.el: Change coding-system to utf-8. + (select-safe-coding-system-interactively): + New function extracted from select-safe-coding-system. + (select-safe-coding-system): Use it. + +2004-11-08 Richard M. Stallman <rms@gnu.org> + + * subr.el (syntax-after): Doc fix. + + * paren.el (show-paren-function): Change calls to syntax-after + for new way of returning the value. + + * menu-bar.el (menu-bar-file-menu): Make this the real name + and menu-bar-files-menu the alias. Use the former. + (global-map): Use `file', not `files', as the symbol. + + * info.el (Info-revert-find-node): Don't use beginning-of-buffer. + + * filesets.el (filesets-spawn-external-viewer, filesets-run-cmd): + Don't use beginning-of-buffer. + (filesets-cmd-show-result): Use with-no-warnings. + +2004-11-08 Juri Linkov <juri@jurta.org> + + * progmodes/compile.el (compile): Don't overwrite last command in + minibuffer history with default command if they are not equal. + +2004-11-08 Jay Belanger <belanger@truman.edu> + + * calc/calcalg2.el (math-do-integral-methods): Try linear then + non-linear substitutions. + +2004-11-08 Jay Belanger <belanger@truman.edu> + + * calc/calcalg2.el (math-linear-subst-tried): New variable. + (math-do-integral): Set `math-linear-subst-tried' to nil. + (math-do-integral-methods): Use `math-linear-subst-tried' to + determine what type of substitution to try. + (math-integ-try-linear-substituion): + Set `math-linear-subst-tried' to t. + +2004-11-08 Kim F. Storm <storm@cua.dk> + + * Makefile.in (bootstrap-clean): New target for 'make bootstrap'. + +2004-11-07 Juri Linkov <juri@jurta.org> + + * info-look.el (info-lookup): Allow reusing in the current buffer + not only *info* buffer, but all (even renamed) Info buffers + by checking for major-mode instead of *info* buffer name. + (c-mode, autoconf-mode, emacs-lisp-mode, scheme-mode) + (octave-mode, maxima-mode) <doc-spec>: + Allow long dashes generated by Texinfo 4.7 before definitions. + (texinfo-mode) <doc-spec>: Add space to suffix to find command + definitions with argument separated by space. + +2004-11-06 Richard M. Stallman <rms@gnu.org> + + * simple.el (next-error group, face): Move before first use. + (next-error-highlight, next-error-highlight-no-select): Likewise. + + * simple.el (line-move-invisible-p): Rename from line-move-invisible. + (line-move): New args NOERROR and TO-END. + Return t if if succeed in moving specified number of lines. + (move-end-of-line): New function. + + * simple.el (beginning-of-buffer-other-window): Use with-no-warnings. + (end-of-buffer-other-window): Likewise. + + * simple.el (line-move-ignore-invisible): Default to t. + + * subr.el (syntax-after): Return the syntax letter, not the raw code. + + * emacs-lisp/elp.el (elp-results): Delete wasteful beginning-of-buffer. + + * international/iso-cvt.el (iso-cvt-define-menu): + Rename menu-bar-files-menu to menu-bar-file-menu. + + * net/browse-url.el (browse-url-gnome-moz-program) + (browse-url-gnome-moz-arguments): Move up before first use. + + * net/tramp.el (tramp group): Add :version. + + * progmodes/ada-xref.el (ada-gdb-application): + Use goto-char instead of beginning-of-buffer. + + * progmodes/cperl-mode.el (cperl-info-on-command): + Use goto-char instead of beginning-of-buffer. + + * progmodes/idlw-shell.el (idlwave-shell-examine-map): + Move up before first use. + (idlwave-shell-temp-pro-file): Likewise. + (idlwave-shell-temp-rinfo-save-file): Likewise. + (idlwave-shell-temp-file): Minor doc fix. + + * textmodes/flyspell.el (flyspell-external-point-words): + Use goto-char instead of beginning-of-buffer. + +2004-11-06 Kai Grossjohann <kai.grossjohann@gmx.net> + + * net/tramp.el (tramp-coding-commands): Additionally try "uudecode -o + /dev/stdout" before trying "uudecode -o -". Suggested by Han Boetes. + (tramp-uudecode): Mention `uudecode -o /dev/stdout'. + +2004-11-06 David Ponce <david@dponce.com> + + * recentf.el (recentf-menu-path): Use menu item name. + +2004-11-06 Eli Zaretskii <eliz@gnu.org> + + * progmodes/gdb-ui.el: Don't call define-fringe-bitmap if the + display doesn't support images. + +2004-11-06 Andreas Schwab <schwab@suse.de> + + * tempo.el (tempo-match-finder): Doc fix. + + * emacs-lisp/easymenu.el (easy-menu-get-map): Fix last change. + +2004-11-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/easymenu.el (easy-menu-get-map-look-for-name): Remove. + (easy-menu-lookup-name): New fun to replace it. + (easy-menu-get-map): Use it to obey menu item names (rather than just + keys) when looking up `path'. + (easy-menu-always-true-p): Rename from easy-menu-always-true. + (easy-menu-convert-item-1): Adjust to new name. + +2004-11-06 Peter Heslin <pj@heslin.eclipse.co.uk> (tiny change) + + * outline.el (hide-body): Don't hide lines at the top of the file + that precede the first header line. + +2004-11-06 Paul Pogonyshev <pogonyshev@gmx.net> + + * align.el (align-areas): Delete whitespace before reindenting, so + that tabs are never placed after spaces. + +2004-11-06 Alan Shutko <ats@acm.org> + + * macros.el (insert-kbd-macro): Do completions based on macros, + rather than all commands. + +2004-11-06 David Hansen <david.hansen@gmx.net> (tiny change) + + * tempo.el (tempo-match-finder): Use [:word:] instead of "^\\b", + to solve a bug whereby tags with 'b' don't match. + +2004-11-05 Juri Linkov <juri@jurta.org> + + * info.el (Info-search): Don't search in node header lines + and file headers. + + * emacs-lisp/edebug.el (edebug-next-token-class): Allow all + symbol-constituent characters after dot, not only digits. + +2004-11-04 Daniel Pfeiffer <occitan@esperanto.org> + + * files.el (set-auto-mode): Don't get error after setting -*-mode-*-. + +2004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * dired.el (dired-read-dir-and-switches): Call read-directory-name + if a dialog will be used, read-file-name otherwise. + +2004-11-04 Richard M. Stallman <rms@gnu.org> + + * textmodes/table.el (table group): Add :version. + + * textmodes/ispell.el (ispell-word): + Don't alter args; set them only thru `interactive' spec. + + * textmodes/flyspell.el (flyspell-word): + Don't alter FOLLOWING; set it only thru `interactive' spec. + + * progmodes/f90.el (f90-end-of-block): Don't use interactive-p. + + * net/browse-url.el (browse-url-maybe-new-window): + Use called-interactively-p. + + * mail/supercite.el (sc-cite-region): + Don't use interactive-p. Add arg INTERACTIVE. + (sc-version): Don't use interactive-p. Rename arg to MESSAGE. + + * international/mule-cmds.el (set-input-method, toggle-input-method): + Don't use interactive-p. Add arg INTERACTIVE. + + * eshell/esh-mode.el (eshell-show-maximum-output): + Don't use interactive-p. + (eshell-truncate-buffer): Just message, no error, if buffer is short. + + * mouse.el (mouse-show-mark): Get positions to delete from mark + and point, not from mouse-drag-overlay. + + * imenu.el (imenu-eager-completion-buffer): Add :version. + + * filesets.el (filesets group): Add :version. + 2004-11-03 Daniel Pfeiffer <occitan@esperanto.org> * files.el (xml-based-modes): Delete var. @@ -28,6 +462,12 @@ 2004-11-02 Richard M. Stallman <rms@gnu.org> + * cus-edit.el (customize-group-other-window): + Select the window that displays the custom buffer. + (custom-buffer-create-other-window): Likewise. + + * comint.el (comint-insert-input): Fix previous change. + * emacs-lisp/elp.el (elp-instrument-function): Use called-interactively-p. @@ -74,8 +514,7 @@ (icalendar-convert-diary-to-ical) (icalendar-extract-ical-from-buffer): Use only two args for make-obsolete (XEmacs compatibility). - (icalendar-export-file, icalendar-import-file): Blank at end of - prompt. + (icalendar-export-file, icalendar-import-file): Blank at end of prompt. (icalendar-export-region): Doc fix. If error, return non-nil and write errors to a buffer. Use correct weekday for weekly recurring events. @@ -115,16 +554,16 @@ 2004-11-02 Pavel Kobiakov <pk_at_work@yahoo.com> - * progmodes/flymake.el (flymake-err-line-patterns): Use - `flymake-reformat-err-line-patterns-from-compile-el' to convert + * progmodes/flymake.el (flymake-err-line-patterns): + Use `flymake-reformat-err-line-patterns-from-compile-el' to convert `compilation-error-regexp-alist-alist' to internal Flymake format. * progmodes/flymake.el: eliminated byte-compiler warnings. 2004-11-01 Jay Belanger <belanger@truman.edu> - * calc/calc-frac.el (calc-over-notation): Replaced - `completing-read' with `interactive "s"'. + * calc/calc-frac.el (calc-over-notation): Replace `completing-read' + with `interactive "s"'. 2004-11-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
--- a/lisp/ChangeLog.10 Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/ChangeLog.10 Fri Nov 12 02:53:04 2004 +0000 @@ -4150,6 +4150,7 @@ (desktop-path): New customizable variable. List of directories in which to lookup the desktop file. Replaces hardcoded list. (desktop-globals-to-clear): New variable replaces hardcoded list. + (desktop-globals-to-save): Variable made customizable. (desktop-clear-preserve-buffers-regexp): New customizable variable. (desktop-after-read-hook): New hook run after a desktop is read. (desktop-no-desktop-file-hook): New hook when no desktop file found.
--- a/lisp/ChangeLog.7 Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/ChangeLog.7 Fri Nov 12 02:53:04 2004 +0000 @@ -23104,8 +23104,8 @@ * message.el (message-mode): Delete abbrev mode initialization. (message-mode-hook): Move it here, instead, so the user can override it. - (message-y-or-n-p, message-talkative-question, - message-flatten-list, message-flatten-list-1): Move utility + (message-y-or-n-p, message-talkative-question) + (message-flatten-list, message-flatten-list-1): Move utility functions up so macro is defined before first invocation. * f90.el (f90-auto-fill-mode): Function deleted, all references @@ -23115,24 +23115,23 @@ 1996-08-13 Torbjorn Einarsson <etxeina@etxdn.ericsson.se> - * f90.el: (f90-do-auto-fill): Fixed bug which made program hang for + * f90.el: (f90-do-auto-fill): Fix bug which made program hang for space in fill-column. (f90-font-lock-keywords-1): Now we have common font-lock exps for Emacs and XEmacs - (f90-font-lock-keywords-2): Changed reg-exp for line number. A - number must be followed by a letter to be highlighted. Fixed - highlighting of declarations with trailing comments. - (f90-match-end): Fixed bug due to new message syntax. - (f90-mode): Fixed setup of variable font-lock-defaults. + (f90-font-lock-keywords-2): Change reg-exp for line number. + A number must be followed by a letter to be highlighted. + Fix highlighting of declarations with trailing comments. + (f90-match-end): Fix bug due to new message syntax. + (f90-mode): Fix setup of variable font-lock-defaults. (f90-looking-at-program-block-start): Small error in detecting of function start. Made the detection of subroutine start more flexible. (f90-mode-map): Much nicer menu with sections and added submenus for highlighting and keyword case change. Also added 'menu-enable' properties for region-based commands. - (f90-imenu-generic-expression): Fixed expression to find + (f90-imenu-generic-expression): Fix expression to find procedures, modules and types. - (f90-add-imenu-menu): New function for adding imenu menu to the - menubar. + (f90-add-imenu-menu): New function for adding imenu menu to the menubar. 1996-08-13 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
--- a/lisp/Makefile.in Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/Makefile.in Fri Nov 12 02:53:04 2004 +0000 @@ -309,9 +309,12 @@ fi \ fi -maintainer-clean: +maintainer-clean: distclean cd $(lisp); rm -f *.elc */*.elc $(AUTOGENEL) +bootstrap-clean: + cd $(lisp); rm -f *.elc */*.elc + # Generate/update files for the bootstrap process. bootstrap: update-subdirs autoloads compile
--- a/lisp/align.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/align.el Fri Nov 12 02:53:04 2004 +0000 @@ -1212,6 +1212,14 @@ (cond ((< gocol 0) t) ; don't do anything ((= cur gocol) t) ; don't need to ((< cur gocol) ; just add space + ;; FIXME: It is stated above that "...the + ;; whitespace to be modified was already + ;; deleted by `align-region', all we have + ;; to do here is indent." However, this + ;; doesn't seem to be true, so we first + ;; delete the whitespace to avoid tabs + ;; after spaces. + (delete-horizontal-space t) (indent-to gocol)) (t ;; This code works around an oddity in the
--- a/lisp/calc/calc-aent.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-aent.el Fri Nov 12 02:53:04 2004 +0000 @@ -101,10 +101,7 @@ (message "Result: %s" buf))) (if (eq last-command-char 10) (insert shortbuf) - (setq kill-ring (cons shortbuf kill-ring)) - (when (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) - (setq kill-ring-yank-pointer kill-ring))))) + (kill-new shortbuf))))) (defun calc-do-calc-eval (str separator args) (calc-check-defines) @@ -301,10 +298,12 @@ (defvar calc-alg-ent-esc-map nil "The keymap used for escapes in algebraic entry.") +(defvar calc-alg-exp) + (defun calc-do-alg-entry (&optional initial prompt no-normalize) (let* ((calc-buffer (current-buffer)) (blink-paren-function 'calcAlg-blink-matching-open) - (alg-exp 'error)) + (calc-alg-exp 'error)) (unless calc-alg-ent-map (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) (define-key calc-alg-ent-map "'" 'calcAlg-previous) @@ -328,13 +327,13 @@ (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") (or initial "") calc-alg-ent-map nil))) - (when (eq alg-exp 'error) - (when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error) - (setq alg-exp nil))) + (when (eq calc-alg-exp 'error) + (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error) + (setq calc-alg-exp nil))) (setq calc-aborted-prefix "alg'") (or no-normalize - (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) - alg-exp))) + (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp)))) + calc-alg-exp))) (defun calcAlg-plus-minus () (interactive) @@ -364,8 +363,8 @@ (interactive) (unwind-protect (calcAlg-enter) - (if (consp alg-exp) - (progn (setq prefix-arg (length alg-exp)) + (if (consp calc-alg-exp) + (progn (setq prefix-arg (length calc-alg-exp)) (calc-unread-command ?=))))) (defun calcAlg-escape () @@ -383,8 +382,8 @@ (calc-minibuffer-contains "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) (insert "`") - (setq alg-exp (minibuffer-contents)) - (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) + (setq calc-alg-exp (minibuffer-contents)) + (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp)) (exit-minibuffer))) (defun calcAlg-enter () @@ -402,7 +401,7 @@ (calc-temp-minibuffer-message (concat " [" (or (nth 2 exp) "Error") "]")) (calc-clear-unread-commands)) - (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") + (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") '((incomplete vec)) exp)) (and (> (length str) 0) (setq calc-previous-alg-entry str)) @@ -460,30 +459,39 @@ ;;; Algebraic expression parsing. [Public] -(defun math-read-exprs (exp-str) - (let ((exp-pos 0) - (exp-old-pos 0) - (exp-keep-spaces nil) - exp-token exp-data) +;;; The next few variables are local to math-read-exprs (and math-read-expr) +;;; but are set in functions they call. + +(defvar math-exp-pos) +(defvar math-exp-str) +(defvar math-exp-old-pos) +(defvar math-exp-token) +(defvar math-exp-keep-spaces) + +(defun math-read-exprs (math-exp-str) + (let ((math-exp-pos 0) + (math-exp-old-pos 0) + (math-exp-keep-spaces nil) + math-exp-token math-expr-data) (if calc-language-input-filter - (setq exp-str (funcall calc-language-input-filter exp-str))) - (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) - (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" - (substring exp-str (+ exp-token 2))))) + (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" + (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) (math-read-token) (let ((val (catch 'syntax (math-read-expr-list)))) (if (stringp val) - (list 'error exp-old-pos val) - (if (equal exp-token 'end) + (list 'error math-exp-old-pos val) + (if (equal math-exp-token 'end) val - (list 'error exp-old-pos "Syntax error")))))) + (list 'error math-exp-old-pos "Syntax error")))))) (defun math-read-expr-list () - (let* ((exp-keep-spaces nil) + (let* ((math-exp-keep-spaces nil) (val (list (math-read-expr-level 0))) (last val)) - (while (equal exp-data ",") + (while (equal math-expr-data ",") (math-read-token) (let ((rest (list (math-read-expr-level 0)))) (setcdr last rest) @@ -496,20 +504,23 @@ (defvar calc-user-tokens nil) (defvar calc-user-token-chars nil) +(defvar math-toks nil + "Tokens to pass between math-build-parse-table and math-find-user-tokens.") + (defun math-build-parse-table () (let ((mtab (cdr (assq nil calc-user-parse-tables))) (ltab (cdr (assq calc-language calc-user-parse-tables)))) (or (and (eq mtab calc-last-main-parse-table) (eq ltab calc-last-lang-parse-table)) (let ((p (append mtab ltab)) - (toks nil)) + (math-toks nil)) (setq calc-user-parse-table p) (setq calc-user-token-chars nil) (while p (math-find-user-tokens (car (car p))) (setq p (cdr p))) (setq calc-user-tokens (mapconcat 'identity - (sort (mapcar 'car toks) + (sort (mapcar 'car math-toks) (function (lambda (x y) (> (length x) (length y))))) @@ -517,7 +528,7 @@ calc-last-main-parse-table mtab calc-last-lang-parse-table ltab))))) -(defun math-find-user-tokens (p) ; uses "toks" +(defun math-find-user-tokens (p) (while p (cond ((and (stringp (car p)) (or (> (length (car p)) 1) (equal (car p) "$") @@ -528,9 +539,9 @@ (setq s (concat "\\<" s))) (if (string-match "[a-zA-Z0-9]\\'" s) (setq s (concat s "\\>"))) - (or (assoc s toks) + (or (assoc s math-toks) (progn - (setq toks (cons (list s) toks)) + (setq math-toks (cons (list s) math-toks)) (or (memq (aref (car p) 0) calc-user-token-chars) (setq calc-user-token-chars (cons (aref (car p) 0) @@ -542,161 +553,168 @@ (setq p (cdr p)))) (defun math-read-token () - (if (>= exp-pos (length exp-str)) - (setq exp-old-pos exp-pos - exp-token 'end - exp-data "\000") - (let ((ch (aref exp-str exp-pos))) - (setq exp-old-pos exp-pos) + (if (>= math-exp-pos (length math-exp-str)) + (setq math-exp-old-pos math-exp-pos + math-exp-token 'end + math-expr-data "\000") + (let ((ch (aref math-exp-str math-exp-pos))) + (setq math-exp-old-pos math-exp-pos) (cond ((memq ch '(32 10 9)) - (setq exp-pos (1+ exp-pos)) - (if exp-keep-spaces - (setq exp-token 'space - exp-data " ") + (setq math-exp-pos (1+ math-exp-pos)) + (if math-exp-keep-spaces + (setq math-exp-token 'space + math-expr-data " ") (math-read-token))) ((and (memq ch calc-user-token-chars) (let ((case-fold-search nil)) - (eq (string-match calc-user-tokens exp-str exp-pos) - exp-pos))) - (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (eq (string-match calc-user-tokens math-exp-str math-exp-pos) + math-exp-pos))) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((or (and (>= ch ?a) (<= ch ?z)) (and (>= ch ?A) (<= ch ?Z))) (string-match (if (memq calc-language '(c fortran pascal maple)) "[a-zA-Z0-9_#]*" "[a-zA-Z0-9'#]*") - exp-str exp-pos) - (setq exp-token 'symbol - exp-pos (match-end 0) - exp-data (math-restore-dashes - (math-match-substring exp-str 0))) + math-exp-str math-exp-pos) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) + math-expr-data (math-restore-dashes + (math-match-substring math-exp-str 0))) (if (eq calc-language 'eqn) - (let ((code (assoc exp-data math-eqn-ignore-words))) + (let ((code (assoc math-expr-data math-eqn-ignore-words))) (cond ((null code)) ((null (cdr code)) (math-read-token)) ((consp (nth 1 code)) (math-read-token) - (if (assoc exp-data (cdr code)) - (setq exp-data (format "%s %s" - (car code) exp-data)))) + (if (assoc math-expr-data (cdr code)) + (setq math-expr-data (format "%s %s" + (car code) math-expr-data)))) ((eq (nth 1 code) 'punc) - (setq exp-token 'punc - exp-data (nth 2 code))) + (setq math-exp-token 'punc + math-expr-data (nth 2 code))) (t (math-read-token) (math-read-token)))))) ((or (and (>= ch ?0) (<= ch ?9)) (and (eq ch '?\.) - (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos)) + (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos) + math-exp-pos)) (and (eq ch '?_) - (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos) - (or (eq exp-pos 0) + (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) + math-exp-pos) + (or (eq math-exp-pos 0) (and (memq calc-language '(nil flat big unform tex eqn)) (eq (string-match "[^])}\"a-zA-Z0-9'$]_" - exp-str (1- exp-pos)) - (1- exp-pos)))))) + math-exp-str (1- math-exp-pos)) + (1- math-exp-pos)))))) (or (and (eq calc-language 'c) - (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos)) - (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" exp-str exp-pos)) - (setq exp-token 'number - exp-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) + (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" + math-exp-str math-exp-pos)) + (setq math-exp-token 'number + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((eq ch ?\$) (if (and (eq calc-language 'pascal) (eq (string-match "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" - exp-str exp-pos) - exp-pos)) - (setq exp-token 'number - exp-data (math-match-substring exp-str 1) - exp-pos (match-end 1)) - (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos) - exp-pos) - (setq exp-data (- (string-to-int (math-match-substring - exp-str 1)))) - (string-match "\\$+" exp-str exp-pos) - (setq exp-data (- (match-end 0) (match-beginning 0)))) - (setq exp-token 'dollar - exp-pos (match-end 0)))) + math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'number + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 1)) + (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) + math-exp-pos) + (setq math-expr-data (- (string-to-int (math-match-substring + math-exp-str 1)))) + (string-match "\\$+" math-exp-str math-exp-pos) + (setq math-expr-data (- (match-end 0) (match-beginning 0)))) + (setq math-exp-token 'dollar + math-exp-pos (match-end 0)))) ((eq ch ?\#) - (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos) - exp-pos) - (setq exp-data (string-to-int - (math-match-substring exp-str 1)) - exp-pos (match-end 0)) - (setq exp-data 1 - exp-pos (1+ exp-pos))) - (setq exp-token 'hash)) + (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) + math-exp-pos) + (setq math-expr-data (string-to-int + (math-match-substring math-exp-str 1)) + math-exp-pos (match-end 0)) + (setq math-expr-data 1 + math-exp-pos (1+ math-exp-pos))) + (setq math-exp-token 'hash)) ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>" - exp-str exp-pos) - exp-pos) - (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((and (eq ch ?\") - (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos)) + (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" + math-exp-str math-exp-pos)) (if (eq calc-language 'eqn) (progn - (setq exp-str (copy-sequence exp-str)) - (aset exp-str (match-beginning 1) ?\{) - (if (< (match-end 1) (length exp-str)) - (aset exp-str (match-end 1) ?\})) + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str (match-beginning 1) ?\{) + (if (< (match-end 1) (length math-exp-str)) + (aset math-exp-str (match-end 1) ?\})) (math-read-token)) - (setq exp-token 'string - exp-data (math-match-substring exp-str 1) - exp-pos (match-end 0)))) + (setq math-exp-token 'string + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 0)))) ((and (= ch ?\\) (eq calc-language 'tex) - (< exp-pos (1- (length exp-str)))) - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos)) - (setq exp-token 'symbol - exp-pos (match-end 0) - exp-data (math-restore-dashes - (math-match-substring exp-str 1))) - (let ((code (assoc exp-data math-tex-ignore-words))) + (< math-exp-pos (1- (length math-exp-str)))) + (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + math-exp-str math-exp-pos) + (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + math-exp-str math-exp-pos)) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) + math-expr-data (math-restore-dashes + (math-match-substring math-exp-str 1))) + (let ((code (assoc math-expr-data math-tex-ignore-words))) (cond ((null code)) ((null (cdr code)) (math-read-token)) ((eq (nth 1 code) 'punc) - (setq exp-token 'punc - exp-data (nth 2 code))) + (setq math-exp-token 'punc + math-expr-data (nth 2 code))) ((and (eq (nth 1 code) 'mat) - (string-match " *{" exp-str exp-pos)) - (setq exp-pos (match-end 0) - exp-token 'punc - exp-data "[") - (let ((right (string-match "}" exp-str exp-pos))) + (string-match " *{" math-exp-str math-exp-pos)) + (setq math-exp-pos (match-end 0) + math-exp-token 'punc + math-expr-data "[") + (let ((right (string-match "}" math-exp-str math-exp-pos))) (and right - (setq exp-str (copy-sequence exp-str)) - (aset exp-str right ?\]))))))) + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str right ?\]))))))) ((and (= ch ?\.) (eq calc-language 'fortran) (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." - exp-str exp-pos) exp-pos)) - (setq exp-token 'punc - exp-data (upcase (math-match-substring exp-str 0)) - exp-pos (match-end 0))) + math-exp-str math-exp-pos) math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (upcase (math-match-substring math-exp-str 0)) + math-exp-pos (match-end 0))) ((and (eq calc-language 'math) - (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos) - exp-pos)) - (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((and (eq calc-language 'eqn) (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" - exp-str exp-pos) - exp-pos)) - (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) - exp-pos (match-end 0)) - (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos) - (setq exp-pos (match-end 0))) - (if (memq (aref exp-data 0) '(?~ ?^)) + math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0)) + (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-pos (match-end 0))) + (if (memq (aref math-expr-data 0) '(?~ ?^)) (math-read-token))) - ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos) - (setq exp-pos (match-end 0)) + ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) + (setq math-exp-pos (match-end 0)) (math-read-token)) (t (if (and (eq ch ?\{) (memq calc-language '(tex eqn))) @@ -705,9 +723,9 @@ (setq ch ?\))) (if (and (eq ch ?\&) (eq calc-language 'tex)) (setq ch ?\,)) - (setq exp-token 'punc - exp-data (char-to-string ch) - exp-pos (1+ exp-pos))))))) + (setq math-exp-token 'punc + math-expr-data (char-to-string ch) + math-exp-pos (1+ math-exp-pos))))))) (defun math-read-expr-level (exp-prec &optional exp-term) @@ -716,10 +734,10 @@ (setq op (calc-check-user-syntax x exp-prec)) (setq x op op '("2x" ident 999999 -1))) - (and (setq op (assoc exp-data math-expr-opers)) + (and (setq op (assoc math-expr-data math-expr-opers)) (/= (nth 2 op) -1) (or (and (setq op2 (assoc - exp-data + math-expr-data (cdr (memq op math-expr-opers)))) (eq (= (nth 3 op) -1) (/= (nth 3 op2) -1)) @@ -728,27 +746,27 @@ (setq op op2)) t)) (and (or (eq (nth 2 op) -1) - (memq exp-token '(symbol number dollar hash)) - (equal exp-data "(") - (and (equal exp-data "[") + (memq math-exp-token '(symbol number dollar hash)) + (equal math-expr-data "(") + (and (equal math-expr-data "[") (not (eq calc-language 'math)) - (not (and exp-keep-spaces + (not (and math-exp-keep-spaces (eq (car-safe x) 'vec))))) - (or (not (setq op (assoc exp-data math-expr-opers))) + (or (not (setq op (assoc math-expr-data math-expr-opers))) (/= (nth 2 op) -1)) (or (not calc-user-parse-table) - (not (eq exp-token 'symbol)) + (not (eq math-exp-token 'symbol)) (let ((p calc-user-parse-table)) (while (and p (or (not (integerp (car (car (car p))))) (not (equal (nth 1 (car (car p))) - exp-data)))) + math-expr-data)))) (setq p (cdr p))) (not p))) (setq op (assoc "2x" math-expr-opers)))) - (not (and exp-term (equal exp-data exp-term))) + (not (and exp-term (equal math-expr-data exp-term))) (>= (nth 2 op) exp-prec)) (if (not (equal (car op) "2x")) (math-read-token)) @@ -787,13 +805,13 @@ (if x (and (integerp (car rule)) (>= (car rule) prec) - (equal exp-data + (equal math-expr-data (car (setq rule (cdr rule))))) - (equal exp-data (car rule))))) - (let ((save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) - (save-exp-data exp-data)) + (equal math-expr-data (car rule))))) + (let ((save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) + (save-exp-data math-expr-data)) (or (not (listp (setq matches (calc-match-user-syntax rule)))) (let ((args (progn @@ -856,22 +874,23 @@ (if match (not (setq match (math-multi-subst match args matches))) - (setq exp-old-pos save-exp-old-pos - exp-token save-exp-token - exp-data save-exp-data - exp-pos save-exp-pos))))))) + (setq math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token + math-expr-data save-exp-data + math-exp-pos save-exp-pos))))))) (setq p (cdr p))) (and p match))) (defun calc-match-user-syntax (p &optional term) (let ((matches nil) - (save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) - (save-exp-data exp-data)) + (save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) + (save-exp-data math-expr-data) + m) (while (and p (cond ((stringp (car p)) - (and (equal exp-data (car p)) + (and (equal math-expr-data (car p)) (progn (math-read-token) t))) @@ -895,7 +914,7 @@ (cons 'vec (and (listp m) m)))))) (or (listp m) (not (nth 2 (car p))) (not (eq (aref (car (nth 2 (car p))) 0) ?\$)) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (t (setq m (calc-match-user-syntax (nth 1 (car p)) (car (nth 2 (car p))))) @@ -903,22 +922,22 @@ (let ((vec (cons 'vec m)) opos mm) (while (and (listp - (setq opos exp-pos + (setq opos math-exp-pos mm (calc-match-user-syntax (or (nth 2 (car p)) (nth 1 (car p))) (car (nth 2 (car p)))))) - (> exp-pos opos)) + (> math-exp-pos opos)) (setq vec (nconc vec mm))) (setq matches (nconc matches (list vec)))) (and (eq (car (car p)) '*) (setq matches (nconc matches (list '(vec))))))))) (setq p (cdr p))) (if p - (setq exp-pos save-exp-pos - exp-old-pos save-exp-old-pos - exp-token save-exp-token - exp-data save-exp-data + (setq math-exp-pos save-exp-pos + math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token + math-expr-data save-exp-data matches "Failed")) matches)) @@ -940,28 +959,28 @@ (defun math-read-if (cond op) (let ((then (math-read-expr-level 0))) - (or (equal exp-data ":") + (or (equal math-expr-data ":") (throw 'syntax "Expected ':'")) (math-read-token) (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) (defun math-factor-after () - (let ((exp-pos exp-pos) - exp-old-pos exp-token exp-data) + (let ((math-exp-pos math-exp-pos) + math-exp-old-pos math-exp-token math-expr-data) (math-read-token) - (or (memq exp-token '(number symbol dollar hash string)) - (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) - (assoc (concat "u" exp-data) math-expr-opers)) - (eq (nth 2 (assoc exp-data math-expr-opers)) -1) - (assoc exp-data '(("(") ("[") ("{")))))) + (or (memq math-exp-token '(number symbol dollar hash string)) + (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/"))) + (assoc (concat "u" math-expr-data) math-expr-opers)) + (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1) + (assoc math-expr-data '(("(") ("[") ("{")))))) (defun math-read-factor () (let (op) - (cond ((eq exp-token 'number) - (let ((num (math-read-number exp-data))) + (cond ((eq math-exp-token 'number) + (let ((num (math-read-number math-expr-data))) (if (not num) (progn - (setq exp-old-pos exp-pos) + (setq math-exp-old-pos math-exp-pos) (throw 'syntax "Bad format"))) (math-read-token) (if (and math-read-expr-quotes @@ -971,14 +990,14 @@ ((and calc-user-parse-table (setq op (calc-check-user-syntax))) op) - ((or (equal exp-data "-") - (equal exp-data "+") - (equal exp-data "!") - (equal exp-data "|") - (equal exp-data "/")) - (setq exp-data (concat "u" exp-data)) + ((or (equal math-expr-data "-") + (equal math-expr-data "+") + (equal math-expr-data "!") + (equal math-expr-data "|") + (equal math-expr-data "/")) + (setq math-expr-data (concat "u" math-expr-data)) (math-read-factor)) - ((and (setq op (assoc exp-data math-expr-opers)) + ((and (setq op (assoc math-expr-data math-expr-opers)) (eq (nth 2 op) -1)) (if (consp (nth 1 op)) (funcall (car (nth 1 op)) op) @@ -990,20 +1009,20 @@ (equal (car op) "u-")) (math-neg val)) (t (list (nth 1 op) val)))))) - ((eq exp-token 'symbol) - (let ((sym (intern exp-data))) + ((eq math-exp-token 'symbol) + (let ((sym (intern math-expr-data))) (math-read-token) - (if (equal exp-data calc-function-open) + (if (equal math-expr-data calc-function-open) (let ((f (assq sym math-expr-function-mapping))) (math-read-token) (if (consp (cdr f)) (funcall (car (cdr f)) f sym) - (let ((args (if (or (equal exp-data calc-function-close) - (eq exp-token 'end)) + (let ((args (if (or (equal math-expr-data calc-function-close) + (eq math-exp-token 'end)) nil (math-read-expr-list)))) - (if (not (or (equal exp-data calc-function-close) - (eq exp-token 'end))) + (if (not (or (equal math-expr-data calc-function-close) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) (if (and (eq calc-language 'fortran) args @@ -1045,44 +1064,44 @@ 4)) (cdr v)))))) (while (and (memq calc-language '(c pascal maple)) - (equal exp-data "[")) + (equal math-expr-data "[")) (math-read-token) (setq val (append (list 'calcFunc-subscr val) (math-read-expr-list))) - (if (equal exp-data "]") + (if (equal math-expr-data "]") (math-read-token) (throw 'syntax "Expected ']'"))) val))))) - ((eq exp-token 'dollar) - (let ((abs (if (> exp-data 0) exp-data (- exp-data)))) + ((eq math-exp-token 'dollar) + (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data)))) (if (>= (length calc-dollar-values) abs) - (let ((num exp-data)) + (let ((num math-expr-data)) (math-read-token) (setq calc-dollar-used (max calc-dollar-used num)) (math-check-complete (nth (1- abs) calc-dollar-values))) (throw 'syntax (if calc-dollar-values "Too many $'s" "$'s not allowed in this context"))))) - ((eq exp-token 'hash) + ((eq math-exp-token 'hash) (or calc-hashes-used (throw 'syntax "#'s not allowed in this context")) (calc-extensions) - (if (<= exp-data (length calc-arg-values)) - (let ((num exp-data)) + (if (<= math-expr-data (length calc-arg-values)) + (let ((num math-expr-data)) (math-read-token) (setq calc-hashes-used (max calc-hashes-used num)) (nth (1- num) calc-arg-values)) (throw 'syntax "Too many # arguments"))) - ((equal exp-data "(") - (let* ((exp (let ((exp-keep-spaces nil)) + ((equal math-expr-data "(") + (let* ((exp (let ((math-exp-keep-spaces nil)) (math-read-token) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) '(neg (var inf var-inf)) (math-read-expr-level 0))))) - (let ((exp-keep-spaces nil)) + (let ((math-exp-keep-spaces nil)) (cond - ((equal exp-data ",") + ((equal math-expr-data ",") (progn (math-read-token) (let ((exp2 (math-read-expr-level 0))) @@ -1090,7 +1109,7 @@ (if (and exp2 (Math-realp exp) (Math-realp exp2)) (math-normalize (list 'cplx exp exp2)) (list '+ exp (list '* exp2 '(var i var-i)))))))) - ((equal exp-data ";") + ((equal math-expr-data ";") (progn (math-read-token) (let ((exp2 (math-read-expr-level 0))) @@ -1103,36 +1122,36 @@ (list '* (math-to-radians-2 exp2) '(var i var-i))))))))) - ((or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + ((or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) (progn (math-read-token) - (let ((exp2 (if (or (equal exp-data ")") - (equal exp-data "]") - (eq exp-token 'end)) + (let ((exp2 (if (or (equal math-expr-data ")") + (equal math-expr-data "]") + (eq math-exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq exp (list 'intv - (if (equal exp-data ")") 0 1) + (if (equal math-expr-data ")") 0 1) exp exp2))))))) - (if (not (or (equal exp-data ")") - (and (equal exp-data "]") (eq (car-safe exp) 'intv)) - (eq exp-token 'end))) + (if (not (or (equal math-expr-data ")") + (and (equal math-expr-data "]") (eq (car-safe exp) 'intv)) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) exp)) - ((eq exp-token 'string) + ((eq math-exp-token 'string) (calc-extensions) (math-read-string)) - ((equal exp-data "[") + ((equal math-expr-data "[") (calc-extensions) (math-read-brackets t "]")) - ((equal exp-data "{") + ((equal math-expr-data "{") (calc-extensions) (math-read-brackets nil "}")) - ((equal exp-data "<") + ((equal math-expr-data "<") (calc-extensions) (math-read-angle-brackets)) (t (throw 'syntax "Expected a number")))))
--- a/lisp/calc/calc-comb.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-comb.el Fri Nov 12 02:53:04 2004 +0000 @@ -82,6 +82,11 @@ 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003]) +;; The variable math-prime-factors-finished is set by calcFunc-prfac to +;; indicate whether factoring is complete, and used by calcFunc-factors, +;; calcFunc-totient and calcFunc-moebius. +(defvar math-prime-factors-finished) + ;;; Combinatorics (defun calc-gcd (arg) @@ -195,6 +200,8 @@ (res (math-prime-test n iters))) (calc-report-prime-test res)))) +(defvar calc-verbose-nextprime nil) + (defun calc-next-prime (iters) (interactive "p") (calc-slow-wrapper @@ -386,7 +393,7 @@ (if (math-evenp temp) even (math-div (calcFunc-fact n) even)))) - (list 'calcFunc-dfact max)))) + (list 'calcFunc-dfact n)))) ((equal n '(var inf var-inf)) n) (t (calc-record-why 'natnump n) (list 'calcFunc-dfact n)))) @@ -484,6 +491,12 @@ (math-stirling-number n m 0)) (defvar math-stirling-cache (vector [[1]] [[1]])) + +;; The variable math-stirling-local-cache is local to +;; math-stirling-number, but is used by math-stirling-1 +;; and math-stirling-2, which are called by math-stirling-number. +(defvar math-stirling-local-cache) + (defun math-stirling-number (n m k) (or (math-num-natnump n) (math-reject-arg n 'natnump)) (or (math-num-natnump m) (math-reject-arg m 'natnump)) @@ -493,14 +506,16 @@ (or (integerp m) (math-reject-arg m 'fixnump)) (if (< n m) 0 - (let ((cache (aref math-stirling-cache k))) - (while (<= (length cache) n) - (let ((i (1- (length cache))) + (let ((math-stirling-local-cache (aref math-stirling-cache k))) + (while (<= (length math-stirling-local-cache) n) + (let ((i (1- (length math-stirling-local-cache))) row) - (setq cache (vconcat cache (make-vector (length cache) nil))) - (aset math-stirling-cache k cache) - (while (< (setq i (1+ i)) (length cache)) - (aset cache i (setq row (make-vector (1+ i) nil))) + (setq math-stirling-local-cache + (vconcat math-stirling-local-cache + (make-vector (length math-stirling-local-cache) nil))) + (aset math-stirling-cache k math-stirling-local-cache) + (while (< (setq i (1+ i)) (length math-stirling-local-cache)) + (aset math-stirling-local-cache i (setq row (make-vector (1+ i) nil))) (aset row 0 0) (aset row i 1)))) (if (= k 1) @@ -508,14 +523,14 @@ (math-stirling-2 n m))))) (defun math-stirling-1 (n m) - (or (aref (aref cache n) m) - (aset (aref cache n) m + (or (aref (aref math-stirling-local-cache n) m) + (aset (aref math-stirling-local-cache n) m (math-add (math-stirling-1 (1- n) (1- m)) (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) (defun math-stirling-2 (n m) - (or (aref (aref cache n) m) - (aset (aref cache n) m + (or (aref (aref math-stirling-local-cache n) m) + (aset (aref math-stirling-local-cache n) m (math-add (math-stirling-2 (1- n) (1- m)) (math-mul m (math-stirling-2 (1- n) m)))))) @@ -527,8 +542,13 @@ ;;; Produce a random 10-bit integer, with (random) if no seed provided, ;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. + +(defvar var-RandSeed nil) +(defvar math-random-cache nil) +(defvar math-gaussian-cache nil) + (defun math-init-random-base () - (if (and (boundp 'var-RandSeed) var-RandSeed) + (if var-RandSeed (if (eq (car-safe var-RandSeed) 'vec) nil (if (Math-integerp var-RandSeed) @@ -555,13 +575,13 @@ (random t) (setq var-RandSeed nil math-random-cache nil - i 0 math-random-shift -4) ; assume RAND_MAX >= 16383 ;; This exercises the random number generator and also helps ;; deduce a better value for RAND_MAX. - (while (< (setq i (1+ i)) 30) - (if (> (lsh (math-abs (random)) math-random-shift) 4095) - (setq math-random-shift (1- math-random-shift))))) + (let ((i 0)) + (while (< (setq i (1+ i)) 30) + (if (> (lsh (math-abs (random)) math-random-shift) 4095) + (setq math-random-shift (1- math-random-shift)))))) (setq math-last-RandSeed var-RandSeed math-gaussian-cache nil)) @@ -583,8 +603,8 @@ ;;; Avoid various pitfalls that may lurk in the built-in (random) function! ;;; Shuffling algorithm from Numerical Recipes, section 7.1. (defun math-random-digit () - (let (i) - (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) + (let (i math-random-last) + (or (eq var-RandSeed math-last-RandSeed) (math-init-random-base)) (or math-random-cache (progn @@ -599,7 +619,6 @@ (aset math-random-cache i (math-random-base)) (>= math-random-last 1000))) math-random-last)) -(setq math-random-cache nil) ;;; Produce an N-digit random integer. (defun math-random-digits (n) @@ -639,7 +658,6 @@ (setq math-gaussian-cache (cons calc-internal-prec (math-mul v1 fac))) (math-mul v2 fac)))))) -(setq math-gaussian-cache nil) ;;; Produce a random integer or real 0 <= N < MAX. (defun calcFunc-random (max) @@ -765,6 +783,12 @@ ;;; (nil unknown) if non-prime with no known factors, ;;; (t) if prime, ;;; (maybe N P) if probably prime (after N iters with probability P%) +(defvar math-prime-test-cache '(-1)) + +(defvar math-prime-test-cache-k) +(defvar math-prime-test-cache-q) +(defvar math-prime-test-cache-nm1) + (defun math-prime-test (n iters) (if (and (Math-vectorp n) (cdr n)) (setq n (nth (1- (length n)) n))) @@ -849,7 +873,6 @@ (1- iters) 0))) res)) -(defvar math-prime-test-cache '(-1)) (defun calcFunc-prime (n &optional iters) (or (math-num-integerp n) (math-reject-arg n 'integerp)) @@ -965,7 +988,6 @@ (if (Math-realp n) (calcFunc-nextprime (math-trunc n) iters) (math-reject-arg n 'integerp)))) -(setq calc-verbose-nextprime nil) (defun calcFunc-prevprime (n &optional iters) (if (Math-integerp n)
--- a/lisp/calc/calc-ext.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-ext.el Fri Nov 12 02:53:04 2004 +0000 @@ -108,6 +108,7 @@ (define-key calc-mode-map "\C-w" 'calc-kill-region) (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) (define-key calc-mode-map "\C-y" 'calc-yank) + (define-key calc-mode-map [mouse-2] 'calc-yank) (define-key calc-mode-map "\C-_" 'calc-undo) (define-key calc-mode-map "\C-xu" 'calc-undo) (define-key calc-mode-map "\M-\C-m" 'calc-last-args) @@ -662,16 +663,6 @@ (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) (define-key calc-alg-map "\e\177" 'calc-pop-above) - ;; The following is a relic for backward compatability only. - ;; The calc-define property list is now the recommended method. - (if (and (boundp 'calc-ext-defs) - calc-ext-defs) - (progn - (calc-need-macros) - (message "Evaluating calc-ext-defs...") - (eval (cons 'progn calc-ext-defs)) - (setq calc-ext-defs nil))) - ;;;; (Autoloads here) (mapcar (function (lambda (x) (mapcar (function (lambda (func) @@ -1769,10 +1760,13 @@ (cdr res) res))) +(defvar calc-z-prefix-buf nil) +(defvar calc-z-prefix-msgs nil) + (defun calc-z-prefix-help () (interactive) - (let* ((msgs nil) - (buf "") + (let* ((calc-z-prefix-msgs nil) + (calc-z-prefix-buf "") (kmap (sort (copy-sequence (calc-user-key-map)) (function (lambda (x y) (< (car x) (car y)))))) (flags (apply 'logior @@ -1783,12 +1777,12 @@ (if (= (logand flags 8) 0) (calc-user-function-list kmap 7) (calc-user-function-list kmap 1) - (setq msgs (cons buf msgs) - buf "") + (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs) + calc-z-prefix-buf "") (calc-user-function-list kmap 6)) (if (/= flags 0) - (setq msgs (cons buf msgs))) - (calc-do-prefix-help (nreverse msgs) "user" ?z))) + (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs))) + (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z))) (defun calc-user-function-classify (key) (cond ((/= key (downcase key)) ; upper-case @@ -1822,14 +1816,15 @@ (upcase key) (downcase name)))) (char-to-string (upcase key))))) - (if (= (length buf) 0) - (setq buf (concat (if (= flags 1) "SHIFT + " "") + (if (= (length calc-z-prefix-buf) 0) + (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) - (if (> (+ (length buf) (length desc)) 58) - (setq msgs (cons buf msgs) - buf (concat (if (= flags 1) "SHIFT + " "") + (if (> (+ (length calc-z-prefix-buf) (length desc)) 58) + (setq calc-z-prefix-msgs + (cons calc-z-prefix-buf calc-z-prefix-msgs) + calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) - (setq buf (concat buf ", " desc)))))) + (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc)))))) (calc-user-function-list (cdr map) flags)))) @@ -1854,10 +1849,10 @@ (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) (list 'progn - (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'setq cache-val (list 'quote init)) - (list 'setq last-prec -100) - (list 'setq last-val nil) + (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) + (list 'defvar cache-val (list 'quote init)) + (list 'defvar last-prec -100) + (list 'defvar last-val nil) (list 'setq 'math-cache-list (list 'cons (list 'quote cache-prec) @@ -2223,25 +2218,25 @@ (math-normalize (car a)) (error "Can't use multi-valued function in an expression"))))) -(defun math-normalize-nonstandard () ; uses "a" +(defun math-normalize-nonstandard () (if (consp calc-simplify-mode) (progn (setq calc-simplify-mode 'none - math-simplify-only (car-safe (cdr-safe a))) + math-simplify-only (car-safe (cdr-safe math-normalize-a))) nil) - (and (symbolp (car a)) + (and (symbolp (car math-normalize-a)) (or (eq calc-simplify-mode 'none) (and (eq calc-simplify-mode 'num) - (let ((aptr (setq a (cons - (car a) - (mapcar 'math-normalize (cdr a)))))) + (let ((aptr (setq math-normalize-a + (cons + (car math-normalize-a) + (mapcar 'math-normalize + (cdr math-normalize-a)))))) (while (and aptr (math-constp (car aptr))) (setq aptr (cdr aptr))) aptr))) - (cons (car a) (mapcar 'math-normalize (cdr a)))))) - - - + (cons (car math-normalize-a) + (mapcar 'math-normalize (cdr math-normalize-a)))))) ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] @@ -2619,22 +2614,27 @@ (defvar var-FactorRules 'calc-FactorRules) -(defun math-map-tree (mmt-func mmt-expr &optional mmt-many) - (or mmt-many (setq mmt-many 1000000)) +(defvar math-mt-many nil) +(defvar math-mt-func nil) + +(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) + (or math-mt-many (setq math-mt-many 1000000)) (math-map-tree-rec mmt-expr)) (defun math-map-tree-rec (mmt-expr) - (or (= mmt-many 0) + (or (= math-mt-many 0) (let ((mmt-done nil) mmt-nextval) (while (not mmt-done) - (while (and (/= mmt-many 0) - (setq mmt-nextval (funcall mmt-func mmt-expr)) + (while (and (/= math-mt-many 0) + (setq mmt-nextval (funcall math-mt-func mmt-expr)) (not (equal mmt-expr mmt-nextval))) (setq mmt-expr mmt-nextval - mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) + math-mt-many (if (> math-mt-many 0) + (1- math-mt-many) + (1+ math-mt-many)))) (if (or (Math-primp mmt-expr) - (<= mmt-many 0)) + (<= math-mt-many 0)) (setq mmt-done t) (setq mmt-nextval (cons (car mmt-expr) (mapcar 'math-map-tree-rec @@ -2885,22 +2885,24 @@ ;;; Expression parsing. -(defun math-read-expr (exp-str) - (let ((exp-pos 0) - (exp-old-pos 0) - (exp-keep-spaces nil) - exp-token exp-data) - (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) - (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" - (substring exp-str (+ exp-token 2))))) +(defvar math-expr-data) + +(defun math-read-expr (math-exp-str) + (let ((math-exp-pos 0) + (math-exp-old-pos 0) + (math-exp-keep-spaces nil) + math-exp-token math-expr-data) + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" + (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) (math-read-token) (let ((val (catch 'syntax (math-read-expr-level 0)))) (if (stringp val) - (list 'error exp-old-pos val) - (if (equal exp-token 'end) + (list 'error math-exp-old-pos val) + (if (equal math-exp-token 'end) val - (list 'error exp-old-pos "Syntax error")))))) + (list 'error math-exp-old-pos "Syntax error")))))) (defun math-read-plain-expr (exp-str &optional error-check) (let* ((calc-language nil) @@ -2913,8 +2915,8 @@ (defun math-read-string () - (let ((str (read-from-string (concat exp-data "\"")))) - (or (and (= (cdr str) (1+ (length exp-data))) + (let ((str (read-from-string (concat math-expr-data "\"")))) + (or (and (= (cdr str) (1+ (length math-expr-data))) (stringp (car str))) (throw 'syntax "Error in string constant")) (math-read-token)
--- a/lisp/calc/calc-forms.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-forms.el Fri Nov 12 02:53:04 2004 +0000 @@ -1791,8 +1791,8 @@ (defun math-read-angle-brackets () - (let* ((last (or (math-check-for-commas t) (length exp-str))) - (str (substring exp-str exp-pos last)) + (let* ((last (or (math-check-for-commas t) (length math-exp-str))) + (str (substring math-exp-str math-exp-pos last)) (res (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str) (let ((str1 (substring str 0 (1- (match-end 0)))) @@ -1818,7 +1818,7 @@ (throw 'syntax res)) (if (eq (car-safe res) 'error) (throw 'syntax (nth 2 res))) - (setq exp-pos (1+ last)) + (setq math-exp-pos (1+ last)) (math-read-token) res))
--- a/lisp/calc/calc-lang.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-lang.el Fri Nov 12 02:53:04 2004 +0000 @@ -263,15 +263,15 @@ (let ((math-parsing-fortran-vector '(end . "\000"))) (prog1 (math-read-brackets t "]") - (setq exp-token (car math-parsing-fortran-vector) - exp-data (cdr math-parsing-fortran-vector))))) + (setq math-exp-token (car math-parsing-fortran-vector) + math-expr-data (cdr math-parsing-fortran-vector))))) (defun math-parse-fortran-vector-end (x op) (if math-parsing-fortran-vector (progn - (setq math-parsing-fortran-vector (cons exp-token exp-data) - exp-token 'end - exp-data "\000") + (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data) + math-exp-token 'end + math-expr-data "\000") x) (throw 'syntax "Unmatched closing `/'"))) @@ -384,15 +384,15 @@ (defun math-parse-tex-sum (f val) (let (low high save) - (or (equal exp-data "_") (throw 'syntax "Expected `_'")) + (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) (math-read-token) - (setq save exp-old-pos) + (setq save math-exp-old-pos) (setq low (math-read-factor)) (or (eq (car-safe low) 'calcFunc-eq) (progn - (setq exp-old-pos (1+ save)) + (setq math-exp-old-pos (1+ save)) (throw 'syntax "Expected equation"))) - (or (equal exp-data "^") (throw 'syntax "Expected `^'")) + (or (equal math-expr-data "^") (throw 'syntax "Expected `^'")) (math-read-token) (setq high (math-read-factor)) (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) @@ -484,31 +484,31 @@ (defun math-parse-eqn-matrix (f sym) (let ((vec nil)) - (while (assoc exp-data '(("ccol") ("lcol") ("rcol"))) + (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) (math-read-token) - (or (equal exp-data calc-function-open) + (or (equal math-expr-data calc-function-open) (throw 'syntax "Expected `{'")) (math-read-token) (setq vec (cons (cons 'vec (math-read-expr-list)) vec)) - (or (equal exp-data calc-function-close) + (or (equal math-expr-data calc-function-close) (throw 'syntax "Expected `}'")) (math-read-token)) - (or (equal exp-data calc-function-close) + (or (equal math-expr-data calc-function-close) (throw 'syntax "Expected `}'")) (math-read-token) (math-transpose (cons 'vec (nreverse vec))))) (defun math-parse-eqn-prime (x sym) (if (eq (car-safe x) 'var) - (if (equal exp-data calc-function-open) + (if (equal math-expr-data calc-function-open) (progn (math-read-token) - (let ((args (if (or (equal exp-data calc-function-close) - (eq exp-token 'end)) + (let ((args (if (or (equal math-expr-data calc-function-close) + (eq math-exp-token 'end)) nil (math-read-expr-list)))) - (if (not (or (equal exp-data calc-function-close) - (eq exp-token 'end))) + (if (not (or (equal math-expr-data calc-function-close) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) (cons (intern (format "calcFunc-%s'" (nth 1 x))) args))) @@ -622,10 +622,10 @@ (defun math-read-math-subscr (x op) (let ((idx (math-read-expr-level 0))) - (or (and (equal exp-data "]") + (or (and (equal math-expr-data "]") (progn (math-read-token) - (equal exp-data "]"))) + (equal math-expr-data "]"))) (throw 'syntax "Expected ']]'")) (math-read-token) (list 'calcFunc-subscr x idx)))
--- a/lisp/calc/calc-poly.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-poly.el Fri Nov 12 02:53:04 2004 +0000 @@ -1040,7 +1040,7 @@ (memq (car-safe (nth 1 expr)) '(+ -)) (integerp (nth 2 expr)) (if (> (nth 2 expr) 0) - (or (and (or (> mmt-many 500000) (< mmt-many -500000)) + (or (and (or (> math-mt-many 500000) (< math-mt-many -500000)) (math-expand-power (nth 1 expr) (nth 2 expr) nil t)) (list '*
--- a/lisp/calc/calc-rewr.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-rewr.el Fri Nov 12 02:53:04 2004 +0000 @@ -166,7 +166,7 @@ -(defun math-rewrite (whole-expr rules &optional mmt-many) +(defun math-rewrite (whole-expr rules &optional math-mt-many) (let ((crules (math-compile-rewrites rules)) (heads (math-rewrite-heads whole-expr)) (trace-buffer (get-buffer "*Trace*")) @@ -176,20 +176,20 @@ (calc-line-numbering nil) (calc-show-selections t) (calc-why nil) - (mmt-func (function - (lambda (x) - (let ((result (math-apply-rewrites x (cdr crules) - heads crules))) - (if result - (progn - (if trace-buffer - (let ((fmt (math-format-stack-value - (list result nil nil)))) - (save-excursion - (set-buffer trace-buffer) - (insert "\nrewrite to\n" fmt "\n")))) - (setq heads (math-rewrite-heads result heads t)))) - result))))) + (math-mt-func (function + (lambda (x) + (let ((result (math-apply-rewrites x (cdr crules) + heads crules))) + (if result + (progn + (if trace-buffer + (let ((fmt (math-format-stack-value + (list result nil nil)))) + (save-excursion + (set-buffer trace-buffer) + (insert "\nrewrite to\n" fmt "\n")))) + (setq heads (math-rewrite-heads result heads t)))) + result))))) (if trace-buffer (let ((fmt (math-format-stack-value (list whole-expr nil nil)))) (save-excursion @@ -197,22 +197,22 @@ (setq truncate-lines t) (goto-char (point-max)) (insert "\n\nBegin rewriting\n" fmt "\n")))) - (or mmt-many (setq mmt-many (or (nth 1 (car crules)) + (or math-mt-many (setq math-mt-many (or (nth 1 (car crules)) math-rewrite-default-iters))) - (if (equal mmt-many '(var inf var-inf)) (setq mmt-many 1000000)) - (if (equal mmt-many '(neg (var inf var-inf))) (setq mmt-many -1000000)) + (if (equal math-mt-many '(var inf var-inf)) (setq math-mt-many 1000000)) + (if (equal math-mt-many '(neg (var inf var-inf))) (setq math-mt-many -1000000)) (math-rewrite-phase (nth 3 (car crules))) (if trace-buffer (let ((fmt (math-format-stack-value (list whole-expr nil nil)))) (save-excursion (set-buffer trace-buffer) (insert "\nDone rewriting" - (if (= mmt-many 0) " (reached iteration limit)" "") + (if (= math-mt-many 0) " (reached iteration limit)" "") ":\n" fmt "\n")))) whole-expr)) (defun math-rewrite-phase (sched) - (while (and sched (/= mmt-many 0)) + (while (and sched (/= math-mt-many 0)) (if (listp (car sched)) (while (let ((save-expr whole-expr)) (math-rewrite-phase (car sched))
--- a/lisp/calc/calc-vec.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-vec.el Fri Nov 12 02:53:04 2004 +0000 @@ -1466,103 +1466,103 @@ (defun math-read-brackets (space-sep close) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) - (if (or (equal exp-data close) - (eq exp-token 'end)) + (if (or (equal math-expr-data close) + (eq math-exp-token 'end)) (progn (math-read-token) '(vec)) - (let ((save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) - (save-exp-data exp-data) - (vals (let ((exp-keep-spaces space-sep)) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (let ((save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) + (save-exp-data math-expr-data) + (vals (let ((math-exp-keep-spaces space-sep)) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) '(vec (neg (var inf var-inf))) (catch 'syntax (math-read-vector)))))) (if (stringp vals) (if space-sep - (let ((error-exp-pos exp-pos) - (error-exp-old-pos exp-old-pos) + (let ((error-exp-pos math-exp-pos) + (error-exp-old-pos math-exp-old-pos) vals2) - (setq exp-pos save-exp-pos - exp-old-pos save-exp-old-pos - exp-token save-exp-token - exp-data save-exp-data) - (let ((exp-keep-spaces nil)) + (setq math-exp-pos save-exp-pos + math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token + math-expr-data save-exp-data) + (let ((math-exp-keep-spaces nil)) (setq vals2 (catch 'syntax (math-read-vector)))) (if (and (not (stringp vals2)) - (or (assoc exp-data '(("\\ldots") ("\\dots") (";"))) - (equal exp-data close) - (eq exp-token 'end))) + (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";"))) + (equal math-expr-data close) + (eq math-exp-token 'end))) (setq space-sep nil vals vals2) - (setq exp-pos error-exp-pos - exp-old-pos error-exp-old-pos) + (setq math-exp-pos error-exp-pos + math-exp-old-pos error-exp-old-pos) (throw 'syntax vals))) (throw 'syntax vals))) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) (progn (math-read-token) (setq vals (if (> (length vals) 2) (cons 'calcFunc-mul (cdr vals)) (nth 1 vals))) - (let ((exp2 (if (or (equal exp-data close) - (equal exp-data ")") - (eq exp-token 'end)) + (let ((exp2 (if (or (equal math-expr-data close) + (equal math-expr-data ")") + (eq math-exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq vals (list 'intv - (if (equal exp-data ")") 2 3) + (if (equal math-expr-data ")") 2 3) vals exp2))) - (if (not (or (equal exp-data close) - (equal exp-data ")") - (eq exp-token 'end))) + (if (not (or (equal math-expr-data close) + (equal math-expr-data ")") + (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) - (if (equal exp-data ";") - (let ((exp-keep-spaces space-sep)) + (if (equal math-expr-data ";") + (let ((math-exp-keep-spaces space-sep)) (setq vals (cons 'vec (math-read-matrix (list vals)))))) - (if (not (or (equal exp-data close) - (eq exp-token 'end))) + (if (not (or (equal math-expr-data close) + (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) - (or (eq exp-token 'end) + (or (eq math-exp-token 'end) (math-read-token)) vals))) (defun math-check-for-commas (&optional balancing) (let ((count 0) - (pos (1- exp-pos))) + (pos (1- math-exp-pos))) (while (and (>= count 0) (setq pos (string-match (if balancing "[],[{}()<>]" "[],[{}()]") - exp-str (1+ pos))) - (or (/= (aref exp-str pos) ?,) (> count 0) balancing)) - (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<)) + math-exp-str (1+ pos))) + (or (/= (aref math-exp-str pos) ?,) (> count 0) balancing)) + (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<)) (setq count (1+ count))) - ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>)) + ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>)) (setq count (1- count))))) (if balancing pos - (and pos (= (aref exp-str pos) ?,))))) + (and pos (= (aref math-exp-str pos) ?,))))) (defun math-read-vector () (let* ((val (list (math-read-expr-level 0))) (last val)) (while (progn - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) - (and (not (eq exp-token 'end)) - (not (equal exp-data ";")) - (not (equal exp-data close)) - (not (equal exp-data "\\dots")) - (not (equal exp-data "\\ldots")))) - (if (equal exp-data ",") + (and (not (eq math-exp-token 'end)) + (not (equal math-expr-data ";")) + (not (equal math-expr-data close)) + (not (equal math-expr-data "\\dots")) + (not (equal math-expr-data "\\ldots")))) + (if (equal math-expr-data ",") (math-read-token)) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) (let ((rest (list (math-read-expr-level 0)))) (setcdr last rest) @@ -1570,9 +1570,9 @@ (cons 'vec val))) (defun math-read-matrix (mat) - (while (equal exp-data ";") + (while (equal math-expr-data ";") (math-read-token) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) (setq mat (nconc mat (list (math-read-vector))))) mat)
--- a/lisp/calc/calc.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc.el Fri Nov 12 02:53:04 2004 +0000 @@ -654,6 +654,20 @@ calc-word-size calc-internal-prec)) +(defvar calc-mode-hook nil + "Hook run when entering calc-mode.") + +(defvar calc-trail-mode-hook nil + "Hook run when entering calc-trail-mode.") + +(defvar calc-start-hook nil + "Hook run when calc is started.") + +(defvar calc-end-hook nil + "Hook run when calc is quit.") + +(defvar calc-load-hook nil + "Hook run when calc.el is loaded.") ;; Verify that Calc is running on the right kind of system. (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) @@ -1056,9 +1070,6 @@ (progn (setq calc-loaded-settings-file t) (load calc-settings-file t))) ; t = missing-ok - (if (and (eq window-system 'x) (boundp 'mouse-map)) - (substitute-key-definition 'x-paste-text 'calc-x-paste-text - mouse-map)) (let ((p command-line-args)) (while p (and (equal (car p) "-f") @@ -1069,14 +1080,6 @@ (run-hooks 'calc-mode-hook) (calc-refresh t) (calc-set-mode-line) - ;; The calc-defs variable is a relic. Use calc-define properties instead. - (when (and (boundp 'calc-defs) - calc-defs) - (message "Evaluating calc-defs...") - (calc-need-macros) - (eval (cons 'progn calc-defs)) - (setq calc-defs nil) - (calc-set-mode-line)) (calc-check-defines)) (defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks @@ -1163,20 +1166,18 @@ (switch-to-buffer (current-buffer) t) (if (get-buffer-window (current-buffer)) (select-window (get-buffer-window (current-buffer))) - (if (and (boundp 'calc-window-hook) calc-window-hook) - (run-hooks 'calc-window-hook) - (let ((w (get-largest-window))) - (if (and pop-up-windows - (> (window-height w) - (+ window-min-height calc-window-height 2))) - (progn - (setq w (split-window w - (- (window-height w) - calc-window-height 2) - nil)) - (set-window-buffer w (current-buffer)) - (select-window w)) - (pop-to-buffer (current-buffer))))))) + (let ((w (get-largest-window))) + (if (and pop-up-windows + (> (window-height w) + (+ window-min-height calc-window-height 2))) + (progn + (setq w (split-window w + (- (window-height w) + calc-window-height 2) + nil)) + (set-window-buffer w (current-buffer)) + (select-window w)) + (pop-to-buffer (current-buffer)))))) (save-excursion (set-buffer (calc-trail-buffer)) (and calc-display-trail @@ -1722,27 +1723,6 @@ (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) - -(defun calc-x-paste-text (arg) - "Move point to mouse position and insert window system cut buffer contents. -If mouse is pressed in Calc window, push cut buffer contents onto the stack." - (x-mouse-select arg) - (if (memq major-mode '(calc-mode calc-trail-mode)) - (progn - (calc-wrapper - (calc-extensions) - (let* ((buf (x-get-cut-buffer)) - (val (math-read-exprs (calc-clean-newlines buf)))) - (if (eq (car-safe val) 'error) - (progn - (setq val (math-read-exprs buf)) - (if (eq (car-safe val) 'error) - (error "%s in yanked data" (nth 2 val))))) - (calc-enter-result 0 "Xynk" val)))) - (x-paste-text arg))) - - - ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned () @@ -1808,10 +1788,8 @@ (not (if flag (memq flag '(nil 0)) win))) (if (null win) (progn - (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook) - (run-hooks 'calc-trail-window-hook) - (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) - (set-window-buffer w calc-trail-buffer))) + (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) + (set-window-buffer w calc-trail-buffer)) (calc-wrapper (setq overlay-arrow-string calc-trail-overlay overlay-arrow-position calc-trail-pointer) @@ -2254,62 +2232,72 @@ (defvar math-eval-rules-cache) (defvar math-eval-rules-cache-other) ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] -(defun math-normalize (a) + +(defvar math-normalize-a) +(defun math-normalize (math-normalize-a) (cond - ((not (consp a)) - (if (integerp a) - (if (or (>= a 1000000) (<= a -1000000)) - (math-bignum a) - a) - a)) - ((eq (car a) 'bigpos) - (if (eq (nth (1- (length a)) a) 0) - (let* ((last (setq a (copy-sequence a))) (digs a)) + ((not (consp math-normalize-a)) + (if (integerp math-normalize-a) + (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000)) + (math-bignum math-normalize-a) + math-normalize-a) + math-normalize-a)) + ((eq (car math-normalize-a) 'bigpos) + (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) + (let* ((last (setq math-normalize-a + (copy-sequence math-normalize-a))) (digs math-normalize-a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr a))) - a + (if (cdr (cdr (cdr math-normalize-a))) + math-normalize-a (cond - ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000))) - ((cdr a) (nth 1 a)) + ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) + (* (nth 2 math-normalize-a) 1000))) + ((cdr math-normalize-a) (nth 1 math-normalize-a)) (t 0)))) - ((eq (car a) 'bigneg) - (if (eq (nth (1- (length a)) a) 0) - (let* ((last (setq a (copy-sequence a))) (digs a)) + ((eq (car math-normalize-a) 'bigneg) + (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) + (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) + (digs math-normalize-a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr a))) - a + (if (cdr (cdr (cdr math-normalize-a))) + math-normalize-a (cond - ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000)))) - ((cdr a) (- (nth 1 a))) + ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) + (* (nth 2 math-normalize-a) 1000)))) + ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) (t 0)))) - ((eq (car a) 'float) - (math-make-float (math-normalize (nth 1 a)) (nth 2 a))) - ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote - special-const calcFunc-if calcFunc-lambda - calcFunc-quote calcFunc-condition - calcFunc-evalto)) - (integerp (car a)) - (and (consp (car a)) (not (eq (car (car a)) 'lambda)))) + ((eq (car math-normalize-a) 'float) + (math-make-float (math-normalize (nth 1 math-normalize-a)) + (nth 2 math-normalize-a))) + ((or (memq (car math-normalize-a) + '(frac cplx polar hms date mod sdev intv vec var quote + special-const calcFunc-if calcFunc-lambda + calcFunc-quote calcFunc-condition + calcFunc-evalto)) + (integerp (car math-normalize-a)) + (and (consp (car math-normalize-a)) + (not (eq (car (car math-normalize-a)) 'lambda)))) (calc-extensions) - (math-normalize-fancy a)) + (math-normalize-fancy math-normalize-a)) (t (or (and calc-simplify-mode (calc-extensions) (math-normalize-nonstandard)) - (let ((args (mapcar 'math-normalize (cdr a)))) + (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) (or (condition-case err - (let ((func (assq (car a) '( ( + . math-add ) - ( - . math-sub ) - ( * . math-mul ) - ( / . math-div ) - ( % . math-mod ) - ( ^ . math-pow ) - ( neg . math-neg ) - ( | . math-concat ) )))) + (let ((func + (assq (car math-normalize-a) '( ( + . math-add ) + ( - . math-sub ) + ( * . math-mul ) + ( / . math-div ) + ( % . math-mod ) + ( ^ . math-pow ) + ( neg . math-neg ) + ( | . math-concat ) )))) (or (and var-EvalRules (progn (or (eq var-EvalRules math-eval-rules-cache-tag) @@ -2317,51 +2305,54 @@ (calc-extensions) (math-recompile-eval-rules))) (and (or math-eval-rules-cache-other - (assq (car a) math-eval-rules-cache)) + (assq (car math-normalize-a) + math-eval-rules-cache)) (math-apply-rewrites - (cons (car a) args) + (cons (car math-normalize-a) args) (cdr math-eval-rules-cache) nil math-eval-rules-cache)))) (if func (apply (cdr func) args) - (and (or (consp (car a)) - (fboundp (car a)) + (and (or (consp (car math-normalize-a)) + (fboundp (car math-normalize-a)) (and (not calc-extensions-loaded) (calc-extensions) - (fboundp (car a)))) - (apply (car a) args))))) + (fboundp (car math-normalize-a)))) + (apply (car math-normalize-a) args))))) (wrong-number-of-arguments (calc-record-why "*Wrong number of arguments" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (wrong-type-argument - (or calc-next-why (calc-record-why "Wrong type of argument" - (cons (car a) args))) + (or calc-next-why + (calc-record-why "Wrong type of argument" + (cons (car math-normalize-a) args))) nil) (args-out-of-range - (calc-record-why "*Argument out of range" (cons (car a) args)) + (calc-record-why "*Argument out of range" + (cons (car math-normalize-a) args)) nil) (inexact-result (calc-record-why "No exact representation for result" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (math-overflow (calc-record-why "*Floating-point overflow occurred" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (math-underflow (calc-record-why "*Floating-point underflow occurred" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (void-variable (if (eq (nth 1 err) 'var-EvalRules) (progn (setq var-EvalRules nil) - (math-normalize (cons (car a) args))) + (math-normalize (cons (car math-normalize-a) args))) (calc-record-why "*Variable is void" (nth 1 err))))) - (if (consp (car a)) + (if (consp (car math-normalize-a)) (math-dimension-error) - (cons (car a) args)))))))) + (cons (car math-normalize-a) args))))))))
--- a/lisp/calc/calcalg2.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calcalg2.el Fri Nov 12 02:53:04 2004 +0000 @@ -738,8 +738,12 @@ (setcar (cdr cur-record) 'cancelled))) (math-replace-integral-parts (car expr))))))) +(defvar math-linear-subst-tried t + "Non-nil means that a linear substitution has been tried.") + (defun math-do-integral (expr) - (let (t1 t2) + (let ((math-linear-subst-tried nil) + t1 t2) (or (cond ((not (math-expr-contains expr math-integ-var)) (math-mul expr math-integ-var)) ((equal expr math-integ-var) @@ -977,9 +981,8 @@ ;; Integration by substitution, for various likely sub-expressions. ;; (In first pass, we look only for sub-exprs that are linear in X.) - (or (if math-enable-subst - (math-integ-try-substitutions expr) - (math-integ-try-linear-substitutions expr)) + (or (math-integ-try-linear-substitutions expr) + (math-integ-try-substitutions expr) ;; If function has sines and cosines, try tan(x/2) substitution. (and (let ((p (setq rat-in (math-expr-rational-in expr)))) @@ -1189,6 +1192,7 @@ ;;; Look for substitutions of the form u = a x + b. (defun math-integ-try-linear-substitutions (sub-expr) + (setq math-linear-subst-tried t) (and (not (Math-primp sub-expr)) (or (and (not (memq (car sub-expr) '(+ - * / neg))) (not (and (eq (car sub-expr) '^)
--- a/lisp/calendar/diary-lib.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calendar/diary-lib.el Fri Nov 12 02:53:04 2004 +0000 @@ -1974,19 +1974,20 @@ (throw 'finished t)))) nil)) -(defun diary-from-outlook () +(defun diary-from-outlook (&optional noconfirm) "Maybe snarf diary entry from current Outlook-generated message. -Currently knows about Gnus and Rmail modes." - (interactive) +Currently knows about Gnus and Rmail modes. Unless the optional +argument NOCONFIRM is non-nil (which is the case when this +function is called interactively), then if an entry is found the +user is asked to confirm its addition." + (interactive "p") (let ((func (cond ((eq major-mode 'rmail-mode) #'diary-from-outlook-rmail) ((memq major-mode '(gnus-summary-mode gnus-article-mode)) #'diary-from-outlook-gnus) (t (error "Don't know how to snarf in `%s'" major-mode))))) - (if (interactive-p) - (call-interactively func) - (funcall func)))) + (funcall func noconfirm))) (defvar gnus-article-mime-handles) @@ -1996,11 +1997,14 @@ (autoload 'gnus-narrow-to-body "gnus") (autoload 'mm-get-part "mm-decode") -(defun diary-from-outlook-gnus () +(defun diary-from-outlook-gnus (&optional noconfirm) "Maybe snarf diary entry from Outlook-generated message in Gnus. -Add this to `gnus-article-prepare-hook' to notice appointments +Unless the optional argument NOCONFIRM is non-nil (which is the case when +this function is called interactively), then if an entry is found the +user is asked to confirm its addition. +Add this function to `gnus-article-prepare-hook' to notice appointments automatically." - (interactive) + (interactive "p") (with-current-buffer gnus-article-buffer (let ((subject (gnus-fetch-field "subject")) (body (if gnus-article-mime-handles @@ -2011,8 +2015,7 @@ (gnus-narrow-to-body) (buffer-string))))) (when (diary-from-outlook-internal t) - (when (or (interactive-p) - (y-or-n-p "Snarf diary entry? ")) + (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) (diary-from-outlook-internal) (message "Diary entry added")))))) @@ -2021,9 +2024,12 @@ (defvar rmail-buffer) -(defun diary-from-outlook-rmail () - "Maybe snarf diary entry from Outlook-generated message in Rmail." - (interactive) +(defun diary-from-outlook-rmail (&optional noconfirm) + "Maybe snarf diary entry from Outlook-generated message in Rmail. +Unless the optional argument NOCONFIRM is non-nil (which is the case when +this function is called interactively), then if an entry is found the +user is asked to confirm its addition." + (interactive "p") (with-current-buffer rmail-buffer (let ((subject (mail-fetch-field "subject")) (body (buffer-substring (save-excursion @@ -2031,8 +2037,7 @@ (point)) (point-max)))) (when (diary-from-outlook-internal t) - (when (or (interactive-p) - (y-or-n-p "Snarf diary entry? ")) + (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) (diary-from-outlook-internal) (message "Diary entry added"))))))
--- a/lisp/cvs-status.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/cvs-status.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,6 +1,6 @@ ;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- -;; Copyright (C) 1999, 2000, 03, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs cvs status tree tools @@ -31,8 +31,8 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'pcvs-util) (eval-when-compile (require 'pcvs)) -(require 'pcvs-util) ;;; @@ -50,7 +50,7 @@ ("\M-p" . cvs-status-prev) ("t" . cvs-status-cvstrees) ("T" . cvs-status-trees) - (">" . cvs-status-checkout)) + (">" . cvs-mode-checkout)) "CVS-Status' keymap." :group 'cvs-status :inherit 'cvs-mode-map) @@ -89,7 +89,7 @@ (defconst cvs-status-font-lock-defaults '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t))) - +(defvar cvs-minor-wrap-function) (put 'cvs-status-mode 'mode-class 'special) ;;;###autoload (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status" @@ -108,7 +108,8 @@ (let* ((file (match-string 1)) (cvsdir (and (re-search-backward cvs-status-dir-re nil t) (match-string 1))) - (pcldir (and (re-search-backward cvs-pcl-cvs-dirchange-re nil t) + (pcldir (and (if (boundp 'cvs-pcl-cvs-dirchange-re) + (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) (match-string 1))) (dir "")) (let ((default-directory "")) @@ -466,25 +467,6 @@ ;;(sit-for 0) )))))) -(defun-cvs-mode (cvs-status-checkout . NOARGS) (dir) - "Run cvs-checkout against the tag under the point. -The files are stored to DIR." - (interactive - (let* ((module (cvs-get-module)) - (branch (cvs-prefix-get 'cvs-branch-prefix)) - (prompt (format "CVS Checkout Directory for `%s%s': " - module - (if branch (format "(branch: %s)" branch) - "")))) - (list - (read-directory-name prompt - nil default-directory nil)))) - (let ((modules (cvs-string->strings (cvs-get-module))) - (flags (cvs-add-branch-prefix - (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))) - (cvs-cvsroot (cvs-get-cvsroot))) - (cvs-checkout modules dir flags))) - (defun cvs-tree-tags-insert (tags prev) (when tags (let* ((tag (car tags)) @@ -556,5 +538,5 @@ (provide 'cvs-status) -;;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0 +;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0 ;;; cvs-status.el ends here
--- a/lisp/descr-text.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/descr-text.el Fri Nov 12 02:53:04 2004 +0000 @@ -499,7 +499,10 @@ (format (if (< code 256) "0x%02X" "0x%04X") code) (format "0x%04X%04X" (car code) (cdr code)))) ("syntax" - ,(let ((syntax (syntax-after pos))) + ,(let* ((st (if parse-sexp-lookup-properties + (get-char-property pos 'syntax-table))) + (syntax (if (consp st) st + (aref (or st (syntax-table)) (char-after pos))))) (with-temp-buffer (internal-describe-syntax-value syntax) (buffer-string))))
--- a/lisp/desktop.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/desktop.el Fri Nov 12 02:53:04 2004 +0000 @@ -129,7 +129,8 @@ (const :tag "Ask if desktop file exists, else don't save" ask-if-exists) (const :tag "Save if desktop file exists, else don't" if-exists) (const :tag "Never save" nil)) - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-base-file-name (convert-standard-filename ".emacs.desktop") @@ -142,7 +143,8 @@ "List of directories to search for the desktop file. The base name of the file is specified in `desktop-base-file-name'." :type '(repeat directory) - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-missing-file-warning nil "*If non-nil then `desktop-read' asks if a non-existent file should be recreated. @@ -151,19 +153,22 @@ If nil, just print error messages in the message buffer." :type 'boolean - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-no-desktop-file-hook nil "Normal hook run when `desktop-read' can't find a desktop file. May e.g. be used to show a dired buffer." :type 'hook - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-after-read-hook nil "Normal hook run after a successful `desktop-read'. May e.g. be used to show a buffer list." :type 'hook - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-save-hook nil "Normal hook run before the desktop is saved in a desktop file. @@ -198,14 +203,16 @@ \(VAR . FORM). Symbols are set to nil and for cons cells VAR is set to the value obtained by evaluateing FORM." :type '(repeat (restricted-sexp :match-alternatives (symbolp consp))) - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-clear-preserve-buffers-regexp "^\\(\\*scratch\\*\\|\\*Messages\\*\\|\\*tramp/.+\\*\\)$" "Regexp identifying buffers that `desktop-clear' should not delete. See also `desktop-clear-preserve-buffers'." :type 'regexp - :group 'desktop) + :group 'desktop + :version "21.4") (defcustom desktop-clear-preserve-buffers nil "*List of buffer names that `desktop-clear' should not delete. @@ -257,7 +264,8 @@ tilde -- Relative to ~. local -- Relative to directory of desktop file." :type '(choice (const absolute) (const tilde) (const local)) - :group 'desktop) + :group 'desktop + :version "21.4") ;;;###autoload (defvar desktop-save-buffer nil
--- a/lisp/dired.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/dired.el Fri Nov 12 02:53:04 2004 +0000 @@ -546,8 +546,14 @@ (if current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)) - (read-directory-name (format "Dired %s(directory): " str) - nil default-directory nil)))) + ;; If a dialog is about to be used, call read-directory-name so + ;; the dialog code knows we want directories. Some dialogs can + ;; only select directories or files when popped up, not both. + (if (next-read-file-uses-dialog-p) + (read-directory-name (format "Dired %s(directory): " str) + nil default-directory nil) + (read-file-name (format "Dired %s(directory): " str) + nil default-directory nil))))) ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload
--- a/lisp/ebuff-menu.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/ebuff-menu.el Fri Nov 12 02:53:04 2004 +0000 @@ -38,9 +38,12 @@ (defvar electric-buffer-menu-mode-map nil) +(defvar electric-buffer-menu-mode-hook nil + "Normal hook run by `electric-buffer-list'.") + ;;;###autoload (defun electric-buffer-list (arg) - "Pops up a buffer describing the set of Emacs buffers. + "Pop up a buffer describing the set of Emacs buffers. Vaguely like ITS lunar select buffer; combining typeoutoid buffer listing with menuoid buffer selection. @@ -50,9 +53,9 @@ To exit and select a new buffer, type a space when the cursor is on the appropriate line of the buffer-list window. Other commands are -much like those of buffer-menu-mode. +much like those of `Buffer-menu-mode'. -Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. +Run hooks in `electric-buffer-menu-mode-hook' on entry. \\{electric-buffer-menu-mode-map}" (interactive "P") @@ -144,8 +147,8 @@ \\{electric-buffer-menu-mode-map} -Entry to this mode via command electric-buffer-list calls the value of -electric-buffer-menu-mode-hook if it is non-nil." +Entry to this mode via command `electric-buffer-list' calls the value of +`electric-buffer-menu-mode-hook'." (kill-all-local-variables) (use-local-map electric-buffer-menu-mode-map) (setq mode-name "Electric Buffer Menu") @@ -223,8 +226,8 @@ (defun Electric-buffer-menu-select () "Leave Electric Buffer Menu, selecting buffers and executing changes. -Saves buffers marked \"S\". Deletes buffers marked \"K\". -Selects buffer at point and displays buffers marked \">\" in other windows." +Save buffers marked \"S\". Delete buffers marked \"K\". +Select buffer at point and display buffers marked \">\" in other windows." (interactive) (throw 'electric-buffer-menu-select (point))) @@ -237,7 +240,7 @@ (defun Electric-buffer-menu-quit () "Leave Electric Buffer Menu, restoring previous window configuration. -Does not execute select, save, or delete commands." +Skip execution of select, save, and delete commands." (interactive) (throw 'electric-buffer-menu-select nil)) @@ -258,7 +261,7 @@ (defun Electric-buffer-menu-mode-view-buffer () "View buffer on current line in Electric Buffer Menu. -Returns to Electric Buffer Menu when done." +Return to Electric Buffer Menu when done." (interactive) (let ((bufnam (Buffer-menu-buffer nil))) (if bufnam
--- a/lisp/emacs-lisp/bytecomp.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,7 +1,7 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code -;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, +;; 2003, 2004 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -447,7 +447,9 @@ "Alist of functions defined in the file being compiled. This is so we can inline them when necessary. Each element looks like (FUNCTIONNAME . DEFINITION). It is -\(FUNCTIONNAME . nil) when a function is redefined as a macro.") +\(FUNCTIONNAME . nil) when a function is redefined as a macro. +It is \(FUNCTIONNAME . t) when all we know is that it was defined, +and we don't know the definition.") (defvar byte-compile-unresolved-functions nil "Alist of undefined functions to which calls have been compiled. @@ -1103,6 +1105,10 @@ ;;; sanity-checking arglists +;; If a function has an entry saying (FUNCTION . t). +;; that means we know it is defined but we don't know how. +;; If a function has an entry saying (FUNCTION . nil), +;; that means treat it as not defined. (defun byte-compile-fdefinition (name macro-p) (let* ((list (if macro-p byte-compile-macro-environment @@ -1168,7 +1174,7 @@ (defun byte-compile-callargs-warn (form) (let* ((def (or (byte-compile-fdefinition (car form) nil) (byte-compile-fdefinition (car form) t))) - (sig (if def + (sig (if (and def (not (eq def t))) (byte-compile-arglist-signature (if (eq 'lambda (car-safe def)) (nth 1 def) @@ -1198,7 +1204,7 @@ (byte-compile-format-warn form) ;; Check to see if the function will be available at runtime ;; and/or remember its arity if it's unknown. - (or (and (or sig (fboundp (car form))) ; might be a subr or autoload. + (or (and (or def (fboundp (car form))) ; might be a subr or autoload. (not (memq (car form) byte-compile-noruntime-functions))) (eq (car form) byte-compile-current-form) ; ## this doesn't work ; with recursion. @@ -1209,9 +1215,8 @@ (if cons (or (memq n (cdr cons)) (setcdr cons (cons n (cdr cons)))) - (setq byte-compile-unresolved-functions - (cons (list (car form) n) - byte-compile-unresolved-functions))))))) + (push (list (car form) n) + byte-compile-unresolved-functions)))))) (defun byte-compile-format-warn (form) "Warn if FORM is `format'-like with inconsistent args. @@ -1243,7 +1248,7 @@ ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) - (if old + (if (and old (not (eq old t))) (let ((sig1 (byte-compile-arglist-signature (if (eq 'lambda (car-safe old)) (nth 1 old) @@ -2123,9 +2128,9 @@ (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) (symbolp (nth 1 (nth 1 form)))) - (add-to-list 'byte-compile-function-environment - (cons (nth 1 (nth 1 form)) - (cons 'autoload (cdr (cdr form)))))) + (push (cons (nth 1 (nth 1 form)) + (cons 'autoload (cdr (cdr form)))) + byte-compile-function-environment)) (if (stringp (nth 3 form)) form ;; No doc string, so we can compile this as a normal form. @@ -3610,7 +3615,6 @@ (byte-defop-compiler-1 defconst byte-compile-defvar) (byte-defop-compiler-1 autoload) (byte-defop-compiler-1 lambda byte-compile-lambda-form) -(byte-defop-compiler-1 defalias) (defun byte-compile-defun (form) ;; This is not used for file-level defuns with doc strings. @@ -3712,22 +3716,22 @@ (error "`lambda' used as function name is invalid")) ;; Compile normally, but deal with warnings for the function being defined. -(defun byte-compile-defalias (form) +(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias) +(defun byte-compile-file-form-defalias (form) (if (and (consp (cdr form)) (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form))) - (consp (nthcdr 2 form)) - (consp (nth 2 form)) - (eq (car (nth 2 form)) 'quote) - (consp (cdr (nth 2 form))) - (symbolp (nth 1 (nth 2 form)))) - (progn + (symbolp (nth 1 (nth 1 form)))) + (let ((constant + (and (consp (nthcdr 2 form)) + (consp (nth 2 form)) + (eq (car (nth 2 form)) 'quote) + (consp (cdr (nth 2 form))) + (symbolp (nth 1 (nth 2 form)))))) (byte-compile-defalias-warn (nth 1 (nth 1 form))) - (setq byte-compile-function-environment - (cons (cons (nth 1 (nth 1 form)) - (nth 1 (nth 2 form))) - byte-compile-function-environment)))) + (push (cons (nth 1 (nth 1 form)) + (if constant (nth 1 (nth 2 form)) t)) + byte-compile-function-environment))) (byte-compile-normal-call form)) ;; Turn off warnings about prior calls to the function being defalias'd. @@ -3930,7 +3934,7 @@ (while rest (or (nth 1 (car rest)) (null (setq f (car (car rest)))) - (byte-compile-fdefinition f t) + (functionp (byte-compile-fdefinition f t)) (commandp (byte-compile-fdefinition f nil)) (setq uncalled (cons f uncalled))) (setq rest (cdr rest))) @@ -4112,5 +4116,5 @@ (run-hooks 'bytecomp-load-hook) -;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a +;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a ;;; bytecomp.el ends here
--- a/lisp/emacs-lisp/easymenu.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/emacs-lisp/easymenu.el Fri Nov 12 02:53:04 2004 +0000 @@ -42,25 +42,7 @@ :version "20.3") (defsubst easy-menu-intern (s) - (if (stringp s) - (let ((copy (copy-sequence s)) - (pos 0) - found) - ;; For each letter that starts a word, flip its case. - ;; This way, the usual convention for menu strings (capitalized) - ;; corresponds to the usual convention for menu item event types - ;; (all lower case). It's a 1-1 mapping so causes no conflicts. - (while (setq found (string-match "\\<\\sw" copy pos)) - (setq pos (match-end 0)) - (unless (= (upcase (aref copy found)) - (downcase (aref copy found))) - (aset copy found - (if (= (upcase (aref copy found)) - (aref copy found)) - (downcase (aref copy found)) - (upcase (aref copy found)))))) - (intern copy)) - s)) + (if (stringp s) (intern s) s)) ;;;###autoload (put 'easy-menu-define 'lisp-indent-function 'defun) @@ -242,9 +224,9 @@ (setq visible (or arg ''nil))))) (if (equal visible ''nil) nil ; Invisible menu entry, return nil. - (if (and visible (not (easy-menu-always-true visible))) + (if (and visible (not (easy-menu-always-true-p visible))) (setq prop (cons :visible (cons visible prop)))) - (if (and enable (not (easy-menu-always-true enable))) + (if (and enable (not (easy-menu-always-true-p enable))) (setq prop (cons :enable (cons enable prop)))) (if filter (setq prop (cons :filter (cons filter prop)))) (if help (setq prop (cons :help (cons help prop)))) @@ -363,12 +345,12 @@ (cons cmd keys)))) (setq cache-specified nil)) (if keys (setq prop (cons :keys (cons keys prop))))) - (if (and visible (not (easy-menu-always-true visible))) + (if (and visible (not (easy-menu-always-true-p visible))) (if (equal visible ''nil) ;; Invisible menu item. Don't insert into keymap. (setq remove t) (setq prop (cons :visible (cons visible prop))))))) - (if (and active (not (easy-menu-always-true active))) + (if (and active (not (easy-menu-always-true-p active))) (setq prop (cons :enable (cons active prop)))) (if (and (or no-name cache-specified) (or (null cache) (stringp cache) (vectorp cache))) @@ -396,6 +378,7 @@ BEFORE can be either a string (menu item name) or a symbol \(the fake function key for the menu item). KEY does not have to be a symbol, and comparison is done with equal." + (if (symbolp menu) (setq menu (indirect-function menu))) (let ((inserted (null item)) ; Fake already inserted. tail done) (while (not done) @@ -426,7 +409,8 @@ (defun easy-menu-name-match (name item) "Return t if NAME is the name of menu item ITEM. -NAME can be either a string, or a symbol." +NAME can be either a string, or a symbol. +ITEM should be a keymap binding of the form (KEY . MENU-ITEM)." (if (consp item) (if (symbolp name) (eq (car-safe item) name) @@ -436,10 +420,9 @@ (error nil)) ;`item' might not be a proper list. ;; Also check the string version of the symbol name, ;; for backwards compatibility. - (eq (car-safe item) (intern name)) - (eq (car-safe item) (easy-menu-intern name))))))) + (eq (car-safe item) (intern name))))))) -(defun easy-menu-always-true (x) +(defun easy-menu-always-true-p (x) "Return true if form X never evaluates to nil." (if (consp x) (and (eq (car x) 'quote) (cadr x)) (or (eq x t) (not (symbolp x))))) @@ -540,15 +523,10 @@ (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before) (if (or (keymapp item) - (and (symbolp item) (keymapp (symbol-value item)))) + (and (symbolp item) (keymapp (symbol-value item)) + (setq item (symbol-value item)))) ;; Item is a keymap, find the prompt string and use as item name. - (let ((tail (easy-menu-get-map item nil)) name) - (if (not (keymapp item)) (setq item tail)) - (while (and (null name) (consp (setq tail (cdr tail))) - (not (keymapp tail))) - (if (stringp (car tail)) (setq name (car tail)) ; Got a name. - (setq tail (cdr tail)))) - (setq item (cons name item)))) + (setq item (cons (keymap-prompt item) item))) (easy-menu-do-add-item map item before))) (defun easy-menu-item-present-p (map path name) @@ -591,10 +569,24 @@ (cons name item)) ; Keymap or new menu format ))) -(defun easy-menu-get-map-look-for-name (name submap) - (while (and submap (not (easy-menu-name-match name (car submap)))) - (setq submap (cdr submap))) - submap) +(defun easy-menu-lookup-name (map name) + "Lookup menu item NAME in keymap MAP. +Like `lookup-key' except that NAME is not an array but just a single key +and that NAME can be a string representing the menu item's name." + (or (lookup-key map (vector (easy-menu-intern name))) + (when (stringp name) + ;; `lookup-key' failed and we have a menu item name: look at the + ;; actual menu entries's names. + (catch 'found + (map-keymap (lambda (key item) + (if (condition-case nil (member name item) + (error nil)) + ;; Found it!! Look for it again with + ;; `lookup-key' so as to handle inheritance and + ;; to extract the actual command/keymap bound to + ;; `name' from the item (via get_keyelt). + (throw 'found (lookup-key map (vector key))))) + map))))) (defun easy-menu-get-map (map path &optional to-modify) "Return a sparse keymap in which to add or remove an item. @@ -605,34 +597,34 @@ In some cases we use that to select between the local and global maps." (setq map (catch 'found - (let* ((key (vconcat (unless map '(menu-bar)) - (mapcar 'easy-menu-intern path))) - (maps (mapcar (lambda (map) - (setq map (lookup-key map key)) - (while (and (symbolp map) (keymapp map)) - (setq map (symbol-function map))) - map) - (if map - (list (if (and (symbolp map) - (not (keymapp map))) - (symbol-value map) map)) - (current-active-maps))))) + (if (and map (symbolp map) (not (keymapp map))) + (setq map (symbol-value map))) + (let ((maps (if map (list map) (current-active-maps)))) + ;; Look for PATH in each map. + (unless map (push 'menu-bar path)) + (dolist (name path) + (setq maps + (delq nil (mapcar (lambda (map) + (setq map (easy-menu-lookup-name + map name)) + (and (keymapp map) map)) + maps)))) + ;; Prefer a map that already contains the to-be-modified entry. (when to-modify (dolist (map maps) - (when (and (keymapp map) - (easy-menu-get-map-look-for-name to-modify map)) + (when (easy-menu-lookup-name map to-modify) (throw 'found map)))) ;; Use the first valid map. - (dolist (map maps) - (when (keymapp map) - (throw 'found map))) + (when maps (throw 'found (car maps))) + ;; Otherwise, make one up. ;; Hardcoding current-local-map is lame, but it's difficult ;; to know what the caller intended for us to do ;-( (let* ((name (if path (format "%s" (car (reverse path))))) (newmap (make-sparse-keymap name))) - (define-key (or map (current-local-map)) key + (define-key (or map (current-local-map)) + (apply 'vector (mapcar 'easy-menu-intern path)) (if name (cons name newmap) newmap)) newmap)))) (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map)) @@ -640,5 +632,5 @@ (provide 'easymenu) -;;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a +;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a ;;; easymenu.el ends here
--- a/lisp/emacs-lisp/edebug.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/emacs-lisp/edebug.el Fri Nov 12 02:53:04 2004 +0000 @@ -714,8 +714,10 @@ (if (and (eq (following-char) ?.) (save-excursion (forward-char 1) - (and (>= (following-char) ?0) - (<= (following-char) ?9)))) + (or (and (eq (aref edebug-read-syntax-table (following-char)) + 'symbol) + (not (= (following-char) ?\;))) + (memq (following-char) '(?\, ?\.))))) 'symbol (aref edebug-read-syntax-table (following-char))))
--- a/lisp/emacs-lisp/elp.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/emacs-lisp/elp.el Fri Nov 12 02:53:04 2004 +0000 @@ -564,7 +564,6 @@ (generate-new-buffer elp-results-buffer)))) (set-buffer resultsbuf) (erase-buffer) - (beginning-of-buffer) ;; get the length of the longest function name being profiled (let* ((longest 0) (title "Function Name")
--- a/lisp/eshell/esh-mode.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/eshell/esh-mode.el Fri Nov 12 02:53:04 2004 +0000 @@ -946,10 +946,11 @@ (eshell-bol) (kill-region (point) here)))) -(defun eshell-show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (interactive) - (if (interactive-p) +(defun eshell-show-maximum-output (&optional interactive) + "Put the end of the buffer at the bottom of the window. +When run interactively, widen the buffer first." + (interactive "p") + (if interactive (widen)) (goto-char (point-max)) (recenter -1)) @@ -1005,7 +1006,7 @@ (let ((pos (point))) (if (bobp) (if (interactive-p) - (error "Buffer too short to truncate")) + (message "Buffer too short to truncate")) (delete-region (point-min) (point)) (if (interactive-p) (message "Truncated buffer from %d to %d lines (%.1fk freed)"
--- a/lisp/files.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/files.el Fri Nov 12 02:53:04 2004 +0000 @@ -676,7 +676,7 @@ both at the level of the file and at the level of the directories containing it, until no links are left at any level. -\(fn FILENAME)" +\(fn FILENAME)" ;; Don't document the optional arguments. ;; COUNTER and PREV-DIRS are only used in recursive calls. ;; COUNTER can be a cons cell whose car is the count of how many ;; more links to chase before getting an error. @@ -1751,6 +1751,30 @@ ("BROWSE\\'" . ebrowse-tree-mode) ("\\.ebrowse\\'" . ebrowse-tree-mode) ("#\\*mail\\*" . mail-mode) + ("\\.g\\'" . antlr-mode) + ("\\.ses\\'" . ses-mode) + ("\\.\\(soa\\|zone\\)\\'" . dns-mode) + ("\\.docbook\\'" . sgml-mode) + ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) + ;; Windows candidates may be opened case sensitively on Unix + ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) + ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode) + ("java.+\\.conf\\'" . conf-javaprop-mode) + ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) + ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config + ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode) + ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|permissions\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) + ("\\`/etc/\\(?:aliases\\|hosts\\..+\\|ksysguarddrc\\|opera6rc\\)\\'" . conf-mode) + ;; either user's dot-files or under /etc or some such + ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode) + ;; alas not all ~/.*rc files are like this + ("/\\.\\(?:enigma\\|gltron\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) + ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) + ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) + ("/X11.+app-defaults/" . conf-xdefaults-mode) + ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) + ;; this contains everything twice, with space and with colon :-( + ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) ;; Get rid of any trailing .n.m and try again. ;; This is for files saved by cvs-merge that look like .#<file>.<rev> ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~. @@ -1761,11 +1785,7 @@ ;; for the sake of ChangeLog.1, etc. ;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too. ("\\.[1-9]\\'" . nroff-mode) - ("\\.g\\'" . antlr-mode) - ("\\.ses\\'" . ses-mode) - ("\\.orig\\'" nil t) ; from patch - ("\\.\\(soa\\|zone\\)\\'" . dns-mode) - ("\\.in\\'" nil t))) + ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t))) "Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) @@ -1846,26 +1866,32 @@ with that interpreter in `interpreter-mode-alist'.") (defvar magic-mode-alist - '(;; The < comes before the groups (but the first) to reduce backtracking. - ;; Is there a nicer way of getting . including \n? + `(;; The < comes before the groups (but the first) to reduce backtracking. ;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff. - ("\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\)?\\s *\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*[Hh][Tt][Mm][Ll]" . html-mode) + (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") + (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)"))) + (concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<" + comment-re "*" + "\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?" + "[Hh][Tt][Mm][Ll]")) . html-mode) ;; These two must come after html, because they are more general: ("<\\?xml " . xml-mode) - ("\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*!DOCTYPE " . sgml-mode) - ("%![^V]" . ps-mode)) - "Alist of buffer beginnings vs corresponding major mode functions. + (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") + (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)"))) + (concat "\\s *<" comment-re "*!DOCTYPE ")) . sgml-mode) + ("%![^V]" . ps-mode) + ("# xmcd " . conf-unix-mode)) + "Alist of buffer beginnings vs. corresponding major mode functions. Each element looks like (REGEXP . FUNCTION). FUNCTION will be -called, unless it is nil.") +called, unless it is nil (to allow `auto-mode-alist' to override).") (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, checks the interpreter that runs this file against `interpreter-mode-alist', -compares the buffer beginning against `magic-mode-alist', -or compares the filename against the entries in -`auto-mode-alist'. +compares the buffer beginning against `magic-mode-alist', or +compares the filename against the entries in `auto-mode-alist'. It does not check for the `mode:' local variable in the Local Variables section of the file; for that, use `hack-local-variables'. @@ -1876,13 +1902,11 @@ If the optional argument KEEP-MODE-IF-SAME is non-nil, then we only set the major mode, if that would change it." ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- - (let (end done mode modes xml) + (let (end done mode modes) ;; Find a -*- mode tag (save-excursion (goto-char (point-min)) (skip-chars-forward " \t\n") - ;; While we're at this point, check xml for later. - (setq xml (looking-at "<\\?xml \\|<!DOCTYPE")) (and enable-local-variables (setq end (set-auto-mode-1)) (if (save-excursion (search-forward ":" end t)) @@ -1912,6 +1936,7 @@ (message "Ignoring unknown mode `%s'" mode) (setq done t) (or (set-auto-mode-0 mode keep-mode-if-same) + ;; continuing would call minor modes again, toggling them off (throw 'nop nil))))) ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which @@ -1924,16 +1949,19 @@ ;; Map interpreter name to a mode, signalling we're done at the ;; same time. done (assoc (file-name-nondirectory mode) - interpreter-mode-alist))) - ;; If we found an interpreter mode to use, invoke it now. - (if done - (set-auto-mode-0 (cdr done) keep-mode-if-same) + interpreter-mode-alist)) + ;; If we found an interpreter mode to use, invoke it now. + (if done + (set-auto-mode-0 (cdr done) keep-mode-if-same))) + ;; If we didn't, match the buffer beginning against magic-mode-alist. + (unless done (if (setq done (save-excursion (goto-char (point-min)) (assoc-default nil magic-mode-alist (lambda (re dummy) (looking-at re))))) (set-auto-mode-0 done keep-mode-if-same) + ;; Compare the filename against the entries in auto-mode-alist. (if buffer-file-name (let ((name buffer-file-name)) ;; Remove backup-suffixes from file name. @@ -1943,7 +1971,7 @@ (let ((case-fold-search (memq system-type '(vax-vms windows-nt cygwin)))) (if (and (setq mode (assoc-default name auto-mode-alist - 'string-match)) + 'string-match)) (consp mode) (cadr mode)) (setq mode (car mode) @@ -1952,7 +1980,6 @@ (when mode (set-auto-mode-0 mode keep-mode-if-same))))))))) - ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ;; same one we already have, don't actually reset it. We don't want to lose @@ -1971,7 +1998,6 @@ (funcall mode) mode)) - (defun set-auto-mode-1 () "Find the -*- spec in the buffer. Call with point at the place to start searching from.
--- a/lisp/filesets.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/filesets.el Fri Nov 12 02:53:04 2004 +0000 @@ -295,7 +295,8 @@ (defgroup filesets nil "The fileset swapper." :prefix "filesets-" - :group 'convenience) + :group 'convenience + :version "21.4") (defcustom filesets-menu-name "Filesets" "*Filesets' menu name." @@ -1355,7 +1356,7 @@ (run-hooks 'oh)) (set-buffer-modified-p nil) (setq buffer-read-only t) - (beginning-of-buffer)) + (goto-char (point-min))) (when oh (run-hooks 'oh)))) (filesets-error 'error @@ -1592,7 +1593,8 @@ (defun filesets-cmd-show-result (cmd output) "Show OUTPUT of CMD (a shell command)." (pop-to-buffer "*Filesets: Shell Command Output*") - (end-of-buffer) + (with-no-warnings + (end-of-buffer)) (insert "*** ") (insert cmd) (newline) @@ -1637,7 +1639,7 @@ (save-restriction (let ((buffer (filesets-find-file this))) (when buffer - (beginning-of-buffer) + (goto-char (point-min)) (let () (cond ((stringp fn)
--- a/lisp/font-lock.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/font-lock.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,7 +1,7 @@ ;;; font-lock.el --- Electric font lock mode -;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001, 02, 2003, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: jwz, then rms, then sm ;; Maintainer: FSF @@ -1289,20 +1289,20 @@ (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) (goto-char start) ;; - ;; Find the state at the `beginning-of-line' before `start'. + ;; Find the `start' state. (setq state (or ppss (syntax-ppss start))) ;; ;; Find each interesting place between here and `end'. (while (progn + (setq state (parse-partial-sexp (point) end nil nil state + 'syntax-table)) (when (or (nth 3 state) (nth 4 state)) (setq face (funcall font-lock-syntactic-face-function state)) (setq beg (max (nth 8 state) start)) (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table)) (when face (put-text-property beg (point) 'face face))) - (setq state (parse-partial-sexp (point) end nil nil state - 'syntax-table)) (< (point) end))))) ;;; End of Syntactic fontification functions. @@ -2004,5 +2004,5 @@ (provide 'font-lock) -;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c +;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c ;;; font-lock.el ends here
--- a/lisp/gnus/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/gnus/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,23 @@ +2004-11-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by + default; improve customization type. + (gnus-emphasis-custom-with-format): New macro. + (gnus-emphasis-custom-value-to-external): New function. + (gnus-emphasis-custom-value-to-internal): New function. + +2004-11-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-msg.el (gnus-configure-posting-styles): Don't cause the + "Args out of range" error. Reported by Arnaud Giersch + <arnaud.giersch@free.fr>. + +2004-11-04 Richard M. Stallman <rms@gnu.org> + + * spam.el (spam group): Add :version. + + * pgg-def.el (pgg group): Add :version. + 2004-11-04 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art. (gnus-article-edit-article): Don't associate the
--- a/lisp/gnus/gnus-art.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/gnus/gnus-art.el Fri Nov 12 02:53:04 2004 +0000 @@ -321,27 +321,55 @@ :version "21.4" :group 'gnus-article-washing) +(defmacro gnus-emphasis-custom-with-format (&rest body) + `(let ((format "\ +\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\ +\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")) + ,@body)) + +(defun gnus-emphasis-custom-value-to-external (value) + (gnus-emphasis-custom-with-format + (if (consp (car value)) + (list (format format (car (car value)) (cdr (car value))) + 2 + (if (nth 1 value) 2 3) + (nth 2 value)) + value))) + +(defun gnus-emphasis-custom-value-to-internal (value) + (gnus-emphasis-custom-with-format + (let ((regexp (concat "\\`" + (format (regexp-quote format) + "\\([^()]+\\)" "\\([^()]+\\)") + "\\'")) + pattern) + (if (string-match regexp (setq pattern (car value))) + (list (cons (match-string 1 pattern) (match-string 2 pattern)) + (= (nth 2 value) 2) + (nth 3 value)) + value)))) + (defcustom gnus-emphasis-alist - (let ((format - "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") - (types - '(("\\*" "\\*" bold) + (let ((types + '(("\\*" "\\*" bold nil 2) ("_" "_" underline) ("/" "/" italic) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(,@(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types) - ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-strikethru) - ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline))) + (nconc + (gnus-emphasis-custom-with-format + (mapcar (lambda (spec) + (list (format format (car spec) (cadr spec)) + (or (nth 3 spec) 2) + (or (nth 4 spec) 3) + (intern (format "gnus-emphasis-%s" (nth 2 spec))))) + types)) + '(("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-strikethru) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline)))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -352,11 +380,43 @@ the entire emphasized word. The third is a number that says what regexp grouping should be displayed and highlighted. The fourth is the face used for highlighting." - :type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) + :type + '(repeat + (menu-choice + :format "%[Customizing Style%]\n%v" + :indent 2 + (group :tag "Default" + :value ("" 0 0 default) + :value-create + (lambda (widget) + (let ((value (widget-get + (cadr (widget-get (widget-get widget :parent) + :args)) + :value))) + (if (not (eq (nth 2 value) 'default)) + (widget-put + widget + :value + (gnus-emphasis-custom-value-to-external value)))) + (widget-group-value-create widget)) + (regexp :format "%t: %v\n" :size 1) + (integer :format "Match group: %v\n" :size 0) + (integer :format "Emphasize group: %v\n" :size 0) + face) + (group :tag "Simple" + :value (("_" . "_") nil default) + (cons :format "%v" + (regexp :format "Start regexp: %v\n" :size 0) + (regexp :format "End regexp: %v\n" :size 0)) + (boolean :format "Show start and end patterns: %[%v%]\n" + :on " On " :off " Off ") + face))) + :get (lambda (symbol) + (mapcar 'gnus-emphasis-custom-value-to-internal + (default-value symbol))) + :set (lambda (symbol value) + (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external + value))) :group 'gnus-article-emphasis) (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
--- a/lisp/gnus/gnus-msg.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/gnus/gnus-msg.el Fri Nov 12 02:53:04 2004 +0000 @@ -1871,11 +1871,13 @@ (when (and filep v) (setq v (with-temp-buffer (insert-file-contents v) - (goto-char (point-max)) - (skip-chars-backward "\n") - (delete-region (+ (point) (if (bolp) 0 1)) - (point-max)) - (buffer-string)))) + (buffer-substring + (point-min) + (progn + (goto-char (point-max)) + (if (zerop (skip-chars-backward "\n")) + (point) + (1+ (point)))))))) (setq results (delq (assoc element results) results)) (push (cons element v) results)))) ;; Now we have all the styles, so we insert them.
--- a/lisp/gnus/pgg-def.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/gnus/pgg-def.el Fri Nov 12 02:53:04 2004 +0000 @@ -29,7 +29,8 @@ (defgroup pgg () "Glue for the various PGP implementations." - :group 'mime) + :group 'mime + :version "21.4") (defcustom pgg-default-scheme 'gpg "Default PGP scheme."
--- a/lisp/gnus/spam.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/gnus/spam.el Fri Nov 12 02:53:04 2004 +0000 @@ -76,7 +76,8 @@ ;;; Main parameters. (defgroup spam nil - "Spam configuration.") + "Spam configuration." + :version "21.4") (defcustom spam-directory (nnheader-concat gnus-directory "spam/") "Directory for spam whitelists and blacklists."
--- a/lisp/help-fns.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/help-fns.el Fri Nov 12 02:53:04 2004 +0000 @@ -228,9 +228,14 @@ (if (eobp) (insert-file-contents-literally (expand-file-name internal-doc-file-name doc-directory))) - (search-forward (concat " " name "\n")) + (let ((file (catch 'loop + (while t + (let ((pnt (search-forward (concat " " name "\n")))) (re-search-backward " S\\(.*\\)") (let ((file (match-string 1))) + (if (member file build-files) + (throw 'loop file) + (goto-char pnt)))))))) (if (string-match "\\.\\(o\\|obj\\)\\'" file) (setq file (replace-match ".c" t t file))) (if (string-match "\\.c\\'" file)
--- a/lisp/imenu.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/imenu.el Fri Nov 12 02:53:04 2004 +0000 @@ -126,7 +126,9 @@ (defcustom imenu-eager-completion-buffer (not (eq imenu-always-use-completion-buffer-p 'never)) "If non-nil, eagerly popup the completion buffer." - :type 'boolean) + :type 'boolean + :group 'imenu + :version "21.4") (defcustom imenu-after-jump-hook nil "*Hooks called after jumping to a place in the buffer.
--- a/lisp/info-look.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/info-look.el Fri Nov 12 02:53:04 2004 +0000 @@ -328,22 +328,22 @@ (modes (info-lookup->all-modes topic mode)) (window (selected-window)) found doc-spec node prefix suffix doc-found) - (if (or (not info-lookup-other-window-flag) - (eq (current-buffer) (get-buffer "*info*"))) - (info) - (progn - (save-window-excursion (info)) - ;; Determine whether or not the Info buffer is visible in - ;; another frame on the same display. If it is, simply raise - ;; that frame. Otherwise, display it in another window. - (let* ((window (get-buffer-window "*info*" t)) - (info-frame (and window (window-frame window)))) - (if (and info-frame - (display-multi-frame-p) - (memq info-frame (frames-on-display-list)) - (not (eq info-frame (selected-frame)))) - (select-frame info-frame) - (switch-to-buffer-other-window "*info*"))))) + (if (not (eq major-mode 'Info-mode)) + (if (not info-lookup-other-window-flag) + (info) + (progn + (save-window-excursion (info)) + ;; Determine whether or not the Info buffer is visible in + ;; another frame on the same display. If it is, simply raise + ;; that frame. Otherwise, display it in another window. + (let* ((window (get-buffer-window "*info*" t)) + (info-frame (and window (window-frame window)))) + (if (and info-frame + (display-multi-frame-p) + (memq info-frame (frames-on-display-list)) + (not (eq info-frame (selected-frame)))) + (select-frame info-frame) + (switch-to-buffer-other-window "*info*")))))) (while (and (not found) modes) (setq doc-spec (info-lookup->doc-spec topic (car modes))) (while (and (not found) doc-spec) @@ -633,11 +633,11 @@ :mode 'c-mode :topic 'symbol :regexp "\\(struct \\|union \\|enum \\)?[_a-zA-Z][_a-zA-Z0-9]*" :doc-spec '(("(libc)Function Index" nil - "^[ \t]+- \\(Function\\|Macro\\): .*\\<" "\\>") + "^[ \t]+-+ \\(Function\\|Macro\\): .*\\<" "\\>") ("(libc)Variable Index" nil - "^[ \t]+- \\(Variable\\|Macro\\): .*\\<" "\\>") + "^[ \t]+-+ \\(Variable\\|Macro\\): .*\\<" "\\>") ("(libc)Type Index" nil - "^[ \t]+- Data Type: \\<" "\\>") + "^[ \t]+-+ Data Type: \\<" "\\>") ("(termcap)Var Index" nil "^[ \t]*`" "'")) :parse-rule 'info-lookup-guess-c-symbol) @@ -673,7 +673,7 @@ (lambda (item) (if (string-match "^\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\( .*\\)?$" item) (concat "@" (match-string 1 item)))) - "`" "'"))) + "`" "[' ]"))) (info-lookup-maybe-add-help :mode 'm4-mode @@ -690,7 +690,7 @@ ("(autoconf)Autoconf Macro Index" (lambda (item) (if (string-match "^A._" item) item (concat "AC_" item))) - "^[ \t]+- \\(Macro\\|Variable\\): .*\\<" "\\>") + "^[ \t]+-+ \\(Macro\\|Variable\\): .*\\<" "\\>") ;; M4 Macro Index entries are without "AS_" prefixes, and ;; mostly without "m4_" prefixes. "dnl" is an exception, not ;; wanting any prefix. So AS_ is added back to upper-case @@ -705,13 +705,13 @@ (concat "AS_" item)) (t (concat "m4_" item))))) - "^[ \t]+- Macro: .*\\<" "\\>") + "^[ \t]+-+ Macro: .*\\<" "\\>") ;; Autotest Macro Index entries are without "AT_". ("(autoconf)Autotest Macro Index" "AT_" - "^[ \t]+- Macro: .*\\<" "\\>") + "^[ \t]+-+ Macro: .*\\<" "\\>") ;; This is for older versions (probably pre autoconf 2.5x): ("(autoconf)Macro Index" "AC_" - "^[ \t]+- \\(Macro\\|Variable\\): .*\\<" "\\>") + "^[ \t]+-+ \\(Macro\\|Variable\\): .*\\<" "\\>") ;; Automake has index entries for its notes on various autoconf ;; macros (eg. AC_PROG_CC). Ensure this is after the autoconf ;; index, so as to prefer the autoconf docs. @@ -788,13 +788,13 @@ ;; Variables normally appear in nodes as just `foo'. ("(emacs)Variable Index" nil "`" "'") ;; Almost all functions, variables, etc appear in nodes as - ;; " - Function: foo" etc. A small number of aliases and + ;; " -- Function: foo" etc. A small number of aliases and ;; symbols appear only as `foo', and will miss out on exact ;; positions. Allowing `foo' would hit too many false matches ;; for things that should go to Function: etc, and those latter ;; are much more important. Perhaps this could change if some ;; sort of fallback match scheme existed. - ("(elisp)Index" nil "^ - .*: " "\\( \\|$\\)"))) + ("(elisp)Index" nil "^ -+ .*: " "\\( \\|$\\)"))) (info-lookup-maybe-add-help :mode 'lisp-interaction-mode @@ -814,14 +814,14 @@ :ignore-case t ;; Aubrey Jaffer's rendition from <URL:ftp://ftp-swiss.ai.mit.edu/pub/scm> :doc-spec '(("(r5rs)Index" nil - "^[ \t]+- [^:]+:[ \t]*" "\\b"))) + "^[ \t]+-+ [^:]+:[ \t]*" "\\b"))) (info-lookup-maybe-add-help :mode 'octave-mode :regexp "[_a-zA-Z0-9]+" :doc-spec '(("(octave)Function Index" nil - "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil) - ("(octave)Variable Index" nil "^ - [^:]+:[ ]+" nil) + "^ -+ [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil) + ("(octave)Variable Index" nil "^ -+ [^:]+:[ ]+" nil) ;; Catch lines of the form "xyz statement" ("(octave)Concept Index" (lambda (item) @@ -829,15 +829,15 @@ ((string-match "^\\([A-Z]+\\) statement\\b" item) (match-string 1 item)) (t nil))) - nil; "^ - [^:]+:[ ]+" don't think this prefix is useful here. + nil; "^ -+ [^:]+:[ ]+" don't think this prefix is useful here. nil))) (info-lookup-maybe-add-help :mode 'maxima-mode :ignore-case t :regexp "[a-zA-Z_%]+" - :doc-spec '( ("(maxima)Function and Variable Index" nil - "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil))) + :doc-spec '( ("(maxima)Function and Variable Index" nil + "^ -+ [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil))) (info-lookup-maybe-add-help :mode 'inferior-maxima-mode
--- a/lisp/info.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/info.el Fri Nov 12 02:53:04 2004 +0000 @@ -657,10 +657,10 @@ (equal old-nodename Info-current-node)) (progn ;; note goto-line is no good, we want to measure from point-min - (beginning-of-buffer) + (goto-char (point-min)) (forward-line wline) (set-window-start (selected-window) (point)) - (beginning-of-buffer) + (goto-char (point-min)) (forward-line pline) (move-to-column pcolumn)) ;; only add to the history when coming from a different file+node @@ -1476,11 +1476,26 @@ (save-excursion (save-restriction (widen) + (when backward + ;; Hide Info file header for backward search + (narrow-to-region (save-excursion + (goto-char (point-min)) + (search-forward "\n\^_") + (1- (point))) + (point-max))) (while (and (not give-up) - (or (null found) - (if backward - (isearch-range-invisible found beg-found) - (isearch-range-invisible beg-found found)))) + (save-match-data + (or (null found) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)) + ;; Skip node header line + (save-excursion (forward-line -1) + (looking-at "\^_")) + ;; Skip Tag Table node + (save-excursion + (and (search-backward "\^_" nil t) + (looking-at "\^_\nTag Table")))))) (if (if backward (re-search-backward regexp bound t) (re-search-forward regexp bound t)) @@ -1531,14 +1546,29 @@ (while list (message "Searching subfile %s..." (cdr (car list))) (Info-read-subfile (car (car list))) - (if backward (goto-char (point-max))) + (when backward + ;; Hide Info file header for backward search + (narrow-to-region (save-excursion + (goto-char (point-min)) + (search-forward "\n\^_") + (1- (point))) + (point-max)) + (goto-char (point-max))) (setq list (cdr list)) (setq give-up nil found nil) (while (and (not give-up) - (or (null found) - (if backward - (isearch-range-invisible found beg-found) - (isearch-range-invisible beg-found found)))) + (save-match-data + (or (null found) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)) + ;; Skip node header line + (save-excursion (forward-line -1) + (looking-at "\^_")) + ;; Skip Tag Table node + (save-excursion + (and (search-backward "\^_" nil t) + (looking-at "\^_\nTag Table")))))) (if (if backward (re-search-backward regexp nil t) (re-search-forward regexp nil t))
--- a/lisp/international/iso-cvt.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/international/iso-cvt.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,7 +1,8 @@ ;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: iso-latin-1 -*- ;; This file was formerly called gm-lingo.el. -;; Copyright (C) 1993, 1994, 1995, 1996, 1998, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1996, 1998, 2000, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at> ;; Keywords: tex, iso, latin, i18n @@ -828,69 +829,67 @@ ;;;###autoload (defun iso-cvt-define-menu () - "Add submenus to the Files menu, to convert to and from various formats." + "Add submenus to the File menu, to convert to and from various formats." (interactive) - (define-key menu-bar-files-menu [load-as-separator] '("--")) + (let ((load-as-menu-map (make-sparse-keymap "Load As...")) + (insert-as-menu-map (make-sparse-keymap "Insert As...")) + (write-as-menu-map (make-sparse-keymap "Write As...")) + (translate-to-menu-map (make-sparse-keymap "Translate to...")) + (translate-from-menu-map (make-sparse-keymap "Translate from...")) + (menu menu-bar-file-menu)) + + (define-key menu [load-as-separator] '("--")) - (define-key menu-bar-files-menu [load-as] '("Load As..." . load-as)) - (defvar load-as-menu-map (make-sparse-keymap "Load As...")) - (fset 'load-as load-as-menu-map) - - ;;(define-key menu-bar-files-menu [insert-as] '("Insert As..." . insert-as)) - (defvar insert-as-menu-map (make-sparse-keymap "Insert As...")) - (fset 'insert-as insert-as-menu-map) + (define-key menu [load-as] '("Load As..." . iso-cvt-load-as)) + (fset 'iso-cvt-load-as load-as-menu-map) - (define-key menu-bar-files-menu [write-as] '("Write As..." . write-as)) - (defvar write-as-menu-map (make-sparse-keymap "Write As...")) - (fset 'write-as write-as-menu-map) + ;;(define-key menu [insert-as] '("Insert As..." . iso-cvt-insert-as)) + (fset 'iso-cvt-insert-as insert-as-menu-map) - (define-key menu-bar-files-menu [translate-separator] '("--")) + (define-key menu [write-as] '("Write As..." . iso-cvt-write-as)) + (fset 'iso-cvt-write-as write-as-menu-map) - (define-key menu-bar-files-menu [translate-to] '("Translate to..." . translate-to)) - (defvar translate-to-menu-map (make-sparse-keymap "Translate to...")) - (fset 'translate-to translate-to-menu-map) + (define-key menu [translate-separator] '("--")) - (define-key menu-bar-files-menu [translate-from] '("Translate from..." . translate-from)) - (defvar translate-from-menu-map (make-sparse-keymap "Translate from...")) - (fset 'translate-from translate-from-menu-map) + (define-key menu [translate-to] '("Translate to..." . iso-cvt-translate-to)) + (fset 'iso-cvt-translate-to translate-to-menu-map) + + (define-key menu [translate-from] '("Translate from..." . iso-cvt-translate-from)) + (fset 'iso-cvt-translate-from translate-from-menu-map) - (let ((file-types (reverse format-alist)) - name - str-name) - (while file-types - (setq name (car (car file-types)) - str-name (car (cdr (car file-types))) - file-types (cdr file-types)) - (if (stringp str-name) - (progn - (define-key load-as-menu-map (vector name) - (cons str-name - `(lambda (file) - (interactive (format "FFind file (as %s): " ,name)) - (format-find-file file ',name)))) - (define-key insert-as-menu-map (vector name) - (cons str-name - `(lambda (file) - (interactive (format "FInsert file (as %s): " ,name)) - (format-insert-file file ',name)))) - (define-key write-as-menu-map (vector name) - (cons str-name - `(lambda (file) - (interactive (format "FWrite file (as %s): " ,name)) - (format-write-file file ',name)))) - (define-key translate-to-menu-map (vector name) - (cons str-name - `(lambda () - (interactive) - (format-encode-buffer ',name)))) - (define-key translate-from-menu-map (vector name) - (cons str-name - `(lambda () - (interactive) - (format-decode-buffer ',name))))))))) + (dolist (file-type (reverse format-alist)) + (let ((name (car file-type)) + (str-name (cadr file-type))) + (if (stringp str-name) + (progn + (define-key load-as-menu-map (vector name) + (cons str-name + `(lambda (file) + (interactive ,(format "FFind file (as %s): " name)) + (format-find-file file ',name)))) + (define-key insert-as-menu-map (vector name) + (cons str-name + `(lambda (file) + (interactive (format "FInsert file (as %s): " ,name)) + (format-insert-file file ',name)))) + (define-key write-as-menu-map (vector name) + (cons str-name + `(lambda (file) + (interactive (format "FWrite file (as %s): " ,name)) + (format-write-file file ',name)))) + (define-key translate-to-menu-map (vector name) + (cons str-name + `(lambda () + (interactive) + (format-encode-buffer ',name)))) + (define-key translate-from-menu-map (vector name) + (cons str-name + `(lambda () + (interactive) + (format-decode-buffer ',name)))))))))) (provide 'iso-cvt) -;;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840 +;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840 ;;; iso-cvt.el ends here
--- a/lisp/international/mule-cmds.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/international/mule-cmds.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,7 +1,8 @@ ;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*- + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Licensed to the Free Software Foundation. ;; Copyright (C) 2003 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H13PRO009 @@ -611,6 +612,175 @@ function `select-safe-coding-system' (which see). This variable overrides that argument.") +(defun select-safe-coding-system-interactively (from to codings unsafe + &optional rejected default) + "Select interactively a coding system for the region FROM ... TO. +FROM can be a string, as in `write-region'. +CODINGS is the list of base coding systems known to be safe for this region, + typically obtained with `find-coding-systems-region'. +UNSAFE is a list of coding systems known to be unsafe for this region. +REJECTED is a list of coding systems which were safe but for some reason + were not recommended in the particular context. +DEFAULT is the coding system to use by default in the query." + ;; At first, if some defaults are unsafe, record at most 11 + ;; problematic characters and their positions for them by turning + ;; (CODING ...) + ;; into + ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...) + (if unsafe + (setq unsafe + (mapcar #'(lambda (coding) + (cons coding + (if (stringp from) + (mapcar #'(lambda (pos) + (cons pos (aref from pos))) + (unencodable-char-position + 0 (length from) coding + 11 from)) + (mapcar #'(lambda (pos) + (cons pos (char-after pos))) + (unencodable-char-position + from to coding 11))))) + unsafe))) + + ;; Change each safe coding system to the corresponding + ;; mime-charset name if it is also a coding system. Such a name + ;; is more friendly to users. + (let ((l codings) + mime-charset) + (while l + (setq mime-charset (coding-system-get (car l) 'mime-charset)) + (if (and mime-charset (coding-system-p mime-charset)) + (setcar l mime-charset)) + (setq l (cdr l)))) + + ;; Don't offer variations with locking shift, which you + ;; basically never want. + (let (l) + (dolist (elt codings (setq codings (nreverse l))) + (unless (or (eq 'coding-category-iso-7-else + (coding-system-category elt)) + (eq 'coding-category-iso-8-else + (coding-system-category elt))) + (push elt l)))) + + ;; Remove raw-text, emacs-mule and no-conversion unless nothing + ;; else is available. + (setq codings + (or (delq 'raw-text + (delq 'emacs-mule + (delq 'no-conversion codings))) + '(raw-text emacs-mule no-conversion))) + + (let ((window-configuration (current-window-configuration)) + (bufname (buffer-name)) + coding-system) + (save-excursion + ;; If some defaults are unsafe, make sure the offending + ;; buffer is displayed. + (when (and unsafe (not (stringp from))) + (pop-to-buffer bufname) + (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x))) + unsafe)))) + ;; Then ask users to select one from CODINGS while showing + ;; the reason why none of the defaults are not used. + (with-output-to-temp-buffer "*Warning*" + (with-current-buffer standard-output + (if (and (null rejected) (null unsafe)) + (insert "No default coding systems to try for " + (if (stringp from) + (format "string \"%s\"." from) + (format "buffer `%s'." bufname))) + (insert + "These default coding systems were tried to encode" + (if (stringp from) + (concat " \"" (if (> (length from) 10) + (concat (substring from 0 10) "...\"") + (concat from "\""))) + (format " text\nin the buffer `%s'" bufname)) + ":\n") + (let ((pos (point)) + (fill-prefix " ")) + (dolist (x (append rejected unsafe)) + (princ " ") (princ (car x))) + (insert "\n") + (fill-region-as-paragraph pos (point))) + (when rejected + (insert "These safely encodes the target text, +but it is not recommended for encoding text in this context, +e.g., for sending an email message.\n ") + (dolist (x rejected) + (princ " ") (princ x)) + (insert "\n")) + (when unsafe + (insert (if rejected "And the others" + "However, each of them") + " encountered these problematic characters:\n") + (dolist (coding unsafe) + (insert (format " %s:" (car coding))) + (let ((i 0) + (func1 + #'(lambda (bufname pos) + (when (buffer-live-p (get-buffer bufname)) + (pop-to-buffer bufname) + (goto-char pos)))) + (func2 + #'(lambda (bufname pos coding) + (when (buffer-live-p (get-buffer bufname)) + (pop-to-buffer bufname) + (if (< (point) pos) + (goto-char pos) + (forward-char 1) + (search-unencodable-char coding) + (forward-char -1)))))) + (dolist (elt (cdr coding)) + (insert " ") + (if (stringp from) + (insert (if (< i 10) (cdr elt) "...")) + (if (< i 10) + (insert-text-button + (cdr elt) + :type 'help-xref + 'help-echo + "mouse-2, RET: jump to this character" + 'help-function func1 + 'help-args (list bufname (car elt))) + (insert-text-button + "..." + :type 'help-xref + 'help-echo + "mouse-2, RET: next unencodable character" + 'help-function func2 + 'help-args (list bufname (car elt) + (car coding))))) + (setq i (1+ i)))) + (insert "\n")) + (insert "\ +The first problematic character is at point in the displayed buffer,\n" + (substitute-command-keys "\ +and \\[universal-argument] \\[what-cursor-position] will give information about it.\n")))) + (insert "\nSelect \ +one of the following safe coding systems, or edit the buffer:\n") + (let ((pos (point)) + (fill-prefix " ")) + (dolist (x codings) + (princ " ") (princ x)) + (insert "\n") + (fill-region-as-paragraph pos (point))) + (insert "Or specify any other coding system +at the risk of losing the problematic characters.\n"))) + + ;; Read a coding system. + (setq coding-system + (read-coding-system + (format "Select coding system (default %s): " default) + default)) + (setq last-coding-system-specified coding-system)) + + (kill-buffer "*Warning*") + (set-window-configuration window-configuration) + coding-system)) + (defun select-safe-coding-system (from to &optional default-coding-system accept-default-p file) "Ask a user to select a safe coding system from candidates. @@ -705,7 +875,6 @@ (let ((codings (find-coding-systems-region from to)) (coding-system nil) - (bufname (buffer-name)) safe rejected unsafe) ;; Classify the defaults into safe, rejected, and unsafe. (dolist (elt default-coding-system) @@ -1344,12 +1513,14 @@ current-input-method-title nil) (force-mode-line-update))))) -(defun set-input-method (input-method) +(defun set-input-method (input-method &optional interactive) "Select and activate input method INPUT-METHOD for the current buffer. This also sets the default input method to the one you specify. If INPUT-METHOD is nil, this function turns off the input method, and also causes you to be prompted for a name of an input method the next time you invoke \\[toggle-input-method]. +When called interactively, the optional arg INTERACTIVE is non-nil, +which marks the variable `default-input-method' as set for Custom buffers. To deactivate the input method interactively, use \\[toggle-input-method]. To deactivate it programmatically, use \\[inactivate-input-method]." @@ -1357,14 +1528,15 @@ (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name (if default "Select input method (default %s): " "Select input method: ") - default t)))) + default t) + t))) (activate-input-method input-method) (setq default-input-method input-method) - (when (interactive-p) + (when interactive (customize-mark-as-set 'default-input-method)) default-input-method) -(defun toggle-input-method (&optional arg) +(defun toggle-input-method (&optional arg interactive) "Enable or disable multilingual text input method for the current buffer. Only one input method can be enabled at any time in a given buffer. @@ -1377,9 +1549,12 @@ With a prefix argument, read an input method name with the minibuffer and enable that one. The default is the most recent input method specified -\(not including the currently active input method, if any)." +\(not including the currently active input method, if any). - (interactive "P") +When called interactively, the optional arg INTERACTIVE is non-nil, +which marks the variable `default-input-method' as set for Custom buffers." + + (interactive "P\np") (if (and current-input-method (not arg)) (inactivate-input-method) (let ((default (or (car input-method-history) default-input-method))) @@ -1396,7 +1571,7 @@ (unless default-input-method (prog1 (setq default-input-method current-input-method) - (when (interactive-p) + (when interactive (customize-mark-as-set 'default-input-method))))))) (eval-when-compile (autoload 'help-buffer "help-mode")) @@ -2545,5 +2720,5 @@ (defvar nonascii-translation-table nil "This variable is obsolete.") -;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc +;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc ;;; mule-cmds.el ends here
--- a/lisp/macros.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/macros.el Fri Nov 12 02:53:04 2004 +0000 @@ -63,7 +63,14 @@ To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', use this command, and then save the file." - (interactive "CInsert kbd macro (name): \nP") + (interactive (list (intern (completing-read "Insert kbd macro (name): " + obarray + (lambda (elt) + (and (fboundp elt) + (or (stringp (symbol-function elt)) + (vectorp (symbol-function elt))))) + t)) + current-prefix-arg)) (let (definition) (if (string= (symbol-name macroname) "") (progn
--- a/lisp/mail/supercite.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/mail/supercite.el Fri Nov 12 02:53:04 2004 +0000 @@ -1424,18 +1424,21 @@ nil) ;; interactive functions -(defun sc-cite-region (start end &optional confirm-p) +(defun sc-cite-region (start end &optional confirm-p interactive) "Cite a region delineated by START and END. If optional CONFIRM-P is non-nil, the attribution is confirmed before its use in the citation string. This function first runs -`sc-pre-cite-hook'." - (interactive "r\nP") +`sc-pre-cite-hook'. + +When called interactively, the optional arg INTERACTIVE is non-nil, +and that means call `sc-select-attribution' too." + (interactive "r\nP\np") (undo-boundary) (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist) sc-default-cite-frame)) (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) (run-hooks 'sc-pre-cite-hook) - (if (interactive-p) + (if interactive (sc-select-attribution)) (regi-interpret frame start end))) @@ -1978,16 +1981,15 @@ (insert (sc-mail-field "sc-citation")) (error "Line is already cited")))) -(defun sc-version (arg) +(defun sc-version (message) "Echo the current version of Supercite in the minibuffer. -With \\[universal-argument] (universal-argument), or if run non-interactively, +If MESSAGE is non-nil (interactively, with no prefix argument), inserts the version string in the current buffer instead." - (interactive "P") + (interactive (not current-prefix-arg)) (let ((verstr (format "Using Supercite.el %s" sc-version))) - (if (or (consp arg) - (not (interactive-p))) - (insert "`sc-version' says: " verstr) - (message verstr)))) + (if message + (message verstr) + (insert "`sc-version' says: " verstr)))) (defun sc-describe () "
--- a/lisp/menu-bar.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/menu-bar.el Fri Nov 12 02:53:04 2004 +0000 @@ -63,78 +63,78 @@ (cons "Options" menu-bar-options-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(defvar menu-bar-files-menu (make-sparse-keymap "File")) -(define-key global-map [menu-bar files] (cons "File" menu-bar-files-menu)) +(defvar menu-bar-file-menu (make-sparse-keymap "File")) +(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) ;; This alias is for compatibility with 19.28 and before. -(defvar menu-bar-file-menu menu-bar-files-menu) +(defvar menu-bar-files-menu menu-bar-file-menu) ;; This is referenced by some code below; it is defined in uniquify.el (defvar uniquify-buffer-name-style) ;; The "File" menu items -(define-key menu-bar-files-menu [exit-emacs] +(define-key menu-bar-file-menu [exit-emacs] '(menu-item "Exit Emacs" save-buffers-kill-emacs :help "Save unsaved buffers, then exit")) -(define-key menu-bar-files-menu [separator-exit] +(define-key menu-bar-file-menu [separator-exit] '("--")) ;; Don't use delete-frame as event name because that is a special ;; event. -(define-key menu-bar-files-menu [delete-this-frame] +(define-key menu-bar-file-menu [delete-this-frame] '(menu-item "Delete Frame" delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) :help "Delete currently selected frame")) -(define-key menu-bar-files-menu [make-frame-on-display] +(define-key menu-bar-file-menu [make-frame-on-display] '(menu-item "New Frame on Display..." make-frame-on-display :visible (fboundp 'make-frame-on-display) :help "Open a new frame on another display")) -(define-key menu-bar-files-menu [make-frame] +(define-key menu-bar-file-menu [make-frame] '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) :help "Open a new frame")) -(define-key menu-bar-files-menu [one-window] +(define-key menu-bar-file-menu [one-window] '(menu-item "Unsplit Windows" delete-other-windows :enable (not (one-window-p t nil)) :help "Make selected window fill its frame")) -(define-key menu-bar-files-menu [split-window] +(define-key menu-bar-file-menu [split-window] '(menu-item "Split Window" split-window-vertically :help "Split selected window in two")) -(define-key menu-bar-files-menu [separator-window] +(define-key menu-bar-file-menu [separator-window] '(menu-item "--")) -(define-key menu-bar-files-menu [ps-print-region] +(define-key menu-bar-file-menu [ps-print-region] '(menu-item "Postscript Print Region (B+W)" ps-print-region :enable mark-active :help "Pretty-print marked region in black and white to PostScript printer")) -(define-key menu-bar-files-menu [ps-print-buffer] +(define-key menu-bar-file-menu [ps-print-buffer] '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer :help "Pretty-print current buffer in black and white to PostScript printer")) -(define-key menu-bar-files-menu [ps-print-region-faces] +(define-key menu-bar-file-menu [ps-print-region-faces] '(menu-item "Postscript Print Region" ps-print-region-with-faces :enable mark-active :help "Pretty-print marked region to PostScript printer")) -(define-key menu-bar-files-menu [ps-print-buffer-faces] +(define-key menu-bar-file-menu [ps-print-buffer-faces] '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces :help "Pretty-print current buffer to PostScript printer")) -(define-key menu-bar-files-menu [print-region] +(define-key menu-bar-file-menu [print-region] '(menu-item "Print Region" print-region :enable mark-active :help "Print region between mark and current position")) -(define-key menu-bar-files-menu [print-buffer] +(define-key menu-bar-file-menu [print-buffer] '(menu-item "Print Buffer" print-buffer :help "Print current buffer with page headings")) -(define-key menu-bar-files-menu [separator-print] +(define-key menu-bar-file-menu [separator-print] '(menu-item "--")) -(define-key menu-bar-files-menu [recover-session] +(define-key menu-bar-file-menu [recover-session] '(menu-item "Recover Crashed Session..." recover-session :enable (and auto-save-list-file-prefix (file-directory-p @@ -148,7 +148,7 @@ auto-save-list-file-prefix))) t)) :help "Recover edits from a crashed session")) -(define-key menu-bar-files-menu [revert-buffer] +(define-key menu-bar-file-menu [revert-buffer] '(menu-item "Revert Buffer" revert-buffer :enable (or revert-buffer-function revert-buffer-insert-file-contents-function @@ -157,12 +157,12 @@ (not (verify-visited-file-modtime (current-buffer)))))) :help "Re-read current buffer from its file")) -(define-key menu-bar-files-menu [write-file] +(define-key menu-bar-file-menu [write-file] '(menu-item "Save Buffer As..." write-file :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame))) :help "Write current buffer to another file")) -(define-key menu-bar-files-menu [save-buffer] +(define-key menu-bar-file-menu [save-buffer] '(menu-item "Save (current buffer)" save-buffer :enable (and (buffer-modified-p) (buffer-file-name) @@ -170,27 +170,27 @@ (frame-selected-window menu-updating-frame)))) :help "Save current buffer to its file")) -(define-key menu-bar-files-menu [separator-save] +(define-key menu-bar-file-menu [separator-save] '(menu-item "--")) -(define-key menu-bar-files-menu [kill-buffer] +(define-key menu-bar-file-menu [kill-buffer] '(menu-item "Close (current buffer)" kill-this-buffer :enable (kill-this-buffer-enabled-p) :help "Discard current buffer")) -(define-key menu-bar-files-menu [insert-file] +(define-key menu-bar-file-menu [insert-file] '(menu-item "Insert File..." insert-file :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame))) :help "Insert another file into current buffer")) -(define-key menu-bar-files-menu [dired] +(define-key menu-bar-file-menu [dired] '(menu-item "Open Directory..." dired :help "Read a directory, operate on its files")) -(define-key menu-bar-files-menu [open-file] +(define-key menu-bar-file-menu [open-file] '(menu-item "Open File..." find-file-existing :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame))) :help "Read an existing file into an Emacs buffer")) -(define-key menu-bar-files-menu [new-file] +(define-key menu-bar-file-menu [new-file] '(menu-item "New File..." find-file :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))
--- a/lisp/mouse.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/mouse.el Fri Nov 12 02:53:04 2004 +0000 @@ -1068,8 +1068,7 @@ (unless ignore ;; For certain special keys, delete the region. (if (member key mouse-region-delete-keys) - (delete-region (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay)) + (delete-region (mark t) (point)) ;; Otherwise, unread the key so it gets executed normally. (setq unread-command-events (nconc events unread-command-events))))
--- a/lisp/mwheel.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/mwheel.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,6 +1,6 @@ ;;; mwheel.el --- Wheel mouse support -;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2002, 2004 Free Software Foundation, Inc. ;; Maintainer: William M. Perry <wmperry@gnu.org> ;; Keywords: mouse @@ -137,7 +137,7 @@ (integer :tag "Specific # of lines") (float :tag "Fraction of window")))))) -(defcustom mouse-wheel-progessive-speed t +(defcustom mouse-wheel-progressive-speed t "If non-nil, the faster the user moves the wheel, the faster the scrolling. Note that this has no effect when `mouse-wheel-scroll-amount' specifies a \"near full screen\" scroll or when the mouse wheel sends key instead @@ -197,7 +197,7 @@ (let ((list-elt mouse-wheel-scroll-amount)) (while (consp (setq amt (pop list-elt)))))) (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height)))))) - (when (and mouse-wheel-progessive-speed (numberp amt)) + (when (and mouse-wheel-progressive-speed (numberp amt)) ;; When the double-mouse-N comes in, a mouse-N has been executed already, ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...). (setq amt (* amt (event-click-count event)))) @@ -250,5 +250,5 @@ (provide 'mwheel) -;;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f +;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f ;;; mwheel.el ends here
--- a/lisp/net/browse-url.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/net/browse-url.el Fri Nov 12 02:53:04 2004 +0000 @@ -357,6 +357,15 @@ :type '(repeat (string :tag "Argument")) :group 'browse-url) +;; GNOME means of invoking either Mozilla or Netrape. +(defvar browse-url-gnome-moz-program "gnome-moz-remote") + +(defcustom browse-url-gnome-moz-arguments '() + "*A list of strings passed to the GNOME mozilla viewer as arguments." + :version "21.1" + :type '(repeat (string :tag "Argument")) + :group 'browse-url) + (defcustom browse-url-mozilla-new-window-is-tab nil "*Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if @@ -596,10 +605,11 @@ (not (eq (null browse-url-new-window-flag) (null current-prefix-arg))))) -;; interactive-p needs to be called at a function's top-level, hence -;; the macro. +;; called-interactive-p needs to be called at a function's top-level, hence +;; this macro. We use that rather than interactive-p because +;; use in a keyboard macro should not change this behavior. (defmacro browse-url-maybe-new-window (arg) - `(if (not (interactive-p)) + `(if (or noninteractive (not (called-interactively-p))) ,arg browse-url-new-window-flag)) @@ -1031,14 +1041,6 @@ browse-url-epiphany-program (append browse-url-epiphany-startup-arguments (list url)))))) -;; GNOME means of invoking either Mozilla or Netrape. -(defvar browse-url-gnome-moz-program "gnome-moz-remote") -(defcustom browse-url-gnome-moz-arguments '() - "*A list of strings passed to the GNOME mozilla viewer as arguments." - :version "21.1" - :type '(repeat (string :tag "Argument")) - :group 'browse-url) - ;;;###autoload (defun browse-url-gnome-moz (url &optional new-window) "Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
--- a/lisp/net/tramp.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/net/tramp.el Fri Nov 12 02:53:04 2004 +0000 @@ -159,7 +159,8 @@ (defgroup tramp nil "Edit remote files with a combination of rsh and rcp or similar programs." - :group 'files) + :group 'files + :version "21.4") (defcustom tramp-verbose 9 "*Verbosity level for tramp.el. 0 means be silent, 10 is most verbose." @@ -1535,8 +1536,9 @@ rm -f /tmp/tramp.$$ }" "Shell function to implement `uudecode' to standard output. -Many systems support `uudecode -o -' for this or `uudecode -p', but -some systems don't, and for them we have this shell function.") +Many systems support `uudecode -o /dev/stdout' for this or +`uudecode -o -' or `uudecode -p', but some systems don't, and for +them we have this shell function.") ;; Perl script to implement `file-attributes' in a Lisp `read'able ;; output. If you are hacking on this, note that you get *no* output @@ -5970,6 +5972,8 @@ base64-encode-region base64-decode-region) ("recode data..base64" "recode base64..data" base64-encode-region base64-decode-region) + ("uuencode xxx" "uudecode -o /dev/stdout" + tramp-uuencode-region uudecode-decode-region) ("uuencode xxx" "uudecode -o -" tramp-uuencode-region uudecode-decode-region) ("uuencode xxx" "uudecode -p"
--- a/lisp/outline.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/outline.el Fri Nov 12 02:53:04 2004 +0000 @@ -723,7 +723,7 @@ (progn (outline-next-preface) (point)) nil))) (defun hide-body () - "Hide all of buffer except headings." + "Hide all body lines in buffer, leaving all headings visible." (interactive) (hide-region-body (point-min) (point-max))) @@ -738,7 +738,8 @@ (narrow-to-region start end) (goto-char (point-min)) (if (outline-on-heading-p) - (outline-end-of-heading)) + (outline-end-of-heading) + (outline-next-preface)) (while (not (eobp)) (outline-flag-region (point) (progn (outline-next-preface) (point)) t)
--- a/lisp/paren.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/paren.el Fri Nov 12 02:53:04 2004 +0000 @@ -139,8 +139,8 @@ (defun show-paren-function () (if show-paren-mode (let ((oldpos (point)) - (dir (cond ((eq (car (syntax-after (1- (point)))) 5) -1) - ((eq (car (syntax-after (point))) 4) 1))) + (dir (cond ((eq (car (syntax-after (1- (point)))) ?\)) -1) + ((eq (car (syntax-after (point))) ?\() 1))) pos mismatch face) ;; ;; Find the other end of the sexp.
--- a/lisp/pcvs.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/pcvs.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,7 +1,7 @@ ;;; pcvs.el --- a front-end to CVS -;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,03,2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com ;; (Per Cederqvist) ceder@lysator.liu.se @@ -923,6 +923,21 @@ (append flags modules) nil 'new :noexist t)) +(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir) + "Run cvs checkout against the current branch. +The files are stored to DIR." + (interactive + (let* ((branch (cvs-prefix-get 'cvs-branch-prefix)) + (prompt (format "CVS Checkout Directory for `%s%s': " + (cvs-get-module) + (if branch (format " (branch: %s)" branch) + "")))) + (list (read-directory-name prompt nil default-directory nil)))) + (let ((modules (cvs-string->strings (cvs-get-module))) + (flags (cvs-add-branch-prefix + (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))) + (cvs-cvsroot (cvs-get-cvsroot))) + (cvs-checkout modules dir flags))) ;;;; ;;;; The code for running a "cvs update" and friends in various ways. @@ -2353,5 +2368,5 @@ (provide 'pcvs) -;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61 +;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61 ;;; pcvs.el ends here
--- a/lisp/printing.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/printing.el Fri Nov 12 02:53:04 2004 +0000 @@ -5,13 +5,13 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/09/26 22:11:24 vinicius> +;; Time-stamp: <2004/11/11 23:54:13 vinicius> ;; Keywords: wp, print, PostScript -;; Version: 6.8.1 +;; Version: 6.8.2 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst pr-version "6.8.1" - "printing.el, v 6.8.1 <2004/09/26 vinicius> +(defconst pr-version "6.8.2" + "printing.el, v 6.8.2 <2004/11/11 vinicius> Please send all bug fixes and enhancements to Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -1099,6 +1099,7 @@ :tag "Printing Utilities" :link '(emacs-library-link :tag "Source Lisp File" "printing.el") :prefix "pr-" + :version "20" :group 'wp :group 'postscript) @@ -2474,20 +2475,16 @@ (eval-and-compile (defun pr-get-symbol (name) - ;; Recent versions of easy-menu downcase names before interning them. - (and (fboundp 'easy-menu-name-match) - (setq name (downcase name))) - (or (intern-soft name) - (make-symbol name))) + (easy-menu-intern name)) (cond ((eq ps-print-emacs-type 'emacs) ; GNU Emacs - (defsubst pr-region-active-p () + (defun pr-region-active-p () (and pr-auto-region transient-mark-mode mark-active))) ((eq ps-print-emacs-type 'xemacs) ; XEmacs (defvar zmacs-region-stays nil) ; to avoid compilation gripes - (defsubst pr-region-active-p () + (defun pr-region-active-p () (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p))))) @@ -2907,18 +2904,18 @@ (pr-get-symbol "Printing"))))) ;; Emacs 21 (pr-menu-print-item - (easy-menu-change '("files") "Print" pr-menu-spec "print-buffer") + (easy-menu-change '("file") "Print" pr-menu-spec "print-buffer") (let ((items '("print-buffer" "print-region" "ps-print-buffer-faces" "ps-print-region-faces" "ps-print-buffer" "ps-print-region"))) (while items - (easy-menu-remove-item nil '("files") (car items)) + (easy-menu-remove-item nil '("file") (car items)) (setq items (cdr items))) (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar 'files + pr-menu-bar (vector 'menu-bar 'file (pr-get-symbol "Print"))))) (t - (easy-menu-change '("files") "Print" pr-menu-spec))) + (easy-menu-change '("file") "Print" pr-menu-spec))) ;; Key binding (global-set-key [print] 'pr-ps-fast-fire) @@ -6385,5 +6382,5 @@ (provide 'printing) -;;; arch-tag: 9ce9ac3f-0f60-4370-900b-1943215d9d18 +;; arch-tag: 9ce9ac3f-0f60-4370-900b-1943215d9d18 ;;; printing.el ends here
--- a/lisp/progmodes/ada-xref.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/ada-xref.el Fri Nov 12 02:53:04 2004 +0000 @@ -1292,7 +1292,7 @@ ;; Move to the end of the debugger buffer, so that it is automatically ;; scrolled from then on. - (end-of-buffer) + (goto-char (point-max)) ;; Display both the source window and the debugger window (the former ;; above the latter). No need to show the debugger window unless it
--- a/lisp/progmodes/compile.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/compile.el Fri Nov 12 02:53:04 2004 +0000 @@ -785,11 +785,14 @@ to a function that generates a unique name." (interactive (list - (if (or compilation-read-command current-prefix-arg) - (read-from-minibuffer "Compile command: " - (eval compile-command) nil nil - '(compile-history . 1)) - (eval compile-command)) + (let ((command (eval compile-command))) + (if (or compilation-read-command current-prefix-arg) + (read-from-minibuffer "Compile command: " + command nil nil + (if (equal (car compile-history) command) + '(compile-history . 1) + 'compile-history)) + command)) (consp current-prefix-arg))) (unless (equal command (eval compile-command)) (setq compile-command command))
--- a/lisp/progmodes/cperl-mode.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/cperl-mode.el Fri Nov 12 02:53:04 2004 +0000 @@ -5292,7 +5292,7 @@ iniwin (selected-window) fr1 (window-frame iniwin)) (set-buffer buf) - (beginning-of-buffer) + (goto-char (point-min)) (or isvar (progn (re-search-forward "^-X[ \t\n]") (forward-line -1)))
--- a/lisp/progmodes/f90.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/f90.el Fri Nov 12 02:53:04 2004 +0000 @@ -1223,14 +1223,16 @@ With optional argument NUM, go forward that many balanced blocks. If NUM is negative, go backward to the start of a block. Checks for consistency of block types and labels (if present), -and completes outermost block if necessary." +and completes outermost block if necessary. +Some of these things (which?) are not done if NUM is nil, +which only happens in a noninteractive call." (interactive "p") (if (and num (< num 0)) (f90-beginning-of-block (- num))) (let ((f90-smart-end nil) ; for the final `f90-match-end' (case-fold-search t) (count (or num 1)) start-list start-this start-type start-label end-type end-label) - (if (interactive-p) (push-mark (point) t)) + (if num (push-mark (point) t)) (end-of-line) ; probably want this (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move)) (beginning-of-line) @@ -1266,7 +1268,7 @@ (end-of-line)) (if (> count 0) (error "Missing block end")) ;; Check outermost block. - (if (interactive-p) + (if num (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
--- a/lisp/progmodes/gdb-ui.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Fri Nov 12 02:53:04 2004 +0000 @@ -60,6 +60,7 @@ (defvar gdb-previous-address nil) (defvar gdb-previous-frame nil) (defvar gdb-current-frame nil) +(defvar gdb-current-stack-level nil) (defvar gdb-current-language nil) (defvar gdb-view-source t "Non-nil means that source code can be viewed.") (defvar gdb-selected-view 'source "Code type that user wishes to view.") @@ -183,6 +184,7 @@ (setq gdb-previous-address nil) (setq gdb-previous-frame nil) (setq gdb-current-frame nil) + (setq gdb-current-stack-level nil) (setq gdb-view-source t) (setq gdb-selected-view 'source) (setq gdb-var-list nil) @@ -393,7 +395,8 @@ "If non-nil highlight values that have recently changed in the speedbar. The highlighting is done with `font-lock-warning-face'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-speedbar-expand-node (text token indent) "Expand the node the user clicked on. @@ -1077,8 +1080,9 @@ "Icon for disabled breakpoint in display margin.") ;; Bitmap for breakpoint in fringe -(define-fringe-bitmap 'breakpoint - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") +(and (display-images-p) + (define-fringe-bitmap 'breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")) (defface breakpoint-enabled-bitmap-face '((t @@ -1290,9 +1294,8 @@ '(mouse-face highlight help-echo "mouse-2, RET: Select frame")) (beginning-of-line) - (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") - (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) - (equal (match-string 1) gdb-current-frame)) + (when (and (looking-at "^#\\([0-9]+\\)") + (equal (match-string 1) gdb-current-stack-level)) (put-text-property (point-at-bol) (point-at-eol) 'face '(:inverse-video t))) (forward-line 1)))))) @@ -2046,6 +2049,8 @@ (delq 'gdb-get-current-frame gdb-pending-triggers)) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) + (if (looking-at "Stack level \\([0-9]+\\)") + (setq gdb-current-stack-level (match-string 1))) (forward-line) (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ") (progn
--- a/lisp/progmodes/idlw-shell.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/progmodes/idlw-shell.el Fri Nov 12 02:53:04 2004 +0000 @@ -508,11 +508,19 @@ (defvar comint-last-input-start) (defvar comint-last-input-end) +(defvar idlwave-shell-temp-pro-file nil + "Absolute pathname for temporary IDL file for compiling regions") + +(defvar idlwave-shell-temp-rinfo-save-file nil + "Absolute pathname for temporary IDL file save file for routine_info. +This is used to speed up the reloading of the routine info procedure +before use by the shell.") + (defun idlwave-shell-temp-file (type) "Return a temp file, creating it if necessary. -TYPE is either 'pro or 'rinfo, and idlwave-shell-temp-pro-file or -idlwave-shell-temp-rinfo-save-file is set (respectively)." +TYPE is either `pro' or `rinfo', and `idlwave-shell-temp-pro-file' or +`idlwave-shell-temp-rinfo-save-file' is set (respectively)." (cond ((eq type 'rinfo) (or idlwave-shell-temp-rinfo-save-file @@ -550,17 +558,6 @@ nil) file))) -;; Other variables -(defvar idlwave-shell-temp-pro-file - nil - "Absolute pathname for temporary IDL file for compiling regions") - -(defvar idlwave-shell-temp-rinfo-save-file - nil - "Absolute pathname for temporary IDL file save file for routine_info. -This is used to speed up the reloading of the routine info procedure -before use by the shell.") - (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" "Command used by `idlwave-shell-resync-dirs' to query IDL for the directory stack.") @@ -2523,6 +2520,10 @@ (defvar idlwave-shell-examine-window-alist nil "Variable to hold the win/height pairs for all *Examine* windows.") +(defvar idlwave-shell-examine-map (make-sparse-keymap)) +(define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit) +(define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear) + (defun idlwave-shell-examine-display () "View the examine command output in a separate buffer." (let (win cur-beg cur-end) @@ -2603,10 +2604,6 @@ (skip-chars-backward "\n") (recenter -1))))) -(defvar idlwave-shell-examine-map (make-sparse-keymap)) -(define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit) -(define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear) - (defun idlwave-shell-examine-display-quit () (interactive) (let ((win (selected-window)))
--- a/lisp/recentf.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/recentf.el Fri Nov 12 02:53:04 2004 +0000 @@ -98,7 +98,7 @@ :type 'string :set 'recentf-menu-customization-changed) -(defcustom recentf-menu-path '("files") +(defcustom recentf-menu-path '("File") "*Path where to add the recentf menu. If nil add it at top level (see also `easy-menu-add-item')." :group 'recentf
--- a/lisp/simple.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/simple.el Fri Nov 12 02:53:04 2004 +0000 @@ -67,6 +67,44 @@ (switch-to-buffer found))) ;;; next-error support framework + +(defgroup next-error nil + "next-error support framework." + :group 'compilation + :version "21.4") + +(defface next-error + '((t (:inherit region))) + "Face used to highlight next error locus." + :group 'next-error + :version "21.4") + +(defcustom next-error-highlight 0.1 + "*Highlighting of locations in selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") + +(defcustom next-error-highlight-no-select 0.1 + "*Highlighting of locations in non-selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") + (defvar next-error-last-buffer nil "The most recent next-error buffer. A buffer becomes most recent when its compilation, grep, or @@ -213,43 +251,6 @@ (interactive "p") (next-error-no-select (- (or n 1)))) -(defgroup next-error nil - "next-error support framework." - :group 'compilation - :version "21.4") - -(defface next-error - '((t (:inherit region))) - "Face used to highlight next error locus." - :group 'next-error - :version "21.4") - -(defcustom next-error-highlight 0.1 - "*Highlighting of locations in selected source buffers. -If number, highlight the locus in next-error face for given time in seconds. -If t, use persistent overlays fontified in next-error face. -If nil, don't highlight the locus in the source buffer. -If `fringe-arrow', indicate the locus by the fringe arrow." - :type '(choice (number :tag "Delay") - (const :tag "Persistent overlay" t) - (const :tag "No highlighting" nil) - (const :tag "Fringe arrow" 'fringe-arrow)) - :group 'next-error - :version "21.4") - -(defcustom next-error-highlight-no-select 0.1 - "*Highlighting of locations in non-selected source buffers. -If number, highlight the locus in next-error face for given time in seconds. -If t, use persistent overlays fontified in next-error face. -If nil, don't highlight the locus in the source buffer. -If `fringe-arrow', indicate the locus by the fringe arrow." - :type '(choice (number :tag "Delay") - (const :tag "Persistent overlay" t) - (const :tag "No highlighting" nil) - (const :tag "Fringe arrow" 'fringe-arrow)) - :group 'next-error - :version "21.4") - ;;; Internal variable for `next-error-follow-mode-post-command-hook'. (defvar next-error-follow-last-line nil) @@ -2280,6 +2281,8 @@ visual feedback indicating the extent of the region being copied." (interactive "r") (copy-region-as-kill beg end) + ;; This use of interactive-p is correct + ;; because the code it controls just gives the user visual feedback. (if (interactive-p) (let ((other-end (if (= (point) beg) end beg)) (opoint (point)) @@ -3081,13 +3084,13 @@ at the start of current run of vertical motion commands. When the `track-eol' feature is doing its job, the value is 9999.") -(defcustom line-move-ignore-invisible nil +(defcustom line-move-ignore-invisible t "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. Outline mode sets this." :type 'boolean :group 'editing-basics) -(defun line-move-invisible (pos) +(defun line-move-invisible-p (pos) "Return non-nil if the character after POS is currently invisible." (let ((prop (get-char-property pos 'invisible))) @@ -3098,7 +3101,8 @@ ;; This is the guts of next-line and previous-line. ;; Arg says how many lines to move. -(defun line-move (arg) +;; The value is t if we can move the specified number of lines. +(defun line-move (arg &optional noerror to-end) ;; Don't run any point-motion hooks, and disregard intangibility, ;; for intermediate positions. (let ((inhibit-point-motion-hooks t) @@ -3114,6 +3118,7 @@ (or (not (bolp)) (eq last-command 'end-of-line))) 9999 (current-column)))) + (if (and (not (integerp selective-display)) (not line-move-ignore-invisible)) ;; Use just newline characters. @@ -3129,28 +3134,43 @@ (and (zerop (forward-line arg)) (bolp) (setq arg 0))) - (signal (if (< arg 0) - 'beginning-of-buffer - 'end-of-buffer) - nil)) + (unless noerror + (signal (if (< arg 0) + 'beginning-of-buffer + 'end-of-buffer) + nil))) ;; Move by arg lines, but ignore invisible ones. - (while (> arg 0) - ;; If the following character is currently invisible, - ;; skip all characters with that same `invisible' property value. - (while (and (not (eobp)) (line-move-invisible (point))) - (goto-char (next-char-property-change (point)))) - ;; Now move a line. - (end-of-line) - (and (zerop (vertical-motion 1)) - (signal 'end-of-buffer nil)) - (setq arg (1- arg))) - (while (< arg 0) - (beginning-of-line) - (and (zerop (vertical-motion -1)) - (signal 'beginning-of-buffer nil)) - (setq arg (1+ arg)) - (while (and (not (bobp)) (line-move-invisible (1- (point)))) - (goto-char (previous-char-property-change (point))))))) + (let (done) + (while (and (> arg 0) (not done)) + ;; If the following character is currently invisible, + ;; skip all characters with that same `invisible' property value. + (while (and (not (eobp)) (line-move-invisible-p (point))) + (goto-char (next-char-property-change (point)))) + ;; Now move a line. + (end-of-line) + (and (zerop (vertical-motion 1)) + (if (not noerror) + (signal 'end-of-buffer nil) + (setq done t))) + (unless done + (setq arg (1- arg)))) + (while (and (< arg 0) (not done)) + (beginning-of-line) + + (if (zerop (vertical-motion -1)) + (if (not noerror) + (signal 'beginning-of-buffer nil) + (setq done t))) + (unless done + (setq arg (1+ arg)) + (while (and ;; Don't move over previous invis lines + ;; if our target is the middle of this line. + (or (zerop (or goal-column temporary-goal-column)) + (< arg 0)) + (not (bobp)) (line-move-invisible-p (1- (point)))) + (goto-char (previous-char-property-change (point)))))))) + ;; This is the value the function returns. + (= arg 0)) (cond ((> arg 0) ;; If we did not move down as far as desired, @@ -3161,8 +3181,7 @@ ;; at least go to end of line. (beginning-of-line)) (t - (line-move-finish (or goal-column temporary-goal-column) opoint))))) - nil) + (line-move-finish (or goal-column temporary-goal-column) opoint)))))) (defun line-move-finish (column opoint) (let ((repeat t)) @@ -3175,9 +3194,11 @@ (line-end ;; Compute the end of the line ;; ignoring effectively intangible newlines. - (let ((inhibit-point-motion-hooks nil) - (inhibit-field-text-motion t)) - (save-excursion (end-of-line) (point))))) + (save-excursion + (let ((inhibit-point-motion-hooks nil) + (inhibit-field-text-motion t)) + (end-of-line)) + (point)))) ;; Move to the desired column. (line-move-to-column column) @@ -3228,13 +3249,13 @@ (move-to-column col)) (when (and line-move-ignore-invisible - (not (bolp)) (line-move-invisible (1- (point)))) + (not (bolp)) (line-move-invisible-p (1- (point)))) (let ((normal-location (point)) (normal-column (current-column))) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. (while (and (not (eobp)) - (line-move-invisible (point))) + (line-move-invisible-p (point))) (goto-char (next-char-property-change (point)))) ;; Have we advanced to a larger column position? (if (> (current-column) normal-column) @@ -3247,9 +3268,45 @@ ;; but with a more reasonable buffer position. (goto-char normal-location) (let ((line-beg (save-excursion (beginning-of-line) (point)))) - (while (and (not (bolp)) (line-move-invisible (1- (point)))) + (while (and (not (bolp)) (line-move-invisible-p (1- (point)))) (goto-char (previous-char-property-change (point) line-beg)))))))) +(defun move-end-of-line (arg) + "Move point to end of current line. +With argument ARG not nil or 1, move forward ARG - 1 lines first. +If point reaches the beginning or end of buffer, it stops there. +To ignore intangibility, bind `inhibit-point-motion-hooks' to t. + +This command does not move point across a field boundary unless doing so +would move beyond there to a different line; if ARG is nil or 1, and +point starts at a field boundary, point does not move. To ignore field +boundaries bind `inhibit-field-text-motion' to t." + (interactive "p") + (or arg (setq arg 1)) + (let (done) + (while (not done) + (let ((newpos + (save-excursion + (let ((goal-column 0)) + (and (line-move arg t) + (not (bobp)) + (progn + (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) + (goto-char (previous-char-property-change (point)))) + (backward-char 1))) + (point))))) + (goto-char newpos) + (if (and (> (point) newpos) + (eq (preceding-char) ?\n)) + (backward-char 1) + (if (and (> (point) newpos) (not (eobp)) + (not (eq (following-char) ?\n))) + ;; If we skipped something intangible + ;; and now we're not really at eol, + ;; keep going. + (setq arg 1) + (setq done t))))))) + ;;; Many people have said they rarely use this feature, and often type ;;; it by accident. Maybe it shouldn't even be on a key. (put 'set-goal-column 'disabled t) @@ -3298,7 +3355,8 @@ (progn (select-window window) ;; Set point and mark in that window's buffer. - (beginning-of-buffer arg) + (with-no-warnings + (beginning-of-buffer arg)) ;; Set point accordingly. (recenter '(t))) (select-window orig-window)))) @@ -3314,7 +3372,8 @@ (unwind-protect (progn (select-window window) - (end-of-buffer arg) + (with-no-warnings + (end-of-buffer arg)) (recenter '(t))) (select-window orig-window))))
--- a/lisp/subr.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/subr.el Fri Nov 12 02:53:04 2004 +0000 @@ -2209,12 +2209,20 @@ table)) (defun syntax-after (pos) - "Return the syntax of the char after POS." + "Return the syntax of the char after POS. +The value is either a syntax class character (a character that designates +a syntax in `modify-syntax-entry'), or a cons cell +of the form (CLASS . MATCH), where CLASS is the syntax class character +and MATCH is the matching parenthesis." (unless (or (< pos (point-min)) (>= pos (point-max))) - (let ((st (if parse-sexp-lookup-properties - (get-char-property pos 'syntax-table)))) - (if (consp st) st - (aref (or st (syntax-table)) (char-after pos)))))) + (let* ((st (if parse-sexp-lookup-properties + (get-char-property pos 'syntax-table))) + (value + (if (consp st) st + (aref (or st (syntax-table)) (char-after pos)))) + (code (if (consp value) (car value) value))) + (setq code (aref "-.w_()'\"$\\/<>@!|" code)) + (if (consp value) (cons code (cdr value)) code)))) (defun add-to-invisibility-spec (arg) "Add elements to `buffer-invisibility-spec'.
--- a/lisp/tempo.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/tempo.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,6 +1,6 @@ ;;; tempo.el --- Flexible template insertion -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 2004 Free Software Foundation, Inc. ;; Author: David K}gedal <davidk@lysator.liu.se> ;; Created: 16 Feb 1994 @@ -172,7 +172,7 @@ (defvar tempo-marks nil "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.") -(defvar tempo-match-finder "\\b\\([^\\b]+\\)\\=" +(defvar tempo-match-finder "\\b\\([[:word:]]+\\)\\=" "The regexp or function used to find the string to match against tags. If `tempo-match-finder is a string, it should contain a regular @@ -182,7 +182,7 @@ each string in the tag list. If one is found, the whole text between the first \\( and the point is replaced with the inserted template. -You will probably want to include \\ \= at the end of the regexp to +You will probably want to include \\=\\= at the end of the regexp to make sure that the string is matched only against text adjacent to the point.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/textmodes/conf-mode.el Fri Nov 12 02:53:04 2004 +0000 @@ -0,0 +1,531 @@ +;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files + +;; Copyright (C) 2004 by Daniel Pfeiffer <occitan@esperanto.org> +;; Keywords: conf ini windows java + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; This mode is designed to edit many similar varieties of Conf/Ini files and +;; Java properties. It started out from Aurélien Tisné's ini-mode. +;; `conf-space-keywords' were inspired by Robert Fitzgerald's any-ini-mode. + + +;;; Code: + +(require 'newcomment) + +;; Variables: + +(defgroup conf nil + "Configuration files." + :group 'data + :version "21.4") + +(defcustom conf-assignment-column 24 + "Align assignments to this column by default with \\[conf-align-assignments]. +If this number is negative, the `=' comes before the whitespace. Use 0 to +not align (only setting space according to `conf-assignment-space')." + :type 'integer + :group 'conf) + +(defcustom conf-javaprop-assignment-column 32 + "Value for `conf-assignment-column' in Java properties buffers." + :type 'integer + :group 'conf) + +(defcustom conf-colon-assignment-column (- (abs conf-assignment-column)) + "Value for `conf-assignment-column' in Java properties buffers." + :type 'integer + :group 'conf) + +(defcustom conf-assignment-space t + "Put at least one space around assignments when aligning." + :type 'boolean + :group 'conf) + +(defcustom conf-colon-assignment-space nil + "Value for `conf-assignment-space' in colon style Conf mode buffers." + :type 'boolean + :group 'conf) + + +(defvar conf-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-u" 'conf-unix-mode) + (define-key map "\C-c\C-w" 'conf-windows-mode) + (define-key map "\C-c\C-j" 'conf-javaprop-mode) + (define-key map "\C-c\C-s" 'conf-space-mode) + (define-key map "\C-c " 'conf-space-mode) + (define-key map "\C-c\C-c" 'conf-colon-mode) + (define-key map "\C-c:" 'conf-colon-mode) + (define-key map "\C-c\C-x" 'conf-xdefaults-mode) + (define-key map "\C-c\C-q" 'conf-quote-normal) + (define-key map "\C-c\"" 'conf-quote-normal) + (define-key map "\C-c'" 'conf-quote-normal) + (define-key map "\C-c\C-a" 'conf-align-assignments) + map) + "Local keymap for conf-mode buffers.") + +(defvar conf-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?- "_" table) + (modify-syntax-entry ?. "_" table) + (modify-syntax-entry ?\' "\"" table) +; (modify-syntax-entry ?: "_" table) + (modify-syntax-entry ?\; "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\r ">" table) + table) + "Syntax table in use in Windows style conf-mode buffers.") + +(defvar conf-unix-mode-syntax-table + (let ((table (make-syntax-table conf-mode-syntax-table))) + (modify-syntax-entry ?\# "<" table) + ;; override + (modify-syntax-entry ?\; "." table) + table) + "Syntax table in use in Unix style conf-mode buffers.") + +(defvar conf-javaprop-mode-syntax-table + (let ((table (make-syntax-table conf-unix-mode-syntax-table))) + (modify-syntax-entry ?/ ". 124" table) + (modify-syntax-entry ?* ". 23b" table) + table) + "Syntax table in use in Java prperties buffers.") + +(defvar conf-xdefaults-mode-syntax-table + (let ((table (make-syntax-table conf-mode-syntax-table))) + (modify-syntax-entry ?! "<" table) + ;; override + (modify-syntax-entry ?\; "." table) + table) + "Syntax table in use in Xdefaults style conf-mode buffers.") + + +(defvar conf-font-lock-keywords + `(;; [section] (do this first because it may look like a parameter) + ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) + ;; var=val or var[index]=val + ("^[ \t]*\\(.+?\\)\\(?:\\[\\(.*?\\)\\]\\)?[ \t]*=" + (1 'font-lock-variable-name-face) + (2 'font-lock-constant-face nil t)) + ;; section { ... } (do this last because some assign ...{...) + ("^[ \t]*\\([^=:\n]+?\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face prepend)) + "Keywords to hilight in Conf mode") + +(defvar conf-javaprop-font-lock-keywords + '(;; var=val + ("^[ \t]*\\(.+?\\)\\(?:\\.\\([0-9]+\\)\\(?:\\.\\(.+?\\)\\(?:\\.\\([0-9]+\\)\\(?:\\.\\(.+?\\)\\(?:\\.\\([0-9]+\\)\\(\\..+?\\)?\\)?\\)?\\)?\\)?\\)?\\([:= \t]\\|$\\)" + (1 'font-lock-variable-name-face) + (2 'font-lock-constant-face nil t) + (3 'font-lock-variable-name-face nil t) + (4 'font-lock-constant-face nil t) + (5 'font-lock-variable-name-face nil t) + (6 'font-lock-constant-face nil t) + (7 'font-lock-variable-name-face nil t))) + "Keywords to hilight in Conf Java Properties mode") + +(defvar conf-space-keywords-alist + '(("\\`/etc/gpm/" . "key\\|name\\|foreground\\|background\\|border\\|head") + ("\\`/etc/magic\\'" . "[^ \t]+[ \t]+\\(?:[bl]?e?\\(?:short\\|long\\)\\|byte\\|string\\)[^ \t]*") + ("/mod\\(?:ules\\|probe\\)\\.conf" . "alias\\|in\\(?:clude\\|stall\\)\\|options\\|remove") + ("/manpath\\.config" . "MAN\\(?:DATORY_MANPATH\\|PATH_MAP\\|DB_MAP\\)") + ("/sensors\\.conf" . "chip\\|bus\\|label\\|compute\\|set\\|ignore") + ("/sane\\(\\.d\\)?/" . "option\\|device\\|port\\|usb\\|sc\\(?:si\\|anner\\)") + ("/resmgr\\.conf" . "class\\|add\\|allow\\|deny") + ("/dictionary\\.lst\\'" . "DICT\\|HYPH\\|THES") + ("/tuxracer/options" . "set")) + "File name based settings for `conf-space-keywords'.") + +(defvar conf-space-keywords nil + "Regexps for functions that may come before a space assignment. +This allows constructs such as +keyword var value +This variable is best set in the file local variables, or through +`conf-space-keywords-alist'.") + +(defvar conf-space-font-lock-keywords + `(;; [section] (do this first because it may look like a parameter) + ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) + ;; section { ... } (do this first because it looks like a parameter) + ("^[ \t]*\\(.+?\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face) + ;; var val + (eval if conf-space-keywords + (list (concat "^[ \t]*\\(" conf-space-keywords "\\)[ \t]+\\([^\000- ]+\\)") + '(1 'font-lock-keyword-face) + '(2 'font-lock-variable-name-face)) + '("^[ \t]*\\([^\000- ]+\\)" 1 'font-lock-variable-name-face))) + "Keywords to hilight in Conf Space mode") + +(defvar conf-colon-font-lock-keywords + `(;; [section] (do this first because it may look like a parameter) + ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) + ;; var: val + ("^[ \t]*\\(.+?\\)[ \t]*:" + (1 'font-lock-variable-name-face)) + ;; section { ... } (do this last because some assign ...{...) + ("^[ \t]*\\([^:\n]+\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face prepend)) + "Keywords to hilight in Conf Colon mode") + +(defvar conf-assignment-sign ?= + "What sign is used for assignments.") + +(defvar conf-assignment-regexp ".+?\\([ \t]*=[ \t]*\\)" + "Regexp to recognize assignments. +It is anchored after the first sexp on a line. There must a +grouping for the assignment sign, including leading and trailing +whitespace.") + + +;; If anybody can figure out how to get the same effect by configuring +;; `align', I'd be glad to hear. +(defun conf-align-assignments (&optional arg) + (interactive "P") + (setq arg (if arg + (prefix-numeric-value arg) + conf-assignment-column)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((cs (comment-beginning))) ; go before comment if within + (if cs (goto-char cs))) + (while (forward-comment 9)) ; max-int? + (when (and (not (eobp)) + (looking-at conf-assignment-regexp)) + (goto-char (match-beginning 1)) + (delete-region (point) (match-end 1)) + (if conf-assignment-sign + (if (>= arg 0) + (progn + (indent-to-column arg) + (or (not conf-assignment-space) (memq (char-before (point)) '(? ?\t)) (insert ? )) + (insert conf-assignment-sign (if (and conf-assignment-space (not (eolp))) ?\ ""))) + (insert (if conf-assignment-space ?\ "") conf-assignment-sign) + (unless (eolp) + (indent-to-column (- arg)) + (or (not conf-assignment-space) (memq (char-before (point)) '(? ?\t)) (insert ? )))) + (unless (eolp) + (if (>= (current-column) (abs arg)) + (insert ? ) + (indent-to-column (abs arg)))))) + (forward-line)))) + + +(defun conf-quote-normal () + "Set the syntax of \" and ' to punctuation. +This only affects the current buffer. Some conf files use quotes +to delimit strings, while others allow quotes as simple parts of +the assigned value. In those files font locking will be wrong, +and you can correct it with this command. (Some files even do +both, i.e. quotes delimit strings, except when they are +unbalanced, but hey...)" + (interactive) + (let ((table (copy-syntax-table (syntax-table)))) + (modify-syntax-entry ?\" "." table) + (modify-syntax-entry ?\' "." table) + (set-syntax-table table) + (and (boundp 'font-lock-mode) + font-lock-mode + (font-lock-fontify-buffer)))) + + +(defun conf-outline-level () + (let ((depth 0) + (pt (match-end 0))) + (condition-case nil + (while (setq pt (scan-lists pt -1 1) + depth (1+ depth))) + (scan-error depth)))) + + + +;;;###autoload +(defun conf-mode (&optional comment syntax-table name) + "Mode for Unix and Windows Conf files and Java properties. +Most conf files know only three kinds of constructs: parameter +assignments optionally grouped into sections and comments. Yet +there is a great range of variation in the exact syntax of conf +files. See below for various wrapper commands that set up the +details for some of the most widespread variants. + +This mode sets up font locking, outline, imenu and it provides +alignment support through `conf-align-assignments'. If strings +come out wrong, try `conf-quote-normal'. + +Some files allow continuation lines, either with a backslash at +the end of line, or by indenting the next line (further). These +constructs cannot currently be recognized. + +Because of this great variety of nuances, which are often not +even clearly specified, please don't expect it to get every file +quite right. Patches that clearly identify some special case, +without breaking the general ones, are welcome. + +If instead you start this mode with the generic `conf-mode' +command, it will parse the buffer. It will generally well +identify the first four cases listed below. If the buffer +doesn't have enough contents to decide, this is identical to +`conf-windows-mode' on Windows, elsewhere to `conf-unix-mode'. See +also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode' and +`conf-xdefaults-mode'. + +\\{conf-mode-map}" + + (interactive) + (if (not comment) + (let ((unix 0) (win 0) (equal 0) (colon 0) (space 0) (jp 0)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\f") + (cond ((eq (char-after) ?\#) (setq unix (1+ unix))) + ((eq (char-after) ?\;) (setq win (1+ win))) + ((eq (char-after) ?\[)) ; nop + ((eolp)) ; nop + ((eq (char-after) ?})) ; nop + ;; recognize at most double spaces within names + ((looking-at "[^ \t\n=:]+\\(?: ?[^ \t\n=:]+\\)*[ \t]*[=:]") + (if (eq (char-before (match-end 0)) ?=) + (setq equal (1+ equal)) + (setq colon (1+ colon)))) + ((looking-at "/[/*]") (setq jp (1+ jp))) + ((looking-at ".*{")) ; nop + ((setq space (1+ space)))) + (forward-line))) + (if (> jp (max unix win 3)) + (conf-javaprop-mode) + (if (> colon (max equal space)) + (conf-colon-mode) + (if (> space (max equal colon)) + (conf-space-mode) + (if (or (> win unix) + (and (= win unix) (eq system-type 'windows-nt))) + (conf-windows-mode) + (conf-unix-mode)))))) + (kill-all-local-variables) + (use-local-map conf-mode-map) + + (setq major-mode 'conf-mode + mode-name name) + (set (make-local-variable 'comment-start) comment) + (set (make-local-variable 'comment-start-skip) + (concat comment-start "+\\s *")) + (set (make-local-variable 'comment-use-syntax) t) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'outline-regexp) + "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)") + (set (make-local-variable 'outline-heading-end-regexp) + "[\n}]") + (set (make-local-variable 'outline-level) + 'conf-outline-level) + (set-syntax-table syntax-table) + (setq imenu-generic-expression + '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1) + ;; [section] + (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1) + ;; section { ... } + (nil "^[ \t]*\\([^=:\n]+\\)[ \t\n]*{" 1))) + + (run-mode-hooks 'conf-mode-hook))) + +;;;###autoload +(defun conf-unix-mode () + "Conf Mode starter for Unix style Conf files. +Comments start with `#'. +For details see `conf-mode'. Example: + +# Conf mode font-locks this right on Unix and with C-c C-u + +\[Desktop Entry] + Encoding=UTF-8 + Name=The GIMP + Name[ca]=El GIMP + Name[cs]=GIMP" + (interactive) + (conf-mode "#" conf-unix-mode-syntax-table "Conf[Unix]")) + +;;;###autoload +(defun conf-windows-mode () + "Conf Mode starter for Windows style Conf files. +Comments start with `;'. +For details see `conf-mode'. Example: + +; Conf mode font-locks this right on Windows and with C-c C-w + +\[ExtShellFolderViews] +Default={5984FFE0-28D4-11CF-AE66-08002B2E1262} +{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262} + +\[{5984FFE0-28D4-11CF-AE66-08002B2E1262}] +PersistMoniker=file://Folder.htt" + (interactive) + (conf-mode ";" conf-mode-syntax-table "Conf[WinIni]")) + +;; Here are a few more or less widespread styles. There are others, so +;; obscure, they are not covered. E.g. RFC 2614 allows both Unix and Windows +;; comments. Or the donkey has (* Pascal comments *) -- roll your own starter +;; if you need it. + +;;;###autoload +(defun conf-javaprop-mode () + "Conf Mode starter for Java properties files. +Comments start with `#' but are also recognized with `//' or +between `/*' and `*/'. +For details see `conf-mode'. Example: + +# Conf mode font-locks this right with C-c C-j (Java properties) +// another kind of comment +/* yet another */ + +name:value +name=value +name value +x.1 = +x.2.y.1.z.1 = +x.2.y.1.z.2.zz =" + (interactive) + (conf-mode "#" conf-javaprop-mode-syntax-table "Conf[JavaProp]") + (set (make-local-variable 'conf-assignment-column) + conf-javaprop-assignment-column) + (set (make-local-variable 'conf-assignment-regexp) + ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)") + (set (make-local-variable 'conf-font-lock-keywords) + conf-javaprop-font-lock-keywords) + (setq comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *") + (setq imenu-generic-expression + '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1)))) + +;;;###autoload +(defun conf-space-mode (&optional keywords) + "Conf Mode starter for space separated conf files. +\"Assignments\" are with ` '. Keywords before the parameters are +recognized according to `conf-space-keywords'. Interactively +with a prefix ARG of `0' no keywords will be recognized. With +any other prefix arg you will be prompted for a regexp to match +the keywords. Programmatically you can pass such a regexp as +KEYWORDS, or any non-nil non-string for no keywords. + +For details see `conf-mode'. Example: + +# Conf mode font-locks this right with C-c C-s (space separated) + +image/jpeg jpeg jpg jpe +image/png png +image/tiff tiff tif + +# Or with keywords (from a recognized file name): +class desktop +# Standard multimedia devices +add /dev/audio desktop +add /dev/mixer desktop" + (interactive + (list (if current-prefix-arg + (if (> (prefix-numeric-value current-prefix-arg) 0) + (read-string "Regexp to match keywords: ") + t)))) + (conf-unix-mode) + (setq mode-name "Conf[Space]") + (set (make-local-variable 'conf-assignment-sign) + nil) + (set (make-local-variable 'conf-font-lock-keywords) + conf-space-font-lock-keywords) + ;; This doesn't seem right, but the next two depend on conf-space-keywords + ;; being set, while after-change-major-mode-hook might set up imenu, needing + ;; the following result: + (hack-local-variables-prop-line) + (hack-local-variables) + (if keywords + (set (make-local-variable 'conf-space-keywords) + (if (stringp keywords) keywords)) + (or conf-space-keywords + (not buffer-file-name) + (set (make-local-variable 'conf-space-keywords) + (assoc-default buffer-file-name conf-space-keywords-alist + 'string-match)))) + (set (make-local-variable 'conf-assignment-regexp) + (if conf-space-keywords + (concat "\\(?:" conf-space-keywords "\\)[ \t]+.+?\\([ \t]+\\|$\\)") + ".+?\\([ \t]+\\|$\\)")) + (setq imenu-generic-expression + `(,@(cdr imenu-generic-expression) + ("Parameters" + ,(if conf-space-keywords + (concat "^[ \t]*\\(?:" conf-space-keywords + "\\)[ \t]+\\([^ \t\n]+\\)\\(?:[ \t]\\|$\\)") + "^[ \t]*\\([^ \t\n[]+\\)\\(?:[ \t]\\|$\\)") + 1)))) + +;;;###autoload +(defun conf-colon-mode (&optional comment syntax-table name) + "Conf Mode starter for Colon files. +\"Assignments\" are with `:'. +For details see `conf-mode'. Example: + +# Conf mode font-locks this right with C-c C-c (colon) + +<Multi_key> <exclam> <exclam> : \"\\241\" exclamdown +<Multi_key> <c> <slash> : \"\\242\" cent" + (interactive) + (if comment + (conf-mode comment syntax-table name) + (conf-unix-mode) + (setq mode-name "Conf[Colon]")) + (set (make-local-variable 'conf-assignment-space) + conf-colon-assignment-space) + (set (make-local-variable 'conf-assignment-column) + conf-colon-assignment-column) + (set (make-local-variable 'conf-assignment-sign) + ?:) + (set (make-local-variable 'conf-assignment-regexp) + ".+?\\([ \t]*:[ \t]*\\)") + (set (make-local-variable 'conf-font-lock-keywords) + conf-colon-font-lock-keywords) + (setq imenu-generic-expression + `(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*:" 1) + ,@(cdr imenu-generic-expression)))) + +;;;###autoload +(defun conf-xdefaults-mode () + "Conf Mode starter for Xdefaults files. +Comments start with `!' and \"assignments\" are with `:'. +For details see `conf-mode'. Example: + +! Conf mode font-locks this right with C-c C-x (.Xdefaults) + +*background: gray99 +*foreground: black" + (interactive) + (conf-colon-mode "!" conf-xdefaults-mode-syntax-table "Conf[Xdefaults]")) + + +;; font lock support +(if (boundp 'font-lock-defaults-alist) + (add-to-list + 'font-lock-defaults-alist + (cons 'conf-mode + (list 'conf-font-lock-keywords nil t nil nil)))) + + +(provide 'conf-mode) + +;; arch-tag: 0a3805b2-0371-4d3a-8498-8897116b2356 +;;; conf-mode.el ends here
--- a/lisp/textmodes/flyspell.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/textmodes/flyspell.el Fri Nov 12 02:53:04 2004 +0000 @@ -956,9 +956,7 @@ ;*---------------------------------------------------------------------*/ (defun flyspell-word (&optional following) "Spell check a word." - (interactive (list current-prefix-arg)) - (if (interactive-p) - (setq following ispell-following-word)) + (interactive (list ispell-following-word)) (save-excursion ;; use the correct dictionary (flyspell-accept-buffer-local-defs) @@ -1283,7 +1281,7 @@ (defun flyspell-external-point-words () (let ((buffer flyspell-external-ispell-buffer)) (set-buffer buffer) - (beginning-of-buffer) + (goto-char (point-min)) (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) (start flyspell-large-region-beg)) ;; now we are done with ispell, we have to find the word in
--- a/lisp/textmodes/ispell.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/textmodes/ispell.el Fri Nov 12 02:53:04 2004 +0000 @@ -1410,12 +1410,9 @@ \(\"word\" arg\) word is hand entered. quit spell session exited." - (interactive (list nil nil current-prefix-arg)) + (interactive (list ispell-following-word ispell-quietly current-prefix-arg)) (if continue (ispell-continue) - (if (interactive-p) - (setq following ispell-following-word - quietly ispell-quietly)) (ispell-accept-buffer-local-defs) ; use the correct dictionary (let ((cursor-location (point)) ; retain cursor location (word (ispell-get-word following))
--- a/lisp/textmodes/sgml-mode.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/textmodes/sgml-mode.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,6 +1,7 @@ ;;; sgml-mode.el --- SGML- and HTML-editing modes -;; Copyright (C) 1992,95,96,98,2001,2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: James Clark <jjc@jclark.com> ;; Maintainer: FSF @@ -1051,53 +1052,79 @@ (and (>= start (point-min)) (equal str (buffer-substring-no-properties start (point)))))) +(defun sgml-tag-text-p (start end) + "Return non-nil if text between START and END is a tag. +Checks among other things that the tag does not contain spurious +unquoted < or > chars inside, which would indicate that it +really isn't a tag after all." + (save-excursion + (with-syntax-table sgml-tag-syntax-table + (let ((pps (parse-partial-sexp start end 2))) + (and (= (nth 0 pps) 0)))))) + (defun sgml-parse-tag-backward (&optional limit) "Parse an SGML tag backward, and return information about the tag. Assume that parsing starts from within a textual context. Leave point at the beginning of the tag." - (let (tag-type tag-start tag-end name) - (or (re-search-backward "[<>]" limit 'move) - (error "No tag found")) - (when (eq (char-after) ?<) - ;; Oops!! Looks like we were not in a textual context after all!. - ;; Let's try to recover. - (with-syntax-table sgml-tag-syntax-table - (forward-sexp) - (forward-char -1))) - (setq tag-end (1+ (point))) - (cond - ((sgml-looking-back-at "--") ; comment - (setq tag-type 'comment - tag-start (search-backward "<!--" nil t))) - ((sgml-looking-back-at "]]") ; cdata - (setq tag-type 'cdata - tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t))) - (t - (setq tag-start - (with-syntax-table sgml-tag-syntax-table - (goto-char tag-end) - (backward-sexp) - (point))) - (goto-char (1+ tag-start)) - (case (char-after) - (?! ; declaration - (setq tag-type 'decl)) - (?? ; processing-instruction - (setq tag-type 'pi)) - (?/ ; close-tag - (forward-char 1) - (setq tag-type 'close - name (sgml-parse-tag-name))) - (?% ; JSP tags - (setq tag-type 'jsp)) - (t ; open or empty tag - (setq tag-type 'open - name (sgml-parse-tag-name)) - (if (or (eq ?/ (char-before (- tag-end 1))) - (sgml-empty-tag-p name)) - (setq tag-type 'empty)))))) - (goto-char tag-start) - (sgml-make-tag tag-type tag-start tag-end name))) + (catch 'found + (let (tag-type tag-start tag-end name) + (or (re-search-backward "[<>]" limit 'move) + (error "No tag found")) + (when (eq (char-after) ?<) + ;; Oops!! Looks like we were not in a textual context after all!. + ;; Let's try to recover. + (with-syntax-table sgml-tag-syntax-table + (let ((pos (point))) + (condition-case nil + (forward-sexp) + (scan-error + ;; This < seems to be just a spurious one, let's ignore it. + (goto-char pos) + (throw 'found (sgml-parse-tag-backward limit)))) + ;; Check it is really a tag, without any extra < or > inside. + (unless (sgml-tag-text-p pos (point)) + (goto-char pos) + (throw 'found (sgml-parse-tag-backward limit))) + (forward-char -1)))) + (setq tag-end (1+ (point))) + (cond + ((sgml-looking-back-at "--") ; comment + (setq tag-type 'comment + tag-start (search-backward "<!--" nil t))) + ((sgml-looking-back-at "]]") ; cdata + (setq tag-type 'cdata + tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t))) + (t + (setq tag-start + (with-syntax-table sgml-tag-syntax-table + (goto-char tag-end) + (condition-case nil + (backward-sexp) + (scan-error + ;; This > isn't really the end of a tag. Skip it. + (goto-char (1- tag-end)) + (throw 'found (sgml-parse-tag-backward limit)))) + (point))) + (goto-char (1+ tag-start)) + (case (char-after) + (?! ; declaration + (setq tag-type 'decl)) + (?? ; processing-instruction + (setq tag-type 'pi)) + (?/ ; close-tag + (forward-char 1) + (setq tag-type 'close + name (sgml-parse-tag-name))) + (?% ; JSP tags + (setq tag-type 'jsp)) + (t ; open or empty tag + (setq tag-type 'open + name (sgml-parse-tag-name)) + (if (or (eq ?/ (char-before (- tag-end 1))) + (sgml-empty-tag-p name)) + (setq tag-type 'empty)))))) + (goto-char tag-start) + (sgml-make-tag tag-type tag-start tag-end name)))) (defun sgml-get-context (&optional until) "Determine the context of the current position. @@ -1964,5 +1991,5 @@ (provide 'sgml-mode) -;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401 +;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401 ;;; sgml-mode.el ends here
--- a/lisp/textmodes/table.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/textmodes/table.el Fri Nov 12 02:53:04 2004 +0000 @@ -645,7 +645,8 @@ :group 'editing :group 'wp :group 'paragraphs - :group 'fill) + :group 'fill + :version "21.4") (defgroup table-hooks nil "Hooks for table manipulation utilities"
--- a/lisp/tooltip.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/tooltip.el Fri Nov 12 02:53:04 2004 +0000 @@ -1,6 +1,6 @@ ;;; tooltip.el --- show tooltip windows -;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@acm.org> ;; Keywords: help c mouse tools @@ -26,11 +26,7 @@ ;;; Code: -(eval-when-compile - (require 'cl) - (require 'comint) - (require 'gud) - (require 'gdb-ui)) +(eval-when-compile (require 'cl)) ; for case macro ;;; Customizable settings @@ -524,5 +520,5 @@ (provide 'tooltip) -;;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f +;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f ;;; tooltip.el ends here
--- a/lisp/url/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/url/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,8 @@ +2004-11-12 Masatake YAMATO <jet@gyve.org> + + * url-mailto.el (url-mailto): Fix a typo in the + comment. + 2004-11-02 Masatake YAMATO <jet@gyve.org> * url-imap.el (url-imap-open-host): Don't use
--- a/lisp/url/url-mailto.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/url/url-mailto.el Fri Nov 12 02:53:04 2004 +0000 @@ -63,7 +63,7 @@ (defun url-mailto (url) "Handle the mailto: URL syntax." (if (url-user url) - ;; malformed mailto URL (mailto://wmperry@gnu.org instead of + ;; malformed mailto URL (mailto://wmperry@gnu.org) instead of ;; mailto:wmperry@gnu.org (url-set-filename url (concat (url-user url) "@" (url-filename url)))) (setq url (url-filename url))
--- a/lispref/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/lispref/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,24 @@ +2004-11-08 Richard M. Stallman <rms@gnu.org> + + * syntax.texi (Syntax Table Functions): Add syntax-after. + +2004-11-06 Lars Brinkhoff <lars@nocrew.org> + + * os.texi (Processor Run Time): New section documenting + get-internal-run-time. + +2004-11-06 Eli Zaretskii <eliz@gnu.org> + + * Makefile.in (install, maintainer-clean): Don't use "elisp-*" as + it nukes elisp-cover.texi. + (dist): Change elisp-[0-9] to elisp-[1-9], as there could be no + elisp-0 etc. + +2004-11-05 Luc Teirlinck <teirllm@auburn.edu> + + * commands.texi (Keyboard Macros): Document `append' return value + of `defining-kbd-macro'. + 2004-11-01 Richard M. Stallman <rms@gnu.org> * commands.texi (Interactive Call): Add called-interactively-p.
--- a/lispref/Makefile.in Thu Nov 04 08:55:40 2004 +0000 +++ b/lispref/Makefile.in Fri Nov 12 02:53:04 2004 +0000 @@ -108,7 +108,7 @@ install: elisp $(srcdir)/mkinstalldirs $(infodir) - cp elisp elisp-* $(infodir) + cp elisp elisp-[1-9] elisp-[1-9][0-9] $(infodir) ${INSTALL_INFO} --info-dir=${infodir} ${infodir}/elisp clean: @@ -119,7 +119,7 @@ distclean: clean maintainer-clean: clean - rm -f elisp elisp-* elisp.dvi elisp.oaux + rm -f elisp elisp-[1-9] elisp-[1-9][0-9] elisp.dvi elisp.oaux dist: elisp elisp.dvi -rm -rf temp @@ -128,7 +128,7 @@ -ln $(srcdir)/README $(srcdir)/configure.in $(srcdir)/configure \ $(srcdir)/Makefile.in $(srcs) \ $(srcdir)/../man/texinfo.tex \ - elisp.dvi elisp.aux elisp.??s elisp elisp-[0-9] elisp-[0-9][0-9] \ + elisp.dvi elisp.aux elisp.??s elisp elisp-[1-9] elisp-[1-9][0-9] \ temp/$(manual) -(cd temp/$(manual); rm -f mkinstalldirs) cp $(srcdir)/mkinstalldirs temp/$(manual)
--- a/lispref/commands.texi Thu Nov 04 08:55:40 2004 +0000 +++ b/lispref/commands.texi Fri Nov 12 02:53:04 2004 +0000 @@ -420,7 +420,7 @@ parentheses and brackets) do not do so here. Prompt. @item U -A key sequence or nil. May be used after a @code{k} or @code{K} +A key sequence or @code{nil}. May be used after a @code{k} or @code{K} argument to get the up-event that was discarded in case the key sequence read for that argument was a down-event. No I/O. @@ -3023,9 +3023,10 @@ @defvar defining-kbd-macro This variable is non-@code{nil} if and only if a keyboard macro is being defined. A command can test this variable so as to behave -differently while a macro is being defined. The commands -@code{start-kbd-macro} and @code{end-kbd-macro} set this variable---do -not set it yourself. +differently while a macro is being defined. The value is +@code{append} while appending to the definition of an existing macro. +The commands @code{start-kbd-macro}, @code{kmacro-start-macro} and +@code{end-kbd-macro} set this variable---do not set it yourself. The variable is always local to the current terminal and cannot be buffer-local. @xref{Multiple Displays}.
--- a/lispref/os.texi Thu Nov 04 08:55:40 2004 +0000 +++ b/lispref/os.texi Fri Nov 12 02:53:04 2004 +0000 @@ -23,6 +23,7 @@ * Time of Day:: Getting the current time. * Time Conversion:: Converting a time from numeric form to a string, or to calendrical data (or vice versa). +* Processor Run Time:: Getting the run time used by Emacs. * Time Calculations:: Adding, subtracting, comparing times, etc. * Timers:: Setting a timer to call a function at a certain time. * Terminal Input:: Recording terminal input for debugging. @@ -1285,6 +1286,28 @@ on others, years as early as 1901 do work. @end defun +@node Processor Run Time +@section Processor Run time + +@defun get-internal-run-time +This function returns the processor run time used by Emacs as a list +of three integers: @code{(@var{high} @var{low} @var{microsec})}. The +integers @var{high} and @var{low} combine to give the number of +seconds, which is +@ifnottex +@var{high} * 2**16 + @var{low}. +@end ifnottex +@tex +$high*2^{16}+low$. +@end tex + +The third element, @var{microsec}, gives the microseconds (or 0 for +systems that return time with the resolution of only one second). + +If the system doesn't provide a way to determine the processor run +time, get-internal-run-time returns the same time as current-time. +@end defun + @node Time Calculations @section Time Calculations
--- a/lispref/syntax.texi Thu Nov 04 08:55:40 2004 +0000 +++ b/lispref/syntax.texi Fri Nov 12 02:53:04 2004 +0000 @@ -501,6 +501,18 @@ @code{char-syntax}. @end defun +@defun syntax-after pos +This function returns a description of the syntax of the character in +the buffer after position @var{pos}, taking account of syntax +properties as well as the syntax table. + +The value is usually a syntax class character; however, if the buffer +character has parenthesis syntax, the value is a cons cell of the form +@code{(@var{class} . @var{match})}, where @var{class} is the syntax +class character and @var{match} is the buffer character's matching +parenthesis. +@end defun + @defun set-syntax-table table This function makes @var{table} the syntax table for the current buffer. It returns @var{table}.
--- a/man/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/man/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,10 @@ +2004-11-10 Andre Spiegel <spiegel@gnu.org> + + * files.texi (Version Control): Rewrite the introduction about + version systems, mentioning the new ones that we support. Thanks + to Alex Ott, Karl Fogel, Stefan Monnier, and David Kastrup for + suggestions. + 2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> * emacs-mime.texi (Encoding Customization): Fix
--- a/man/files.texi Thu Nov 04 08:55:40 2004 +0000 +++ b/man/files.texi Fri Nov 12 02:53:04 2004 +0000 @@ -1119,11 +1119,13 @@ description of what was changed in that version. The Emacs version control interface is called VC. Its commands work -with three version control systems---RCS, CVS, and SCCS. The GNU -project recommends RCS and CVS, which are free software and available -from the Free Software Foundation. We also have free software to -replace SCCS, known as CSSC; if you are using SCCS and don't want to -make the incompatible change to RCS or CVS, you can switch to CSSC. +with different version control systems---currently, it supports CVS, +GNU Arch, RCS, Meta-CVS, Subversion, and SCCS. Of these, the GNU +project distributes CVS, GNU Arch, and RCS; we recommend that you use +either CVS or GNU Arch for your projects, and RCS for individual +files. We also have free software to replace SCCS, known as CSSC; if +you are using SCCS and don't want to make the incompatible change to +RCS or CVS, you can switch to CSSC. VC is enabled by default in Emacs. To disable it, set the customizable variable @code{vc-handled-backends} to @code{nil} @@ -1164,31 +1166,61 @@ @node Version Systems @subsubsection Supported Version Control Systems -@cindex RCS @cindex back end (version control) - VC currently works with three different version control systems or -``back ends'': RCS, CVS, and SCCS. - - RCS is a free version control system that is available from the Free -Software Foundation. It is perhaps the most mature of the supported -back ends, and the VC commands are conceptually closest to RCS. Almost -everything you can do with RCS can be done through VC. + VC currently works with six different version control systems or +``back ends'': CVS, GNU Arch, RCS, Meta-CVS, Subversion, and SCCS. @cindex CVS - CVS is built on top of RCS, and extends the features of RCS, allowing -for more sophisticated release management, and concurrent multi-user -development. VC supports basic editing operations under CVS, but for -some less common tasks you still need to call CVS from the command line. -Note also that before using CVS you must set up a repository, which is a -subject too complex to treat here. + CVS is a free version control system that is used for the majority +of free software projects today. It allows concurrent multi-user +development either locally or over the network. Some of its +shortcomings, corrected by newer systems such as GNU Arch, are that it +lacks atomic commits or support for renaming files. VC supports all +basic editing operations under CVS, but for some less common tasks you +still need to call CVS from the command line. Note also that before +using CVS you must set up a repository, which is a subject too complex +to treat here. + +@cindex GNU Arch +@cindex Arch + GNU Arch is a new version control system that is designed for +distributed work. It differs in many ways from old well-known +systems, such as CVS and RCS. It supports different transports for +interoperating between users, offline operations, and it has good +branching and merging features. It also supports atomic commits, and +history of file renaming and moving. VC does not support all +operations provided by GNU Arch, so you must sometimes invoke it from +the command line, or use a specialized module. + +@cindex RCS + RCS is the free version control system around which VC was initially +built. The VC commands are therefore conceptually closest to RCS. +Almost everything you can do with RCS can be done through VC. You +cannot use RCS over the network though, and it only works at the level +of individual files, rather than projects. You should use it if you +want a simple, yet reliable tool for handling individual files. + +@cindex SVN +@cindex Subversion + Subversion is a free version control system designed to be similar +to CVS but without CVS's problems. Subversion supports atomic commits, +and versions directories, symbolic links, meta-data, renames, copies, +and deletes. It can be used via http or via its own protocol. + +@cindex MCVS +@cindex Meta-CVS + Meta-CVS is another attempt to solve problems, arising in CVS. It +supports directory structure versioning, improved branching and +merging, and use of symbolic links and meta-data in repositories. @cindex SCCS SCCS is a proprietary but widely used version control system. In -terms of capabilities, it is the weakest of the three that VC -supports. VC compensates for certain features missing in SCCS -(snapshots, for example) by implementing them itself, but some other VC -features, such as multiple branches, are not available with SCCS. You -should use SCCS only if for some reason you cannot use RCS. +terms of capabilities, it is the weakest of the six that VC supports. +VC compensates for certain features missing in SCCS (snapshots, for +example) by implementing them itself, but some other VC features, such +as multiple branches, are not available with SCCS. You should use +SCCS only if for some reason you cannot use RCS, or one of the +higher-level systems such as CVS or GNU Arch. @node VC Concepts @subsubsection Concepts of Version Control
--- a/msdos/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/msdos/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,29 @@ +2004-11-10 Eli Zaretskii <eliz@gnu.org> + + * sed1.inp: Revert last change. + +2004-11-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * sed1v2.inp: Use djecho for buildobj.lst. + + * sed1.inp: Ditto. + +2004-11-08 Eli Zaretskii <eliz@gnu.org> + + * sedlisp.inp (bootstrap-clean): Copy ldefs-boot.el onto + loaddefs.el, unless the latter exists and is newer. + + * mainmake.v2 (mostlyclean, distclean, maintainer-clean) + (extraclean, bootfast): New targets. + (top_distclean): New macro, used by distclean, maintainer-clean, + and extraclean. + (.PHONY): Add bootfast. + (bootstrap): Make bootstrap-after in lisp. + (bootstrap-clean-before): Clean in man, lispref, and lispintro as + well. + + * sed2v2.inp (HAVE_BZERO): Define for GCC v3.x and later. + 2004-10-06 Eli Zaretskii <eliz@gnu.org> * sed1v2.inp (LC_ALL=C): Fix src/Makefile breakage caused by
--- a/msdos/mainmake.v2 Thu Nov 04 08:55:40 2004 +0000 +++ b/msdos/mainmake.v2 Fri Nov 12 02:53:04 2004 +0000 @@ -21,7 +21,7 @@ # Boston, MA 02111-1307, USA. # make all to compile and build Emacs. -# make install to install it. +# make install to install it (installs in-place, in `bin' subdir of top dir). # make TAGS to update tags tables. # # make clean or make mostlyclean @@ -40,11 +40,12 @@ # `make distclean' should leave only the files that were in the # distribution. # -# make realclean +# make maintainer-clean # Delete everything from the current directory that can be # reconstructed with this Makefile. This typically includes -# everything deleted by distclean, plus more: C source files -# produced by Bison, tags tables, info files, and so on. +# everything deleted by distclean, plus more: *.elc files, +# C source files produced by Bison, tags tables, info files, +# and so on. # # make extraclean # Still more severe - delete backup and autosave files, too. @@ -135,22 +136,89 @@ check: @echo "We don't have any tests for GNU Emacs yet." -clean: +clean mostlyclean: cd lib-src - $(MAKE) clean + $(MAKE) $(MFLAGS) $@ cd .. cd src - $(MAKE) clean + $(MAKE) $(MFLAGS) $@ + cd .. + cd oldxmenu + -$(MAKE) $(MFLAGS) $@ + cd .. + cd man + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispref + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispintro + -$(MAKE) $(MFLAGS) $@ + cd .. + cd leim + if exist Makefile redir $(MAKE) $(MFLAGS) $@ + cd .. + -$(MAKE) $(MFLAGS) $@ + +top_distclean=rm -f Makefile */Makefile src/_gdbinit + +distclean maintainer-clean: FRC + cd src + $(MAKE) $(MFLAGS) $@ cd .. cd oldxmenu - -$(MAKE) clean + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lib-src + $(MAKE) $(MFLAGS) $@ + cd .. + cd man + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispref + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispintro + -$(MAKE) $(MFLAGS) $@ cd .. cd leim - if exist Makefile redir $(MAKE) clean + if exist Makefile redir $(MAKE) $(MFLAGS) $@ cd .. + cd lisp + $(MAKE) $(MFLAGS) $@ + cd .. + ${top_distclean} -.PHONY: bootstrap bootstrap-lisp-1 boostrap-src bootstrap-lisp bootstrap-clean -.PHONY: maybe_bootstrap +extraclean: + cd src + $(MAKE) $(MFLAGS) $@ + cd .. + cd oldxmenu + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lib-src + $(MAKE) $(MFLAGS) $@ + cd .. + cd man + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispref + -$(MAKE) $(MFLAGS) $@ + cd .. + cd lispintro + -$(MAKE) $(MFLAGS) $@ + cd .. + cd leim + if exist Makefile redir $(MAKE) $(MFLAGS) $@ + cd .. + cd lisp + $(MAKE) $(MFLAGS) $@ + cd .. + ${top_distclean} + -rm -f *~ #* + +.PHONY: bootstrap bootstrap-lisp-1 bootstrap-src bootstrap-lisp bootstrap-clean +.PHONY: maybe_bootstrap bootfast maybe_bootstrap: @if not exist lisp\abbrev.elc djecho \ @@ -158,6 +226,10 @@ @if not exist lisp\abbrev.elc redir -e /dev/null -oe redir fail-this-make.exe bootstrap: bootstrap-clean-before bootstrap-lisp-1 bootstrap-src bootstrap-lisp bootstrap-clean-after all info + cd lisp; $(MAKE) $(MFLAGS) bootstrap-after; cd .. + +bootfast: bootstrap-clean-before bootstrap-src bootstrap-lisp bootstrap-clean-after all info + cd lisp; $(MAKE) $(MFLAGS) bootstrap-after; cd .. bootstrap-lisp-1: cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean; cd .. @@ -172,7 +244,10 @@ bootstrap-clean-before: FRC cd src; $(MAKE) $(MFLAGS) mostlyclean; cd .. cd lib-src; $(MAKE) $(MFLAGS) clean; cd .. - cd leim; $(MAKE) $(MFLAGS) clean; cd .. + -cd man; $(MAKE) $(MFLAGS) clean; cd .. + -cd lispref; $(MAKE) $(MFLAGS) clean; cd .. + -cd lispintro; $(MAKE) $(MFLAGS) clean; cd .. + cd leim; if exist Makefile redir $(MAKE) $(MFLAGS) clean; cd .. bootstrap-clean-after: cd src; $(MAKE) $(MFLAGS) mostlyclean; cd ..
--- a/msdos/sed1v2.inp Thu Nov 04 08:55:40 2004 +0000 +++ b/msdos/sed1v2.inp Fri Nov 12 02:53:04 2004 +0000 @@ -58,6 +58,7 @@ /rm -f bootstrap-emacs/s/b-emacs/b-emacs b-emacs.exe/ /^ els=/c\ ${libsrc}make-docfile -o ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP:.elc=.el} ${shortlisp:.elc=.el} ${SOME_MACHINE_OBJECTS} ${obj} +s/echo.*buildobj.lst/dj&/ /^ mv -f emacs/a\ stubify b-emacs\ stubedit b-emacs.exe minstack=1024k\
--- a/msdos/sed2v2.inp Thu Nov 04 08:55:40 2004 +0000 +++ b/msdos/sed2v2.inp Fri Nov 12 02:53:04 2004 +0000 @@ -84,6 +84,14 @@ #else\ #undef HAVE_STDINT_H\ #endif +# GCC 3.x has a built-in bzero, which conflicts with the define at +# the end of config.in +/^#undef HAVE_BZERO/c\ +#if __GNUC__ >= 3\ +#define HAVE_BZERO 1\ +#else\ +#undef HAVE_BZERO\ +#endif # Comment out any remaining undef directives, because some of them # might be defined in sys/config.h we include at the top of config.h.
--- a/msdos/sedlisp.inp Thu Nov 04 08:55:40 2004 +0000 +++ b/msdos/sedlisp.inp Fri Nov 12 02:53:04 2004 +0000 @@ -24,6 +24,7 @@ /^VPATH=/s|@srcdir@|.| /^srcdir=/s|@srcdir@|.| /^bootstrap-clean:/a\ - command.com /c dtou .../*.el + command.com /c dtou .../*.el\ + command.com /c update $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el # arch-tag: da7a3cff-4839-4ad7-bbe3-e2b61c84c38e
--- a/src/.cvsignore Thu Nov 04 08:55:40 2004 +0000 +++ b/src/.cvsignore Fri Nov 12 02:53:04 2004 +0000 @@ -17,3 +17,4 @@ prefix-args stamp-oldxmenu temacs +buildobj.lst
--- a/src/ChangeLog Thu Nov 04 08:55:40 2004 +0000 +++ b/src/ChangeLog Fri Nov 12 02:53:04 2004 +0000 @@ -1,3 +1,233 @@ +2004-11-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * keymap.c (Fkeymap_prompt): Accept symbol keymaps. + +2004-11-09 Kim F. Storm <storm@cua.dk> + + * xselect.c: Include <sys/types.h> and <unistd.h> (for getpid). + Fix various comments referring to XEvents instead of input events. + (x_queue_event): Fix format strings. + (x_stop_queuing_selection_requests): Likewise. + + * xdisp.c (produce_image_glyph): Remove unused variable 'face_ascent'. + (pint2hrstr): Add extra braces to silence compiler. + + * print.c (print_object): Fix format string. + + * lread.c (read1): Fix next_char matching. + + * lisp.h (Fdelete): Add EXFUN. + (replace_range_2): Add prototype. + + * keyboard.c (read_avail_input): Remove unused variable 'discard'. + + * intervals.h (NULL_INTERVAL_P): Add separate version when + ENABLE_CHECKING is not defined to silence compiler. + (compare_string_intervals): Add prototype. + + * fringe.c (destroy_fringe_bitmap): Fix return type. + (Ffringe_bitmaps_at_pos): Remove unused var 'old_buffer'. + + * emacs.c (Fdump_emacs): Fix format string. + + * doc.c: Include <ctype.h>. + (Fsubstitute_command_keys): Remove unused variable 'firstkey'. + + * data.c (store_symval_forwarding): Remove unused variables. + + * callint.c (Fcall_interactively): Remove unused variable 'funcar'. + +2004-11-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * Makefile.in (stamp-oldxmenu): If HAVE_GTK, don't add dependencies + to ${OLDXMENU}. + +2004-11-09 Kim F. Storm <storm@cua.dk> + + * process.c (Fmake_network_process): Remove kludge for interrupted + connects on BSD. If connect is interrupted, just close socket and + start over rather than sleeping and retry with same socket. + +2004-11-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * .cvsignore: Add buildobj.lst. + + * doc.c: New variable Vbuild_files. + (Fsnarf_documentation): If Vbuild_files is nil, populate it with + file names from buildobh.lst. Only attach docstrings from files + that are in Vbuild_files. + (syms_of_doc): Defvar Vbuild_files. + + * Makefile.in (SOME_MACHINE_OBJECTS): Add fringe.o, image.o + and w32*.o. + (temacs${EXEEXT}): Generate buildobj.lst when temacs is linked. + (mostlyclean): rm buildobj.lst + + * makefile.w32-in ($(TEMACS)): Generate buildobj.lst when temacs + is linked. + +2004-11-09 Kim F. Storm <storm@cua.dk> + + * fringe.c (update_window_fringes): Update fringe bitmaps if + cur and row ends_at_zv_p differs. If bitmaps of a row is updated, + also update previous row to get rid of misc. artifacts. + +2004-11-08 Kim F. Storm <storm@cua.dk> + + * xdisp.c (fast_find_position): Fix start pos if header line present. + (note_mouse_highlight): Clear mouse face if we move out of text area. + +2004-11-08 Eli Zaretskii <eliz@gnu.org> + + * editfns.c: Move #include "systime.h" before <sys/resource.h>. + Don't include <sys/time.h> explicitly. + Include <stdio.h> unconditionally, not just on MacOS. + +2004-11-08 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_pattern_regexp): Cancel my previous change; + don't pay attention to '\' before '*'. + (fontset_pattern_regexp): Change the meaning of the second arg. + (Fnew_fontset): Call fs_query_fontset, not Fquery_fontset. + (check_fontset_name): Try NAME as literal at first, and if it + failes, try NAME as pattern. + +2004-11-07 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * emacs.c (Fdump_emacs): Only output warning on GNU/Linux. + +2004-11-07 Andreas Schwab <schwab@suse.de> + + * lisp.h: Declare Fmsdos_downcase_filename. + * dired.c: Don't declare Fmsdos_downcase_filename. + * fileio.c: Likewise. + +2004-11-07 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * dosfns.c (Fdos_memget, Fdos_memput): Use integer variable offs in + comparisons with integers instead of Lisp_Object address. + (Fmsdos_set_keyboard): Declare argument allkeys. + + * msdos.c (IT_set_frame_parameters): Use EQ, not ==, for Lisp_Object:s. + + * dired.c: extern declare Fmsdos_downcase_filename on MSDOS to avoid + int/Lisp_Object mixup. + + * fileio.c: Ditto. + +2004-11-06 Steven Tamm <steventamm@mac.com> + + * editfns.c: Need to include sys/time.h before resource.h on darwin. + +2004-11-06 Richard M. Stallman <rms@gnu.org> + + * callint.c (Fcall_interactively): Avoid reusing EVENT for other data. + + * xfaces.c (merge_named_face): GCPRO the face_name in the + named_merge_point struct that we make. + (merge_face_heights): Eliminate GCPRO arg. All callers changed. + + * keyboard.c (command_loop_1): Change Vtransient_mark_mode + before deciding whether to inactivate mark. + +2004-11-06 Lars Brinkhoff <lars@nocrew.org> + + * config.in: Regenerate (add HAVE_GETRUSAGE). + * editfns.c (Fget_internal_run_time): New function. + (syms_of_data): Defsubr it. + * fns.c (sxhash): As far as possible, merge calculation of + hash code for symbols and strings. + +2004-11-06 Eli Zaretskii <eliz@gnu.org> + + * frame.c (syms_of_frame): Fix the example in the doc string. + +2004-11-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * eval.c (Feval): Remove check for INPUT_BLOCKED_P. + + * xmenu.c (popup_get_selection, create_and_show_popup_menu) + (create_and_show_dialog): Revert change from 2004-10-31. + +2004-11-05 Luc Teirlinck <teirllm@auburn.edu> + + * macros.c (syms_of_macros) <defining-kbd-macro>: Doc fix. + +2004-11-05 Kim F. Storm <storm@cua.dk> + + * print.c (print_object): Print Lisp_Misc_Save_Value objects. + + * fileio.c (Ffile_modes): Doc fix. + (auto_save_1): Check for Ffile_modes nil value. + +2004-11-05 Kim F. Storm <storm@cua.dk> + + * xselect.c (struct selection_event_queue, selection_queue) + (x_queue_selection_requests, x_queue_event) + (x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests): Add new queue for selection + input events to replace previous XEvent queue in xterm.c. + (queue_selection_requests_unwind): Adapt to new queue. + (x_reply_selection_request): Adapt to new queue. + Unexpect wait_object in case of x errors (memory leak). + (x_handle_selection_request, x_handle_selection_clear): Make static. + (x_handle_selection_event): New function. May queue selection events. + (wait_for_property_change_unwind): Use save_value instead of cons. + Clear property_change_reply_object. + (wait_for_property_change): Abort if already waiting. + Use save_value instead of cons for unwind data. + (x_handle_property_notify): Skip events already arrived, but don't + free them, as "arrived" field is checked by wait_for_property_change, + and it will be freed by unwind or explicit unexpect_property_change. + (x_get_foreign_selection): Add to new queue. + (receive_incremental_selection): Don't unexpect wait_object when done + as it has already been freed by previous wait_for_property_change. + + * xterm.h (x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests, x_handle_selection_request) + (x_handle_selection_clear): Remove prototypes. + (x_handle_selection_event): Add prototype. + + * xterm.c (handle_one_xevent): Don't queue X selection events + here, it may be too late if we start queuing after we have already + stored some selection events into the kbd buffer. + (struct selection_event_queue, queue, x_queue_selection_requests) + (x_queue_event, x_unqueue_events, x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests): Remove/move to xselect.c. + (x_catch_errors_unwind): Block input around final XSync. + + * keyboard.h (kbd_buffer_unget_event): Add prototype. + + * keyboard.c (kbd_buffer_store_event_hold): Remove obsolete code. + (kbd_buffer_unget_event): New function. + (kbd_buffer_get_event, swallow_events): Combine SELECTION events + and use x_handle_selection_event. + (mark_kboards): Don't mark x and y of SELECTION_CLEAR_EVENT. + +2004-11-05 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xselect.c (TRACE3): New debug macro. + (x_reply_selection_request): Use it. + (receive_incremental_selection): In call to TRACE0, the name of + a symbol is in xname. + +2004-11-05 Kim F. Storm <storm@cua.dk> + + * fontset.c (fontset_pattern_regexp): Use unsigned char. + +2004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * fileio.c (Fnext_read_file_uses_dialog_p): New function. + + * gtkutil.h: Declare use_old_gtk_file_dialog. + + * gtkutil.c: Make use_old_gtk_file_dialog non-static. + (xg_initialize): Move DEFVAR_BOOL for use_old_gtk_file_dialog ... + * xfns.c (syms_of_xfns): ... to here. + + * gtkutil.c (xg_get_file_with_chooser): Expand DEFAULT_FILENAME if + it doesn't start with /. + 2004-11-04 Kenichi Handa <handa@m17n.org> * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\', @@ -67,20 +297,20 @@ * lisp.h: Fx_file_dialog takes 5 parameters. - * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add - parameter only_dir_p. + * xfns.c (Fx_file_dialog): Both Motif and GTK version: + Add parameter only_dir_p. In Motif version, don't put DEFAULT_FILENAME in filter part of the dialog, just text field part. Do not add DEFAULT_FILENAME to list of files if it isn't there. In GTK version, pass only_dir_p parameter to xg_get_file_name. - * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check - only_dir_p instead of comparing prompt to "Dired". When using + * macfns.c (Fx_file_dialog): Add parameter only_dir_p. + Check only_dir_p instead of comparing prompt to "Dired". When using a save dialog, add option kNavDontConfirmReplacement, change title to "Enter name", change text for save button to "Ok". - * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check - only_dir_p instead of comparing prompt to "Dired". + * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. + Check only_dir_p instead of comparing prompt to "Dired". * gtkutil.c (xg_get_file_with_chooser) (xg_get_file_with_selection): New functions, only defined ifdef @@ -97,8 +327,8 @@ 2004-11-01 Kim F. Storm <storm@cua.dk> - * process.c (connect_wait_mask, num_pending_connects): Only - declare and use them if NON_BLOCKING_CONNECT is defined. + * process.c (connect_wait_mask, num_pending_connects): + Only declare and use them if NON_BLOCKING_CONNECT is defined. (init_process): Initialize them if NON_BLOCKING_CONNECT defined. (IF_NON_BLOCKING_CONNECT): New helper macro. (wait_reading_process_output): Only declare and use local vars @@ -113,8 +343,8 @@ * xmenu.c: Add prototypes for forward function declarations. (popup_get_selection): Remove parameter do_timers, remove call to timer_check. - (create_and_show_popup_menu, create_and_show_dialog): Remove - parameter do_timers from call to popup_get_selection. + (create_and_show_popup_menu, create_and_show_dialog): + Remove parameter do_timers from call to popup_get_selection. * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to tool_bar_items and assign the result to f->tool_bar_items if @@ -133,7 +363,7 @@ * macterm.c: allow user to assign key modifiers to the Mac Option key via a 'mac-option-modifier' variable. -2004-10-28 Stefan <monnier@iro.umontreal.ca> +2004-10-28 Stefan Monnier <monnier@iro.umontreal.ca> * xselect.c (Vx_lost_selection_functions, Vx_sent_selection_functions): Rename from Vx_lost_selection_hooks and Vx_sent_selection_hooks.
--- a/src/Makefile.in Thu Nov 04 08:55:40 2004 +0000 +++ b/src/Makefile.in Fri Nov 12 02:53:04 2004 +0000 @@ -596,8 +596,10 @@ These go in the DOC file on all machines in case they are needed there. */ SOME_MACHINE_OBJECTS = sunfns.o dosfns.o msdos.o \ - xterm.o xfns.o xmenu.o xselect.o xrdb.o \ - mac.o macterm.o macfns.o macmenu.o fontset.o + xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \ + mac.o macterm.o macfns.o macmenu.o fontset.o \ + w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \ + w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o #ifdef TERMINFO @@ -926,6 +928,7 @@ #endif temacs${EXEEXT}: MAKE_PARALLEL $(LOCALCPP) $(STARTFILES) stamp-oldxmenu ${obj} ${otherobj} OBJECTS_MACHINE prefix-args${EXEEXT} + echo "${obj} ${otherobj} " OBJECTS_MACHINE > buildobj.lst $(LD) YMF_PASS_LDFLAGS (${STARTFLAGS} ${TEMACS_LDFLAGS}) $(LDFLAGS) \ -o temacs ${STARTFILES} ${obj} ${otherobj} \ OBJECTS_MACHINE ${LIBES} @@ -941,7 +944,7 @@ #define OLDXMENU_OPTIONS #endif -#if defined (HAVE_X_WINDOWS) && defined (HAVE_X11) && defined (HAVE_MENUS) +#if defined (HAVE_X_WINDOWS) && defined (HAVE_X11) && defined (HAVE_MENUS) && ! defined (HAVE_GTK) /* We use stamp-xmenu with these two deps to both ensure that lwlib gets remade based on its dependencies @@ -997,12 +1000,12 @@ @true /* make -t should not create really-oldXMenu. */ .PHONY: really-oldXMenu #endif /* not USE_X_TOOLKIT */ -#else /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */ +#else /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS && ! HAVE_GTK) */ /* We don\'t really need this, but satisfy the dependency. */ stamp-oldxmenu: touch stamp-oldxmenu -#endif /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */ +#endif /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS && ! HAVE_GTK) */ ../config.status:: epaths.in @echo "The file epaths.h needs to be set up from epaths.in." @@ -1266,6 +1269,7 @@ rm -f temacs${EXEEXT} prefix-args${EXEEXT} core *.core \#* *.o libXMenu11.a liblw.a rm -f ../etc/DOC rm -f bootstrap-emacs${EXEEXT} + rm -f buildobj.lst clean: mostlyclean rm -f emacs-*${EXEEXT} emacs${EXEEXT} /**/# This is used in making a distribution.
--- a/src/callint.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/callint.c Fri Nov 12 02:53:04 2004 +0000 @@ -265,7 +265,6 @@ Lisp_Object *args, *visargs; unsigned char **argstrings; Lisp_Object fun; - Lisp_Object funcar; Lisp_Object specs; Lisp_Object filter_specs; Lisp_Object teml; @@ -451,25 +450,25 @@ string++; else if (*string == '@') { - Lisp_Object event; + Lisp_Object event, tem; event = (next_event < key_count ? XVECTOR (keys)->contents[next_event] : Qnil); if (EVENT_HAS_PARAMETERS (event) - && (event = XCDR (event), CONSP (event)) - && (event = XCAR (event), CONSP (event)) - && (event = XCAR (event), WINDOWP (event))) + && (tem = XCDR (event), CONSP (tem)) + && (tem = XCAR (tem), CONSP (tem)) + && (tem = XCAR (tem), WINDOWP (tem))) { - if (MINI_WINDOW_P (XWINDOW (event)) - && ! (minibuf_level > 0 && EQ (event, minibuf_window))) + if (MINI_WINDOW_P (XWINDOW (tem)) + && ! (minibuf_level > 0 && EQ (tem, minibuf_window))) error ("Attempt to select inactive minibuffer window"); /* If the current buffer wants to clean up, let it. */ if (!NILP (Vmouse_leave_buffer_hook)) call1 (Vrun_hooks, Qmouse_leave_buffer_hook); - Fselect_window (event, Qnil); + Fselect_window (tem, Qnil); } string++; }
--- a/src/config.in Thu Nov 04 08:55:40 2004 +0000 +++ b/src/config.in Fri Nov 12 02:53:04 2004 +0000 @@ -196,6 +196,9 @@ /* Define to 1 if you have the `getpt' function. */ #undef HAVE_GETPT +/* Define to 1 if you have the `getrusage' function. */ +#undef HAVE_GETRUSAGE + /* Define to 1 if you have the `getsockname' function. */ #undef HAVE_GETSOCKNAME
--- a/src/data.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/data.c Fri Nov 12 02:53:04 2004 +0000 @@ -908,8 +908,6 @@ register Lisp_Object valcontents, newval; struct buffer *buf; { - int offset; - switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) { case Lisp_Misc: @@ -941,7 +939,7 @@ - (char *) &buffer_defaults); int idx = PER_BUFFER_IDX (offset); - Lisp_Object tail, buf; + Lisp_Object tail; if (idx <= 0) break;
--- a/src/doc.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/doc.c Fri Nov 12 02:53:04 2004 +0000 @@ -24,6 +24,7 @@ #include <sys/types.h> #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/ +#include <ctype.h> #ifdef HAVE_FCNTL_H #include <fcntl.h> @@ -51,6 +52,9 @@ Lisp_Object Qfunction_documentation; +/* A list of files used to build this Emacs binary. */ +static Lisp_Object Vbuild_files; + extern Lisp_Object Voverriding_local_map; /* For VMS versions with limited file name syntax, @@ -581,6 +585,7 @@ register char *p, *end; Lisp_Object sym; char *name; + int skip_file = 0; CHECK_STRING (filename); @@ -618,6 +623,54 @@ #endif /* VMS4_4 */ #endif /* VMS */ + /* Vbuild_files is nil when temacs is run, and non-nil after that. */ + if (NILP (Vbuild_files)) + { + size_t cp_size = 0; + size_t to_read; + int nr_read; + char *cp = NULL; + char *beg, *end; + + fd = emacs_open ("buildobj.lst", O_RDONLY, 0); + if (fd < 0) + report_file_error ("Opening file buildobj.lst", Qnil); + + filled = 0; + for (;;) + { + cp_size += 1024; + to_read = cp_size - 1 - filled; + cp = xrealloc (cp, cp_size); + nr_read = emacs_read (fd, &cp[filled], to_read); + filled += nr_read; + if (nr_read < to_read) + break; + } + + emacs_close (fd); + cp[filled] = 0; + + for (beg = cp; *beg; beg = end) + { + int len; + + while (*beg && isspace (*beg)) ++beg; + + for (end = beg; *end && ! isspace (*end); ++end) + if (*end == '/') beg = end+1; /* skip directory part */ + + len = end - beg; + if (len > 4 && end[-4] == '.' && end[-3] == 'o') + len -= 2; /* Just take .o if it ends in .obj */ + + if (len > 0) + Vbuild_files = Fcons (make_string (beg, len), Vbuild_files); + } + + xfree (cp); + } + fd = emacs_open (name, O_RDONLY, 0); if (fd < 0) report_file_error ("Opening doc string file", @@ -640,10 +693,28 @@ if (p != end) { end = (char *) index (p, '\n'); + + /* See if this is a file name, and if it is a file in build-files. */ + if (p[1] == 'S' && end - p > 4 && end[-2] == '.' + && (end[-1] == 'o' || end[-1] == 'c')) + { + int len = end - p - 2; + char *fromfile = alloca (len + 1); + strncpy (fromfile, &p[2], len); + fromfile[len] = 0; + if (fromfile[len-1] == 'c') + fromfile[len-1] = 'o'; + + if (EQ (Fmember (build_string (fromfile), Vbuild_files), Qnil)) + skip_file = 1; + else + skip_file = 0; + } + sym = oblookup (Vobarray, p + 2, multibyte_chars_in_text (p + 2, end - p - 2), end - p - 2); - if (SYMBOLP (sym)) + if (! skip_file && SYMBOLP (sym)) { /* Attach a docstring to a variable? */ if (p[1] == 'V') @@ -756,7 +827,6 @@ } else if (strp[0] == '\\' && strp[1] == '[') { - Lisp_Object firstkey; int start_idx; changed = 1; @@ -919,6 +989,10 @@ doc: /* Name of file containing documentation strings of built-in symbols. */); Vdoc_file_name = Qnil; + DEFVAR_LISP ("build-files", &Vbuild_files, + doc: /* A list of files used to build this Emacs binary. */); + Vbuild_files = Qnil; + defsubr (&Sdocumentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation);
--- a/src/dosfns.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/dosfns.c Fri Nov 12 02:53:04 2004 +0000 @@ -110,7 +110,7 @@ offs = (unsigned long) XINT (address); CHECK_VECTOR (vector); len = XVECTOR (vector)-> size; - if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len) + if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len) return Qnil; buf = alloca (len); dosmemget (offs, len, buf); @@ -135,7 +135,7 @@ offs = (unsigned long) XINT (address); CHECK_VECTOR (vector); len = XVECTOR (vector)-> size; - if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len) + if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len) return Qnil; buf = alloca (len); @@ -155,7 +155,7 @@ all keys; otherwise it is only used when the ALT key is pressed. The current keyboard layout is available in dos-keyboard-code. */) (country_code, allkeys) - Lisp_Object country_code; + Lisp_Object country_code, allkeys; { CHECK_NUMBER (country_code); if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys)))
--- a/src/editfns.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/editfns.c Fri Nov 12 02:53:04 2004 +0000 @@ -22,6 +22,7 @@ #include <config.h> #include <sys/types.h> +#include <stdio.h> #ifdef VMS #include "vms-pwd.h" @@ -33,10 +34,13 @@ #include <unistd.h> #endif -/* Without this, sprintf on Mac OS Classic will produce wrong - result. */ -#ifdef MAC_OS8 -#include <stdio.h> +/* systime.h includes <sys/time.h> which, on some systems, is required + for <sys/resource.h>; thus systime.h must be included before + <sys/resource.h> */ +#include "systime.h" + +#if defined HAVE_SYS_RESOURCE_H +#include <sys/resource.h> #endif #include <ctype.h> @@ -49,8 +53,6 @@ #include "frame.h" #include "window.h" -#include "systime.h" - #ifdef STDC_HEADERS #include <float.h> #define MAX_10_EXP DBL_MAX_10_EXP @@ -1370,6 +1372,47 @@ return Flist (3, result); } + +DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, + 0, 0, 0, + doc: /* Return the current run time used by Emacs. +The time is returned as a list of three integers. The first has the +most significant 16 bits of the seconds, while the second has the +least significant 16 bits. The third integer gives the microsecond +count. + +On systems that can't determine the run time, get-internal-run-time +does the same thing as current-time. The microsecond count is zero on +systems that do not provide resolution finer than a second. */) + () +{ +#ifdef HAVE_GETRUSAGE + struct rusage usage; + Lisp_Object result[3]; + int secs, usecs; + + if (getrusage (RUSAGE_SELF, &usage) < 0) + /* This shouldn't happen. What action is appropriate? */ + Fsignal (Qerror, Qnil); + + /* Sum up user time and system time. */ + secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; + usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec; + if (usecs >= 1000000) + { + usecs -= 1000000; + secs++; + } + + XSETINT (result[0], (secs >> 16) & 0xffff); + XSETINT (result[1], (secs >> 0) & 0xffff); + XSETINT (result[2], usecs); + + return Flist (3, result); +#else + return Fcurrent_time (); +#endif +} int @@ -4447,6 +4490,7 @@ defsubr (&Suser_full_name); defsubr (&Semacs_pid); defsubr (&Scurrent_time); + defsubr (&Sget_internal_run_time); defsubr (&Sformat_time_string); defsubr (&Sfloat_time); defsubr (&Sdecode_time);
--- a/src/emacs.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/emacs.c Fri Nov 12 02:53:04 2004 +0000 @@ -1626,16 +1626,14 @@ keys_of_minibuf (); keys_of_window (); } - else + else { - /* - Initialization that must be done even if the global variable - initialized is non zero - */ + /* Initialization that must be done even if the global variable + initialized is non zero. */ #ifdef HAVE_NTGUI globals_of_w32fns (); globals_of_w32menu (); -#endif /* end #ifdef HAVE_NTGUI */ +#endif /* HAVE_NTGUI */ } init_charset (); @@ -2189,16 +2187,19 @@ if (! noninteractive) error ("Dumping Emacs works only in batch mode"); +#ifdef __linux__ if (heap_bss_diff > MAX_HEAP_BSS_DIFF) { fprintf (stderr, "**************************************************\n"); fprintf (stderr, "Warning: Your system has a gap between BSS and the\n"); - fprintf (stderr, "heap. This usually means that exec-shield or\n"); - fprintf (stderr, "something similar is in effect. The dump may fail\n"); - fprintf (stderr, "because of this. See the section about exec-shield\n"); - fprintf (stderr, "in etc/PROBLEMS for more information.\n"); + fprintf (stderr, "heap (%lu byte). This usually means that exec-shield\n", + heap_bss_diff); + fprintf (stderr, "or something similar is in effect. The dump may\n"); + fprintf (stderr, "fail because of this. See the section about \n"); + fprintf (stderr, "exec-shield in etc/PROBLEMS for more information.\n"); fprintf (stderr, "**************************************************\n"); } +#endif /* __linux__ */ /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line @@ -2287,7 +2288,7 @@ { *plocale = desired_locale; setlocale (category, (STRINGP (desired_locale) - ? (char *)(SDATA (desired_locale)) + ? (char *) SDATA (desired_locale) : "")); } }
--- a/src/eval.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/eval.c Fri Nov 12 02:53:04 2004 +0000 @@ -1996,7 +1996,7 @@ struct backtrace backtrace; struct gcpro gcpro1, gcpro2, gcpro3; - if (handling_signal || INPUT_BLOCKED_P) + if (handling_signal) abort (); if (SYMBOLP (form))
--- a/src/fileio.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/fileio.c Fri Nov 12 02:53:04 2004 +0000 @@ -3371,7 +3371,8 @@ } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, - doc: /* Return mode bits of file named FILENAME, as an integer. */) + doc: /* Return mode bits of file named FILENAME, as an integer. +Return nil, if file does not exist or is not accessible. */) (filename) Lisp_Object filename; { @@ -5628,17 +5629,21 @@ auto_save_1 () { struct stat st; + Lisp_Object modes; + + auto_save_mode_bits = 0666; /* Get visited file's mode to become the auto save file's mode. */ - if (! NILP (current_buffer->filename) - && stat (SDATA (current_buffer->filename), &st) >= 0) - /* But make sure we can overwrite it later! */ - auto_save_mode_bits = st.st_mode | 0600; - else if (! NILP (current_buffer->filename)) - /* Remote files don't cooperate with stat. */ - auto_save_mode_bits = XINT (Ffile_modes (current_buffer->filename)) | 0600; - else - auto_save_mode_bits = 0666; + if (! NILP (current_buffer->filename)) + { + if (stat (SDATA (current_buffer->filename), &st) >= 0) + /* But make sure we can overwrite it later! */ + auto_save_mode_bits = st.st_mode | 0600; + else if ((modes = Ffile_modes (current_buffer->filename), + INTEGERP (modes))) + /* Remote files don't cooperate with stat. */ + auto_save_mode_bits = XINT (modes) | 0600; + } return Fwrite_region (Qnil, Qnil, @@ -6090,6 +6095,23 @@ return Ffile_exists_p (string); } +DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p, + Snext_read_file_uses_dialog_p, 0, 0, 0, + doc: /* Return t if a call to `read-file-name' will use a dialog. +The return value is only relevant for a call to `read-file-name' that happens +before any other event (mouse or keypress) is handeled. */) + () +{ +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) + if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) + && use_dialog_box + && use_file_dialog + && have_menus_p ()) + return Qt; +#endif + return Qnil; +} + DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, doc: /* Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. @@ -6222,10 +6244,7 @@ GCPRO2 (insdef, default_filename); #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) - if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && use_file_dialog - && have_menus_p ()) + if (! NILP (Fnext_read_file_uses_dialog_p ())) { /* If DIR contains a file name, split it. */ Lisp_Object file; @@ -6610,6 +6629,7 @@ defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); + defsubr (&Snext_read_file_uses_dialog_p); #ifdef unix defsubr (&Sunix_sync);
--- a/src/fns.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/fns.c Fri Nov 12 02:53:04 2004 +0000 @@ -4476,15 +4476,14 @@ hash = XUINT (obj); break; - case Lisp_Symbol: - hash = sxhash_string (SDATA (SYMBOL_NAME (obj)), - SCHARS (SYMBOL_NAME (obj))); - break; - case Lisp_Misc: hash = XUINT (obj); break; + case Lisp_Symbol: + obj = SYMBOL_NAME (obj); + /* Fall through. */ + case Lisp_String: hash = sxhash_string (SDATA (obj), SCHARS (obj)); break;
--- a/src/fontset.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/fontset.c Fri Nov 12 02:53:04 2004 +0000 @@ -1069,14 +1069,14 @@ || strcmp (SDATA (pattern), CACHED_FONTSET_NAME)) { /* We must at first update the cached data. */ - char *regex, *p0, *p1; + unsigned char *regex, *p0, *p1; int ndashes = 0, nstars = 0; - + for (p0 = SDATA (pattern); *p0; p0++) { if (*p0 == '-') ndashes++; - else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') + else if (*p0 == '*') nstars++; } @@ -1084,14 +1084,14 @@ we convert "*" to "[^-]*" which is much faster in regular expression matching. */ if (ndashes < 14) - p1 = regex = (char *) alloca (SBYTES (pattern) + 2 * nstars + 1); + p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1); else - p1 = regex = (char *) alloca (SBYTES (pattern) + 5 * nstars + 1); + p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1); *p1++ = '^'; - for (p0 = (char *) SDATA (pattern); *p0; p0++) + for (p0 = SDATA (pattern); *p0; p0++) { - if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') + if (*p0 == '*') { if (ndashes < 14) *p1++ = '.'; @@ -1115,31 +1115,35 @@ } /* Return ID of the base fontset named NAME. If there's no such - fontset, return -1. */ + fontset, return -1. NAME_PATTERN specifies how to treat NAME as this: + 0: pattern containing '*' and '?' as wildcards + 1: regular expression + 2: literal fontset name +*/ int -fs_query_fontset (name, regexpp) +fs_query_fontset (name, name_pattern) Lisp_Object name; - int regexpp; + int name_pattern; { Lisp_Object tem; int i; name = Fdowncase (name); - if (!regexpp) + if (name_pattern != 1) { tem = Frassoc (name, Vfontset_alias_alist); if (NILP (tem)) tem = Fassoc (name, Vfontset_alias_alist); if (CONSP (tem) && STRINGP (XCAR (tem))) name = XCAR (tem); - else + else if (name_pattern == 0) { tem = fontset_pattern_regexp (name); if (STRINGP (tem)) { name = tem; - regexpp = 1; + name_pattern = 1; } } } @@ -1154,7 +1158,7 @@ continue; this_name = FONTSET_NAME (fontset); - if (regexpp + if (name_pattern == 1 ? fast_string_match (name, this_name) >= 0 : !strcmp (SDATA (name), SDATA (this_name))) return i; @@ -1284,7 +1288,11 @@ return Vdefault_fontset; CHECK_STRING (name); - id = fs_query_fontset (name, 0); + /* First try NAME as literal. */ + id = fs_query_fontset (name, 2); + if (id < 0) + /* For backward compatibility, try again NAME as pattern. */ + id = fs_query_fontset (name, 0); if (id < 0) error ("Fontset `%s' does not exist", SDATA (name)); return FONTSET_FROM_ID (id);
--- a/src/frame.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/frame.c Fri Nov 12 02:53:04 2004 +0000 @@ -4037,7 +4037,7 @@ DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist, doc: /* Alist of default values for frame creation. These may be set in your init file, like this: - (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1)) + (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))) These override values given in window system configuration data, including X Windows' defaults database. For values specific to the first Emacs frame, see `initial-frame-alist'.
--- a/src/fringe.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/fringe.c Fri Nov 12 02:53:04 2004 +0000 @@ -930,6 +930,7 @@ if (force_p || row->y != cur->y || row->visible_height != cur->visible_height + || row->ends_at_zv_p != cur->ends_at_zv_p || left != cur->left_fringe_bitmap || right != cur->right_fringe_bitmap || left_face_id != cur->left_fringe_face_id @@ -953,6 +954,9 @@ row->right_fringe_bitmap = right; row->left_fringe_face_id = left_face_id; row->right_fringe_face_id = right_face_id; + + if (rn > 0 && row->redraw_fringe_bitmaps_p) + row[-1].redraw_fringe_bitmaps_p = cur[-1].redraw_fringe_bitmaps_p = 1; } return redraw_p; @@ -1056,7 +1060,7 @@ /* Free resources used by a user-defined bitmap. */ -int +void destroy_fringe_bitmap (n) int n; { @@ -1367,7 +1371,6 @@ Lisp_Object pos, window; { struct window *w; - struct buffer *old_buffer = NULL; struct glyph_row *row; int textpos;
--- a/src/gtkutil.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/gtkutil.c Fri Nov 12 02:53:04 2004 +0000 @@ -1131,7 +1131,7 @@ }; #ifdef HAVE_GTK_FILE_BOTH -static int use_old_gtk_file_dialog; +int use_old_gtk_file_dialog; #endif @@ -1178,8 +1178,24 @@ if (default_filename) - gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), - default_filename); + { + Lisp_Object file; + struct gcpro gcpro1; + GCPRO1 (file); + + /* File chooser does not understand ~/... in the file name. It must be + an absolute name starting with /. */ + if (default_filename[0] != '/') + { + file = Fexpand_file_name (build_string (default_filename), Qnil); + default_filename = SDATA (file); + } + + gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), + default_filename); + + UNGCPRO; + } gtk_widget_show (filewin); @@ -3538,14 +3554,6 @@ "gtk-key-theme-name", "Emacs", EMACS_CLASS); - -#ifdef HAVE_GTK_FILE_BOTH - DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, - doc: /* *Non-nil means that the old GTK file selection dialog is used. - If nil the new GTK file chooser is used instead. To turn off - all file dialogs set the variable `use-file-dialog'. */); - use_old_gtk_file_dialog = 0; -#endif } #endif /* USE_GTK */
--- a/src/gtkutil.h Thu Nov 04 08:55:40 2004 +0000 +++ b/src/gtkutil.h Fri Nov 12 02:53:04 2004 +0000 @@ -126,6 +126,10 @@ struct _widget_value *free_list; } widget_value; +#ifdef HAVE_GTK_FILE_BOTH +extern int use_old_gtk_file_dialog; +#endif + extern widget_value *malloc_widget_value P_ ((void)); extern void free_widget_value P_ ((widget_value *));
--- a/src/intervals.h Thu Nov 04 08:55:40 2004 +0000 +++ b/src/intervals.h Fri Nov 12 02:53:04 2004 +0000 @@ -84,9 +84,14 @@ #define INT_LISPLIKE(i) (BUFFERP ((Lisp_Object){(EMACS_INT)(i)}) \ || STRINGP ((Lisp_Object){(EMACS_INT)(i)})) #endif + +#ifdef ENABLE_CHECKING #define NULL_INTERVAL_P(i) \ (CHECK (!INT_LISPLIKE (i), "non-interval"), (i) == NULL_INTERVAL) /* old #define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL || INT_LISPLIKE (i)) */ +#else +#define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL) +#endif /* True if this interval has no right child. */ #define NULL_RIGHT_CHILD(i) ((i)->right == NULL_INTERVAL) @@ -289,6 +294,7 @@ extern INLINE void copy_intervals_to_string P_ ((Lisp_Object, struct buffer *, int, int)); extern INTERVAL copy_intervals P_ ((INTERVAL, int, int)); +extern int compare_string_intervals P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object textget P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object lookup_char_property P_ ((Lisp_Object, Lisp_Object, int)); extern void move_if_not_intangible P_ ((int));
--- a/src/keyboard.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/keyboard.c Fri Nov 12 02:53:04 2004 +0000 @@ -1840,6 +1840,14 @@ if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks)) { + /* Setting transient-mark-mode to `only' is a way of + turning it on for just one command. */ + + if (EQ (Vtransient_mark_mode, Qidentity)) + Vtransient_mark_mode = Qnil; + if (EQ (Vtransient_mark_mode, Qonly)) + Vtransient_mark_mode = Qidentity; + if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) { /* We could also call `deactivate'mark'. */ @@ -1855,16 +1863,6 @@ call1 (Vrun_hooks, intern ("activate-mark-hook")); } - /* Setting transient-mark-mode to `only' is a way of - turning it on for just one command. */ - if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks)) - { - if (EQ (Vtransient_mark_mode, Qidentity)) - Vtransient_mark_mode = Qnil; - if (EQ (Vtransient_mark_mode, Qonly)) - Vtransient_mark_mode = Qidentity; - } - finalize: if (current_buffer == prev_buffer @@ -3697,40 +3695,30 @@ Discard the event if it would fill the last slot. */ if (kbd_fetch_ptr - 1 != kbd_store_ptr) { - -#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error - prone to assign individual members for other events, in case - the input_event structure is changed. --2000-07-13, gerd. */ - struct input_event *sp = kbd_store_ptr; - sp->kind = event->kind; - if (event->kind == SELECTION_REQUEST_EVENT) - { - /* We must not use the ordinary copying code for this case, - since `part' is an enum and copying it might not copy enough - in this case. */ - bcopy (event, (char *) sp, sizeof (*event)); - } - else - - { - sp->code = event->code; - sp->part = event->part; - sp->frame_or_window = event->frame_or_window; - sp->arg = event->arg; - sp->modifiers = event->modifiers; - sp->x = event->x; - sp->y = event->y; - sp->timestamp = event->timestamp; - } -#else *kbd_store_ptr = *event; -#endif - ++kbd_store_ptr; } } +/* Put an input event back in the head of the event queue. */ + +void +kbd_buffer_unget_event (event) + register struct input_event *event; +{ + if (kbd_fetch_ptr == kbd_buffer) + kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE; + + /* Don't let the very last slot in the buffer become full, */ + if (kbd_fetch_ptr - 1 != kbd_store_ptr) + { + --kbd_fetch_ptr; + *kbd_fetch_ptr = *event; + } +} + + /* Generate HELP_EVENT input_events in BUFP which has room for SIZE events. If there's not enough room in BUFP, ignore this event. @@ -3941,7 +3929,8 @@ /* These two kinds of events get special handling and don't actually appear to the command loop. We return nil for them. */ - if (event->kind == SELECTION_REQUEST_EVENT) + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) { #ifdef HAVE_X11 struct input_event copy; @@ -3952,7 +3941,7 @@ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (0); - x_handle_selection_request (©); + x_handle_selection_event (©); #else /* We're getting selection request events, but we don't have a window system. */ @@ -3960,22 +3949,6 @@ #endif } - else if (event->kind == SELECTION_CLEAR_EVENT) - { -#ifdef HAVE_X11 - struct input_event copy; - - /* Remove it from the buffer before processing it. */ - copy = *event; - kbd_fetch_ptr = event + 1; - input_pending = readable_events (0); - x_handle_selection_clear (©); -#else - /* We're getting selection request events, but we don't have - a window system. */ - abort (); -#endif - } #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS) else if (event->kind == DELETE_WINDOW_EVENT) { @@ -4200,7 +4173,8 @@ /* These two kinds of events get special handling and don't actually appear to the command loop. */ - if (event->kind == SELECTION_REQUEST_EVENT) + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) { #ifdef HAVE_X11 struct input_event copy; @@ -4211,25 +4185,7 @@ copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (0); - x_handle_selection_request (©); -#else - /* We're getting selection request events, but we don't have - a window system. */ - abort (); -#endif - } - - else if (event->kind == SELECTION_CLEAR_EVENT) - { -#ifdef HAVE_X11 - struct input_event copy; - - /* Remove it from the buffer before processing it, */ - copy = *event; - - kbd_fetch_ptr = event + 1; - input_pending = readable_events (0); - x_handle_selection_clear (©); + x_handle_selection_event (©); #else /* We're getting selection request events, but we don't have a window system. */ @@ -6670,7 +6626,6 @@ if (read_socket_hook) { - int discard = 0; int nr; struct input_event hold_quit; @@ -11454,7 +11409,8 @@ { if (event == kbd_buffer + KBD_BUFFER_SIZE) event = kbd_buffer; - if (event->kind != SELECTION_REQUEST_EVENT) + if (event->kind != SELECTION_REQUEST_EVENT + && event->kind != SELECTION_CLEAR_EVENT) { mark_object (event->x); mark_object (event->y);
--- a/src/keyboard.h Thu Nov 04 08:55:40 2004 +0000 +++ b/src/keyboard.h Fri Nov 12 02:53:04 2004 +0000 @@ -330,6 +330,7 @@ extern void kbd_buffer_store_event P_ ((struct input_event *)); extern void kbd_buffer_store_event_hold P_ ((struct input_event *, struct input_event *)); +extern void kbd_buffer_unget_event P_ ((struct input_event *)); #ifdef POLL_FOR_INPUT extern void poll_for_input_1 P_ ((void)); #endif
--- a/src/keymap.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/keymap.c Fri Nov 12 02:53:04 2004 +0000 @@ -214,13 +214,13 @@ (map) Lisp_Object map; { + map = get_keymap (map, 0, 0); while (CONSP (map)) { - register Lisp_Object tem; - tem = Fcar (map); + Lisp_Object tem = XCAR (map); if (STRINGP (tem)) return tem; - map = Fcdr (map); + map = XCDR (map); } return Qnil; }
--- a/src/lisp.h Thu Nov 04 08:55:40 2004 +0000 +++ b/src/lisp.h Fri Nov 12 02:53:04 2004 +0000 @@ -2302,6 +2302,7 @@ EXFUN (Fmember, 2); EXFUN (Frassq, 2); EXFUN (Fdelq, 2); +EXFUN (Fdelete, 2); EXFUN (Fsort, 2); EXFUN (Freverse, 1); EXFUN (Fnreverse, 1); @@ -2386,6 +2387,7 @@ extern void adjust_after_replace_noundo P_ ((int, int, int, int, int, int)); extern void adjust_after_insert P_ ((int, int, int, int, int)); extern void replace_range P_ ((int, int, Lisp_Object, int, int, int)); +extern void replace_range_2 P_ ((int, int, int, int, char *, int, int, int)); extern void syms_of_insdel P_ ((void)); /* Defined in dispnew.c */ @@ -3179,6 +3181,11 @@ /* Defined in getloadavg.c */ extern int getloadavg P_ ((double [], int)); + +#ifdef MSDOS +/* Defined in msdos.c */ +EXFUN (Fmsdos_downcase_filename, 1); +#endif /* Nonzero means Emacs has already been initialized. Used during startup to detect startup of dumped Emacs. */
--- a/src/lread.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/lread.c Fri Nov 12 02:53:04 2004 +0000 @@ -2581,9 +2581,9 @@ if (next_char <= 040 || (next_char < 0200 - && index ("\"';([#?", next_char) - || (!first_in_list && next_char == '`') - || (new_backquote_flag && next_char == ','))) + && (index ("\"';([#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')))) { *pch = c; return Qnil; @@ -3819,7 +3819,7 @@ /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overridden by the - EMACSLOADPATH environment variable below, disable the warning on NT. + EMACSLOADPATH environment variable below, disable the warning on NT. Also, when using the "self-contained" option for Carbon Emacs for MacOSX, the "standard" paths may not exist and would be overridden by EMACSLOADPATH as on NT. Since this depends on how the executable
--- a/src/macros.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/macros.c Fri Nov 12 02:53:04 2004 +0000 @@ -392,7 +392,9 @@ defsubr (&Sstore_kbd_macro_event); DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro, - doc: /* Non-nil while a keyboard macro is being defined. Don't set this! */); + doc: /* Non-nil while a keyboard macro is being defined. Don't set this! +The value is the symbol `append' while appending to the definition of +an existing macro. */); DEFVAR_LISP ("executing-macro", &Vexecuting_macro, doc: /* Currently executing keyboard macro (string or vector); nil if none executing. */);
--- a/src/makefile.w32-in Thu Nov 04 08:55:40 2004 +0000 +++ b/src/makefile.w32-in Fri Nov 12 02:53:04 2004 +0000 @@ -171,6 +171,9 @@ $(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) $(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS) "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20 + echo $(OBJ0) > $(BLD)/buildobj.lst + echo $(OBJ1) >> $(BLD)/buildobj.lst + echo $(WIN32OBJ) >> $(BLD)/buildobj.lst bootstrap: bootstrap-emacs
--- a/src/msdos.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/msdos.c Fri Nov 12 02:53:04 2004 +0000 @@ -2320,7 +2320,7 @@ /* If we are creating a new frame, begin with the original screen colors used for the initial frame. */ - if (alist == Vdefault_frame_alist + if (EQ (alist, Vdefault_frame_alist) && initial_screen_colors[0] != -1 && initial_screen_colors[1] != -1) { FRAME_FOREGROUND_PIXEL (f) = initial_screen_colors[0];
--- a/src/print.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/print.c Fri Nov 12 02:53:04 2004 +0000 @@ -2183,6 +2183,15 @@ PRINTCHAR ('>'); break; + case Lisp_Misc_Save_Value: + strout ("#<save_value ", -1, -1, printcharfun, 0); + sprintf(buf, "ptr=0x%08lx int=%d", + (unsigned long) XSAVE_VALUE (obj)->pointer, + XSAVE_VALUE (obj)->integer); + strout (buf, -1, -1, printcharfun, 0); + PRINTCHAR ('>'); + break; + default: goto badtype; }
--- a/src/process.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/process.c Fri Nov 12 02:53:04 2004 +0000 @@ -2723,7 +2723,6 @@ int xerrno = 0; int s = -1, outch, inch; struct gcpro gcpro1; - int retry = 0; int count = SPECPDL_INDEX (); int count1; Lisp_Object QCaddress; /* one of QClocal or QCremote */ @@ -3024,6 +3023,8 @@ { int optn, optbits; + retry_connect: + s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol); if (s < 0) { @@ -3102,8 +3103,6 @@ break; } - retry_connect: - immediate_quit = 1; QUIT; @@ -3145,22 +3144,13 @@ immediate_quit = 0; - if (xerrno == EINTR) - goto retry_connect; - if (xerrno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - and should be infrequent. */ - Fsleep_for (make_number (1), Qnil); - retry++; - goto retry_connect; - } - /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count1; emacs_close (s); s = -1; + + if (xerrno == EINTR) + goto retry_connect; } if (s >= 0)
--- a/src/window.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/window.c Fri Nov 12 02:53:04 2004 +0000 @@ -204,7 +204,7 @@ Lisp_Object Qwindow_configuration_change_hook; Lisp_Object Vwindow_configuration_change_hook; -/* Nonzero means scroll commands try to put point +/* Non-nil means scroll commands try to put point at the same screen height as previously. */ Lisp_Object Vscroll_preserve_screen_position; @@ -4523,7 +4523,7 @@ start = it.current.pos; } - /* If scroll_preserve_screen_position is non-zero, we try to set + /* If scroll_preserve_screen_position is non-nil, we try to set point in the same window line as it is now, so get that line. */ if (!NILP (Vscroll_preserve_screen_position)) {
--- a/src/xdisp.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xdisp.c Fri Nov 12 02:53:04 2004 +0000 @@ -16142,27 +16142,31 @@ { tenths = remainder / 100; if (50 <= remainder % 100) - if (tenths < 9) - tenths++; - else - { - quotient++; - if (quotient == 10) - tenths = -1; - else - tenths = 0; - } + { + if (tenths < 9) + tenths++; + else + { + quotient++; + if (quotient == 10) + tenths = -1; + else + tenths = 0; + } + } } else if (500 <= remainder) - if (quotient < 999) - quotient++; - else - { - quotient = 1; - exponent++; - tenths = 0; - } + { + if (quotient < 999) + quotient++; + else + { + quotient = 1; + exponent++; + tenths = 0; + } + } } /* Calculate the LENGTH of QUOTIENT.TENTHS as a string. */ @@ -18455,7 +18459,7 @@ { struct image *img; struct face *face; - int face_ascent, glyph_ascent; + int glyph_ascent; struct glyph_slice slice; xassert (it->what == IT_IMAGE); @@ -18538,7 +18542,7 @@ #if 0 /* this breaks image tiling */ /* If this glyph is alone on the last line, adjust it.ascent to minimum row ascent. */ - face_ascent = face->font ? FONT_BASE (face->font) : FRAME_BASELINE_OFFSET (it->f); + int face_ascent = face->font ? FONT_BASE (face->font) : FRAME_BASELINE_OFFSET (it->f); if (face_ascent > it->ascent) it->ascent = it->phys_ascent = face_ascent; #endif @@ -20558,19 +20562,20 @@ int past_end = 0; first = MATRIX_FIRST_TEXT_ROW (w->current_matrix); + if (charpos < MATRIX_ROW_START_CHARPOS (first)) + { + *x = first->x; + *y = first->y; + *hpos = 0; + *vpos = MATRIX_ROW_VPOS (first, w->current_matrix); + return 1; + } + row = row_containing_pos (w, charpos, first, NULL, 0); if (row == NULL) { - if (charpos < MATRIX_ROW_START_CHARPOS (first)) - { - *x = *y = *hpos = *vpos = 0; - return 1; - } - else - { - row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); - past_end = 1; - } + row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); + past_end = 1; } *x = row->x; @@ -21116,8 +21121,10 @@ /* Which window is that in? */ window = window_from_coordinates (f, x, y, &part, 0, 0, 1); - /* If we were displaying active text in another window, clear that. */ - if (! EQ (window, dpyinfo->mouse_face_window)) + /* If we were displaying active text in another window, clear that. + Also clear if we move out of text area in same window. */ + if (! EQ (window, dpyinfo->mouse_face_window) + || (part != ON_TEXT && !NILP (dpyinfo->mouse_face_window))) clear_mouse_face (dpyinfo); /* Not on a window -> return. */
--- a/src/xfaces.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xfaces.c Fri Nov 12 02:53:04 2004 +0000 @@ -3511,8 +3511,8 @@ call into lisp. */ Lisp_Object -merge_face_heights (from, to, invalid, gcpro) - Lisp_Object from, to, invalid, gcpro; +merge_face_heights (from, to, invalid) + Lisp_Object from, to, invalid; { Lisp_Object result = invalid; @@ -3537,16 +3537,11 @@ /* Call function with current height as argument. From is the new height. */ Lisp_Object args[2]; - struct gcpro gcpro1; - - GCPRO1 (gcpro); args[0] = from; args[1] = to; result = safe_call (2, args); - UNGCPRO; - /* Ensure that if TO was absolute, so is the result. */ if (INTEGERP (to) && !INTEGERP (result)) result = invalid; @@ -3599,8 +3594,7 @@ if (!UNSPECIFIEDP (from[i])) { if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i])) - to[i] = merge_face_heights (from[i], to[i], to[i], - named_merge_points); + to[i] = merge_face_heights (from[i], to[i], to[i]); else to[i] = from[i]; } @@ -3627,11 +3621,16 @@ if (push_named_merge_point (&named_merge_point, face_name, &named_merge_points)) { + struct gcpro gcpro1; Lisp_Object from[LFACE_VECTOR_SIZE]; int ok = get_lface_attributes (f, face_name, from, 0); if (ok) - merge_face_vectors (f, from, to, named_merge_points); + { + GCPRO1 (named_merge_point.face_name); + merge_face_vectors (f, from, to, named_merge_points); + UNGCPRO; + } return ok; } @@ -3722,8 +3721,7 @@ else if (EQ (keyword, QCheight)) { Lisp_Object new_height = - merge_face_heights (value, to[LFACE_HEIGHT_INDEX], - Qnil, Qnil); + merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil); if (! NILP (new_height)) to[LFACE_HEIGHT_INDEX] = new_height; @@ -4110,7 +4108,7 @@ /* The default face must have an absolute size, otherwise, we do a test merge with a random height to see if VALUE's ok. */ - : merge_face_heights (value, make_number (10), Qnil, Qnil)); + : merge_face_heights (value, make_number (10), Qnil)); if (!INTEGERP (test) || XINT (test) <= 0) signal_error ("Invalid face height", value); @@ -4824,7 +4822,7 @@ if (EQ (value1, Qunspecified)) return value2; else if (EQ (attribute, QCheight)) - return merge_face_heights (value1, value2, value1, Qnil); + return merge_face_heights (value1, value2, value1); else return value1; }
--- a/src/xfns.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xfns.c Fri Nov 12 02:53:04 2004 +0000 @@ -5541,6 +5541,14 @@ Fprovide (intern ("x-toolkit"), Qnil); Fprovide (intern ("gtk"), Qnil); +#ifdef HAVE_GTK_FILE_BOTH + DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, + doc: /* *Non-nil means that the old GTK file selection dialog is used. +If nil the new GTK file chooser is used instead. To turn off +all file dialogs set the variable `use-file-dialog'. */); + use_old_gtk_file_dialog = 0; +#endif + DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string, doc: /* Version info for GTK+. */); {
--- a/src/xmenu.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xmenu.c Fri Nov 12 02:53:04 2004 +0000 @@ -115,7 +115,7 @@ static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); static void popup_get_selection P_ ((XEvent *, struct x_display_info *, - LWLIB_ID, int)); + LWLIB_ID, int, int)); /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ @@ -157,6 +157,8 @@ static void list_of_panes P_ ((Lisp_Object)); static void list_of_items P_ ((Lisp_Object)); +extern EMACS_TIME timer_check P_ ((int)); + /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. @@ -1120,7 +1122,6 @@ popped down (deactivated). This is used for x-popup-menu and x-popup-dialog; it is not used for the menu bar. - If DO_TIMERS is nonzero, run timers. If DOWN_ON_KEYPRESS is nonzero, pop down if a key is pressed. NOTE: All calls to popup_get_selection should be protected @@ -1128,17 +1129,22 @@ #ifdef USE_X_TOOLKIT static void -popup_get_selection (initial_event, dpyinfo, id, down_on_keypress) +popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) XEvent *initial_event; struct x_display_info *dpyinfo; LWLIB_ID id; + int do_timers; int down_on_keypress; { XEvent event; while (popup_activated_flag) { - if (initial_event) + /* If we have no events to run, consider timers. */ + if (do_timers && !XtAppPending (Xt_app_con)) + timer_check (1); + + if (initial_event) { event = *initial_event; initial_event = 0; @@ -2484,7 +2490,7 @@ popup_activated_flag = 1; /* Process events that apply to the menu. */ - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); /* fp turned off the following statement and wrote a comment that it is unnecessary--that the menu has already disappeared. @@ -2878,7 +2884,8 @@ Fcons (make_number (dialog_id >> (fact)), make_number (dialog_id & ~(-1 << (fact))))); - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), + dialog_id, 1, 1); unbind_to (count, Qnil); }
--- a/src/xselect.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xselect.c Fri Nov 12 02:53:04 2004 +0000 @@ -24,6 +24,14 @@ #include <config.h> #include <stdio.h> /* termhooks.h needs this */ + +#ifdef HAVE_SYS_TYPES_H +#include <sys/types.h> +#endif +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + #include "lisp.h" #include "xterm.h" /* for all of the X includes */ #include "dispextern.h" /* frame.h seems to want this */ @@ -32,6 +40,7 @@ #include "buffer.h" #include "process.h" #include "termhooks.h" +#include "keyboard.h" #include <X11/Xproto.h> @@ -85,10 +94,13 @@ fprintf (stderr, "%d: " fmt "\n", getpid (), a0) #define TRACE2(fmt, a0, a1) \ fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1) +#define TRACE3(fmt, a0, a1, a2) \ + fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2) #else #define TRACE0(fmt) (void) 0 #define TRACE1(fmt, a0) (void) 0 #define TRACE2(fmt, a0, a1) (void) 0 +#define TRACE3(fmt, a0, a1) (void) 0 #endif @@ -168,6 +180,89 @@ static Lisp_Object selection_data_to_lisp_data (); static Lisp_Object x_get_window_property_as_lisp_data (); + + +/* Define a queue to save up SELECTION_REQUEST_EVENT events for later + handling. */ + +struct selection_event_queue + { + struct input_event event; + struct selection_event_queue *next; + }; + +static struct selection_event_queue *selection_queue; + +/* Nonzero means queue up SELECTION_REQUEST_EVENT events. */ + +static int x_queue_selection_requests; + +/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */ + +static void +x_queue_event (event) + struct input_event *event; +{ + struct selection_event_queue *queue_tmp; + + /* Don't queue repeated requests. + This only happens for large requests which uses the incremental protocol. */ + for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next) + { + if (!bcmp (&queue_tmp->event, event, sizeof (*event))) + { + TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp); + x_decline_selection_request (event); + return; + } + } + + queue_tmp + = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue)); + + if (queue_tmp != NULL) + { + TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp); + queue_tmp->event = *event; + queue_tmp->next = selection_queue; + selection_queue = queue_tmp; + } +} + +/* Start queuing SELECTION_REQUEST_EVENT events. */ + +static void +x_start_queuing_selection_requests () +{ + if (x_queue_selection_requests) + abort (); + + x_queue_selection_requests++; + TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests); +} + +/* Stop queuing SELECTION_REQUEST_EVENT events. */ + +static void +x_stop_queuing_selection_requests () +{ + TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests); + --x_queue_selection_requests; + + /* Take all the queued events and put them back + so that they get processed afresh. */ + + while (selection_queue != NULL) + { + struct selection_event_queue *queue_tmp = selection_queue; + TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp); + kbd_buffer_unget_event (&queue_tmp->event); + selection_queue = queue_tmp->next; + xfree ((char *)queue_tmp); + } +} + + /* This converts a Lisp symbol to a server Atom, avoiding a server roundtrip whenever possible. */ @@ -557,13 +652,10 @@ static struct prop_location *property_change_wait_list; static Lisp_Object -queue_selection_requests_unwind (frame) - Lisp_Object frame; +queue_selection_requests_unwind (tem) + Lisp_Object tem; { - FRAME_PTR f = XFRAME (frame); - - if (! NILP (frame)) - x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f)); + x_stop_queuing_selection_requests (); return Qnil; } @@ -623,6 +715,17 @@ BLOCK_INPUT; count = x_catch_errors (display); +#ifdef TRACE_SELECTION + { + static int cnt; + char *sel = XGetAtomName (display, reply.selection); + char *tgt = XGetAtomName (display, reply.target); + TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt); + if (sel) XFree (sel); + if (tgt) XFree (tgt); + } +#endif /* TRACE_SELECTION */ + /* Store the data on the requested property. If the selection is large, only store the first N bytes of it. */ @@ -650,10 +753,10 @@ bother trying to queue them. */ if (!NILP (frame)) { - x_start_queuing_selection_requests (display); + x_start_queuing_selection_requests (); record_unwind_protect (queue_selection_requests_unwind, - frame); + Qnil); } if (x_window_to_frame (dpyinfo, window)) /* #### debug */ @@ -687,6 +790,8 @@ XGetAtomName (display, reply.property)); wait_for_property_change (wait_object); } + else + unexpect_property_change (wait_object); TRACE0 ("Got ACK"); while (bytes_remaining) @@ -760,7 +865,7 @@ /* Handle a SelectionRequest event EVENT. This is called from keyboard.c when such an event is found in the queue. */ -void +static void x_handle_selection_request (event) struct input_event *event; { @@ -775,6 +880,10 @@ struct x_display_info *dpyinfo = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event)); + TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu", + (unsigned long) SELECTION_EVENT_REQUESTOR (event), + (unsigned long) SELECTION_EVENT_TIME (event)); + local_selection_data = Qnil; target_symbol = Qnil; converted_selection = Qnil; @@ -869,7 +978,7 @@ client cleared out our previously asserted selection. This is called from keyboard.c when such an event is found in the queue. */ -void +static void x_handle_selection_clear (event) struct input_event *event; { @@ -882,6 +991,8 @@ struct x_display_info *dpyinfo = x_display_info_for_display (display); struct x_display_info *t_dpyinfo; + TRACE0 ("x_handle_selection_clear"); + /* If the new selection owner is also Emacs, don't clear the new selection. */ BLOCK_INPUT; @@ -950,6 +1061,24 @@ } } +void +x_handle_selection_event (event) + struct input_event *event; +{ + TRACE0 ("x_handle_selection_event"); + + if (event->kind == SELECTION_REQUEST_EVENT) + { + if (x_queue_selection_requests) + x_queue_event (event); + else + x_handle_selection_request (event); + } + else + x_handle_selection_clear (event); +} + + /* Clear all selections that were made from frame F. We do this when about to delete a frame. */ @@ -1080,12 +1209,14 @@ /* Remove the property change expectation element for IDENTIFIER. */ static Lisp_Object -wait_for_property_change_unwind (identifierval) - Lisp_Object identifierval; +wait_for_property_change_unwind (loc) + Lisp_Object loc; { - unexpect_property_change ((struct prop_location *) - (XFASTINT (XCAR (identifierval)) << 16 - | XFASTINT (XCDR (identifierval)))); + struct prop_location *location = XSAVE_VALUE (loc)->pointer; + + unexpect_property_change (location); + if (location == property_change_reply_object) + property_change_reply_object = 0; return Qnil; } @@ -1098,18 +1229,17 @@ { int secs, usecs; int count = SPECPDL_INDEX (); - Lisp_Object tem; - - tem = Fcons (Qnil, Qnil); - XSETCARFASTINT (tem, (EMACS_UINT)location >> 16); - XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff); + + if (property_change_reply_object) + abort (); /* Make sure to do unexpect_property_change if we quit or err. */ - record_unwind_protect (wait_for_property_change_unwind, tem); + record_unwind_protect (wait_for_property_change_unwind, + make_save_value (location, 0)); XSETCAR (property_change_reply, Qnil); - property_change_reply_object = location; + /* If the event we are waiting for arrives beyond here, it will set property_change_reply, because property_change_reply_object says so. */ if (! location->arrived) @@ -1140,7 +1270,8 @@ while (rest) { - if (rest->property == event->atom + if (!rest->arrived + && rest->property == event->atom && rest->window == event->window && rest->display == event->display && rest->desired_state == event->state) @@ -1156,11 +1287,6 @@ if (rest == property_change_reply_object) XSETCAR (property_change_reply, Qt); - if (prev) - prev->next = rest->next; - else - property_change_wait_list = rest->next; - xfree (rest); return; } @@ -1286,10 +1412,10 @@ bother trying to queue them. */ if (!NILP (frame)) { - x_start_queuing_selection_requests (display); + x_start_queuing_selection_requests (); record_unwind_protect (queue_selection_requests_unwind, - frame); + Qnil); } UNBLOCK_INPUT; @@ -1445,10 +1571,10 @@ BLOCK_INPUT; XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); TRACE1 (" Delete property %s", - XSYMBOL (x_atom_to_symbol (display, property))->name->data); + SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property)))); XDeleteProperty (display, window, property); TRACE1 (" Expect new value of property %s", - XSYMBOL (x_atom_to_symbol (display, property))->name->data); + SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property)))); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); @@ -1478,7 +1604,6 @@ if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, STANDARD_EVENT_SET); - unexpect_property_change (wait_object); /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ if (tmp_data) xfree (tmp_data);
--- a/src/xterm.c Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xterm.c Fri Nov 12 02:53:04 2004 +0000 @@ -5581,73 +5581,6 @@ } -/* Define a queue to save up SelectionRequest events for later handling. */ - -struct selection_event_queue - { - XEvent event; - struct selection_event_queue *next; - }; - -static struct selection_event_queue *queue; - -/* Nonzero means queue up certain events--don't process them yet. */ - -static int x_queue_selection_requests; - -/* Queue up an X event *EVENT, to be processed later. */ - -static void -x_queue_event (f, event) - FRAME_PTR f; - XEvent *event; -{ - struct selection_event_queue *queue_tmp - = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue)); - - if (queue_tmp != NULL) - { - queue_tmp->event = *event; - queue_tmp->next = queue; - queue = queue_tmp; - } -} - -/* Take all the queued events and put them back - so that they get processed afresh. */ - -static void -x_unqueue_events (display) - Display *display; -{ - while (queue != NULL) - { - struct selection_event_queue *queue_tmp = queue; - XPutBackEvent (display, &queue_tmp->event); - queue = queue_tmp->next; - xfree ((char *)queue_tmp); - } -} - -/* Start queuing SelectionRequest events. */ - -void -x_start_queuing_selection_requests (display) - Display *display; -{ - x_queue_selection_requests++; -} - -/* Stop queuing SelectionRequest events. */ - -void -x_stop_queuing_selection_requests (display) - Display *display; -{ - x_queue_selection_requests--; - x_unqueue_events (display); -} - /* The main X event-reading loop - XTread_socket. */ #if 0 @@ -6025,11 +5958,7 @@ if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner)) goto OTHER; #endif /* USE_X_TOOLKIT */ - if (x_queue_selection_requests) - x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner), - &event); - else - { + { XSelectionRequestEvent *eventp = (XSelectionRequestEvent *) &event; @@ -6041,7 +5970,7 @@ SELECTION_EVENT_PROPERTY (&inev) = eventp->property; SELECTION_EVENT_TIME (&inev) = eventp->time; inev.frame_or_window = Qnil; - } + } break; case PropertyNotify: @@ -7626,7 +7555,11 @@ /* The display may have been closed before this function is called. Check if it is still open before calling XSync. */ if (x_display_info_for_display (dpy) != 0) - XSync (dpy, False); + { + BLOCK_INPUT; + XSync (dpy, False); + UNBLOCK_INPUT; + } x_error_message_string = XCDR (old_val); return Qnil;
--- a/src/xterm.h Thu Nov 04 08:55:40 2004 +0000 +++ b/src/xterm.h Fri Nov 12 02:53:04 2004 +0000 @@ -52,7 +52,7 @@ #undef XSync #define XSync(d, b) do { gdk_window_process_all_updates (); \ XSync (d, b); } while (0) - + #endif /* USE_GTK */ @@ -976,8 +976,6 @@ extern void cancel_mouse_face P_ ((struct frame *)); extern void x_scroll_bar_clear P_ ((struct frame *)); -extern void x_start_queuing_selection_requests P_ ((Display *)); -extern void x_stop_queuing_selection_requests P_ ((Display *)); extern int x_text_icon P_ ((struct frame *, char *)); extern int x_bitmap_icon P_ ((struct frame *, Lisp_Object)); extern int x_catch_errors P_ ((Display *)); @@ -1013,8 +1011,7 @@ extern void x_handle_property_notify P_ ((XPropertyEvent *)); extern void x_handle_selection_notify P_ ((XSelectionEvent *)); -extern void x_handle_selection_request P_ ((struct input_event *)); -extern void x_handle_selection_clear P_ ((struct input_event *)); +extern void x_handle_selection_event P_ ((struct input_event *)); extern void x_clear_frame_selections P_ ((struct frame *)); extern int x_handle_dnd_message P_ ((struct frame *,