diff options
106 files changed, 3857 insertions, 1907 deletions
diff --git a/ChangeLog b/ChangeLog index 8fbd47889c3..696d2b16f9e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2004-11-12 Eli Zaretskii <eliz@gnu.org> + + * config.bat: Don't require djecho.exe for the v1.x build. + Add a test for DECL_ALIGN support, and add a trivial definition to + src/config.h if 8-byte alignment is not supported. + +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. diff --git a/Makefile.in b/Makefile.in index 34b9965b60e..ce476a95cf0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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 @@ dvi: ### 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 @@ maybe_bootstrap: 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 @@ bootstrap: bootstrap-clean-before info FRC (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) diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index e5e719f9037..8e660744370 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -10,6 +10,12 @@ Tasks needed before the next release. ** 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 @@ invalid pointer from string_free_list. ** 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 @@ interrupting I can get a backtrace, here's an example: 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> @@ -180,52 +141,6 @@ Date: Mon, 11 Oct 2004 11:14:49 +0200 now I can drag the modeline only upwards but not downwards -** line-spacing and (recenter -1) - -From: SAITO Takuya <tabmore@rivo.mediatti.net> -Date: Mon, 31 May 2004 02:07:57 +0900 (JST) - -(recenter -1) does not show point at the bottom of the window -if line-spacing is set to positive integer. - -Start emacs -Q, and evaluate below: - -(progn - (setq line-spacing 1) - (dotimes (i (window-height)) - (insert "\n" (int-to-string i))) - (recenter -1)) - -Then, point is displayed at the center of the window. -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 +159,8 @@ Electric-pop-up-window can use it. * DOCUMENTATION +** Document Custom Themes. + ** Finish updating the Emacs Lisp manual. ** Update the Emacs manual. @@ -318,11 +235,11 @@ names of the people who have checked it. 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" diff --git a/config.bat b/config.bat index c3e36975dec..64775244391 100644 --- a/config.bat +++ b/config.bat @@ -121,7 +121,9 @@ Goto End set djgpp_ver=1
If ErrorLevel 20 set djgpp_ver=2
rm -f junk.c junk junk.exe
-rem DJECHO is used by the top-level Makefile
+rem The v1.x build does not need djecho
+if "%DJGPP_VER%" == "1" Goto djechoOk
+rem DJECHO is used by the top-level Makefile in the v2.x build
Echo Checking whether 'djecho' is available...
redir -o Nul -eo djecho -o junk.$$$ foo
If Exist junk.$$$ Goto djechoOk
@@ -156,6 +158,22 @@ goto src42 :src41
sed -f ../msdos/sed2v2.inp <config.tmp >config.h2
:src42
+Rem See if DECL_ALIGN can be supported with this GCC
+rm -f junk.c junk.o junk junk.exe
+echo struct { int i; char *p; } __attribute__((__aligned__(8))) foo; >junk.c
+rem Two percent signs because it is a special character for COMMAND.COM
+echo int main(void) { return (unsigned long)&foo %% 8; } >>junk.c
+gcc -o junk junk.c
+if not exist junk.exe coff2exe junk
+junk
+If Not ErrorLevel 1 Goto alignOk
+Echo WARNING: Your GCC does not support 8-byte aligned variables.
+Echo WARNING: Therefore Emacs cannot support buffers larger than 128MB.
+rem The following line disables DECL_ALIGN which in turn disables USE_LSB_TAG
+rem For details see lisp.h where it defines USE_LSB_TAG
+echo #define DECL_ALIGN(type, var) type var >>config.h2
+:alignOk
+rm -f junk.c junk junk.exe
update config.h2 config.h >nul
rm -f config.tmp config.h2
@@ -98,14 +98,16 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types. * 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 @@ -2089,6 +2091,13 @@ anyone has committed to the repository since you last executed * 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. @@ -2327,6 +2336,14 @@ configuration files. * 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. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index c04bdf2f094..8d6e7f2b734 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -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, diff --git a/lib-src/etags.c b/lib-src/etags.c index a6004a048a9..e435c4d3926 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1400,6 +1400,8 @@ main (argc, argv) this_file = argbuffer[i].what; process_file (stdin, this_file, lang); break; + case at_end: + break; } } @@ -2900,6 +2902,8 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) case tkeyseen: switch (toktype) { + default: + break; case st_none: case st_C_class: case st_C_struct: @@ -2917,12 +2921,16 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) 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 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) fvdef = fvnone; } return FALSE; + default: + break; } if (structdef == skeyseen) @@ -2983,6 +2993,8 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) case st_C_objimpl: objdef = oimplementation; return FALSE; + default: + break; } break; case oimplementation: @@ -3039,6 +3051,8 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) objdef = onone; } return FALSE; + default: + break; } /* A function, variable or enum constant? */ @@ -3091,6 +3105,8 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) return FALSE; } break; + default: + break; } /* FALLTHRU */ case fvnameseen: @@ -3107,8 +3123,12 @@ consider_token (str, len, c, c_extp, bracelev, parlev, is_func_or_var) fvdef = fvnameseen; /* function or variable */ *is_func_or_var = TRUE; return TRUE; + default: + break; } break; + default: + break; } return FALSE; @@ -3584,6 +3604,8 @@ C_entries (c_ext, inf) fvdef = fignore; } break; + default: + break; } if (structdef == stagseen && !cjava) { @@ -3594,6 +3616,8 @@ C_entries (c_ext, inf) case dsharpseen: savetoken = token; break; + default: + break; } if (!yacc_rules || lp == newlb.buffer + 1) { @@ -3632,6 +3656,8 @@ C_entries (c_ext, inf) linebuffer_setlen (&token_name, token_name.len + 1); strcat (token_name.buffer, ":"); break; + default: + break; } if (structdef == stagseen) { @@ -3709,6 +3735,8 @@ C_entries (c_ext, inf) make_C_tag (TRUE); /* an Objective C method */ objdef = oinbody; break; + default: + break; } switch (fvdef) { @@ -3779,6 +3807,8 @@ C_entries (c_ext, inf) fvdef = fvnone; } break; + default: + break; } break; case '(': @@ -3812,6 +3842,8 @@ C_entries (c_ext, inf) case flistseen: fvdef = finlist; break; + default: + break; } parlev++; break; @@ -3837,6 +3869,8 @@ C_entries (c_ext, inf) case finlist: fvdef = flistseen; break; + default: + break; } if (!instruct && (typdef == tend @@ -3886,6 +3920,8 @@ C_entries (c_ext, inf) bracelev = -1; } break; + default: + break; } switch (structdef) { @@ -3899,6 +3935,8 @@ C_entries (c_ext, inf) structdef = snone; make_C_tag (FALSE); /* a struct or enum */ break; + default: + break; } bracelev++; break; diff --git a/lib-src/hexl.c b/lib-src/hexl.c index 5ca7c2a5b8a..7a2f127ae61 100644 --- a/lib-src/hexl.c +++ b/lib-src/hexl.c @@ -173,7 +173,7 @@ main (argc, argv) #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 @@ main (argc, argv) string[17] = '\0'; for (;;) { - register int i, c; + register int i, c = 0; for (i=0; i < 16; ++i) { diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 802b4e09e67..e502061b759 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -617,6 +617,7 @@ scan_c_file (filename, mode) c = getc (infile); defunflag = c == 'U'; defvarflag = 0; + defvarperbufferflag = 0; } else continue; diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 663d08e6f13..0f806912be5 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -124,9 +124,30 @@ $(BLD)/ctags.$(O): ctags.c # $(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 # diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6fc7796f339..b443f53ebba 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,410 @@ +2004-11-12 Jay Belanger <belanger@truman.edu> + + * calc/calc-graph.el (calc-dumb-map): Declared it. + (calc-graph-show-dumb): Check if calc-dumb-map is non-nil rather + than unbound. + + (calc-graph-name): Made `end' a local variable. + (calc-graph-lookup): Made `varname' a local variable. + + (var-DUMMY, var-DUMMY2, var-PlotRejects, calc-gnuplot-trail-mark): + Declared them. + + (calc-graph-format-data): Don't check if var-PlotRejects is + bound. + + (calc-graph-plot, calc-graph-compute-3d): Removed references to + the unused variable y3vec. + + (calc-graph-show-dumb): Removed reference to unused variable + found-pt. + + (calc-graph-kill-hook, calc-graph-plot): Removed reference to + calc-graph-prev-kill-hook. + + (calc-graph-yvalue, calc-graph-yvec, calc-graph-numsteps) + (calc-graph-numsteps3, calc-graph-xvalue, calc-graph-xvec) + (calc-graph-xname, calc-graph-yname, calc-graph-xstep) + (calc-graph-ycache, calc-graph-ycacheptr, calc-graph-refine) + (calc-graph-keep-file, calc-graph-xval, calc-graph-xlow) + (calc-graph-xhigh, calc-graph-yval, calc-graph-yp, calc-graph-xp) + (calc-graph-zp, calc-graph-yvector, calc-graph-resolution) + (calc-graph-y3value, calc-graph-y3name) + (calc-graph-y3step, calc-graph-y3step, calc-graph-zval) + (calc-graph-stepcount, calc-graph-is-splot) + (calc-graph-surprise-splot, calc-graph-blank) + (calc-graph-non-blank, calc-graph-curve-num): New variables. + (calc-graph-plot, calc-graph-compute-2d, calc-graph-refine-2d) + (calc-graph-recompute-2d, calc-graph-compute-3d) + (calc-graph-format-data): Replaced undeclared variables with the + above newly declared variables. + +2004-11-12 Diane Murray <dsm@muenster.de> (tiny change) + + * mail/rmail.el (rmail-get-new-mail): Use the renamed variables + `rsf-beep' and `rsf-sleep-after-message'. + + * mail/rmail-spam-filter.el (rmail-spam-filter): Only check white + list if `message-sender' is non-nil. + +2004-11-12 Kevin Rodgers <ihs_4664@yahoo.com> (tiny change) + + * desktop.el (desktop-create-buffer, desktop-save): Avoid some + consing by using mapc instead of mapcar. + +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> + + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Understand the + new byte-compile-function-environment binding to t. + + * font-lock.el (font-lock-fontify-syntactically-region): + Don't forget to highlight the last char when we hit `end'. + + * mwheel.el (mouse-wheel-progressive-speed): Fix typo in name. + (mwheel-scroll): Adjust accordingly. + + * cvs-status.el: Reduce spurious warnings. + (cvs-status-checkout): Remove. + (cvs-status-mode-map): Use cvs-mode-checkout instead. + + * pcvs.el (cvs-mode-checkout): New command. + + * 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. + * 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> @@ -59,8 +461,7 @@ 2004-11-04 Daniel Pfeiffer <occitan@esperanto.org> - * files.el (set-auto-mode): Don't get error after setting - -*-mode-*-. + * files.el (set-auto-mode): Don't get error after setting -*-mode-*-. 2004-11-04 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> @@ -182,8 +583,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. @@ -223,16 +623,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> diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 486f0f38964..a702e56fdf3 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -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. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 85dfaeaf35f..f89cb7b0d47 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -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> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 5085d3b5b91..e87ffa6f265 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -311,9 +311,12 @@ bootstrap-prepare: 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 diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 2db722ccb2d..182b3b0635c 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -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"))))) diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index c7ecbecc80b..8b0dffe3f15 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -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) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 4679cf8abaa..77057fd4a7a 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) (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 @@ calc-kill calc-kill-region calc-yank)))) ;;; 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 @@ calc-kill calc-kill-region calc-yank)))) (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) diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 31f9e776a0c..e64983ad33d 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1791,8 +1791,8 @@ and ends on the last Sunday of October at 2 a.m." (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 @@ and ends on the last Sunday of October at 2 a.m." (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)) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index cec7a5d2136..ff537109816 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -66,6 +66,7 @@ (defvar calc-graph-data-cache-limit 10) (defvar calc-graph-no-auto-view nil) (defvar calc-graph-no-wait nil) +(defvar calc-gnuplot-trail-mark) (defun calc-graph-fast (many) (interactive "P") @@ -224,11 +225,10 @@ thing (let ((found (assoc thing calc-graph-var-cache))) (or found - (progn - (setq varname (concat "PlotData" - (int-to-string - (1+ (length calc-graph-var-cache)))) - var (list 'var (intern varname) + (let ((varname (concat "PlotData" + (int-to-string + (1+ (length calc-graph-var-cache)))))) + (setq var (list 'var (intern varname) (intern (concat "var-" varname))) found (cons thing var) calc-graph-var-cache (cons found calc-graph-var-cache)) @@ -275,6 +275,47 @@ (interactive "P") (calc-graph-plot flag t)) +(defvar var-DUMMY) +(defvar var-DUMMY2) +(defvar var-PlotRejects) + +;; The following variables are local to calc-graph-plot, but are +;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d, +;; calc-graph-recompute-2d, calc-graph-compute-3d and +;; calc-graph-format-data, which are called by calc-graph-plot. +(defvar calc-graph-yvalue) +(defvar calc-graph-yvec) +(defvar calc-graph-numsteps) +(defvar calc-graph-numsteps3) +(defvar calc-graph-xvalue) +(defvar calc-graph-xvec) +(defvar calc-graph-xname) +(defvar calc-graph-yname) +(defvar calc-graph-xstep) +(defvar calc-graph-ycache) +(defvar calc-graph-ycacheptr) +(defvar calc-graph-refine) +(defvar calc-graph-keep-file) +(defvar calc-graph-xval) +(defvar calc-graph-xlow) +(defvar calc-graph-xhigh) +(defvar calc-graph-yval) +(defvar calc-graph-yp) +(defvar calc-graph-xp) +(defvar calc-graph-zp) +(defvar calc-graph-yvector) +(defvar calc-graph-resolution) +(defvar calc-graph-y3value) +(defvar calc-graph-y3name) +(defvar calc-graph-y3step) +(defvar calc-graph-zval) +(defvar calc-graph-stepcount) +(defvar calc-graph-is-splot) +(defvar calc-graph-surprise-splot) +(defvar calc-graph-blank) +(defvar calc-graph-non-blank) +(defvar calc-graph-curve-num) + (defun calc-graph-plot (flag &optional printing) (interactive "P") (calc-slow-wrapper @@ -282,22 +323,20 @@ (tempbuf (get-buffer-create "*Gnuplot Temp-2*")) (tempbuftop 1) (tempoutfile nil) - (curve-num 0) - (refine (and flag (> (prefix-numeric-value flag) 0))) + (calc-graph-curve-num 0) + (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0))) (recompute (and flag (< (prefix-numeric-value flag) 0))) - (surprise-splot nil) + (calc-graph-surprise-splot nil) (tty-output nil) - cache-env is-splot device output resolution precision samples-pos) - (or (boundp 'calc-graph-prev-kill-hook) - (setq calc-graph-prev-kill-hook nil) - (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)) + cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos) + (add-hook 'kill-emacs-hook 'calc-graph-kill-hook) (save-excursion (calc-graph-init) (set-buffer tempbuf) (erase-buffer) (set-buffer calc-gnuplot-input) (goto-char (point-min)) - (setq is-splot (re-search-forward "^splot[ \t]" nil t)) + (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t)) (let ((str (buffer-string)) (ver calc-gnuplot-version)) (set-buffer (get-buffer-create "*Gnuplot Temp*")) @@ -313,14 +352,14 @@ "set nogrid\nset nokey\nset nopolar\n")) (if (>= ver 3) (insert "set surface\nset nocontour\n" - "set " (if is-splot "" "no") "parametric\n" + "set " (if calc-graph-is-splot "" "no") "parametric\n" "set notime\nset border\nset ztics\nset zeroaxis\n" "set view 60,30,1,1\nset offsets 0,0,0,0\n")) (setq samples-pos (point)) (insert "\n\n" str)) (goto-char (point-min)) - (if is-splot - (if refine + (if calc-graph-is-splot + (if calc-graph-refine (error "This option works only for 2d plots") (setq recompute t))) (let ((calc-gnuplot-input (current-buffer)) @@ -366,10 +405,10 @@ (if (equal output "STDOUT") "" (prin1-to-string output))))) - (setq resolution (calc-graph-find-command "samples")) - (if resolution - (setq resolution (string-to-int resolution)) - (setq resolution (if is-splot + (setq calc-graph-resolution (calc-graph-find-command "samples")) + (if calc-graph-resolution + (setq calc-graph-resolution (string-to-int calc-graph-resolution)) + (setq calc-graph-resolution (if calc-graph-is-splot calc-graph-default-resolution-3d calc-graph-default-resolution))) (setq precision (calc-graph-find-command "precision")) @@ -381,8 +420,8 @@ (calc-graph-set-command "samples") (calc-graph-set-command "precision")) (goto-char samples-pos) - (insert "set samples " (int-to-string (max (if is-splot 20 200) - (+ 5 resolution))) "\n") + (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200) + (+ 5 calc-graph-resolution))) "\n") (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t) (delete-region (match-beginning 0) (match-end 0)) (if (looking-at ",") @@ -398,7 +437,7 @@ calc-simplify-mode calc-infinite-mode calc-word-size - precision is-splot)) + precision calc-graph-is-splot)) (if (and (not recompute) (equal (cdr (car calc-graph-data-cache)) cache-env)) (while (> (length calc-graph-data-cache) @@ -408,88 +447,88 @@ (setq calc-graph-data-cache (list (cons nil cache-env))))) (calc-graph-find-plot t t) (while (re-search-forward - (if is-splot + (if calc-graph-is-splot "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}" "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}") nil t) - (setq curve-num (1+ curve-num)) - (let* ((xname (buffer-substring (match-beginning 1) (match-end 1))) - (xvar (intern (concat "var-" xname))) - (xvalue (math-evaluate-expr (calc-var-value xvar))) - (y3name (and is-splot + (setq calc-graph-curve-num (1+ calc-graph-curve-num)) + (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1))) + (xvar (intern (concat "var-" calc-graph-xname))) + (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar))) + (calc-graph-y3name (and calc-graph-is-splot (buffer-substring (match-beginning 2) (match-end 2)))) - (y3var (and is-splot (intern (concat "var-" y3name)))) - (y3value (and is-splot (calc-var-value y3var))) - (yname (buffer-substring (match-beginning 3) (match-end 3))) - (yvar (intern (concat "var-" yname))) - (yvalue (calc-var-value yvar)) + (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name)))) + (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var))) + (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3))) + (yvar (intern (concat "var-" calc-graph-yname))) + (calc-graph-yvalue (calc-var-value yvar)) filename) (delete-region (match-beginning 0) (match-end 0)) - (setq filename (calc-temp-file-name curve-num)) + (setq filename (calc-temp-file-name calc-graph-curve-num)) (save-excursion (set-buffer calcbuf) (let (tempbuftop - (xp xvalue) - (yp yvalue) - (zp nil) - (xlow nil) (xhigh nil) (y3low nil) (y3high nil) - xvec xval xstep var-DUMMY - y3vec y3val y3step var-DUMMY2 (zval nil) - yvec yval ycache ycacheptr yvector - numsteps numsteps3 - (keep-file (and (not is-splot) (file-exists-p filename))) - (stepcount 0) + (calc-graph-xp calc-graph-xvalue) + (calc-graph-yp calc-graph-yvalue) + (calc-graph-zp nil) + (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil) + calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY + y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) + calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector + calc-graph-numsteps calc-graph-numsteps3 + (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename))) + (calc-graph-stepcount 0) (calc-symbolic-mode nil) (calc-prefer-frac nil) (calc-internal-prec (max 3 precision)) (calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) calc-simplify-mode)) - (blank t) - (non-blank nil) + (calc-graph-blank t) + (calc-graph-non-blank nil) (math-working-step 0) (math-working-step-2 nil)) (save-excursion - (if is-splot + (if calc-graph-is-splot (calc-graph-compute-3d) (calc-graph-compute-2d)) (set-buffer tempbuf) (goto-char (point-max)) - (insert "\n" xname) - (if is-splot - (insert ":" y3name)) - (insert ":" yname "\n\n") + (insert "\n" calc-graph-xname) + (if calc-graph-is-splot + (insert ":" calc-graph-y3name)) + (insert ":" calc-graph-yname "\n\n") (setq tempbuftop (point)) (let ((calc-group-digits nil) (calc-leading-zeros nil) (calc-number-radix 10) - (entry (and (not is-splot) - (list xp yp xhigh numsteps)))) + (entry (and (not calc-graph-is-splot) + (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps)))) (or (equal entry - (nth 1 (nth (1+ curve-num) + (nth 1 (nth (1+ calc-graph-curve-num) calc-graph-file-cache))) - (setq keep-file nil)) - (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache)) + (setq calc-graph-keep-file nil)) + (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache)) entry) - (or keep-file + (or calc-graph-keep-file (calc-graph-format-data))) - (or keep-file + (or calc-graph-keep-file (progn - (or non-blank + (or calc-graph-non-blank (error "No valid data points for %s:%s" - xname yname)) + calc-graph-xname calc-graph-yname)) (write-region tempbuftop (point-max) filename nil 'quiet)))))) (insert (prin1-to-string filename)))) - (if surprise-splot + (if calc-graph-surprise-splot (setcdr cache-env nil)) - (if (= curve-num 0) + (if (= calc-graph-curve-num 0) (progn (calc-gnuplot-command "clear") (calc-clear-command-flag 'clear-message) (message "No data to plot!")) - (setq calc-graph-data-cache-limit (max curve-num + (setq calc-graph-data-cache-limit (max calc-graph-curve-num calc-graph-data-cache-limit) filename (calc-temp-file-name 0)) (write-region (point-min) (point-max) filename nil 'quiet) @@ -517,325 +556,325 @@ (eval command)))))))))) (defun calc-graph-compute-2d () - (if (setq yvec (eq (car-safe yvalue) 'vec)) - (if (= (setq numsteps (1- (length yvalue))) 0) + (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) + (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0) (error "Can't plot an empty vector") - (if (setq xvec (eq (car-safe xvalue) 'vec)) - (or (= (1- (length xvalue)) numsteps) - (error "%s and %s have different lengths" xname yname)) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq xstep (math-div (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)) - xvalue (nth 2 xvalue)) - (if (math-realp xvalue) - (setq xstep 1) - (error "%s is not a suitable basis for %s" xname yname))))) - (or (math-realp yvalue) + (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)) + (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps) + (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname)) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)) + calc-graph-xvalue (nth 2 calc-graph-xvalue)) + (if (math-realp calc-graph-xvalue) + (setq calc-graph-xstep 1) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))) + (or (math-realp calc-graph-yvalue) (let ((arglist nil)) - (setq yvalue (math-evaluate-expr yvalue)) - (calc-default-formula-arglist yvalue) + (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) + (calc-default-formula-arglist calc-graph-yvalue) (or arglist - (error "%s does not contain any unassigned variables" yname)) + (error "%s does not contain any unassigned variables" calc-graph-yname)) (and (cdr arglist) (error "%s contains more than one variable: %s" - yname arglist)) - (setq yvalue (math-expr-subst yvalue + calc-graph-yname arglist)) + (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue (math-build-var-name (car arglist)) '(var DUMMY var-DUMMY))))) - (setq ycache (assoc yvalue calc-graph-data-cache)) - (delq ycache calc-graph-data-cache) + (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache)) + (delq calc-graph-ycache calc-graph-data-cache) (nconc calc-graph-data-cache - (list (or ycache (setq ycache (list yvalue))))) - (if (and (not (setq xvec (eq (car-safe xvalue) 'vec))) - refine (cdr (cdr ycache))) + (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue))))) + (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))) + calc-graph-refine (cdr (cdr calc-graph-ycache))) (calc-graph-refine-2d) (calc-graph-recompute-2d)))) (defun calc-graph-refine-2d () - (setq keep-file nil - ycacheptr (cdr ycache)) - (if (and (setq xval (calc-graph-find-command "xrange")) + (setq calc-graph-keep-file nil + calc-graph-ycacheptr (cdr calc-graph-ycache)) + (if (and (setq calc-graph-xval (calc-graph-find-command "xrange")) (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'" - xval)) + calc-graph-xval)) (let ((b2 (match-beginning 2)) (e2 (match-end 2))) - (setq xlow (math-read-number (substring xval + (setq calc-graph-xlow (math-read-number (substring calc-graph-xval (match-beginning 1) (match-end 1))) - xhigh (math-read-number (substring xval b2 e2)))) - (if xlow - (while (and (cdr ycacheptr) - (Math-lessp (car (nth 1 ycacheptr)) xlow)) - (setq ycacheptr (cdr ycacheptr))))) - (setq math-working-step-2 (1- (length ycacheptr))) - (while (and (cdr ycacheptr) - (or (not xhigh) - (Math-lessp (car (car ycacheptr)) xhigh))) - (setq var-DUMMY (math-div (math-add (car (car ycacheptr)) - (car (nth 1 ycacheptr))) + calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2)))) + (if calc-graph-xlow + (while (and (cdr calc-graph-ycacheptr) + (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow)) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))))) + (setq math-working-step-2 (1- (length calc-graph-ycacheptr))) + (while (and (cdr calc-graph-ycacheptr) + (or (not calc-graph-xhigh) + (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh))) + (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr)) + (car (nth 1 calc-graph-ycacheptr))) 2) math-working-step (1+ math-working-step) - yval (math-evaluate-expr yvalue)) - (setcdr ycacheptr (cons (cons var-DUMMY yval) - (cdr ycacheptr))) - (setq ycacheptr (cdr (cdr ycacheptr)))) - (setq yp ycache - numsteps 1000000)) + calc-graph-yval (math-evaluate-expr calc-graph-yvalue)) + (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval) + (cdr calc-graph-ycacheptr))) + (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr)))) + (setq calc-graph-yp calc-graph-ycache + calc-graph-numsteps 1000000)) (defun calc-graph-recompute-2d () - (setq ycacheptr ycache) - (if xvec - (setq numsteps (1- (length xvalue)) - yvector nil) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq numsteps resolution - yp nil - xlow (nth 2 xvalue) - xhigh (nth 3 xvalue) - xstep (math-div (math-sub xhigh xlow) - (1- numsteps)) - xvalue (nth 2 xvalue)) + (setq calc-graph-ycacheptr calc-graph-ycache) + (if calc-graph-xvec + (setq calc-graph-numsteps (1- (length calc-graph-xvalue)) + calc-graph-yvector nil) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-numsteps calc-graph-resolution + calc-graph-yp nil + calc-graph-xlow (nth 2 calc-graph-xvalue) + calc-graph-xhigh (nth 3 calc-graph-xvalue) + calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow) + (1- calc-graph-numsteps)) + calc-graph-xvalue (nth 2 calc-graph-xvalue)) (error "%s is not a suitable basis for %s" - xname yname))) - (setq math-working-step-2 numsteps) - (while (>= (setq numsteps (1- numsteps)) 0) + calc-graph-xname calc-graph-yname))) + (setq math-working-step-2 calc-graph-numsteps) + (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0) (setq math-working-step (1+ math-working-step)) - (if xvec + (if calc-graph-xvec (progn - (setq xp (cdr xp) - xval (car xp)) - (and (not (eq ycacheptr ycache)) - (consp (car ycacheptr)) - (not (Math-lessp (car (car ycacheptr)) xval)) - (setq ycacheptr ycache))) - (if (= numsteps 0) - (setq xval xhigh) ; avoid cumulative roundoff - (setq xval xvalue - xvalue (math-add xvalue xstep)))) - (while (and (cdr ycacheptr) - (Math-lessp (car (nth 1 ycacheptr)) xval)) - (setq ycacheptr (cdr ycacheptr))) - (or (and (cdr ycacheptr) - (Math-equal (car (nth 1 ycacheptr)) xval)) + (setq calc-graph-xp (cdr calc-graph-xp) + calc-graph-xval (car calc-graph-xp)) + (and (not (eq calc-graph-ycacheptr calc-graph-ycache)) + (consp (car calc-graph-ycacheptr)) + (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval)) + (setq calc-graph-ycacheptr calc-graph-ycache))) + (if (= calc-graph-numsteps 0) + (setq calc-graph-xval calc-graph-xhigh) ; avoid cumulative roundoff + (setq calc-graph-xval calc-graph-xvalue + calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)))) + (while (and (cdr calc-graph-ycacheptr) + (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval)) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))) + (or (and (cdr calc-graph-ycacheptr) + (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval)) (progn - (setq keep-file nil - var-DUMMY xval) - (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue)) - (cdr ycacheptr))))) - (setq ycacheptr (cdr ycacheptr)) - (if xvec - (setq yvector (cons (cdr (car ycacheptr)) yvector)) - (or yp (setq yp ycacheptr)))) - (if xvec - (setq xp xvalue - yvec t - yp (cons 'vec (nreverse yvector)) - numsteps (1- (length xp))) - (setq numsteps 1000000))) + (setq calc-graph-keep-file nil + var-DUMMY calc-graph-xval) + (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue)) + (cdr calc-graph-ycacheptr))))) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)) + (if calc-graph-xvec + (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector)) + (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr)))) + (if calc-graph-xvec + (setq calc-graph-xp calc-graph-xvalue + calc-graph-yvec t + calc-graph-yp (cons 'vec (nreverse calc-graph-yvector)) + calc-graph-numsteps (1- (length calc-graph-xp))) + (setq calc-graph-numsteps 1000000))) (defun calc-graph-compute-3d () - (if (setq yvec (eq (car-safe yvalue) 'vec)) - (if (math-matrixp yvalue) + (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) + (if (math-matrixp calc-graph-yvalue) (progn - (setq numsteps (1- (length yvalue)) - numsteps3 (1- (length (nth 1 yvalue)))) - (if (eq (car-safe xvalue) 'vec) - (or (= (1- (length xvalue)) numsteps) - (error "%s has wrong length" xname)) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq xvalue (calcFunc-index numsteps - (nth 2 xvalue) + (setq calc-graph-numsteps (1- (length calc-graph-yvalue)) + calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue)))) + (if (eq (car-safe calc-graph-xvalue) 'vec) + (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps) + (error "%s has wrong length" calc-graph-xname)) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps + (nth 2 calc-graph-xvalue) (math-div - (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)))) - (if (math-realp xvalue) - (setq xvalue (calcFunc-index numsteps xvalue 1)) - (error "%s is not a suitable basis for %s" xname yname)))) - (if (eq (car-safe y3value) 'vec) - (or (= (1- (length y3value)) numsteps3) - (error "%s has wrong length" y3name)) - (if (and (eq (car-safe y3value) 'intv) - (math-constp y3value)) - (setq y3value (calcFunc-index numsteps3 - (nth 2 y3value) + (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)))) + (if (math-realp calc-graph-xvalue) + (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1)) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))) + (if (eq (car-safe calc-graph-y3value) 'vec) + (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3) + (error "%s has wrong length" calc-graph-y3name)) + (if (and (eq (car-safe calc-graph-y3value) 'intv) + (math-constp calc-graph-y3value)) + (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 + (nth 2 calc-graph-y3value) (math-div - (math-sub (nth 3 y3value) - (nth 2 y3value)) - (1- numsteps3)))) - (if (math-realp y3value) - (setq y3value (calcFunc-index numsteps3 y3value 1)) - (error "%s is not a suitable basis for %s" y3name yname)))) - (setq xp nil - yp nil - zp nil - xvec t) - (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue)) - (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) - yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) - zp (nconc zp (cons '(skip) - (copy-sequence (cdr (car yvalue))))))) - (setq numsteps (1- (* numsteps (1+ numsteps3))))) - (if (= (setq numsteps (1- (length yvalue))) 0) + (math-sub (nth 3 calc-graph-y3value) + (nth 2 calc-graph-y3value)) + (1- calc-graph-numsteps3)))) + (if (math-realp calc-graph-y3value) + (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1)) + (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname)))) + (setq calc-graph-xp nil + calc-graph-yp nil + calc-graph-zp nil + calc-graph-xvec t) + (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue)) + (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue))) + calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value)))) + calc-graph-zp (nconc calc-graph-zp (cons '(skip) + (copy-sequence (cdr (car calc-graph-yvalue))))))) + (setq calc-graph-numsteps (1- (* calc-graph-numsteps + (1+ calc-graph-numsteps3))))) + (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0) (error "Can't plot an empty vector")) - (or (and (eq (car-safe xvalue) 'vec) - (= (1- (length xvalue)) numsteps)) - (error "%s is not a suitable basis for %s" xname yname)) - (or (and (eq (car-safe y3value) 'vec) - (= (1- (length y3value)) numsteps)) - (error "%s is not a suitable basis for %s" y3name yname)) - (setq xp xvalue - yp y3value - zp yvalue - xvec t)) - (or (math-realp yvalue) + (or (and (eq (car-safe calc-graph-xvalue) 'vec) + (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)) + (or (and (eq (car-safe calc-graph-y3value) 'vec) + (= (1- (length calc-graph-y3value)) calc-graph-numsteps)) + (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname)) + (setq calc-graph-xp calc-graph-xvalue + calc-graph-yp calc-graph-y3value + calc-graph-zp calc-graph-yvalue + calc-graph-xvec t)) + (or (math-realp calc-graph-yvalue) (let ((arglist nil)) - (setq yvalue (math-evaluate-expr yvalue)) - (calc-default-formula-arglist yvalue) + (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) + (calc-default-formula-arglist calc-graph-yvalue) (setq arglist (sort arglist 'string-lessp)) (or (cdr arglist) - (error "%s does not contain enough unassigned variables" yname)) + (error "%s does not contain enough unassigned variables" calc-graph-yname)) (and (cdr (cdr arglist)) - (error "%s contains too many variables: %s" yname arglist)) - (setq yvalue (math-multi-subst yvalue + (error "%s contains too many variables: %s" calc-graph-yname arglist)) + (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue (mapcar 'math-build-var-name arglist) '((var DUMMY var-DUMMY) (var DUMMY2 var-DUMMY2)))))) - (if (setq xvec (eq (car-safe xvalue) 'vec)) - (setq numsteps (1- (length xvalue))) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq numsteps resolution - xvalue (calcFunc-index numsteps - (nth 2 xvalue) - (math-div (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)))) + (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)) + (setq calc-graph-numsteps (1- (length calc-graph-xvalue))) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-numsteps calc-graph-resolution + calc-graph-xvalue (calcFunc-index calc-graph-numsteps + (nth 2 calc-graph-xvalue) + (math-div (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)))) (error "%s is not a suitable basis for %s" - xname yname))) - (if (setq y3vec (eq (car-safe y3value) 'vec)) - (setq numsteps3 (1- (length y3value))) - (if (and (eq (car-safe y3value) 'intv) - (math-constp y3value)) - (setq numsteps3 resolution - y3value (calcFunc-index numsteps3 - (nth 2 y3value) - (math-div (math-sub (nth 3 y3value) - (nth 2 y3value)) - (1- numsteps3)))) + calc-graph-xname calc-graph-yname))) + (if (eq (car-safe calc-graph-y3value) 'vec) + (setq calc-graph-numsteps3 (1- (length calc-graph-y3value))) + (if (and (eq (car-safe calc-graph-y3value) 'intv) + (math-constp calc-graph-y3value)) + (setq calc-graph-numsteps3 calc-graph-resolution + calc-graph-y3value (calcFunc-index calc-graph-numsteps3 + (nth 2 calc-graph-y3value) + (math-div (math-sub (nth 3 calc-graph-y3value) + (nth 2 calc-graph-y3value)) + (1- calc-graph-numsteps3)))) (error "%s is not a suitable basis for %s" - y3name yname))) - (setq xp nil - yp nil - zp nil - xvec t) + calc-graph-y3name calc-graph-yname))) + (setq calc-graph-xp nil + calc-graph-yp nil + calc-graph-zp nil + calc-graph-xvec t) (setq math-working-step 0) - (while (setq xvalue (cdr xvalue)) - (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) - yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) - zp (cons '(skip) zp) - y3step y3value - var-DUMMY (car xvalue) + (while (setq calc-graph-xvalue (cdr calc-graph-xvalue)) + (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue))) + calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value)))) + calc-graph-zp (cons '(skip) calc-graph-zp) + calc-graph-y3step calc-graph-y3value + var-DUMMY (car calc-graph-xvalue) math-working-step-2 0 math-working-step (1+ math-working-step)) - (while (setq y3step (cdr y3step)) + (while (setq calc-graph-y3step (cdr calc-graph-y3step)) (setq math-working-step-2 (1+ math-working-step-2) - var-DUMMY2 (car y3step) - zp (cons (math-evaluate-expr yvalue) zp)))) - (setq zp (nreverse zp) - numsteps (1- (* numsteps (1+ numsteps3)))))) + var-DUMMY2 (car calc-graph-y3step) + calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp)))) + (setq calc-graph-zp (nreverse calc-graph-zp) + calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3)))))) (defun calc-graph-format-data () - (while (<= (setq stepcount (1+ stepcount)) numsteps) - (if xvec - (setq xp (cdr xp) - xval (car xp) - yp (cdr yp) - yval (car yp) - zp (cdr zp) - zval (car zp)) - (if yvec - (setq xval xvalue - xvalue (math-add xvalue xstep) - yp (cdr yp) - yval (car yp)) - (setq xval (car (car yp)) - yval (cdr (car yp)) - yp (cdr yp)) - (if (or (not yp) - (and xhigh (equal xval xhigh))) - (setq numsteps 0)))) - (if is-splot - (if (and (eq (car-safe zval) 'calcFunc-xyz) - (= (length zval) 4)) - (setq xval (nth 1 zval) - yval (nth 2 zval) - zval (nth 3 zval))) - (if (and (eq (car-safe yval) 'calcFunc-xyz) - (= (length yval) 4)) + (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps) + (if calc-graph-xvec + (setq calc-graph-xp (cdr calc-graph-xp) + calc-graph-xval (car calc-graph-xp) + calc-graph-yp (cdr calc-graph-yp) + calc-graph-yval (car calc-graph-yp) + calc-graph-zp (cdr calc-graph-zp) + calc-graph-zval (car calc-graph-zp)) + (if calc-graph-yvec + (setq calc-graph-xval calc-graph-xvalue + calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep) + calc-graph-yp (cdr calc-graph-yp) + calc-graph-yval (car calc-graph-yp)) + (setq calc-graph-xval (car (car calc-graph-yp)) + calc-graph-yval (cdr (car calc-graph-yp)) + calc-graph-yp (cdr calc-graph-yp)) + (if (or (not calc-graph-yp) + (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh))) + (setq calc-graph-numsteps 0)))) + (if calc-graph-is-splot + (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz) + (= (length calc-graph-zval) 4)) + (setq calc-graph-xval (nth 1 calc-graph-zval) + calc-graph-yval (nth 2 calc-graph-zval) + calc-graph-zval (nth 3 calc-graph-zval))) + (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz) + (= (length calc-graph-yval) 4)) (progn - (or surprise-splot + (or calc-graph-surprise-splot (save-excursion (set-buffer (get-buffer-create "*Gnuplot Temp*")) (save-excursion (goto-char (point-max)) (re-search-backward "^plot[ \t]") (insert "set parametric\ns") - (setq surprise-splot t)))) - (setq xval (nth 1 yval) - zval (nth 3 yval) - yval (nth 2 yval))) - (if (and (eq (car-safe yval) 'calcFunc-xy) - (= (length yval) 3)) - (setq xval (nth 1 yval) - yval (nth 2 yval))))) - (if (and (Math-realp xval) - (Math-realp yval) - (or (not zval) (Math-realp zval))) + (setq calc-graph-surprise-splot t)))) + (setq calc-graph-xval (nth 1 calc-graph-yval) + calc-graph-zval (nth 3 calc-graph-yval) + calc-graph-yval (nth 2 calc-graph-yval))) + (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy) + (= (length calc-graph-yval) 3)) + (setq calc-graph-xval (nth 1 calc-graph-yval) + calc-graph-yval (nth 2 calc-graph-yval))))) + (if (and (Math-realp calc-graph-xval) + (Math-realp calc-graph-yval) + (or (not calc-graph-zval) (Math-realp calc-graph-zval))) (progn - (setq blank nil - non-blank t) - (if (Math-integerp xval) - (insert (math-format-number xval)) - (if (eq (car xval) 'frac) - (setq xval (math-float xval))) - (insert (math-format-number (nth 1 xval)) - "e" (int-to-string (nth 2 xval)))) + (setq calc-graph-blank nil + calc-graph-non-blank t) + (if (Math-integerp calc-graph-xval) + (insert (math-format-number calc-graph-xval)) + (if (eq (car calc-graph-xval) 'frac) + (setq calc-graph-xval (math-float calc-graph-xval))) + (insert (math-format-number (nth 1 calc-graph-xval)) + "e" (int-to-string (nth 2 calc-graph-xval)))) (insert " ") - (if (Math-integerp yval) - (insert (math-format-number yval)) - (if (eq (car yval) 'frac) - (setq yval (math-float yval))) - (insert (math-format-number (nth 1 yval)) - "e" (int-to-string (nth 2 yval)))) - (if zval + (if (Math-integerp calc-graph-yval) + (insert (math-format-number calc-graph-yval)) + (if (eq (car calc-graph-yval) 'frac) + (setq calc-graph-yval (math-float calc-graph-yval))) + (insert (math-format-number (nth 1 calc-graph-yval)) + "e" (int-to-string (nth 2 calc-graph-yval)))) + (if calc-graph-zval (progn (insert " ") - (if (Math-integerp zval) - (insert (math-format-number zval)) - (if (eq (car zval) 'frac) - (setq zval (math-float zval))) - (insert (math-format-number (nth 1 zval)) - "e" (int-to-string (nth 2 zval)))))) + (if (Math-integerp calc-graph-zval) + (insert (math-format-number calc-graph-zval)) + (if (eq (car calc-graph-zval) 'frac) + (setq calc-graph-zval (math-float calc-graph-zval))) + (insert (math-format-number (nth 1 calc-graph-zval)) + "e" (int-to-string (nth 2 calc-graph-zval)))))) (insert "\n")) - (and (not (equal zval '(skip))) - (boundp 'var-PlotRejects) + (and (not (equal calc-graph-zval '(skip))) (eq (car-safe var-PlotRejects) 'vec) (nconc var-PlotRejects (list (list 'vec - curve-num - stepcount - xval yval))) + calc-graph-curve-num + calc-graph-stepcount + calc-graph-xval calc-graph-yval))) (calc-refresh-evaltos 'var-PlotRejects)) - (or blank + (or calc-graph-blank (progn (insert "\n") - (setq blank t)))))) + (setq calc-graph-blank t)))))) (defun calc-temp-file-name (num) (while (<= (length calc-graph-file-cache) (1+ num)) @@ -859,9 +898,7 @@ (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) (defun calc-graph-kill-hook () - (calc-graph-delete-temps) - (if calc-graph-prev-kill-hook - (funcall calc-graph-prev-kill-hook))) + (calc-graph-delete-temps)) (defun calc-graph-show-tty (output) "Default calc-gnuplot-plot-command for \"tty\" output mode. @@ -870,6 +907,9 @@ This is useful for tek40xx and other graphics-terminal types." nil calc-gnuplot-buffer nil "-c" (format "cat %s >/dev/tty; rm %s" output output))) +(defvar calc-dumb-map nil + "The keymap for the \"dumb\" terminal plot.") + (defun calc-graph-show-dumb (&optional output) "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. This \"dumb\" driver will be present in Gnuplot 3.0." @@ -882,7 +922,6 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (sleep-for 1)) (goto-char (point-max)) (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T") - (setq found-pt (point)) (if (looking-at "\f") (progn (forward-char 1) @@ -898,7 +937,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (end-of-line) (backward-char 1) (recenter '(4))) - (or (boundp 'calc-dumb-map) + (or calc-dumb-map (progn (setq calc-dumb-map (make-sparse-keymap)) (define-key calc-dumb-map "\n" 'scroll-up) @@ -1097,7 +1136,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or (calc-graph-find-plot nil nil) (error "No data points have been set!")) (let ((base (point)) - start) + start + end) (re-search-forward "[,\n]\\|[ \t]+with") (setq end (match-beginning 0)) (goto-char base) diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index bb6699a4ac9..ee00e022553 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -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))) diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 213b7dc4474..6ede0888319 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -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 '* diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 47b48bd88d8..fd361bd3eee 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -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)) diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 51d7450278e..a78f98ec3cc 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -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) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4ace5fb6780..6480b1960a5 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -654,6 +654,20 @@ If nil, selections displayed but ignored.") 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 @@ Notations: 3.14e6 3.14 * 10^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 @@ Notations: 3.14e6 3.14 * 10^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 @@ commands given here will actually operate on the *Calculator* stack." (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 @@ See calc-keypad for details." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (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)))))))) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 2a463009e58..ff23c3e5421 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -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) '^) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 945119f06df..679c4b991b6 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1974,19 +1974,20 @@ message contains an appointment, don't make a diary entry." (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 @@ Currently knows about Gnus and Rmail modes." (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 @@ automatically." (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 @@ automatically." (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 @@ automatically." (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")))))) diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el index 419f8567a90..324da8d3ce1 100644 --- a/lisp/cvs-status.el +++ b/lisp/cvs-status.el @@ -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)) -(eval-when-compile (require 'pcvs)) (require 'pcvs-util) +(eval-when-compile (require 'pcvs)) ;;; @@ -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 @@ Optional prefix ARG chooses between two representations." ;;(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 @@ The files are stored to DIR." (provide 'cvs-status) -;;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0 +;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0 ;;; cvs-status.el ends here diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 72ddde7c8cb..7dd6966a486 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -507,7 +507,10 @@ as well as widgets, buttons, overlays, and text properties." (format "%d" (nth 1 split)) (format "%d %d" (nth 1 split) (nth 2 split))))) ("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)))) diff --git a/lisp/desktop.el b/lisp/desktop.el index 64e8770ffd0..55ebd662df6 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -129,7 +129,8 @@ determine where the desktop is saved." (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 @@ determine where the desktop is saved." "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 @@ Also pause for a moment to display message about errors signaled in 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 @@ An element may be variable name (a symbol) or a cons cell of the form \(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 @@ Possible values are: 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 @@ -628,7 +636,7 @@ See also `desktop-base-file-name'." ";; Desktop file format version " desktop-file-version "\n" ";; Emacs version " emacs-version "\n\n" ";; Global section:\n") - (mapcar (function desktop-outvar) desktop-globals-to-save) + (mapc (function desktop-outvar) desktop-globals-to-save) (if (memq 'kill-ring desktop-globals-to-save) (insert "(setq kill-ring-yank-pointer (nthcdr " @@ -636,15 +644,15 @@ See also `desktop-base-file-name'." " kill-ring))\n")) (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") - (mapcar #'(lambda (l) - (if (apply 'desktop-save-buffer-p l) - (progn - (insert "(desktop-create-buffer " desktop-file-version) - (mapcar #'(lambda (e) - (insert "\n " (desktop-value-to-string e))) - l) - (insert ")\n\n")))) - info) + (mapc #'(lambda (l) + (if (apply 'desktop-save-buffer-p l) + (progn + (insert "(desktop-create-buffer " desktop-file-version) + (mapc #'(lambda (e) + (insert "\n " (desktop-value-to-string e))) + l) + (insert ")\n\n")))) + info) (setq default-directory dirname) (when (file-exists-p filename) (delete-file filename)) (let ((coding-system-for-write 'emacs-mule)) @@ -865,9 +873,9 @@ directory DIRNAME." ((equal '(nil) desktop-buffer-minor-modes) ; backwards compatible (auto-fill-mode 0)) (t - (mapcar #'(lambda (minor-mode) - (when (functionp minor-mode) (funcall minor-mode 1))) - desktop-buffer-minor-modes))) + (mapc #'(lambda (minor-mode) + (when (functionp minor-mode) (funcall minor-mode 1))) + desktop-buffer-minor-modes))) ;; Even though point and mark are non-nil when written by `desktop-save' ;; they may be modified by handlers wanting to set point or mark themselves. (when desktop-buffer-point diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index bed46c71618..2bfbace4c4b 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -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 @@ window, marking buffers to be selected, saved or deleted. To exit and select a new buffer, type a space when the cursor is on the appropriate line of the buffer-list window. Other commands are -much like those of buffer-menu-mode. +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 @@ Letters do not insert themselves; instead, they are commands. \\{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 @@ electric-buffer-menu-mode-hook if it is non-nil." (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 @@ Selects buffer at point and displays buffers marked \">\" in other windows." (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 @@ Type \\[Electric-buffer-menu-quit] to exit, \ (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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e00bebc91d5..856a31551df 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,6 +1,7 @@ ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -;; Copyright (c) 1991,1994,2000,01,02,2004 Free Software Foundation, Inc. +;; Copyright (c) 1991, 1994, 2000, 2001, 2002, 2004 +;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -266,7 +267,7 @@ (cdr (assq name byte-compile-function-environment))))) (if (and (consp fn) (eq (car fn) 'autoload)) (error "File `%s' didn't define `%s'" (nth 1 fn) name)) - (if (symbolp fn) + (if (and (symbolp fn) (not (eq fn t))) (byte-compile-inline-expand (cons fn (cdr form))) (if (byte-code-function-p fn) (let (string) @@ -2032,5 +2033,5 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-optimize-lapcode)))) nil) -;;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1 +;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1 ;;; byte-opt.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2116cc33b34..ee29039e05e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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 @@ Each element looks like (MACRONAME . DEFINITION). It is "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 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;;; 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 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (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 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (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 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (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 @@ extra args." ;; 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 @@ list that represents a doc string reference. (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. @@ -3608,7 +3613,6 @@ being undefined will be suppressed." (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. @@ -3710,22 +3714,22 @@ being undefined will be suppressed." (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. @@ -3928,7 +3932,7 @@ invoked interactively." (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))) @@ -4110,5 +4114,5 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." (run-hooks 'bytecomp-load-hook) -;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a +;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a ;;; bytecomp.el ends here diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 7b18756fd7e..b0f3b9b9d3e 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -42,25 +42,7 @@ menus, turn this variable off, otherwise it is probably better to keep it on." :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) @@ -396,6 +378,7 @@ otherwise put the new binding last in MENU. 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) @@ -437,8 +420,7 @@ ITEM should be a keymap binding of the form (KEY . MENU-ITEM)." (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-p (x) "Return true if form X never evaluates to nil." @@ -541,15 +523,10 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'." (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) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index d701db9e9b6..82ce6f404f7 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -564,7 +564,6 @@ displayed." (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") diff --git a/lisp/files.el b/lisp/files.el index 75d9965133c..d0f3b47f2b5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1751,6 +1751,30 @@ in that case, this function acts as if `enable-local-variables' were t." ("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 @@ in that case, this function acts as if `enable-local-variables' were t." ;; 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 @@ regular expression. The mode is then determined as the mode associated 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 `enable-local-variables' is nil, this function does not check for a 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)) @@ -1926,9 +1950,10 @@ only set the major mode, if that would change it." ;; 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))) - ;; If we found an interpreter mode to use, invoke it now. + ;; If we didn't, match the buffer beginning against magic-mode-alist. (unless done (if (setq done (save-excursion (goto-char (point-min)) @@ -1936,6 +1961,7 @@ only set the major mode, if that would change it." (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. @@ -1945,7 +1971,7 @@ only set the major mode, if that would change it." (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) @@ -1954,7 +1980,6 @@ only set the major mode, if that would change it." (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 @@ -1973,7 +1998,6 @@ same, do nothing and return nil." (funcall mode) mode)) - (defun set-auto-mode-1 () "Find the -*- spec in the buffer. Call with point at the place to start searching from. diff --git a/lisp/filesets.el b/lisp/filesets.el index 74a2a72bb34..8599cb01d93 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1356,7 +1356,7 @@ Use the viewer defined in EV-ENTRY (a valid element of (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 @@ -1593,7 +1593,8 @@ SAVE-FUNCTION takes no argument, but works on the current buffer." (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) @@ -1638,7 +1639,7 @@ Replace <file-name> or <<file-name>> with filename." (save-restriction (let ((buffer (filesets-find-file this))) (when buffer - (beginning-of-buffer) + (goto-char (point-min)) (let () (cond ((stringp fn) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d0c749bf385..8a7e1c28cf4 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -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 @@ START should be at the beginning of a line." (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. @@ -2003,5 +2003,5 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." (provide 'font-lock) -;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c +;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c ;;; font-lock.el ends here diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index d7ebedc53f8..b605875da89 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,17 @@ +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. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c0266300983..a87348188f9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -321,27 +321,55 @@ advertisements. For example: :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 @@ is a number that says what regular expression grouping used to find 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" diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 6b093480940..7948efc2572 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1871,11 +1871,13 @@ this is a reply." (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. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 8f2a1b7fa6e..c06a7b1ee73 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -228,9 +228,14 @@ KIND should be `var' for a variable or `subr' for a subroutine." (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) diff --git a/lisp/info-look.el b/lisp/info-look.el index 3f3ea7c2fd4..4bc90c7e5aa 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -328,22 +328,22 @@ If optional argument QUERY is non-nil, query for the help mode." (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 @@ Return nil if there is nothing appropriate in the buffer near point." :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 @@ Return nil if there is nothing appropriate in the buffer near point." (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 @@ Return nil if there is nothing appropriate in the buffer near point." ("(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 @@ Return nil if there is nothing appropriate in the buffer near point." (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 @@ Return nil if there is nothing appropriate in the buffer near point." ;; 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 @@ Return nil if there is nothing appropriate in the buffer near point." :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 @@ Return nil if there is nothing appropriate in the buffer near point." ((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 diff --git a/lisp/info.el b/lisp/info.el index 8aaf7755df2..cc7ed2ae59b 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -657,10 +657,10 @@ is preserved, if possible." (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 @@ -1484,13 +1484,18 @@ If DIRECTION is `backward', search in the reverse direction." (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)) - ;; Skip node header line - (save-excursion (forward-line -1) - (looking-at "\^_")))) + (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)) @@ -1552,13 +1557,18 @@ If DIRECTION is `backward', search in the reverse direction." (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)) - ;; Skip node header line - (save-excursion (forward-line -1) - (looking-at "\^_")))) + (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)) diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el index b0dffc40f50..d7baabb29c8 100644 --- a/lisp/international/iso-cvt.el +++ b/lisp/international/iso-cvt.el @@ -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 @@ Optional arg BUFFER is ignored (for use in `format-alist')." ;;;###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] '("--")) - - (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-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-bar-files-menu [translate-separator] '("--")) - - (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-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) - - (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))))))))) + (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 [load-as] '("Load As..." . iso-cvt-load-as)) + (fset 'iso-cvt-load-as load-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 [write-as] '("Write As..." . iso-cvt-write-as)) + (fset 'iso-cvt-write-as write-as-menu-map) + + (define-key menu [translate-separator] '("--")) + + (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) + + (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 diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 510a3c9358d..404ee5529f8 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -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. ;; Keywords: mule, multilingual @@ -625,6 +626,175 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the 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. @@ -721,7 +891,6 @@ and TO is ignored." (let ((codings (find-coding-systems-region from to)) (coding-system nil) - (bufname (buffer-name)) safe rejected unsafe) (if (eq (car codings) 'undecided) ;; Any coding system is ok. @@ -739,172 +908,8 @@ and TO is ignored." ;; If all the defaults failed, ask a user. (when (not coding-system) - ;; 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 - (if (stringp from) - (setq unsafe - (mapcar #'(lambda (coding) - (cons coding - (mapcar #'(lambda (pos) - (cons pos (aref from pos))) - (unencodable-char-position - 0 (length from) coding - 11 from)))) - unsafe)) - (setq unsafe - (mapcar #'(lambda (coding) - (cons coding - (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))) - (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*" - (save-excursion - (set-buffer standard-output) - (if (not default-coding-system) - (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 " ")) - (mapc #'(lambda (x) (princ " ") (princ (car x))) - default-coding-system) - (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 ") - (mapc #'(lambda (x) (princ " ") (princ x)) rejected) - (insert "\n")) - (when unsafe - (insert (if rejected "And the others" - "However, each of them") - " encountered these problematic characters:\n") - (mapc - #'(lambda (coding) - (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")) - unsafe) - (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 (if safe - "\nSelect the above, or " - "\nSelect ") - "\ -one of the following safe coding systems, or edit the buffer:\n") - (let ((pos (point)) - (fill-prefix " ")) - (mapcar (function (lambda (x) (princ " ") (princ x))) - codings) - (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 default-coding-system (or (car safe) (car codings))) - (setq coding-system - (read-coding-system - (format "Select coding system (default %s): " - default-coding-system) - default-coding-system)) - (setq last-coding-system-specified coding-system)) - - (kill-buffer "*Warning*") - (set-window-configuration window-configuration))) + (setq coding-system (select-safe-coding-system-interactively + from to codings unsafe rejected (car codings)))) (if (vectorp (coding-system-eol-type coding-system)) (let ((eol (coding-system-eol-type buffer-file-coding-system))) @@ -2627,5 +2632,5 @@ If CODING-SYSTEM can't safely encode CHAR, return nil." (substring enc2 0 i2)))) -;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc +;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc ;;; mule-cmds.el ends here diff --git a/lisp/international/mule.el b/lisp/international/mule.el index f5294fea92f..9136a257ee1 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -2126,7 +2126,7 @@ This function is intended to be added to `auto-coding-functions'." (save-excursion (forward-line 10) (point)))) - (when (and (search-forward "<html>" size t) + (when (and (search-forward "<html" size t) (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t)) (let* ((match (match-string 1)) (sym (intern (downcase match)))) diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index 43177b7c99b..c7fc8a0da03 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -302,13 +302,14 @@ it from rmail file. Called for each new message retrieved by ;; Check white list, and likewise cause while loop ;; bypass. - (if (let ((white-list rsf-white-list) - (found nil)) - (while (and (not found) white-list) - (if (string-match (car white-list) message-sender) - (setq found t) - (setq white-list (cdr white-list)))) - found) + (if (and message-sender + (let ((white-list rsf-white-list) + (found nil)) + (while (and (not found) white-list) + (if (string-match (car white-list) message-sender) + (setq found t) + (setq white-list (cdr white-list)))) + found)) (setq exit-while-loop t maybe-spam nil this-is-a-spam-email nil)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index f8e31dfda04..a7524cc8246 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1504,8 +1504,8 @@ It returns t if it got any new messages." (if (and (featurep 'rmail-spam-filter) rmail-use-spam-filter (> rsf-number-of-spam 0)) - (progn (if rmail-spam-filter-beep (beep t)) - (sleep-for rmail-spam-sleep-after-message))) + (progn (if rsf-beep (beep t)) + (sleep-for rsf-sleep-after-message))) ;; Move to the first new message ;; unless we have other unseen messages before it. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 2c1d37c80e2..597e77b6165 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -63,78 +63,78 @@ A large number or nil slows down menu responsiveness." (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 @@ A large number or nil slows down menu responsiveness." 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 @@ A large number or nil slows down menu responsiveness." (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 @@ A large number or nil slows down menu responsiveness." (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))) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 0194160bcf4..231b7c3d6e3 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -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 @@ less than a full screen." (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 @@ This should only be bound to mouse buttons 4 and 5." (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 @@ Returns non-nil if the new state is enabled." (provide 'mwheel) -;;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f +;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f ;;; mwheel.el ends here diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index c5a2218e36e..098f2988f1b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -357,6 +357,15 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time :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 @@ -1032,14 +1041,6 @@ used instead of `browse-url-new-window-flag'." 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'. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e153ab3341f..502dc5e5115 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -159,7 +159,8 @@ Nil means to use a separate filename syntax for Tramp.") (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." diff --git a/lisp/paren.el b/lisp/paren.el index 6c5f9dece99..10695a41098 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -139,8 +139,8 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." (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. diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 0a666927c52..0c8fe92f2d6 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -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 @@ With a prefix argument, prompt for cvs FLAGS to use." (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 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (provide 'pcvs) -;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61 +;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61 ;;; pcvs.el ends here diff --git a/lisp/printing.el b/lisp/printing.el index 3efb53111fd..003e6893428 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -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 @@ Unless optional argument INPLACE is non-nil, return a new string." :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 @@ See `pr-ps-printer-alist'.") (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 @@ See `pr-ps-printer-alist'.") (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 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (provide 'printing) -;;; arch-tag: 9ce9ac3f-0f60-4370-900b-1943215d9d18 +;; arch-tag: 9ce9ac3f-0f60-4370-900b-1943215d9d18 ;;; printing.el ends here diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 472cfc3053e..e7eb0657eac 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1292,7 +1292,7 @@ If ARG is non-nil, ask the user to confirm the command." ;; 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 diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 223455e9872..034cdaf5fdd 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -785,11 +785,14 @@ the function in `compilation-buffer-name-function', so you can set that 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)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 94458df56e8..38cc167d942 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5292,7 +5292,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', 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))) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 74368661d3e..cf2b0797e82 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -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 @@ detailed description of this mode. (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 @@ detailed description of this mode. "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. @@ -1291,9 +1294,8 @@ static char *magick[] = { '(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)))))) @@ -2047,6 +2049,8 @@ BUFFER nil or omitted means use the current buffer." (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 diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 692fce0234e..6720014ed31 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -508,11 +508,19 @@ the expression output by IDL." (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 @@ idlwave-shell-temp-rinfo-save-file is set (respectively)." 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 @@ idlw-shell-examine-alist from which to select the help command text." (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 @@ idlw-shell-examine-alist from which to select the help command text." (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))) diff --git a/lisp/simple.el b/lisp/simple.el index b45d9eee348..8f38dfde2ec 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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 @@ select the source buffer." (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) @@ -2284,6 +2285,8 @@ This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied." (interactive "r") (copy-region-as-kill beg end) + ;; 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)) @@ -3085,13 +3088,13 @@ It is the column where point was at the start of current run of vertical motion commands. When the `track-eol' feature is doing its job, the value is 9999.") -(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))) @@ -3102,7 +3105,8 @@ Outline mode sets this." ;; 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) @@ -3118,6 +3122,7 @@ Outline mode sets this." (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. @@ -3133,28 +3138,43 @@ Outline mode sets this." (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, @@ -3165,8 +3185,7 @@ Outline mode sets this." ;; 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)) @@ -3179,9 +3198,11 @@ Outline mode sets this." (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) @@ -3232,13 +3253,13 @@ and `current-column' to be able to ignore invisible text." (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) @@ -3251,9 +3272,45 @@ and `current-column' to be able to ignore invisible text." ;; 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) @@ -3302,7 +3359,8 @@ With arg N, put point N/10 of the way from the true beginning." (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)))) @@ -3318,7 +3376,8 @@ With arg N, put point N/10 of the way from the true end." (unwind-protect (progn (select-window window) - (end-of-buffer arg) + (with-no-warnings + (end-of-buffer arg)) (recenter '(t))) (select-window orig-window)))) diff --git a/lisp/subr.el b/lisp/subr.el index 621aec8d571..bb13298d6fe 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2221,12 +2221,20 @@ from `standard-syntax-table' otherwise." 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'. diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el new file mode 100644 index 00000000000..cb692616947 --- /dev/null +++ b/lisp/textmodes/conf-mode.el @@ -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 diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 556369077d8..441d9972173 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1281,7 +1281,7 @@ Word syntax described by `ispell-dictionary-alist' (which see)." (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 diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 4ac96b2e4b0..dd606a53434 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -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 @@ -1053,53 +1054,79 @@ You might want to turn on `auto-fill-mode' to get better results." (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. @@ -1966,5 +1993,5 @@ Can be used as a value for `html-mode-hook'." (provide 'sgml-mode) -;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401 +;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401 ;;; sgml-mode.el ends here diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 6ff86b4cf0b..f8243f4a0ac 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -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 @@ use either \\[customize] or the function `tooltip-mode'." (provide 'tooltip) -;;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f +;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f ;;; tooltip.el ends here diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 261635d51e2..eb10dd2a933 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -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 diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index f5192bcb03f..42793093117 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -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)) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 197c7217785..4491956f06f 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +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 diff --git a/lispref/syntax.texi b/lispref/syntax.texi index 8c95e78d00c..57b0590d239 100644 --- a/lispref/syntax.texi +++ b/lispref/syntax.texi @@ -501,6 +501,18 @@ We use @code{string} to make it easier to see the character returned by @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}. diff --git a/man/ChangeLog b/man/ChangeLog index 22ac03e8677..6aa29b26aee 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -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 diff --git a/man/files.texi b/man/files.texi index 4e36c2ab2fa..6a0d2c662b5 100644 --- a/man/files.texi +++ b/man/files.texi @@ -1119,11 +1119,13 @@ such as the creation time of each version, who created it, and a 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 @@ you want to use. @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 diff --git a/msdos/ChangeLog b/msdos/ChangeLog index e906a8f4954..c52f73e640c 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -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 diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2 index 0952380a202..f2291cf2989 100644 --- a/msdos/mainmake.v2 +++ b/msdos/mainmake.v2 @@ -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 @@ TAGS tags: lib-src FRC 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) clean + -$(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 .. + -$(MAKE) $(MFLAGS) $@ -.PHONY: bootstrap bootstrap-lisp-1 boostrap-src bootstrap-lisp bootstrap-clean -.PHONY: maybe_bootstrap +top_distclean=rm -f Makefile */Makefile src/_gdbinit + +distclean maintainer-clean: FRC + 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} + +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 @@ maybe_bootstrap: @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-src: 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 .. diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 8edc1616f23..93b4f7d5d89 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -58,6 +58,7 @@ s/bootstrap-doc/b-doc/ /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\ diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 4d77194cff0..31687bf0086 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -84,6 +84,14 @@ s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/ #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. diff --git a/msdos/sedlisp.inp b/msdos/sedlisp.inp index 26ce2082399..9cff732a445 100644 --- a/msdos/sedlisp.inp +++ b/msdos/sedlisp.inp @@ -24,6 +24,7 @@ export FNCASE=y /^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 diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c index 840c423471b..363b225a355 100644 --- a/oldXMenu/Activate.c +++ b/oldXMenu/Activate.c @@ -85,6 +85,20 @@ /* For debug, set this to 0 to not grab the keyboard on menu popup */ int x_menu_grab_keyboard = 1; +typedef void (*Wait_func)(); + +static Wait_func wait_func; +static void* wait_data; + +void +XMenuActivateSetWaitFunction (func, data) + Wait_func func; + void *data; +{ + wait_func = func; + wait_data = data; +} + int XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data, help_callback) @@ -266,6 +280,7 @@ XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data, * Begin event processing loop. */ while (1) { + if (wait_func) (*wait_func) (wait_data); XNextEvent(display, &event); /* Get next event. */ switch (event.type) { /* Dispatch on the event type. */ case Expose: @@ -557,6 +572,8 @@ XMenuActivate(display, menu, p_num, s_num, x_pos, y_pos, event_mask, data, free((char *)feq_tmp); } + wait_func = 0; + /* * Return successfully. */ diff --git a/oldXMenu/ChangeLog b/oldXMenu/ChangeLog index 4bcd8120556..ab86c364736 100644 --- a/oldXMenu/ChangeLog +++ b/oldXMenu/ChangeLog @@ -1,3 +1,10 @@ +2004-11-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * XMenu.h (XMenuActivateSetWaitFunction): New function. + + * Activate.c (XMenuActivateSetWaitFunction): New function. + (XMenuActivate): Call wait_func if set, before XNextEvent. + 2002-04-22 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * Activate.c: Add calls to GrabKeyboard to remove strange diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h index fde2a954620..46e390d3b0a 100644 --- a/oldXMenu/XMenu.h +++ b/oldXMenu/XMenu.h @@ -251,6 +251,7 @@ int XMenuRecompute(); int XMenuEventHandler(); /* No value actually returned. */ int XMenuLocate(); int XMenuSetFreeze(); /* No value actually returned. */ +void XMenuActivateSetWaitFunction(); int XMenuActivate(); char *XMenuPost(); int XMenuDeletePane(); diff --git a/src/.gitignore b/src/.gitignore index 406ff7cd5e2..48c78a4f3a6 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -17,3 +17,4 @@ obj prefix-args stamp-oldxmenu temacs +buildobj.lst diff --git a/src/ChangeLog b/src/ChangeLog index b65bb2d5714..cc9e71290d5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,189 @@ +2004-11-12 Kim F. Storm <storm@cua.dk> + + * dispextern.h (struct glyph_row): New member extra_line_spacing. + (struct it): New member max_extra_line_spacing. + (MR_PARTIALLY_VISIBLE, MR_PARTIALLY_VISIBLE_AT_TOP) + (MR_PARTIALLY_VISIBLE_AT_BOTTOM): New helper macros. + (MATRIX_ROW_PARTIALLY_VISIBLE_P): Fix to return false if invisible + part of last line is only extra line spacing (so the text on the + line is fully visible). Use helper macros. + Add W arg (to use them). All callers changed. + (MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P) + (MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P): Use helper macros. + + * window.c (window_scroll_pixel_based, Frecenter): Use + move_it_vertically_backward directly. + (Frecenter): Fix calculation of new start pos for negative arg. + Before, the new start pos was sometimes chosen too far back, so + the last line became only partially visible, and thus would be + either only semi-visible or automatically scrolled to the middle + of the window by redisplay. + + * xdisp.c (init_iterator): Clear it.max_extra_line_spacing. + (move_it_vertically_backward): Don't recure to move further back. + (move_it_vertically): Remove superfluous condition. + (move_it_by_lines): Clear last_height when moved 0 lines. + (resize_mini_window): use it.max_extra_line_spacing. + (display_tool_bar_line): Clear row->extra_line_spacing. + (try_scrolling): Use move_it_vertically_backward directly. + (redisplay_window): Likewise. + (compute_line_metrics): Set row->extra_line_spacing. + (display_line, display_string): Likewise. + (x_produce_glyphs): Update it->max_extra_line_spacing. + + * xmenu.c (pop_down_menu): Return nil. + +2004-11-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xmenu.c (x_menu_wait_for_event): New function. + (popup_get_selection, popup_widget_loop): Call x_menu_wait_for_event + to handle timers. + (popup_widget_loop): Add argument do_timers. + (create_and_show_popup_menu, create_and_show_dialog): Pass 1 for + do_timers to popup_widget_loop. + (xmenu_show): Call XMenuActivateSetWaitFunction so that + x_menu_wait_for_event is called by XMenuActivate. + (create_and_show_popup_menu): Pass 1 for do_timers to + popup_get_selection. + (pop_down_menu): New function. + (popup_get_selection, popup_widget_loop): Unwind protect to + pop_down_menu. + (popup_widget_loop): Add argument widget. + (create_and_show_popup_menu, create_and_show_dialog): Pass new + argument widget to popup_widget_loop. + +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). @@ -16,7 +202,6 @@ * 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> @@ -37,8 +222,8 @@ (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_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. @@ -91,7 +276,7 @@ * gtkutil.h: Declare use_old_gtk_file_dialog. * gtkutil.c: Make use_old_gtk_file_dialog non-static. - (xg_initialize): Moved DEFVAR_BOOL for use_old_gtk_file_dialog ... + (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 @@ -166,20 +351,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 @@ -196,8 +381,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 @@ -212,8 +397,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 @@ -232,7 +417,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. diff --git a/src/Makefile.in b/src/Makefile.in index ebbc4f45d61..820ade11d39 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -596,8 +596,10 @@ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ 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 @@ -948,6 +950,7 @@ ${libsrc}make-docfile${EXEEXT}: #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} @@ -963,7 +966,7 @@ prefix-args${EXEEXT}: prefix-args.c $(config_h) #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 @@ -1019,12 +1022,12 @@ really-oldXMenu: @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." @@ -1279,6 +1282,7 @@ mostlyclean: 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. diff --git a/src/callint.c b/src/callint.c index da88693cd78..bb71ad50f44 100644 --- a/src/callint.c +++ b/src/callint.c @@ -265,7 +265,6 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) 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 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) 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++; } diff --git a/src/data.c b/src/data.c index 92487f82ddb..2e3378cf319 100644 --- a/src/data.c +++ b/src/data.c @@ -908,8 +908,6 @@ store_symval_forwarding (symbol, valcontents, newval, buf) register Lisp_Object valcontents, newval; struct buffer *buf; { - int offset; - switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) { case Lisp_Misc: @@ -941,7 +939,7 @@ store_symval_forwarding (symbol, valcontents, newval, buf) - (char *) &buffer_defaults); int idx = PER_BUFFER_IDX (offset); - Lisp_Object tail, buf; + Lisp_Object tail; if (idx <= 0) break; diff --git a/src/dispextern.h b/src/dispextern.h index 166d420d857..a179c8488dd 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -694,6 +694,10 @@ struct glyph_row frames. It may be < 0 in case of completely invisible rows. */ int visible_height; + /* Extra line spacing added after this row. Do not consider this + in last row when checking if row is fully visible. */ + int extra_line_spacing; + /* Hash code. This hash code is available as soon as the row is constructed, i.e. after a call to display_line. */ unsigned hash; @@ -916,22 +920,39 @@ struct glyph_row *matrix_row P_ ((struct glyph_matrix *, int)); #define MATRIX_ROW_DISPLAYS_TEXT_P(ROW) ((ROW)->displays_text_p) + +/* Helper macros */ + +#define MR_PARTIALLY_VISIBLE(ROW) \ + ((ROW)->height != (ROW)->visible_height) + +#define MR_PARTIALLY_VISIBLE_AT_TOP(W, ROW) \ + ((ROW)->y < WINDOW_HEADER_LINE_HEIGHT ((W))) + +#define MR_PARTIALLY_VISIBLE_AT_BOTTOM(W, ROW) \ + (((ROW)->y + (ROW)->height - (ROW)->extra_line_spacing) \ + > WINDOW_BOX_HEIGHT_NO_MODE_LINE ((W))) + /* Non-zero if ROW is not completely visible in window W. */ -#define MATRIX_ROW_PARTIALLY_VISIBLE_P(ROW) \ - ((ROW)->height != (ROW)->visible_height) +#define MATRIX_ROW_PARTIALLY_VISIBLE_P(W, ROW) \ + (MR_PARTIALLY_VISIBLE ((ROW)) \ + && (MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW)) \ + || MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW)))) + + /* Non-zero if ROW is partially visible at the top of window W. */ #define MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P(W, ROW) \ - (MATRIX_ROW_PARTIALLY_VISIBLE_P ((ROW)) \ - && (ROW)->y < WINDOW_HEADER_LINE_HEIGHT ((W))) + (MR_PARTIALLY_VISIBLE ((ROW)) \ + && MR_PARTIALLY_VISIBLE_AT_TOP ((W), (ROW))) /* Non-zero if ROW is partially visible at the bottom of window W. */ -#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P(W, ROW) \ - (MATRIX_ROW_PARTIALLY_VISIBLE_P ((ROW)) \ - && (ROW)->y + (ROW)->height > WINDOW_BOX_HEIGHT_NO_MODE_LINE ((W))) +#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P(W, ROW) \ + (MR_PARTIALLY_VISIBLE ((ROW)) \ + && MR_PARTIALLY_VISIBLE_AT_BOTTOM ((W), (ROW))) /* Return the bottom Y + 1 of ROW. */ @@ -1986,10 +2007,13 @@ struct it line, if the window has one. */ int last_visible_y; - /* Additional space in pixels between lines (for window systems - only.) */ + /* Default amount of additional space in pixels between lines (for + window systems only.) */ int extra_line_spacing; + /* Max extra line spacing added in this row. */ + int max_extra_line_spacing; + /* Override font height information for this glyph. Used if override_ascent >= 0. Cleared after this glyph. */ int override_ascent, override_descent, override_boff; diff --git a/src/doc.c b/src/doc.c index 82df9134f61..f306caed36a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -24,6 +24,7 @@ Boston, MA 02111-1307, USA. */ #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 Vdoc_file_name; 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 @@ the same file name is found in the `doc-directory'. */) register char *p, *end; Lisp_Object sym; char *name; + int skip_file = 0; CHECK_STRING (filename); @@ -618,6 +623,54 @@ the same file name is found in the `doc-directory'. */) #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 @@ the same file name is found in the `doc-directory'. */) 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 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int } else if (strp[0] == '\\' && strp[1] == '[') { - Lisp_Object firstkey; int start_idx; changed = 1; @@ -919,6 +989,10 @@ syms_of_doc () 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); diff --git a/src/dosfns.c b/src/dosfns.c index d9714693507..bd62147ad48 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -110,7 +110,7 @@ Return the updated VECTOR. */) 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 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, 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 @@ If the optional argument ALLKEYS is non-nil, the keyboard is mapped for 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))) diff --git a/src/editfns.c b/src/editfns.c index 2e8134d4495..45b7caa280b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -22,6 +22,7 @@ Boston, MA 02111-1307, USA. */ #include <config.h> #include <sys/types.h> +#include <stdio.h> #ifdef VMS #include "vms-pwd.h" @@ -33,11 +34,10 @@ Boston, MA 02111-1307, USA. */ #include <unistd.h> #endif -/* Without this, sprintf on Mac OS Classic will produce wrong - result. */ -#ifdef MAC_OS8 -#include <stdio.h> -#endif +/* 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> @@ -53,8 +53,6 @@ Boston, MA 02111-1307, USA. */ #include "frame.h" #include "window.h" -#include "systime.h" - #ifdef STDC_HEADERS #include <float.h> #define MAX_10_EXP DBL_MAX_10_EXP diff --git a/src/emacs.c b/src/emacs.c index ab60df39e27..356f74204bf 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1621,16 +1621,14 @@ main (argc, argv 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_process (); /* init_display uses add_keyboard_wait_descriptor. */ @@ -2180,16 +2178,19 @@ You must run Emacs in batch mode in order to dump it. */) 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 @@ -2278,7 +2279,7 @@ synchronize_locale (category, plocale, desired_locale) { *plocale = desired_locale; setlocale (category, (STRINGP (desired_locale) - ? (char *)(SDATA (desired_locale)) + ? (char *) SDATA (desired_locale) : "")); } } diff --git a/src/fontset.c b/src/fontset.c index f370f2ae981..7dff29f3ed8 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -797,7 +797,7 @@ fontset_pattern_regexp (pattern) { if (*p0 == '-') ndashes++; - else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') + else if (*p0 == '*') nstars++; } @@ -812,7 +812,7 @@ fontset_pattern_regexp (pattern) *p1++ = '^'; for (p0 = SDATA (pattern); *p0; p0++) { - if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') + if (*p0 == '*') { if (ndashes < 14) *p1++ = '.'; @@ -836,29 +836,33 @@ fontset_pattern_regexp (pattern) } /* 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 (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; } } } @@ -873,7 +877,7 @@ fs_query_fontset (name, regexpp) 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; @@ -964,6 +968,7 @@ FONTLIST is an alist of charsets vs corresponding font name patterns. */) { Lisp_Object fontset, elements, ascii_font; Lisp_Object tem, tail, elt; + int id; (*check_window_system_func) (); @@ -971,10 +976,14 @@ FONTLIST is an alist of charsets vs corresponding font name patterns. */) CHECK_LIST (fontlist); name = Fdowncase (name); - tem = Fquery_fontset (name, Qnil); - if (!NILP (tem)) - error ("Fontset `%s' matches the existing fontset `%s'", - SDATA (name), SDATA (tem)); + id = fs_query_fontset (name, 2); + if (id >= 0) + { + fontset = FONTSET_FROM_ID (id); + tem = FONTSET_NAME (fontset); + error ("Fontset `%s' matches the existing fontset `%s'", + SDATA (name), SDATA (tem)); + } /* Check the validity of FONTLIST while creating a template for fontset elements. */ @@ -1049,7 +1058,11 @@ check_fontset_name (name) 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); diff --git a/src/fringe.c b/src/fringe.c index e66fa4adecc..03abffab5c8 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -931,6 +931,7 @@ update_window_fringes (w, force_p) 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 @@ -954,6 +955,9 @@ update_window_fringes (w, force_p) 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; @@ -1057,7 +1061,7 @@ compute_fringe_widths (f, redraw) /* Free resources used by a user-defined bitmap. */ -int +void destroy_fringe_bitmap (n) int n; { diff --git a/src/intervals.h b/src/intervals.h index 15e59537377..f3b281f4184 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -84,9 +84,14 @@ struct interval #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) \ ((void)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,7 +294,7 @@ extern INTERVAL balance_intervals P_ ((INTERVAL)); 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 s1, Lisp_Object s2)); +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)); diff --git a/src/keyboard.c b/src/keyboard.c index 35bfd1402c9..b520d655fb9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1827,6 +1827,14 @@ command_loop_1 () 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'. */ @@ -1842,16 +1850,6 @@ command_loop_1 () 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 @@ -6640,7 +6638,6 @@ read_avail_input (expected) if (d->read_socket_hook) { int nr; - struct input_event hold_quit; EVENT_INIT (hold_quit); diff --git a/src/keymap.c b/src/keymap.c index 256485079c1..891e41f0b58 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -214,13 +214,13 @@ when reading a key-sequence to be looked-up in this keymap. */) (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; } diff --git a/src/lisp.h b/src/lisp.h index 7b9b0427da6..2c3141733bc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2278,6 +2278,7 @@ EXFUN (Felt, 2); EXFUN (Fmember, 2); EXFUN (Frassq, 2); EXFUN (Fdelq, 2); +EXFUN (Fdelete, 2); EXFUN (Fsort, 2); EXFUN (Freverse, 1); EXFUN (Fnreverse, 1); @@ -2369,6 +2370,7 @@ extern void adjust_after_replace P_ ((int, int, Lisp_Object, int, int)); 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 */ @@ -3137,6 +3139,11 @@ extern void syms_of_xterm P_ ((void)); /* 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. */ diff --git a/src/lread.c b/src/lread.c index 46fe6cd3e51..77750eea4fa 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2375,7 +2375,7 @@ read1 (readcharfun, pch, first_in_list) c = 0; else if (c == (CHAR_CTL | '?')) c = 127; - + if (c & CHAR_SHIFT) { /* Shift modifier is valid only with [A-Za-z]. */ @@ -2460,9 +2460,9 @@ read1 (readcharfun, pch, first_in_list) 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; @@ -3682,7 +3682,7 @@ init_lread () /* 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 diff --git a/src/makefile.w32-in b/src/makefile.w32-in index a7efcc4cae5..5a232e28362 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -168,6 +168,9 @@ temacs: $(BLD) $(TEMACS) $(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 16 + echo $(OBJ0) > $(BLD)/buildobj.lst + echo $(OBJ1) >> $(BLD)/buildobj.lst + echo $(WIN32OBJ) >> $(BLD)/buildobj.lst bootstrap: bootstrap-emacs diff --git a/src/msdos.c b/src/msdos.c index 712eb05b959..ab71b642e80 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2320,7 +2320,7 @@ IT_set_frame_parameters (f, alist) /* 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]; diff --git a/src/print.c b/src/print.c index 76c648b9a2e..8bb55f21248 100644 --- a/src/print.c +++ b/src/print.c @@ -2087,7 +2087,7 @@ print_object (obj, printcharfun, escapeflag) case Lisp_Misc_Save_Value: strout ("#<save_value ", -1, -1, printcharfun, 0); - sprintf(buf, "ptr=0x%08x int=%d", + sprintf(buf, "ptr=0x%08lx int=%d", (unsigned long) XSAVE_VALUE (obj)->pointer, XSAVE_VALUE (obj)->integer); strout (buf, -1, -1, printcharfun, 0); diff --git a/src/process.c b/src/process.c index db6e85c0fb3..65dec1457b0 100644 --- a/src/process.c +++ b/src/process.c @@ -2722,7 +2722,6 @@ usage: (make-network-process &rest ARGS) */) 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 */ @@ -3023,6 +3022,8 @@ usage: (make-network-process &rest ARGS) */) { int optn, optbits; + retry_connect: + s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol); if (s < 0) { @@ -3101,8 +3102,6 @@ usage: (make-network-process &rest ARGS) */) break; } - retry_connect: - immediate_quit = 1; QUIT; @@ -3144,22 +3143,13 @@ usage: (make-network-process &rest ARGS) */) 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) diff --git a/src/window.c b/src/window.c index d9ac2eb62bd..be5e9167d67 100644 --- a/src/window.c +++ b/src/window.c @@ -206,7 +206,7 @@ static int window_initialized; 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; @@ -4508,7 +4508,7 @@ window_scroll_pixel_based (window, n, whole, noerror) results for variable height lines. */ init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); it.current_y = it.last_visible_y; - move_it_vertically (&it, - window_box_height (w) / 2); + move_it_vertically_backward (&it, window_box_height (w) / 2); /* The function move_iterator_vertically may move over more than the specified y-distance. If it->w is small, e.g. a @@ -4518,14 +4518,14 @@ window_scroll_pixel_based (window, n, whole, noerror) if (it.current_y <= 0) { init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); - move_it_vertically (&it, 0); + move_it_vertically_backward (&it, 0); it.current_y = 0; } 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)) { @@ -5187,7 +5187,7 @@ and redisplay normally--don't erase and redraw the frame. */) SET_TEXT_POS (pt, PT, PT_BYTE); start_display (&it, w, pt); - move_it_vertically (&it, - window_box_height (w) / 2); + move_it_vertically_backward (&it, window_box_height (w) / 2); charpos = IT_CHARPOS (it); bytepos = IT_BYTEPOS (it); } @@ -5195,29 +5195,62 @@ and redisplay normally--don't erase and redraw the frame. */) { struct it it; struct text_pos pt; - int y0, y1, h, nlines; + int nlines = - XINT (arg); + int extra_line_spacing; + int h = window_box_height (w); SET_TEXT_POS (pt, PT, PT_BYTE); start_display (&it, w, pt); - y0 = it.current_y; + + /* Be sure we have the exact height of the full line containing PT. */ + move_it_by_lines (&it, 0, 1); /* The amount of pixels we have to move back is the window height minus what's displayed in the line containing PT, and the lines below. */ - nlines = - XINT (arg) - 1; + it.current_y = 0; + it.vpos = 0; move_it_by_lines (&it, nlines, 1); - y1 = line_bottom_y (&it); + if (it.vpos == nlines) + h -= it.current_y; + else + { + /* Last line has no newline */ + h -= line_bottom_y (&it); + it.vpos++; + } + + /* Don't reserve space for extra line spacing of last line. */ + extra_line_spacing = it.max_extra_line_spacing; /* If we can't move down NLINES lines because we hit the end of the buffer, count in some empty lines. */ if (it.vpos < nlines) - y1 += (nlines - it.vpos) * FRAME_LINE_HEIGHT (it.f); - - h = window_box_height (w) - (y1 - y0); + { + nlines -= it.vpos; + extra_line_spacing = it.extra_line_spacing; + h -= nlines * (FRAME_LINE_HEIGHT (it.f) + extra_line_spacing); + } + if (h <= 0) + return Qnil; + /* Now find the new top line (starting position) of the window. */ start_display (&it, w, pt); - move_it_vertically (&it, - h); + it.current_y = 0; + move_it_vertically_backward (&it, h); + + /* If extra line spacing is present, we may move too far + back. This causes the last line to be only partially + visible (which triggers redisplay to recenter that line + in the middle), so move forward. + But ignore extra line spacing on last line, as it is not + considered to be part of the visible height of the line. + */ + h += extra_line_spacing; + while (-it.current_y > h) + move_it_by_lines (&it, 1, 1); + charpos = IT_CHARPOS (it); bytepos = IT_BYTEPOS (it); } diff --git a/src/xdisp.c b/src/xdisp.c index 4b0865aa4f0..c3f659a85e6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2071,6 +2071,7 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id) * FRAME_LINE_HEIGHT (it->f)); else if (it->f->extra_line_spacing > 0) it->extra_line_spacing = it->f->extra_line_spacing; + it->max_extra_line_spacing = 0; } /* If realized faces have been removed, e.g. because of face @@ -6066,10 +6067,13 @@ move_it_vertically_backward (it, dy) { int nlines, h; struct it it2, it3; - int start_pos = IT_CHARPOS (*it); + int start_pos; + move_further_back: xassert (dy >= 0); + start_pos = IT_CHARPOS (*it); + /* Estimate how many newlines we must move back. */ nlines = max (1, dy / FRAME_LINE_HEIGHT (it->f)); @@ -6135,13 +6139,13 @@ move_it_vertically_backward (it, dy) a line height of 13 pixels each, recentering with point on the bottom line will try to move -39/2 = 19 pixels backward. Try to avoid moving into the first line. */ - && it->current_y - target_y > line_height / 3 * 2 + && it->current_y - target_y > line_height * 2 / 3 && IT_CHARPOS (*it) > BEGV) { TRACE_MOVE ((stderr, " not far enough -> move_vert %d\n", target_y - it->current_y)); - move_it_vertically (it, target_y - it->current_y); - xassert (IT_CHARPOS (*it) >= BEGV); + dy = it->current_y - target_y; + goto move_further_back; } else if (target_y >= it->current_y + line_height && IT_CHARPOS (*it) < ZV) @@ -6182,7 +6186,7 @@ move_it_vertically (it, dy) { if (dy <= 0) move_it_vertically_backward (it, -dy); - else if (dy > 0) + else { TRACE_MOVE ((stderr, "move_it_v: from %d, %d\n", IT_CHARPOS (*it), dy)); move_it_to (it, ZV, -1, it->current_y + dy, -1, @@ -6279,6 +6283,8 @@ move_it_by_lines (it, dvpos, need_y_p) /* DVPOS == 0 means move to the start of the screen line. */ move_it_vertically_backward (it, 0); xassert (it->current_x == 0 && it->hpos == 0); + /* Let next call to line_bottom_y calculate real line height */ + last_height = 0; } else if (dvpos > 0) move_it_to (it, -1, -1, -1, it->vpos + dvpos, MOVE_TO_VPOS); @@ -7422,7 +7428,7 @@ resize_mini_window (w, exact_p) height = it.current_y + last_height; else height = it.current_y + it.max_ascent + it.max_descent; - height -= it.extra_line_spacing; + height -= min (it.extra_line_spacing, it.max_extra_line_spacing); height = (height + unit - 1) / unit; } @@ -8699,6 +8705,7 @@ display_tool_bar_line (it) { row->height = row->phys_height = it->last_visible_y - row->y; row->ascent = row->phys_ascent = 0; + row->extra_line_spacing = 0; } row->full_width_p = 1; @@ -10888,7 +10895,7 @@ make_cursor_line_fully_visible (w, force_p) row = MATRIX_ROW (matrix, w->cursor.vpos); /* If the cursor row is not partially visible, there's nothing to do. */ - if (!MATRIX_ROW_PARTIALLY_VISIBLE_P (row)) + if (!MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)) return 1; /* If the row the cursor is in is taller than the window's height, @@ -11042,7 +11049,7 @@ try_scrolling (window, just_this_one_p, scroll_conservatively, { start_display (&it, w, scroll_margin_pos); if (this_scroll_margin) - move_it_vertically (&it, - this_scroll_margin); + move_it_vertically_backward (&it, this_scroll_margin); if (extra_scroll_margin_lines) move_it_by_lines (&it, - extra_scroll_margin_lines, 0); scroll_margin_pos = it.current.pos; @@ -11162,7 +11169,7 @@ try_scrolling (window, just_this_one_p, scroll_conservatively, if (amount_to_scroll <= 0) return SCROLLING_FAILED; - move_it_vertically (&it, - amount_to_scroll); + move_it_vertically_backward (&it, amount_to_scroll); startp = it.current.pos; } } @@ -11466,7 +11473,7 @@ try_cursor_movement (window, startp, scroll_step) /* if PT is not in the glyph row, give up. */ rc = CURSOR_MOVEMENT_MUST_SCROLL; } - else if (MATRIX_ROW_PARTIALLY_VISIBLE_P (row)) + else if (MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)) { if (PT == MATRIX_ROW_END_CHARPOS (row) && !row->ends_at_zv_p @@ -12043,7 +12050,7 @@ redisplay_window (window, just_this_one_p) if (it.current_y <= 0) { init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); - move_it_vertically (&it, 0); + move_it_vertically_backward (&it, 0); xassert (IT_CHARPOS (it) <= PT); it.current_y = 0; } @@ -12395,7 +12402,7 @@ try_window_reusing_current_matrix (w) /* Give up if old or new display is scrolled vertically. We could make this function handle this, but right now it doesn't. */ start_row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); - if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (start_row)) + if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row)) return 0; /* The variable new_start now holds the new window start. The old @@ -12443,7 +12450,7 @@ try_window_reusing_current_matrix (w) start = start_row->start.pos; /* If there are no more rows to try, or just one, give up. */ if (start_row == MATRIX_MODE_LINE_ROW (w->current_matrix) - 1 - || w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (start_row) + || w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row) || CHARPOS (start) == ZV) { clear_glyph_matrix (w->desired_matrix); @@ -14237,6 +14244,7 @@ compute_line_metrics (it) row->height = it->max_ascent + it->max_descent; row->phys_ascent = it->max_phys_ascent; row->phys_height = it->max_phys_ascent + it->max_phys_descent; + row->extra_line_spacing = it->max_extra_line_spacing; } /* Compute the width of this line. */ @@ -14280,6 +14288,7 @@ compute_line_metrics (it) row->pixel_width -= it->truncation_pixel_width; row->ascent = row->phys_ascent = 0; row->height = row->phys_height = row->visible_height = 1; + row->extra_line_spacing = 0; } /* Compute a hash code for this row. */ @@ -14616,6 +14625,7 @@ display_line (it) row->height = it->max_ascent + it->max_descent; row->phys_ascent = it->max_phys_ascent; row->phys_height = it->max_phys_ascent + it->max_phys_descent; + row->extra_line_spacing = it->max_extra_line_spacing; /* Loop generating characters. The loop is left with IT on the next character to display. */ @@ -14681,6 +14691,8 @@ display_line (it) row->phys_ascent = max (row->phys_ascent, it->max_phys_ascent); row->phys_height = max (row->phys_height, it->max_phys_ascent + it->max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + it->max_extra_line_spacing); set_iterator_to_next (it, 1); continue; } @@ -14709,6 +14721,8 @@ display_line (it) row->phys_ascent = max (row->phys_ascent, it->max_phys_ascent); row->phys_height = max (row->phys_height, it->max_phys_ascent + it->max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + it->max_extra_line_spacing); if (it->current_x - it->pixel_width < it->first_visible_x) row->x = x - it->first_visible_x; } @@ -14860,6 +14874,8 @@ display_line (it) row->phys_ascent = max (row->phys_ascent, it->max_phys_ascent); row->phys_height = max (row->phys_height, it->max_phys_ascent + it->max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + it->max_extra_line_spacing); /* End of this display line if row is continued. */ if (row->continued_p || row->ends_at_zv_p) @@ -16043,27 +16059,31 @@ pint2hrstr (buf, width, d) { 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. */ @@ -16765,6 +16785,7 @@ display_string (string, lisp_string, face_string, face_string_pos, row->height = it->max_ascent + it->max_descent; row->phys_ascent = it->max_phys_ascent; row->phys_height = it->max_phys_ascent + it->max_phys_descent; + row->extra_line_spacing = it->max_extra_line_spacing; /* This condition is for the case that we are called with current_x past last_visible_x. */ @@ -16824,6 +16845,8 @@ display_string (string, lisp_string, face_string, face_string_pos, row->phys_ascent = max (row->phys_ascent, it->max_phys_ascent); row->phys_height = max (row->phys_height, it->max_phys_ascent + it->max_phys_descent); + row->extra_line_spacing = max (row->extra_line_spacing, + it->max_extra_line_spacing); x += glyph->pixel_width; ++i; } @@ -18350,7 +18373,7 @@ produce_image_glyph (it) { struct image *img; struct face *face; - int face_ascent, glyph_ascent; + int glyph_ascent; struct glyph_slice slice; xassert (it->what == IT_IMAGE); @@ -18433,7 +18456,7 @@ produce_image_glyph (it) #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 @@ -19446,7 +19469,11 @@ x_produce_glyphs (it) it->current_x += it->pixel_width; if (extra_line_spacing > 0) - it->descent += extra_line_spacing; + { + it->descent += extra_line_spacing; + if (extra_line_spacing > it->max_extra_line_spacing) + it->max_extra_line_spacing = extra_line_spacing; + } it->max_ascent = max (it->max_ascent, it->ascent); it->max_descent = max (it->max_descent, it->descent); @@ -20413,19 +20440,20 @@ fast_find_position (w, charpos, hpos, vpos, x, y, stop) 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; @@ -20970,8 +20998,10 @@ note_mouse_highlight (f, x, y) /* 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. */ diff --git a/src/xfaces.c b/src/xfaces.c index 5137ab7e721..b8b946bea47 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3435,8 +3435,8 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p) 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; @@ -3461,16 +3461,11 @@ merge_face_heights (from, to, invalid, gcpro) /* 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; @@ -3523,8 +3518,7 @@ merge_face_vectors (f, from, to, named_merge_points) 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]; } @@ -3551,11 +3545,16 @@ merge_named_face (f, face_name, to, named_merge_points) 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; } @@ -3646,8 +3645,7 @@ merge_face_ref (f, face_ref, to, err_msgs, named_merge_points) 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; @@ -4034,7 +4032,7 @@ FRAME 0 means change the face on all frames, and change the default /* 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); @@ -4740,7 +4738,7 @@ the result will be absolute, otherwise it will be relative. */) 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; } diff --git a/src/xmenu.c b/src/xmenu.c index a08f4610101..0a83266a482 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -48,6 +48,7 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "charset.h" #include "coding.h" +#include "sysselect.h" #ifdef MSDOS #include "msdos.h" @@ -157,8 +158,6 @@ static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object, 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. @@ -525,7 +524,7 @@ single_menu_item (key, item, dummy, skp_v) return; /* Not a menu item. */ map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP]; - + if (skp->notreal) { /* We don't want to make a menu, just traverse the keymaps to @@ -1099,7 +1098,7 @@ on the left of the dialog box and all following items on the right. the dialog. Also, the lesstif/motif version crashes if there are no buttons. */ contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil)); - + list_of_panes (Fcons (contents, Qnil)); /* Display them in a dialog box. */ @@ -1115,9 +1114,73 @@ on the left of the dialog box and all following items on the right. } #endif } + + +#ifndef MSDOS + +/* Wait for an X event to arrive or for a timer to expire. */ + +static void +x_menu_wait_for_event (void *data) +{ + extern EMACS_TIME timer_check P_ ((int)); + + /* Another way to do this is to register a timer callback, that can be + done in GTK and Xt. But we have to do it like this when using only X + anyway, and with callbacks we would have three variants for timer handling + instead of the small ifdefs below. */ + + while ( +#ifdef USE_X_TOOLKIT + ! XtAppPending (Xt_app_con) +#elif defined USE_GTK + ! gtk_events_pending () +#else + ! XPending ((Display*) data) +#endif + ) + { + EMACS_TIME next_time = timer_check (1); + long secs = EMACS_SECS (next_time); + long usecs = EMACS_USECS (next_time); + SELECT_TYPE read_fds; + struct x_display_info *dpyinfo; + int n = 0; + + FD_ZERO (&read_fds); + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + int fd = ConnectionNumber (dpyinfo->display); + FD_SET (fd, &read_fds); + if (fd > n) n = fd; + } + + if (secs < 0 || (secs == 0 && usecs == 0)) + { + /* Sometimes timer_check returns -1 (no timers) even if there are + timers. So do a timeout anyway. */ + EMACS_SET_SECS (next_time, 1); + EMACS_SET_USECS (next_time, 0); + } + + select (n + 1, &read_fds, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &next_time); + } +} +#endif /* ! MSDOS */ + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) +#ifdef USE_X_TOOLKIT + +static Lisp_Object +pop_down_menu (dummy) + int dummy; +{ + popup_activated_flag = 0; + return Qnil; +} + /* Loop in Xt until the menu pulldown or dialog popup has been popped down (deactivated). This is used for x-popup-menu and x-popup-dialog; it is not used for the menu bar. @@ -1127,7 +1190,6 @@ on the left of the dialog box and all following items on the right. NOTE: All calls to popup_get_selection should be protected with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ -#ifdef USE_X_TOOLKIT static void popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) XEvent *initial_event; @@ -1138,19 +1200,21 @@ popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) { XEvent event; + int specpdl_count = SPECPDL_INDEX (); + record_unwind_protect (pop_down_menu, Qnil); + while (popup_activated_flag) { - /* 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; } else - XtAppNextEvent (Xt_app_con, &event); + { + if (do_timers) x_menu_wait_for_event (0); + XtAppNextEvent (Xt_app_con, &event); + } /* Make sure we don't consider buttons grabbed after menu goes. And make sure to deactivate for any ButtonRelease, @@ -1188,6 +1252,8 @@ popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) x_dispatch_event (&event, event.xany.display); } + + unbind_to (specpdl_count, Qnil); } #endif /* USE_X_TOOLKIT */ @@ -1195,16 +1261,40 @@ popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) #ifdef USE_GTK /* Loop util popup_activated_flag is set to zero in a callback. Used for popup menus and dialogs. */ +static GtkWidget *current_menu; + +static Lisp_Object +pop_down_menu (dummy) + int dummy; +{ + if (current_menu) + { + gtk_widget_unmap (current_menu); + current_menu = 0; + popup_activated_flag = 0; + } + return Qnil; +} + static void -popup_widget_loop () +popup_widget_loop (do_timers, widget) + int do_timers; + GtkWidget *widget; { + int specpdl_count = SPECPDL_INDEX (); + current_menu = widget; + record_unwind_protect (pop_down_menu, Qnil); + ++popup_activated_flag; /* Process events in the Gtk event loop until done. */ while (popup_activated_flag) { + if (do_timers) x_menu_wait_for_event (0); gtk_main_iteration (); } + + unbind_to (specpdl_count, Qnil); } #endif @@ -2329,7 +2419,7 @@ menu_position_func (menu, x, y, push_in, user_data) GtkRequisition req; int disp_width = FRAME_X_DISPLAY_INFO (data->f)->width; int disp_height = FRAME_X_DISPLAY_INFO (data->f)->height; - + *x = data->x; *y = data->y; @@ -2402,7 +2492,7 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click) two. show_help_echo uses this to detect popup menus. */ popup_activated_flag = 1; /* Process events that apply to the menu. */ - popup_widget_loop (); + popup_widget_loop (1, 0); gtk_widget_destroy (menu); @@ -2490,7 +2580,7 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click) popup_activated_flag = 1; /* Process events that apply to the menu. */ - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 1, 0); /* fp turned off the following statement and wrote a comment that it is unnecessary--that the menu has already disappeared. @@ -2811,7 +2901,7 @@ create_and_show_dialog (f, first_wv) gtk_widget_show_all (menu); /* Process events that apply to the menu. */ - popup_widget_loop (); + popup_widget_loop (1, menu); gtk_widget_destroy (menu); } @@ -3323,6 +3413,10 @@ xmenu_show (f, x, y, for_click, keymaps, title, error) XMenuSetFreeze (menu, TRUE); pane = selidx = 0; +#ifndef MSDOS + XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); +#endif + /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ menu_help_frame = f; diff --git a/src/xselect.c b/src/xselect.c index 06f4bfbd2a1..cd059e81979 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -24,6 +24,14 @@ Boston, MA 02111-1307, USA. */ #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 */ @@ -174,7 +182,8 @@ static Lisp_Object x_get_window_property_as_lisp_data (); -/* Define a queue to save up SelectionRequest events for later handling. */ +/* Define a queue to save up SELECTION_REQUEST_EVENT events for later + handling. */ struct selection_event_queue { @@ -184,11 +193,11 @@ struct selection_event_queue static struct selection_event_queue *selection_queue; -/* Nonzero means queue up certain events--don't process them yet. */ +/* Nonzero means queue up SELECTION_REQUEST_EVENT events. */ static int x_queue_selection_requests; -/* Queue up an X event *EVENT, to be processed later. */ +/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */ static void x_queue_event (event) @@ -196,12 +205,14 @@ x_queue_event (event) { struct selection_event_queue *queue_tmp; - /* Don't queue repeated requests */ + /* 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 ("IGNORE DUP SELECTION EVENT %08x", (unsigned long)queue_tmp); + TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp); + x_decline_selection_request (event); return; } } @@ -211,14 +222,14 @@ x_queue_event (event) if (queue_tmp != NULL) { - TRACE1 ("QUEUE SELECTION EVENT %08x", (unsigned long)queue_tmp); + TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp); queue_tmp->event = *event; queue_tmp->next = selection_queue; selection_queue = queue_tmp; } } -/* Start queuing SelectionRequest events. */ +/* Start queuing SELECTION_REQUEST_EVENT events. */ static void x_start_queuing_selection_requests () @@ -230,7 +241,7 @@ x_start_queuing_selection_requests () TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests); } -/* Stop queuing SelectionRequest events. */ +/* Stop queuing SELECTION_REQUEST_EVENT events. */ static void x_stop_queuing_selection_requests () @@ -244,7 +255,7 @@ x_stop_queuing_selection_requests () while (selection_queue != NULL) { struct selection_event_queue *queue_tmp = selection_queue; - TRACE1 ("RESTORE SELECTION EVENT %08x", (unsigned long)queue_tmp); + 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); @@ -877,7 +888,9 @@ x_handle_selection_request (event) struct x_display_info *dpyinfo = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event)); - TRACE0 ("x_handle_selection_request"); + 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; |