mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-18 10:16:51 +00:00
Code Issues Releases Activity

Merged in changes from CVS trunk.

Browse Source 
Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-673
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-674
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-675
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-676
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-677
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-681
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-682
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-683
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-684
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-685
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-686
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-687
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-692
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-693
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71
   Update from CVS

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-267
This commit is contained in:
Karoly Lorentey 2004-11-13 18:34:40 +00:00
commit e417405015
106 changed files with 3851 additions and 1901 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ChangeLog
View File

@ -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.

24
Makefile.in
View File

@ -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)

103
admin/FOR-RELEASE
View File

@ -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"

20
config.bat
View File

@ -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

21
etc/NEWS
View File

@ -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.
@ -2326,6 +2335,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.

15
lib-src/ChangeLog
View File

@ -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,

38
lib-src/etags.c
View File

@ -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;

4
lib-src/hexl.c
View File

@ -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)
{

1
lib-src/make-docfile.c
View File

@ -617,6 +617,7 @@ scan_c_file (filename, mode)
c = getc (infile);
defunflag = c == 'U';
defvarflag = 0;
defvarperbufferflag = 0;
}
else continue;

25
lib-src/makefile.w32-in
View File

@ -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
#

422
lisp/ChangeLog
View File

@ -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>

1
lisp/ChangeLog.10
View File

@ -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.

21
lisp/ChangeLog.7
View File

@ -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>

5
lisp/Makefile.in
View File

@ -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

475
lisp/calc/calc-aent.el
View File

@ -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")))))

68
lisp/calc/calc-comb.el
View File

@ -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)

114
lisp/calc/calc-ext.el
View File

@ -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)

6
lisp/calc/calc-forms.el
View File

@ -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))

688
lisp/calc/calc-graph.el
View File

@ -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)

40
lisp/calc/calc-lang.el
View File

@ -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)))

2
lisp/calc/calc-poly.el
View File

@ -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 '*

40
lisp/calc/calc-rewr.el
View File

@ -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))

104
lisp/calc/calc-vec.el
View File

@ -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)

201
lisp/calc/calc.el
View File

@ -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))))))))

12
lisp/calc/calcalg2.el
View File

@ -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) '^)

37
lisp/calendar/diary-lib.el
View File

@ -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"))))))

32
lisp/cvs-status.el
View File

@ -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

5
lisp/descr-text.el
View File

@ -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))))

50
lisp/desktop.el
View File

@ -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

21
lisp/ebuff-menu.el
View File

@ -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

7
lisp/emacs-lisp/byte-opt.el
View File

@ -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

58
lisp/emacs-lisp/bytecomp.el
View File

@ -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

35
lisp/emacs-lisp/easymenu.el
View File

@ -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)

1
lisp/emacs-lisp/elp.el
View File

@ -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")

68
lisp/files.el
View File

@ -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.

7
lisp/filesets.el
View File

@ -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)

12
lisp/font-lock.el
View File

@ -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

14
lisp/gnus/ChangeLog
View File

@ -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.

98
lisp/gnus/gnus-art.el
View File

@ -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"

12
lisp/gnus/gnus-msg.el
View File

@ -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.

7
lisp/help-fns.el
View File

@ -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)

64
lisp/info-look.el
View File

@ -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

42
lisp/info.el
View File

@ -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))

107
lisp/international/iso-cvt.el
View File

@ -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] '("--"))
(let ((load-as-menu-map (make-sparse-keymap "Load As..."))
(insert-as-menu-map (make-sparse-keymap "Insert As..."))
(write-as-menu-map (make-sparse-keymap "Write As..."))
(translate-to-menu-map (make-sparse-keymap "Translate to..."))
(translate-from-menu-map (make-sparse-keymap "Translate from..."))
(menu menu-bar-file-menu))
(define-key menu [load-as-separator] '("--"))
(define-key menu-bar-files-menu [load-as] '("Load As..." . load-as))
(defvar load-as-menu-map (make-sparse-keymap "Load As..."))
(fset 'load-as load-as-menu-map)
(define-key menu [load-as] '("Load As..." . iso-cvt-load-as))
(fset 'iso-cvt-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 [insert-as] '("Insert As..." . iso-cvt-insert-as))
(fset 'iso-cvt-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 [write-as] '("Write As..." . iso-cvt-write-as))
(fset 'iso-cvt-write-as write-as-menu-map)
(define-key menu-bar-files-menu [translate-separator] '("--"))
(define-key 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 [translate-to] '("Translate to..." . iso-cvt-translate-to))
(fset 'iso-cvt-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)
(define-key menu [translate-from] '("Translate from..." . iso-cvt-translate-from))
(fset 'iso-cvt-translate-from translate-from-menu-map)
(let ((file-types (reverse format-alist))
name
str-name)
(while file-types
(setq name (car (car file-types))
str-name (car (cdr (car file-types)))
file-types (cdr file-types))
(if (stringp str-name)
(progn
(define-key load-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive (format "FFind file (as %s): " ,name))
(format-find-file file ',name))))
(define-key insert-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive (format "FInsert file (as %s): " ,name))
(format-insert-file file ',name))))
(define-key write-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive (format "FWrite file (as %s): " ,name))
(format-write-file file ',name))))
(define-key translate-to-menu-map (vector name)
(cons str-name
`(lambda ()
(interactive)
(format-encode-buffer ',name))))
(define-key translate-from-menu-map (vector name)
(cons str-name
`(lambda ()
(interactive)
(format-decode-buffer ',name)))))))))
(dolist (file-type (reverse format-alist))
(let ((name (car file-type))
(str-name (cadr file-type)))
(if (stringp str-name)
(progn
(define-key load-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive ,(format "FFind file (as %s): " name))
(format-find-file file ',name))))
(define-key insert-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive (format "FInsert file (as %s): " ,name))
(format-insert-file file ',name))))
(define-key write-as-menu-map (vector name)
(cons str-name
`(lambda (file)
(interactive (format "FWrite file (as %s): " ,name))
(format-write-file file ',name))))
(define-key translate-to-menu-map (vector name)
(cons str-name
`(lambda ()
(interactive)
(format-encode-buffer ',name))))
(define-key translate-from-menu-map (vector name)
(cons str-name
`(lambda ()
(interactive)
(format-decode-buffer ',name))))))))))
(provide 'iso-cvt)
;;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840
;; arch-tag: 64ae843f-ed0e-43e1-ba50-ffd581b90840
;;; iso-cvt.el ends here

343
lisp/international/mule-cmds.el
View File

@ -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

2
lisp/international/mule.el
View File

@ -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))))

15
lisp/mail/rmail-spam-filter.el
View File

@ -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))

4
lisp/mail/rmail.el
View File

@ -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.

56
lisp/menu-bar.el
View File

@ -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)))

8
lisp/mwheel.el
View File

@ -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

17
lisp/net/browse-url.el
View File

@ -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'.

3
lisp/net/tramp.el
View File

@ -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."

4
lisp/paren.el
View File

@ -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.

21
lisp/pcvs.el
View File

@ -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

29
lisp/printing.el
View File

@ -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

2
lisp/progmodes/ada-xref.el
View File

@ -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

13
lisp/progmodes/compile.el
View File

@ -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))

2
lisp/progmodes/cperl-mode.el
View File

@ -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)))

12
lisp/progmodes/gdb-ui.el
View File

@ -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

31
lisp/progmodes/idlw-shell.el
View File

@ -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)))

201
lisp/simple.el
View File

@ -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))))

18
lisp/subr.el
View File

@ -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'.

531
lisp/textmodes/conf-mode.el Normal file
View File

@ -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

2
lisp/textmodes/flyspell.el
View File

@ -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

117
lisp/textmodes/sgml-mode.el
View File

@ -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

10
lisp/tooltip.el
View File

@ -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

5
lisp/url/ChangeLog
View File

@ -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

2
lisp/url/url-mailto.el
View File

@ -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))

4
lispref/ChangeLog
View File

@ -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

12
lispref/syntax.texi
View File

@ -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}.

7
man/ChangeLog
View File

@ -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

80
man/files.texi
View File

@ -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

26
msdos/ChangeLog
View File

@ -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

99
msdos/mainmake.v2
View File

@ -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 ..

1
msdos/sed1v2.inp
View File

@ -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\

8
msdos/sed2v2.inp
View File

@ -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.

3
msdos/sedlisp.inp
View File

@ -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

17
oldXMenu/Activate.c
View File

@ -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.
*/

7
oldXMenu/ChangeLog
View File

@ -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

1
oldXMenu/XMenu.h
View File

@ -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();

1
src/.gitignore vendored
View File

@ -17,3 +17,4 @@ obj
prefix-args
stamp-oldxmenu
temacs
buildobj.lst

215
src/ChangeLog
View File

@ -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.

14
src/Makefile.in
View File

@ -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.

15
src/callint.c
View File

@ -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++;
}

4
src/data.c
View File

@ -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;

42
src/dispextern.h
View File

@ -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;

78
src/doc.c
View File

@ -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);

6
src/dosfns.c
View File

@ -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)))

12
src/editfns.c
View File

@ -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

23
src/emacs.c
View File

@ -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)
: ""));
}
}

41
src/fontset.c
View File

@ -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);

6
src/fringe.c
View File

@ -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;
{

7
src/intervals.h
View File

@ -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));

19
src/keyboard.c
View File

@ -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);

6
src/keymap.c
View File

@ -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;
}

7
src/lisp.h
View File

@ -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. */

10
src/lread.c
View File

@ -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

3
src/makefile.w32-in
View File

@ -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

2
src/msdos.c
View File

@ -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];

2
src/print.c
View File

@ -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);

Some files were not shown because too many files have changed in this diff Show More