mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Merged in changes from CVS trunk. (Long time no see!) :-)

Browse Source 
Patches applied:

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

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

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

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

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-12
   Remove "-face" suffix from lazy-highlight face name

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-22
   <no summary provided>

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-40
   Fix regressions from latest reftex update

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

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

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

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

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-54
   Update from CVS: lisp/cus-start.el (all): Add `undo-outer-limit'.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-72
   src/dispextern.h (xassert): Enable unconditionally.

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

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

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

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--base-0
   tag of miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-82

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

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-2
   Merge from miles@gnu.org--gnu-2004

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

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

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-5
   Update from CVS: exi/gnus-faq.texi ([4.1]): Typo.

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-6
   Update from CVS

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

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-8
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-9
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-10
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-11
   Update from CVS


git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-281
This commit is contained in:
Karoly Lorentey 2005-02-03 23:28:36 +00:00
commit 597cfb3fbc
238 changed files with 11938 additions and 5635 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ChangeLog
View File

@ -1,3 +1,8 @@
2005-01-19 Steven Tamm <steventamm@mac.com>
* configure.in: Check for <sys/utsname.h>.
* configure: Regenerate.
2004-12-11 Kim F. Storm <storm@cua.dk>
* Makefile.in (info): Undo 2004-12-05 change.

137
admin/FOR-RELEASE
View File

@ -4,13 +4,15 @@ Tasks needed before the next release.
** Face remapping.
** 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>.
** define-minor-mode should not put :require into defcustom.
See msg from rms to emacs-devel on 21 Dec.
** Update Speedbar.
* FATAL ERRORS
** Investigate face cache related crash.
@ -32,9 +34,10 @@ invalid pointer from string_free_list.
** Fix up url-ldap.el.
* BUGS
** url/*.el has lots of `(declare (special ...))' which
are meaningless. What's that trying to do?
** Incomplete overlay mouse-face highlight bug (Ralf Angeli, Oct 18)
* BUGS
** Ange-ftp should ignore irrelevant IPv6 errors:
@ -62,48 +65,6 @@ further.
I think in the near future we will see more of this problem, so it might be
time to make anfe-ftp more intelligent.
** Mailabbrev should quote addresses to correspond to RFC 822.
See http://article.gmane.org/gmane.emacs.devel/27585
** The '@' character should not expand addresses in mailabbrev
See http://article.gmane.org/gmane.emacs.devel/27585
** Bug in url-http-parse-headers, reported in
From: Vivek Dasmohapatra <vivek@zeus.com>
Date: Tue, 28 Sep 2004 16:13:13 +0100
Fetching a url with url-retrieve can reult in an anrbitrary buffer
being killed if a 401 (or possibly a 407) result is encountered:
url-http-parse-headers calls url-http-handle-authentication,
which can call url-retrieve.
This results in the current buffer being killed, and a new http buffer
being generated. However, when the old http buffer is killed, emacs
picks the top buffer from the list as the new current buffer, so by the
time we get to the end of url-http-parse-headers, _that_ buffer is marked
as dead even though it is not necessarily a url buffer, so next time the
url libraries reap their dead buffers, an innocent bystander buffer is
killed instead (and an obsolete http buffer may be left lying around too).
A possible fix (which I am currently using) is to call set-buffer
on the return value of url-http-parse-headers:
(case url-http-response-status
(401
;; The request requires user authentication. The response
;; MUST include a WWW-Authenticate header field containing a
;; challenge applicable to the requested resource. The
;; client MAY repeat the request with a suitable
;; Authorization header field.
(url-mark-buffer-as-dead (current-buffer))
(set-buffer (url-http-handle-authentication nil)))
etc ....
which makes sure that it is the right http buffer that is current when
we come to mark the http buffers as dead.
* GTK RELATED BUGS
@ -189,48 +150,6 @@ interrupting I can get a backtrace, here's an example:
Update: Maybe only reveals itself when compiled with GTK+
** line-spacing and Electric-pop-up-window
From: SAITO Takuya <tabmore@rivo.mediatti.net>
Date: Mon, 31 May 2004 02:08:10 +0900 (JST)
Electric-pop-up-window does not work well
if truncate long lines disabled and/or
`line-spacing' is set to positive integer.
For example, start emacs -Q --line-spacing 1, and type M-` .
Then, the last line of *Completions* buffer is not visible.
fit-window-to-buffer works well for me, so I guess
Electric-pop-up-window can use it.
** Partial highlighting of wrapped overlay
From: Ralf Angeli <angeli@iwi.uni-sb.de>
Date: Mon, 18 Oct 2004 19:09:19 +0200
If you put
(let* ((length (+ (- (window-width) (current-column)) 40))
(start (point))
(end (+ (point) length))
(string (make-string length ?x))
ov)
(insert string)
(setq ov (make-overlay start end))
(overlay-put ov 'mouse-face 'highlight)
(overlay-put ov 'display string))
into the *scratch* buffer and type `C-x C-e' with point at the last
parenthesis, you will get a string which does not fit into the line
and has to be wrapped. If you move over it with your mouse, you
should see that only the part on the second line is being highlighted.
The full string is highlighted only if the 'display property is not
set.
* DOCUMENTATION
** Document Custom Themes.
@ -251,9 +170,10 @@ set.
** Check the Emacs manual.
Each manual section should be proof-read by at least two people.
After each file name, on the same line or the following line, come the
names of the people who have checked it.
Each manual section should be checked for factual correctness
regarding recent changes by at least two people. After each file
name, on the same line or the following line, come the names of the
people who have checked it.
SECTION READERS
@ -261,9 +181,9 @@ SECTION READERS
man/abbrevs.texi
man/anti.texi
man/basic.texi "Luc Teirlinck"
man/buffers.texi "Luc Teirlinck"
man/buffers.texi "Luc Teirlinck" Chong Yidong
man/building.texi "Ted Zlatanov" <tzz@lifelogs.com>
man/calendar.texi
man/calendar.texi Joakim Verona <joakim@verona.se>
man/cmdargs.texi
man/commands.texi "Luc Teirlinck"
man/custom.texi
@ -271,9 +191,9 @@ man/dired.texi
man/display.texi "Luc Teirlinck"
man/emacs.texi "Luc Teirlinck"
man/entering.texi "Luc Teirlinck"
man/files.texi "Luc Teirlinck"
man/files.texi "Luc Teirlinck" Chong Yidong
man/fixit.texi "Luc Teirlinck"
man/frames.texi "Luc Teirlinck"
man/frames.texi "Luc Teirlinck" Chong Yidong
man/glossary.texi
man/help.texi "Luc Teirlinck"
man/indent.texi "Luc Teirlinck"
@ -288,23 +208,24 @@ man/misc.texi
man/msdog.texi
man/mule.texi "Luc Teirlinck"
man/m-x.texi "Luc Teirlinck"
man/picture.texi
man/programs.texi
man/picture.texi Joakim Verona <joakim@verona.se>
man/programs.texi "Stephen Eglen"
man/regs.texi "Luc Teirlinck"
man/rmail.texi
man/screen.texi "Luc Teirlinck"
man/search.texi "Luc Teirlinck"
man/sending.texi
man/text.texi "Luc Teirlinck"
man/text.texi "Luc Teirlinck" Chong Yidong
man/trouble.texi
man/windows.texi "Luc Teirlinck"
man/windows.texi "Luc Teirlinck" Chong Yidong
man/xresources.texi
** Check the Emacs Lisp manual.
Each manual section should be proof-read by at least two people.
After each file name, on the same line or the following line, come the
names of the people who have checked it.
Each manual section should be checked for factual correctness
regarding recent changes by at least two people. After each file
name, on the same line or the following line, come the names of the
people who have checked it.
SECTION READERS
----------------------------------
@ -312,7 +233,7 @@ lispref/abbrevs.texi "Luc Teirlinck"
lispref/advice.texi Joakim Verona <joakim@verona.se>
lispref/anti.texi
lispref/backups.texi "Luc Teirlinck"
lispref/buffers.texi "Luc Teirlinck"
lispref/buffers.texi "Luc Teirlinck" Chong Yidong
lispref/calendar.texi Joakim Verona <joakim@verona.se>
lispref/commands.texi "Luc Teirlinck"
lispref/compile.texi "Luc Teirlinck"
@ -324,8 +245,8 @@ lispref/edebug.texi
lispref/elisp.texi "Luc Teirlinck"
lispref/errors.texi "Luc Teirlinck"
lispref/eval.texi "Luc Teirlinck"
lispref/files.texi "Luc Teirlinck"
lispref/frames.texi "Luc Teirlinck"
lispref/files.texi "Luc Teirlinck" Chong Yidong
lispref/frames.texi "Luc Teirlinck" Chong Yidong
lispref/functions.texi "Luc Teirlinck"
lispref/hash.texi "Luc Teirlinck"
lispref/help.texi "Luc Teirlinck"
@ -353,10 +274,10 @@ lispref/streams.texi "Luc Teirlinck"
lispref/strings.texi "Luc Teirlinck"
lispref/symbols.texi "Luc Teirlinck"
lispref/syntax.texi "Luc Teirlinck"
lispref/text.texi
lispref/text.texi Chong Yidong
lispref/tips.texi "Luc Teirlinck"
lispref/variables.texi "Luc Teirlinck"
lispref/windows.texi "Luc Teirlinck"
lispref/windows.texi "Luc Teirlinck" Chong Yidong
Local variables:

547
configure vendored
View File

File diff suppressed because it is too large Load Diff

3
configure.in
View File

@ -1449,7 +1449,8 @@ dnl checks for header files
AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \
linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \
termcap.h stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \
sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h)
sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \
sys/utsname.h)
AC_MSG_CHECKING(if personality LINUX32 can be set)
AC_TRY_COMPILE([#include <sys/personality.h>], [personality (PER_LINUX32)],

25
etc/ChangeLog
View File

@ -1,3 +1,28 @@
2005-01-22 David Kastrup <dak@gnu.org>
* NEWS: Mention alias `find-grep' for `grep-find'.
2005-01-22 Nick Roberts <nickrob@snap.net.nz>
* TODO: Add entry for toolbar on ttys.
2005-01-18 Nick Roberts <nickrob@snap.net.nz>
* DEBUG: Suggest separate terminal for debug session.
2005-01-15 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
* TUTORIAL.nl: Correct translation and the Dutch text (typos).
More consistent use of terminology.
2005-01-13 Cheng Gao <chenggao@gmail.com>
* MORE.STUFF: Add entries of some well known and widely used packages.
2005-01-07 Lars Hansen <larsh@math.ku.dk>
* NEWS: Describe desktop package lazy restore feature.
2004-12-21 Richard M. Stallman <rms@gnu.org>
* DISTRIB: Don't say "freeware".

7
etc/DEBUG
View File

@ -62,6 +62,11 @@ use the set command until the inferior process has been started.
Put a breakpoint early in `main', or suspend the Emacs,
to get an opportunity to do the set command.
When Emacs is running in a terminal, it is useful to use a separate terminal
for the debug session. This can be done by starting Emacs as usual, then
attaching to it from gdb with the `attach' command which is explained in the
node "Attach" of the GDB manual.
** Examining Lisp object values.
When you have a live process to debug, and it has not encountered a
@ -115,7 +120,7 @@ called frame. First, use these commands:
b set_frame_buffer_list
r -q
Then when Emacs it hits the breakpoint:
Then Emacs hits the breakpoint:
(gdb) p frame
$1 = 139854428

69
etc/MORE.STUFF
View File

@ -34,7 +34,7 @@ The Emacs Wiki has an area for storing elisp files
You might find bug-fixes or enhancements in these places.
* Ada: <URL:http://libre.act-europe.fr/adamode>
* Ada-mode: <URL:http://libre.act-europe.fr/adamode>
* Battery and Info Look: <URL:ftp://ftp.ul.bawue.de/pub/purple/emacs>
@ -80,6 +80,8 @@ You might find bug-fixes or enhancements in these places.
* Iswitchb: <URL:http://www.anc.ed.ac.uk/%7Estephen/emacs/iswitchb.el>
* MH-E: <URL:http://mh-e.sourceforge.net/>
* PC Selection: <URL:ftp://ftp.thp.uni-duisburg.de/pub/source/elisp/>
* PS mode: <URL:http://odur.let.rug.nl/%7Ekleiweg/postscript/>
@ -133,6 +135,12 @@ Several are for Debian GNU/Linux in particular.
emacs-mule, say by adding `("\\.bbdb\\'" . emacs-mule)' to
`file-coding-system-alist' for non-ASCII characters.]
* Boxquote: <URL:http://www.davep.org/emacs/>
* CEDET: Collection of Emacs Development Environment Tools, including
EIEIO, Semantic, Speedbar, EDE, and COGRE:
<URL:http://cedet.sourceforge.net/>
* CJK-emacs: Converting MULE-encoded text to TeX:
<URL:ftp://ctan.tug.org/tex-archive/language/chinese/CJK/> and
mirrors of the `CTAN' TeX archives.
@ -140,14 +148,13 @@ Several are for Debian GNU/Linux in particular.
* Dismal: spreadsheet:
<URL:http://acs.ist.psu.edu/dismal/dismal.html>
* ECB: Emacs Code Browser: <URL:http://ecb.sourceforge.net/>
* EDB: database: <URL:http://www.glug.org/people/ttn/software/edb/>
* Ee: categorizing information manager:
<URL:http://www.jurta.org/emacs/ee/>
* EIEIO (object system), ETalk (interface to Internet talk):
<URL:http://cedet.sourceforge.net/eieio.shtml>
* EFS: enhanced version of ange-ftp:
<URL:http://www-uk.hpl.hp.com/people/ange/efs>
Version 1.16 is said not to work properly with Emacs 20.
@ -156,12 +163,25 @@ Several are for Debian GNU/Linux in particular.
From GNU distribution mirrors. (Much of this functionality is now
in Emacs.)
* EMacro: <URL:http://emacro.sourceforge.net/>
EMacro is a portable configuration file that configures itself.
* Emacs statistical system (ESS): statistical programming within Emacs
<URL:http://ess.r-project.org>
* Emacspeak -- A Speech Output Subsystem For Emacs:
<URL:http://emacspeak.sourceforge.net/>
* Emacs-w3m : <URL:http://emacs-w3m.namazu.org/>
A simple Emacs interface to w3m, which is a text-mode
WWW browser
* Emacs Wiki Mode: <URL:http://mwolson.org/projects/EmacsWiki.html>
A wiki-like publishing tool and personal information manager
* ERC: IRC client:
<URL:http://www.emacswiki.org/cgi-bin/wiki?EmacsIRCClient>
* Gnuserv:
<URL:ftp://ftp.splode.com/pub/users/friedman/packages/fgnuserv-1.0.tar.gz>
Enhanced emacsclient/emacsserver. See also
@ -184,7 +204,7 @@ Several are for Debian GNU/Linux in particular.
Provides an interactive environment for manipulating an inferior
process running some form of Lisp.
* JDE: <URL:http://jdee.sunsite.dk/>
* JDEE: <URL:http://jdee.sunsite.dk/>
Provides a Java development environment for Emacs.
* Mule-UCS: Universal enCoding System:
@ -195,10 +215,25 @@ Several are for Debian GNU/Linux in particular.
`utf-translate-cjk' turned on.
* Mailcrypt:
<URL:http://www.pobox.com/%7Elbudney/linux/software/mailcrypt.html>
<URL:http://mailcrypt.sourceforge.net/>
PGP and GPG support. PGP isn't free software, but GPG, the GNU
Privacy Guard, is a free replacement <URL:http://www.gnupg.org/>.
* Mew: <URL:http://www.mew.org/>
A MIME mail reader for Emacs/XEmacs.
* MMM Mode: <URL:http://mmm-mode.sourceforge.net/>
MMM Mode is an emacs add-on package providing a minor mode that
allows Multiple Major Modes to coexist in one buffer.
* nXML Mode: New mode for XML:
<URL:http://www.thaiopensource.com/nxml-mode/>
nXML mode is an addon for GNU Emacs, which makes GNU Emacs into a
powerful XML editor.
* Planner Mode:
<URL:http://sacha.free.net.ph/notebook/wiki/PlannerMode.php>
* Pointers to MIME packages:
<URL:http://bmrc.berkeley.edu/%7Etrey/emacs/mime.html>
@ -208,6 +243,18 @@ Several are for Debian GNU/Linux in particular.
* PSGML: <URL:http://www.lysator.liu.se/projects/about_psgml.html>
DTD-aware serious SGML/XML editing.
* Quack: <URL:http://www.neilvandyke.org/quack/>
Quack enhances Emacs support for Scheme
* Remember:
<URL:http://sacha.free.net.ph/notebook/wiki/RememberEl.php>
* Session: <URL:http://emacs-session.sourceforge.net/>
Session Management for Emacs.
* SLIME: The Superior Lisp Interaction Mode for Emacs:
<URL:http://common-lisp.net/project/slime/>
* Tamago: Chinese/Japanese/Korean input method
<URL:ftp://m17n.org/pub/tamago/>
Emacs Lisp package to provide input methods for CJK characters.
@ -216,6 +263,8 @@ Several are for Debian GNU/Linux in particular.
Wnn6,
SJ3 Ver.2
* Tiny Tools: <URL:http://tiny-tools.sourceforge.net/>
* VM (View Mail): <URL:http://www.wonderworks.com/vm/> Alternative
mail reader. There is a VM newsgroup: <URL:news:gnu.emacs.vm.info>
@ -224,6 +273,14 @@ Several are for Debian GNU/Linux in particular.
<URL:news://sunsite.auc.dk/emacs.w3> and a W3 development mail
list/newsgroup <URL:news://sunsite.auc.dk/emacs.w3.dev>.
* Wanderlust: <URL:http://www.gohome.org/wl/>
Yet Another Message Interface on Emacsen. Wanderlust is a mail/news
reader supporting IMAP4rev1 for emacsen.
* WhizzyTex: <URL:http://pauillac.inria.fr/whizzytex/>
WhizzyTeX provides a minor mode for Emacs or XEmacs, a (bash)
shell-script daemon and some LaTeX macros.
* X-Symbol: <URL:http://x-symbol.sf.net/>
Quasi-WYSIWYG editing of TeX & al. (It will be improved to take
better advantage of Emacs 21 features.)

155
etc/NEWS
View File

@ -1,5 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 2003-05-21
Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
Free Software Foundation, Inc.
See the end for copying conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
@ -98,28 +99,50 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
** Emacs now responds to mouse-clicks on the mode-line, header-line and
display margin, when run in an xterm.
** M-SPC (just-one-space) when given a numeric argument N
converts whitespace around point to N spaces.
** Control characters and escape glyphs are now shown in the new
escape-glyph face.
** Non-breaking space and hyphens are now prefixed with an escape
character, unless the new user variable `show-nonbreak-escape' is set
to nil.
---
** The type-break package now allows `type-break-file-name' to be nil
and if so, doesn't store any data across sessions. This is handy if
you don't want the .type-break file in your home directory or are
annoyed by the need for interaction when you kill Emacs.
** display-battery has been replaced by display-battery-mode.
** calculator.el now has radix grouping mode, which is available when
`calculator-output-radix' is non-nil. In this mode a separator
character is used every few digits, making it easier to see byte
boundries etc. For more info, see the documentation of the variable
`calculator-radix-grouping-mode'.
+++
** You can now follow links by clicking Mouse-1 on the link.
Traditionally, Emacs uses a Mouse-1 click to set point and a Mouse-2
click to follow a link, whereas most other applications use a Mouse-1
click for both purposes, depending on whether you click outside or
inside a link. With release 21.4, the behaviour of a Mouse-1 click
has been changed to match this context-sentitive dual behaviour.
inside a link. Now the behavior of a Mouse-1 click has been changed
to match this context-sentitive dual behavior.
Depending on the current mode, a Mouse-2 click in Emacs may do much
more than just follow a link, so the new Mouse-1 behaviour is only
more than just follow a link, so the new Mouse-1 behavior is only
activated for modes which explicitly mark a clickable text as a "link"
(see the new function `mouse-on-link-p' for details). The lisp
(see the new function `mouse-on-link-p' for details). The Lisp
packages that are included in release 21.4 have been adapted to do
this, but external packages may not yet support this. However, there
is no risk in using such packages, as the worst thing that could
happen is that you get the original Mouse-1 behaviour when you click
happen is that you get the original Mouse-1 behavior when you click
on a link, which typically means that you set point where you click.
If you want to get the original Mouse-1 action also inside a link, you
@ -130,7 +153,7 @@ you release it).
Dragging the Mouse-1 inside a link still performs the original
drag-mouse-1 action, typically copy the text.
You can customize the new Mouse-1 behaviour via the new user option
You can customize the new Mouse-1 behavior via the new user option
`mouse-1-click-follows-link'.
+++
@ -153,8 +176,8 @@ modes do.
+++
** When the undo information of the current command gets really large
(beyond the value of `undo-outer-limit'), Emacs asks you whether to
discard it or keep it.
(beyond the value of `undo-outer-limit'), Emacs discards it and warns
you about it.
** line-move-ignore-invisible now defaults to t.
@ -191,6 +214,9 @@ existing values. For example:
will start up Emacs on an initial frame of 100x20 with red background,
irrespective of geometry or background setting on the Windows registry.
** The terminal emulation code in term.el has been improved, it can
run most curses applications now.
** New features in evaluation commands
+++
@ -333,6 +359,10 @@ can be saved and automatically revisited with the new Grep mode.
*** Grep commands now have their own submenu and customization group.
+++
*** `grep-find' is now also available under the name `find-grep' where
people knowing `find-grep-dired' would probably expect it.
*** The new variables `grep-window-height', `grep-auto-highlight', and
`grep-scroll-output' can be used to override the corresponding
compilation mode settings for grep commands.
@ -392,20 +422,30 @@ saving.
*** Buffers are saved in the desktop file in the same order as that in the
buffer list.
*** The desktop package can be customized to restore only some buffers immediately,
remaining buffers are restored lazily (when Emacs is idle).
*** New commands:
- desktop-revert reverts to the last loaded desktop.
- desktop-change-dir kills current desktop and loads a new.
- desktop-save-in-desktop-dir saves desktop in the directory from which
it was loaded.
- desktop-lazy-complete runs the desktop load to completion.
- desktop-lazy-abort aborts lazy loading of the desktop.
*** New customizable variables:
- desktop-save. Determins whether the desktop should be saved when it is
killed.
- desktop-file-name-format.
- desktop-file-name-format. Format in which desktop file names should be saved.
- desktop-path. List of directories in which to lookup the desktop file.
- desktop-locals-to-save.
- desktop-globals-to-clear.
- desktop-clear-preserve-buffers-regexp.
- desktop-locals-to-save. List of local variables to save.
- desktop-globals-to-clear. List of global variables that `desktop-clear' will clear.
- desktop-clear-preserve-buffers-regexp. Regexp identifying buffers that `desktop-clear'
should not delete.
- desktop-restore-eager. Number of buffers to restore immediately. Remaining buffers are
restored lazily (when Emacs is idle).
- desktop-lazy-verbose. Verbose reporting of lazily created buffers.
- desktop-lazy-idle-delay. Idle delay before starting to create buffers.
*** New command line option --no-desktop
@ -437,7 +477,7 @@ Instead, the newline now "overflows" into the right fringe, and the
cursor will be displayed in the fringe when positioned on that newline.
The new user option 'overflow-newline-into-fringe' may be set to nil to
revert to the old behaviour of continuing such lines.
revert to the old behavior of continuing such lines.
+++
** The buffer boundaries (i.e. first and last line in the buffer) may
@ -622,11 +662,6 @@ too. If you want to use just plain `*' as a wildcard, type `*""'; the
doublequotes make no difference in the shell, but they prevent
special treatment in `dired-do-shell-command'.
+++
*** Dired's v command now runs external viewers to view certain
types of files. The variable `dired-view-command-alist' controls
what external viewers to use and when.
*** In Dired, the w command now copies the current line's file name
into the kill ring. With a zero prefix arg, copies absolute file names.
@ -662,7 +697,7 @@ multiple files, and C-x d passes it to `dired'.
** Info mode:
*** A numeric prefix argument of `info' selects an Info buffer
with the number appended to the *info* buffer name.
with the number appended to the *info* buffer name (e.g. "*info*<2>").
*** Regexp isearch (C-M-s and C-M-r) can search through multiple nodes.
Failed isearch wraps to the top/final node.
@ -671,6 +706,10 @@ Failed isearch wraps to the top/final node.
`Info-search-backward', and `Info-search-next' which repeats the last
search without prompting for a new search string.
*** New command `Info-history-forward' (bound to r and new toolbar icon)
moves forward in history to the node you returned from after using
`Info-history-back' (renamed from `Info-last').
*** New command `Info-history' (bound to L) displays a menu of visited nodes.
*** New command `Info-toc' (bound to T) creates a node with table of contents
@ -1500,7 +1539,7 @@ directory listing into a buffer.
** Unexpected yanking of text due to accidental clicking on the mouse
wheel button (typically mouse-2) during wheel scrolling is now avoided.
This behaviour can be customized via the mouse-wheel-click-event and
This behavior can be customized via the mouse-wheel-click-event and
mouse-wheel-inhibit-click-time variables.
+++
@ -1830,7 +1869,7 @@ c-require-final-newline. That is a list of modes, and only those
modes set require-final-newline. By default that's C, C++ and
Objective-C.
The specified modes set require-final-newline based on
The specified modes set require-final-newline based on
mode-require-final-newline, as usual.
*** Format change for syntactic context elements.
@ -2093,6 +2132,14 @@ displays a buffer menu. This option turns the buffer menu off.
---
** Rmail now displays 5-digit message ids in its summary buffer.
+++
** Support for `movemail' from GNU mailutils was added to Rmail.
This version of `movemail' allows to read mail from a wide range of
mailbox formats, including remote POP3 and IMAP4 mailboxes with or
without TLS encryption. If GNU mailutils is installed on the system
and its version of `movemail' can be found in exec-path, it will be
used instead of the native one.
---
** On MS Windows, the "system caret" now follows the cursor.
This enables Emacs to work better with programs that need to track
@ -2324,7 +2371,7 @@ before calling it, if used while defining a macro.
In addition, when ending or calling a macro with C-x e, the macro can
be repeated immediately by typing just the `e'. You can customize
this behaviour via the variable kmacro-call-repeat-key and
this behavior via the variable kmacro-call-repeat-key and
kmacro-call-repeat-with-arg.
Keyboard macros can now be debugged and edited interactively.
@ -2426,8 +2473,33 @@ timing measurements of code (including the garbage collection component).
** `cfengine-mode' is a major mode for editing GNU Cfengine
configuration files.
* Incompatible Lisp Changes in Emacs 21.4
+++
** `suppress-keymap' now works by remapping `self-insert-command' to
the command `undefined'. (In earlier Emacs versions, it used
`substitute-key-definition' to rebind self inserting characters to
`undefined'.)
+++
** Mode line display ignores text properties as well as the
:propertize and :eval forms in the value of a variable whose
`risky-local-variable' property is nil.
* Lisp Changes in Emacs 21.4
** An element of buffer-undo-list can now have the form (FUNNAME .
ARGS), where FUNNAME is a symbol other than t or nil. That stands for
a high-level change that should be undone by evaluating (apply FUNNAME
ARGS).
+++
** The line-move, scroll-up, and scroll-down functions will now
modify the window vscroll to scroll through display rows that are
taller that the height of the window, for example in the presense of
large images. To disable this feature, Lisp code may bind the new
variable `auto-window-vscroll' to nil.
+++
** If a buffer sets buffer-save-without-query to non-nil,
save-some-buffers will always save that buffer without asking
@ -2460,9 +2532,9 @@ back the match can start; this is a way to keep it from taking too long.
+++
** New functions `make-progress-reporter', `progress-reporter-update',
`progress-reporter-force-update' and `progress-reporter-done' provide
a simple and efficient way for a command to present progress messages
for the user.
`progress-reporter-force-update', `progress-reporter-done', and
`dotimes-with-progress-reporter' provide a simple and efficient way for
a command to present progress messages for the user.
---
** To manipulate the File menu using easy-menu, you must specify the
@ -2612,7 +2684,7 @@ specified number of evenly sized slices (rows x columns).
A newline may now have line-height and line-spacing text or overlay
properties that control the height of the corresponding display row.
If the line-height property value is 0, the newline does not
If the line-height property value is t, the newline does not
contribute to the height of the display row; instead the height of the
newline glyph is reduced. Also, a line-spacing property on this
newline is ignored. This can be used to tile small images or image
@ -2626,10 +2698,19 @@ If the line-height property value is a float, the minimum line height
is calculated by multiplying the default frame line height by the
given value.
If the line-height property value is a cons (RATIO . FACE), the
If the line-height property value is a cons (FACE . RATIO), the
minimum line height is calculated as RATIO * height of named FACE.
RATIO is int or float. If FACE is t, it specifies the current face.
If the line-height property value is a cons (nil . RATIO), the line
height is calculated as RATIO * actual height of the line's contents.
If the line-height value is a cons (HEIGHT . TOTAL), HEIGHT specifies
the line height as described above, while TOTAL is any of the forms
described above and specifies the total height of the line, causing a
varying number of pixels to be inserted after the line to make it line
exactly that many pixels high.
If the line-spacing property value is an positive integer, the value
is used as additional pixels to insert after the display line; this
overrides the default frame line-spacing and any buffer local value of
@ -2638,11 +2719,6 @@ the line-spacing variable.
If the line-spacing property may be a float or cons, the line spacing
is calculated as specified above for the line-height property.
If the line-spacing value is a cons (total . SPACING) where SPACING is
any of the forms described above, the value of SPACING is used as the
total height of the line, i.e. a varying number of pixels are inserted
after each line to make each line exactly that many pixels high.
** The buffer local line-spacing variable may now have a float value,
which is used as a height relative to the default frame line height.
@ -3077,7 +3153,7 @@ created and can be changed later by `set-process-filter-multibyte'.
buffer is multibyte, the output of the process is at first converted
to multibyte by `string-to-multibyte' then inserted in the buffer.
Previously, it was converted to multibyte by `string-as-multibyte',
which was not compatible with the behaviour of file reading.
which was not compatible with the behavior of file reading.
+++
** New function `string-to-multibyte' converts a unibyte string to a
@ -3565,7 +3641,7 @@ elements with the following format:
The `insert-for-yank' function looks for a yank-handler property on
the first character on its string argument (typically the first
element on the kill-ring). If a yank-handler property is found,
the normal behaviour of `insert-for-yank' is modified in various ways:
the normal behavior of `insert-for-yank' is modified in various ways:
When FUNCTION is present and non-nil, it is called instead of `insert'
to insert the string. FUNCTION takes one argument--the object to insert.
@ -3653,7 +3729,7 @@ speech synthesis.
On some systems, when emacs reads the output from a subprocess, the
output data is read in very small blocks, potentially resulting in
very poor performance. This behaviour can be remedied to some extent
very poor performance. This behavior can be remedied to some extent
by setting the new variable process-adaptive-read-buffering to a
non-nil value (the default), as it will automatically delay reading
from such processes, to allowing them to produce more output before
@ -3849,11 +3925,6 @@ Reference manual for more detailed documentation.
** The new mode-line construct `(:propertize ELT PROPS...)' can be
used to add text properties to mode-line elements.
+++
** Mode line display ignores text properties as well as the
:propertize and :eval forms in the value of a variable whose
`risky-local-variable' property is nil.
+++
** The new `%i' and `%I' constructs for `mode-line-format' can be used
to display the size of the accessible part of the buffer on the mode
@ -4172,7 +4243,7 @@ By default `unify-8859-on-encoding-mode' is turned on.
If you want the old behavior, set selection-coding-system to
compound-text, which may be significantly more efficient. Using
compound-text-with-extensions seems to be necessary only for decoding
text from applications under XFree86 4.2, whose behaviour is actually
text from applications under XFree86 4.2, whose behavior is actually
contrary to the compound text specification.

16
etc/TODO
View File

@ -20,6 +20,13 @@ to the FSF.
** Redefine define-generic-mode as a macro, so the compiler
sees the definitions it generates.
** Change the way define-minor-mode handles autoloading.
It should not generate :require. Or :require in defcustom
should not be recorded in the user's custom-set-variables call.
** The buttons at the top of a custom buffer should not omit
variables whose values are currently hidden.
* Important features:
** Provide user-friendly ways to list all available font families,
@ -71,6 +78,12 @@ to the FSF.
* Other features we would like:
** A function to check for customizable options that have been
set but not saved, and ask the user whether to save them.
This could go in kill-emacs-query-functions, to remind people
to save their changes. If the user says yes, show them
in a Custom buffer using customize-customized.
** ange-ftp
*** understand sftp
*** Use MLS for ange-ftp-insert-directory if a list of files is specified.
@ -321,6 +334,9 @@ to the FSF.
"japanese". Currently, most Japanese users are using external
packages (e.g. tamago, anthy) or an input method via XIM.
** Provide the toolbar on ttys. This could map a bit like tmm-menubar
for the menubar and buttons could look a bit like those used by customize.
* Internal changes
** Replace gmalloc.c with the modified Doug Lea code from the current

1030
etc/TUTORIAL.nl
View File

File diff suppressed because it is too large Load Diff

4
lib-src/ChangeLog
View File

@ -1,3 +1,7 @@
2005-01-29 Richard M. Stallman <rms@gnu.org>
* movemail.c (popmail): Don't use Errmsg as format string.
2004-12-26 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* make-docfile.c: Include stdlib.h even if WINDOWSNT is not

2
lib-src/movemail.c
View File

@ -789,7 +789,7 @@ popmail (mailbox, outfile, preserve, password, reverse_order)
mbx_delimit_begin (mbf);
if (pop_retr (server, i, mbf) != OK)
{
error (Errmsg, 0, 0);
error ("%s", Errmsg, 0);
close (mbfi);
return EXIT_FAILURE;
}

1186
lisp/ChangeLog
View File

File diff suppressed because it is too large Load Diff

4
lisp/add-log.el
View File

@ -248,7 +248,9 @@ Note: The search is conducted only within 10%, at the beginning of the file."
("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face))
;;
;; Acknowledgements.
("\\(^\t\\| \\)\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
;; Don't include plain "From" because that is vague;
;; we want to encourage people to say something more specific.
("\\(^\t\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
2 'change-log-acknowledgement-face))
"Additional expressions to highlight in Change Log mode.")

17
lisp/battery.el
View File

@ -1,6 +1,6 @@
;;; battery.el --- display battery status information
;; Copyright (C) 1997, 1998, 2000, 2001, 2003, 2004
;; Copyright (C) 1997, 1998, 2000, 2001, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
@ -108,20 +108,23 @@ The text being displayed in the echo area is controlled by the variables
"Battery status not available")))
;;;###autoload
(defun display-battery ()
(define-minor-mode display-battery-mode
"Display battery status information in the mode line.
The text being displayed in the mode line is controlled by the variables
`battery-mode-line-format' and `battery-status-function'.
The mode line will be updated automatically every `battery-update-interval'
seconds."
(interactive)
:global t
(setq battery-mode-line-string "")
(or global-mode-string (setq global-mode-string '("")))
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(and battery-update-timer (cancel-timer battery-update-timer))
(setq battery-update-timer (run-at-time nil battery-update-interval
'battery-update-handler))
(battery-update))
(if (not display-battery-mode)
(setq global-mode-string
(delq 'battery-mode-line-string global-mode-string))
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(setq battery-update-timer (run-at-time nil battery-update-interval
'battery-update-handler))
(battery-update)))
(defun battery-update-handler ()
(battery-update)

12
lisp/bindings.el
View File

@ -1,7 +1,7 @@
;;; bindings.el --- define standard key bindings and some variables
;; Copyright (C) 1985,86,87,92,93,94,95,96,99,2000, 2001
;; Free Software Foundation, Inc.
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1999, 2000,
;; 2001, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@ -403,7 +403,7 @@ Menu of mode operations in the mode line.")
:button (:toggle . line-number-mode)))
(define-key mode-line-mode-menu [highlight-changes-mode]
`(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode
:button (:toggle . highlight-changes-mode)))
:button (:toggle . (bound-and-true-p highlight-changes-mode))))
(define-key mode-line-mode-menu [hide-ifdef-mode]
`(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
:button (:toggle . (bound-and-true-p hide-ifdef-mode))))
@ -421,10 +421,10 @@ Menu of mode operations in the mode line.")
:button (:toggle . column-number-mode)))
(define-key mode-line-mode-menu [auto-revert-tail-mode]
`(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode
:button (:toggle . auto-revert-tail-mode)))
:button (:toggle . (bound-and-true-p auto-revert-tail-mode))))
(define-key mode-line-mode-menu [auto-revert-mode]
`(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
:button (:toggle . auto-revert-mode)))
:button (:toggle . (bound-and-true-p auto-revert-mode))))
(define-key mode-line-mode-menu [auto-fill-mode]
`(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode
:button (:toggle . auto-fill-function)))
@ -1018,5 +1018,5 @@ language you are using."
;; no-update-autoloads: t
;; End:
;;; arch-tag: 23b5c7e6-e47b-49ed-8c6c-ed213c5fffe0
;; arch-tag: 23b5c7e6-e47b-49ed-8c6c-ed213c5fffe0
;;; bindings.el ends here

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

@ -690,7 +690,7 @@ in Calc algebraic input.")
math-exp-pos)
(or (eq math-exp-pos 0)
(and (memq calc-language '(nil flat big unform
tex eqn))
tex latex eqn))
(eq (string-match "[^])}\"a-zA-Z0-9'$]_"
math-exp-str (1- math-exp-pos))
(1- math-exp-pos))))))
@ -756,6 +756,34 @@ in Calc algebraic input.")
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-latex-ignore-words)))
(cond ((null code))
((null (cdr code))
(math-read-token))
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
((and (eq (nth 1 code) 'mat)
(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 math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\])))))))
((and (= ch ?\\) (eq calc-language 'latex)
(< math-exp-pos (1- (length math-exp-str))))
(or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
math-exp-str math-exp-pos)
(string-match "\\\\text *{\\([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))
@ -763,8 +791,23 @@ in Calc algebraic input.")
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
((and (eq (nth 1 code) 'mat)
(string-match " *{" math-exp-str math-exp-pos))
((and (eq (nth 1 code) 'begenv)
(string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
(setq math-exp-pos (match-end 0)
envname (match-string 1 math-exp-str)
math-exp-token 'punc
math-expr-data "[")
(cond ((or (string= envname "matrix")
(string= envname "bmatrix")
(string= envname "smallmatrix")
(string= envname "pmatrix"))
(if (setq j (string-match (concat "\\\\end{" envname "}")
math-exp-str math-exp-pos))
(setq math-exp-str
(replace-match "]" t t math-exp-str))
(error "%s" (concat "No closing \\end{" envname "}"))))))
((and (eq (nth 1 code) 'mat)
(string-match " *{" math-exp-str math-exp-pos))
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
@ -800,11 +843,11 @@ in Calc algebraic input.")
(setq math-exp-pos (match-end 0))
(math-read-token))
(t
(if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
(if (and (eq ch ?\{) (memq calc-language '(tex latex eqn)))
(setq ch ?\())
(if (and (eq ch ?\}) (memq calc-language '(tex eqn)))
(if (and (eq ch ?\}) (memq calc-language '(tex latex eqn)))
(setq ch ?\)))
(if (and (eq ch ?\&) (eq calc-language 'tex))
(if (and (eq ch ?\&) (memq calc-language '(tex latex)))
(setq ch ?\,))
(setq math-exp-token 'punc
math-expr-data (char-to-string ch)

12
lisp/calc/calc-embed.el
View File

@ -48,11 +48,11 @@
(defvar calc-embedded-some-active nil)
(make-variable-buffer-local 'calc-embedded-some-active)
(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
"*A regular expression for the opening delimiter of a formula used by
calc-embedded.")
(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
"*A regular expression for the closing delimiter of a formula used by
calc-embedded.")
@ -308,10 +308,10 @@ This is not required to be present for user-written mode annotations.")
(calc-show-edit-buffer))
(defvar calc-original-buffer)
(defvar calc-edit-top)
(defun calc-embedded-finish-edit (info)
(let ((buf (current-buffer))
(str (buffer-substring (point) (point-max)))
(str (buffer-substring calc-edit-top (point-max)))
(start (point))
pos)
(switch-to-buffer calc-original-buffer)
@ -417,6 +417,8 @@ With any prefix argument, marks only the formula itself."
(forward-char -1))
(setq calc-embed-outer-top (point))
(goto-char (match-end 0))
(if (looking-at "[ \t]*$")
(end-of-line))
(if (eq (following-char) ?\n)
(forward-char 1))
(or (bolp)
@ -885,7 +887,7 @@ The command \\[yank] can retrieve it from there."
(list 'calcFunc-assign
(nth 1 x)
(calc-embedded-subst (nth 2 x)))
(calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x))))))
(calc-normalize (math-evaluate-expr-rec (math-multi-subst x nil nil))))))
(defun calc-embedded-eval-get-var (var base)
(let ((entry base)

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

@ -217,6 +217,7 @@
(define-key calc-mode-map "dO" 'calc-flat-language)
(define-key calc-mode-map "dP" 'calc-pascal-language)
(define-key calc-mode-map "dT" 'calc-tex-language)
(define-key calc-mode-map "dL" 'calc-latex-language)
(define-key calc-mode-map "dU" 'calc-unformatted-language)
(define-key calc-mode-map "dW" 'calc-maple-language)
(define-key calc-mode-map "d[" 'calc-truncate-up)
@ -998,7 +999,7 @@ calc-keypad-press)
("calc-lang" calc-big-language calc-c-language calc-eqn-language
calc-flat-language calc-fortran-language calc-maple-language
calc-mathematica-language calc-normal-language calc-pascal-language
calc-tex-language calc-unformatted-language)
calc-tex-language calc-latex-language calc-unformatted-language)
("calc-map" calc-accumulate calc-apply calc-inner-product calc-map
calc-map-equation calc-map-stack calc-outer-product calc-reduce)
@ -1240,36 +1241,54 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-reset (arg)
(interactive "P")
(save-excursion
(or (eq major-mode 'calc-mode)
(calc-create-buffer))
(if calc-embedded-info
(calc-embedded nil))
(or arg
(setq calc-stack nil))
(setq calc-undo-list nil
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
(mapcar (function (lambda (v) (set v nil))) calc-local-var-list)
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
calc-mode-var-list))
(calc-set-language nil nil t)
(calc-mode)
(calc-flush-caches t)
(run-hooks 'calc-reset-hook))
(calc-wrapper
(let ((win (get-buffer-window (current-buffer))))
(calc-realign 0)
(if win
(let ((height (- (window-height win) 2)))
(set-window-point win (point))
(or (= height calc-window-height)
(let ((swin (selected-window)))
(select-window win)
(enlarge-window (- calc-window-height height))
(select-window swin)))))))
(message "(Calculator reset)"))
(setq arg (if arg (prefix-numeric-value arg) nil))
(cond
((and
calc-embedded-info
(equal (aref calc-embedded-info 0) (current-buffer))
(<= (point) (aref calc-embedded-info 5))
(>= (point) (aref calc-embedded-info 4)))
(let ((cbuf (aref calc-embedded-info 1))
(calc-embedded-quiet t))
(save-window-excursion
(calc-embedded nil)
(set-buffer cbuf)
(calc-reset arg))
(calc-embedded nil)))
((eq major-mode 'calc-mode)
(save-excursion
(unless (and arg (> (abs arg) 0))
(setq calc-stack nil))
(setq calc-undo-list nil
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
(mapcar (function (lambda (v) (set v nil))) calc-local-var-list)
(if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values)))
(calc-set-language nil nil t)
(calc-mode)
(calc-flush-caches t)
(run-hooks 'calc-reset-hook))
(calc-wrapper
(let ((win (get-buffer-window (current-buffer))))
(calc-realign 0)
;; Adjust the window height if the window is visible, but doesn't
;; take up the whole height of the frame.
(if (and
win
(< (window-height win) (1- (frame-height))))
(let ((height (- (window-height win) 2)))
(set-window-point win (point))
(or (= height calc-window-height)
(let ((swin (selected-window)))
(select-window win)
(enlarge-window (- calc-window-height height))
(select-window swin)))))))
(message "(Calculator reset)"))
(t
(message "(Not inside a Calc buffer)"))))
;; What a pain; scroll-left behaves differently when called non-interactively.
(defun calc-scroll-left (n)
@ -1376,10 +1395,14 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-fancy-prefix-other-key (arg)
(interactive "P")
(if (or (not (integerp last-command-char))
(and (>= last-command-char 0) (< last-command-char ? )
(not (eq last-command-char meta-prefix-char))))
(if (and
(not (eq last-command-char 'tab))
(not (eq last-command-char 'M-tab))
(or (not (integerp last-command-char))
(and (>= last-command-char 0) (< last-command-char ? )
(not (eq last-command-char meta-prefix-char)))))
(calc-wrapper)) ; clear flags if not a Calc command.
(setq prefix-arg arg)
(calc-unread-command)
(setq overriding-terminal-local-map nil))
@ -2924,13 +2947,13 @@ calc-kill calc-kill-region calc-yank))))
(setq str (concat (substring str 0 (match-beginning 0))
(substring str (match-end 0)))))
(if (string-match "\\\\[^ \n|]" str)
(if (eq calc-language 'tex)
(if (eq calc-language 'latex)
(math-read-expr str)
(let ((calc-language 'tex)
(let ((calc-language 'latex)
(calc-language-option nil)
(math-expr-opers (get 'tex 'math-oper-table))
(math-expr-function-mapping (get 'tex 'math-function-table))
(math-expr-variable-mapping (get 'tex 'math-variable-table)))
(math-expr-opers (get 'latex 'math-oper-table))
(math-expr-function-mapping (get 'latex 'math-function-table))
(math-expr-variable-mapping (get 'latex 'math-variable-table)))
(math-read-expr str)))
(let ((math-read-big-lines nil)
(pos 0)

20
lisp/calc/calc-help.el
View File

@ -178,15 +178,15 @@ C-w Describe how there is no warranty for Calc."
(if (= (buffer-size) 0)
(progn
(message "Reading Calc summary from manual...")
(save-window-excursion
(save-excursion
(calc-info-goto-node "Summary")
(goto-char (point-min))
(forward-line 1)
(copy-to-buffer "*Calc Summary*"
(point) (point-max))
(if Info-history
(Info-last))))))
(require 'info nil t)
(with-temp-buffer
(Info-mode)
(Info-goto-node "(Calc)Summary")
(goto-char (point-min))
(forward-line 1)
(copy-to-buffer "*Calc Summary*"
(point) (point-max)))
(setq buffer-read-only t)))
(goto-char (point-min))
(setq case-fold-search nil)
(re-search-forward "^\\(.*\\)\\[\\.\\. a b")
@ -593,7 +593,7 @@ C-w Describe how there is no warranty for Calc."
"Why; Line-nums, line-Breaks; <, =, > (justify); Plain"
"\" (strings); Truncate, [, ]; SPC (refresh), RET, @"
"SHIFT + language: Normal, One-line, Big, Unformatted"
"SHIFT + language: C, Pascal, Fortran; TeX, Eqn"
"SHIFT + language: C, Pascal, Fortran; TeX, LaTeX, Eqn"
"SHIFT + language: Mathematica, W=Maple")
"display" ?d))

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

@ -36,6 +36,7 @@
(defun calc-set-language (lang &optional option no-refresh)
(setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
math-expr-function-mapping (get lang 'math-function-table)
math-expr-special-function-mapping (get lang 'math-special-function-table)
math-expr-variable-mapping (get lang 'math-variable-table)
calc-language-input-filter (get lang 'math-input-filter)
calc-language-output-filter (get lang 'math-output-filter)
@ -296,6 +297,26 @@
"TeX language mode with \\func{\\hbox{var}}")
"TeX language mode"))))
(defun calc-latex-language (n)
(interactive "P")
(calc-wrapper
(and n (setq n (prefix-numeric-value n)))
(calc-set-language 'latex n)
(cond ((not n)
(message "LaTeX language mode"))
((= n 0)
(message "LaTeX language mode with multiline matrices"))
((= n 1)
(message "LaTeX language mode with \\text{func}(\\text{var})"))
((> n 1)
(message
"LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
((= n -1)
(message "LaTeX language mode with \\func(\\text{var})"))
((< n -1)
(message
"LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
(put 'tex 'math-oper-table
'( ( "u+" ident -1 1000 )
( "u-" neg -1 1000 )
@ -406,6 +427,80 @@
str)
(put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'latex 'math-oper-table
(append (get 'tex 'math-oper-table)
'(( "\\Hat" calcFunc-Hat -1 950 )
( "\\Check" calcFunc-Check -1 950 )
( "\\Tilde" calcFunc-Tilde -1 950 )
( "\\Acute" calcFunc-Acute -1 950 )
( "\\Grave" calcFunc-Grave -1 950 )
( "\\Dot" calcFunc-Dot -1 950 )
( "\\Ddot" calcFunc-Dotdot -1 950 )
( "\\Breve" calcFunc-Breve -1 950 )
( "\\Bar" calcFunc-Bar -1 950 )
( "\\Vec" calcFunc-VEC -1 950 )
( "\\dddot" calcFunc-dddot -1 950 )
( "\\ddddot" calcFunc-ddddot -1 950 )
( "\div" / 170 171 )
( "\\le" calcFunc-leq 160 161 )
( "\\leqq" calcFunc-leq 160 161 )
( "\\leqsland" calcFunc-leq 160 161 )
( "\\ge" calcFunc-geq 160 161 )
( "\\geqq" calcFunc-geq 160 161 )
( "\\geqslant" calcFunc-geq 160 161 )
( "=" calcFunc-eq 160 161 )
( "\\neq" calcFunc-neq 160 161 )
( "\\ne" calcFunc-neq 160 161 )
( "\\lnot" calcFunc-lnot -1 121 )
( "\\land" calcFunc-land 110 111 )
( "\\lor" calcFunc-lor 100 101 )
( "?" (math-read-if) 91 90 )
( "!!!" calcFunc-pnot -1 85 )
( "&&&" calcFunc-pand 80 81 )
( "|||" calcFunc-por 75 76 )
( "\\gets" calcFunc-assign 51 50 )
( ":=" calcFunc-assign 51 50 )
( "::" calcFunc-condition 45 46 )
( "\\to" calcFunc-evalto 40 41 )
( "\\to" calcFunc-evalto 40 -1 )
( "=>" calcFunc-evalto 40 41 )
( "=>" calcFunc-evalto 40 -1 ))))
(put 'latex 'math-function-table
(append
(get 'tex 'math-function-table)
'(( \\frac . (math-latex-parse-frac /))
( \\tfrac . (math-latex-parse-frac /))
( \\dfrac . (math-latex-parse-frac /))
( \\binom . (math-latex-parse-frac calcFunc-choose))
( \\tbinom . (math-latex-parse-frac calcFunc-choose))
( \\dbinom . (math-latex-parse-frac calcFunc-choose))
( \\phi . calcFunc-totient )
( \\mu . calcFunc-moebius ))))
(put 'latex 'math-special-function-table
'((/ . (math-latex-print-frac "\\frac"))
(calcFunc-choose . (math-latex-print-frac "\\binom"))))
(put 'latex 'math-variable-table
(get 'tex 'math-variable-table))
(put 'latex 'math-complex-format 'i)
(defun math-latex-parse-frac (f val)
(let (numer denom)
(setq args (math-read-expr-list))
(math-read-token)
(setq margs (math-read-factor))
(list (nth 2 f) (car args) margs)))
(defun math-latex-print-frac (a fn)
(list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1)
"}{"
(math-compose-expr (nth 2 a) -1)
"}"))
(put 'latex 'math-input-filter 'math-tex-input-filter)
(defun calc-eqn-language (n)
(interactive "P")

11
lisp/calc/calc-mode.el
View File

@ -309,25 +309,22 @@
(defun calc-settings-file-name (name &optional arg)
(interactive
(list (read-file-name (format "Settings file name (normally %s): "
(abbreviate-file-name (or user-init-file
"~/.emacs"))))
(abbreviate-file-name calc-settings-file)))
current-prefix-arg))
(calc-wrapper
(setq arg (if arg (prefix-numeric-value arg) 0))
(if (equal name "")
(if (string-equal (file-name-nondirectory name) "")
(message "Calc settings file is \"%s\"" calc-settings-file)
(if (< (math-abs arg) 2)
(let ((list calc-mode-var-list))
(while list
(set (car (car list)) (nth 1 (car list)))
(setq list (cdr list)))))
;; FIXME: we should use ~/.calc or so in order to avoid
;; reexecuting ~/.emacs (it's not always idempotent) -cgw 2001.11.12
(setq calc-settings-file name)
(or (and
calc-settings-file
(string-match "\\.emacs" calc-settings-file)
(> arg 0))
(equal user-init-file calc-settings-file)
(> arg 0))
(< arg 0)
(load name t)
(message "New file")))))

364
lisp/calc/calc-prog.el
View File

@ -474,9 +474,10 @@
(let ((lang calc-language))
(calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
t
(format "Editing %s-Mode Syntax Table"
(format "Editing %s-Mode Syntax Table. "
(cond ((null lang) "Normal")
((eq lang 'tex) "TeX")
((eq lang 'latex) "LaTeX")
(t (capitalize (symbol-name lang))))))
(calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
lang)))
@ -519,7 +520,7 @@
(cond ((stringp (car p))
(let ((s (car p)))
(if (and (string-match "\\`\\\\dots\\>" s)
(not (eq calc-lang 'tex)))
(not (eq calc-lang '(tex latex))))
(setq s (concat ".." (substring s 5))))
(if (or (and (string-match
"[a-zA-Z0-9\"{}]\\|\\`:=\\'\\|\\`#\\|\\`%%" s)
@ -582,11 +583,11 @@
(defun calc-fix-token-name (name &optional unquoted)
(cond ((string-match "\\`\\.\\." name)
(concat "\\dots" (substring name 2)))
((and (equal name "{") (memq calc-lang '(tex eqn)))
((and (equal name "{") (memq calc-lang '(tex latex eqn)))
"(")
((and (equal name "}") (memq calc-lang '(tex eqn)))
((and (equal name "}") (memq calc-lang '(tex latex eqn)))
")")
((and (equal name "&") (eq calc-lang 'tex))
((and (equal name "&") (eq calc-lang '(tex latex)))
",")
((equal name "#")
(search-backward "#")
@ -660,7 +661,6 @@
(list '\? (list (car last)) '("$$"))))))))
part))
(defun calc-user-define-invocation ()
(interactive)
(or last-kbd-macro
@ -668,9 +668,8 @@
(setq calc-invocation-macro last-kbd-macro)
(message "Use `M-# Z' to invoke this macro"))
(defun calc-user-define-edit (prefix)
(interactive "P") ; but no calc-wrapper!
(defun calc-user-define-edit ()
(interactive) ; but no calc-wrapper!
(message "Edit definition of command: z-")
(let* ((key (read-char))
(def (or (assq key (calc-user-key-map))
@ -678,118 +677,267 @@
(assq (downcase key) (calc-user-key-map))
(error "No command defined for that key")))
(cmd (cdr def)))
(if (symbolp cmd)
(setq cmd (symbol-function cmd)))
(when (symbolp cmd)
(setq cmdname (symbol-name cmd))
(setq cmd (symbol-function cmd)))
(cond ((or (stringp cmd)
(and (consp cmd)
(eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
(if (and (>= (prefix-numeric-value prefix) 0)
(fboundp 'edit-kbd-macro)
(symbolp (cdr def))
(eq major-mode 'calc-mode))
(progn
(if (and (< (window-width) (frame-width))
calc-display-trail)
(let ((win (get-buffer-window (calc-trail-buffer))))
(if win
(delete-window win))))
(edit-kbd-macro (cdr def) prefix nil
(function
(lambda (x)
(and calc-display-trail
(calc-wrapper
(calc-trail-display 1 t)))))
(function
(lambda (cmd)
(if (stringp (symbol-function cmd))
(symbol-function cmd)
(let ((mac (nth 1 (nth 3 (symbol-function
cmd)))))
(if (vectorp mac)
(aref mac 1)
mac)))))
(function
(lambda (new cmd)
(if (stringp (symbol-function cmd))
(fset cmd new)
(let ((mac (cdr (nth 3 (symbol-function
cmd)))))
(if (vectorp (car mac))
(progn
(aset (car mac) 0
(key-description new))
(aset (car mac) 1 new))
(setcar mac new))))))))
(let ((keys (progn (and (fboundp 'edit-kbd-macro)
(edit-kbd-macro nil))
(fboundp 'edmacro-parse-keys))))
(calc-wrapper
(calc-edit-mode (list 'calc-finish-macro-edit
(list 'quote def)
keys)
t)
(if keys
(let (top
(fill-column 70)
(fill-prefix nil))
(insert "Notations: RET, SPC, TAB, DEL, LFD, NUL"
", C-xxx, M-xxx.\n\n")
(setq top (point))
(insert (if (stringp cmd)
(key-description cmd)
(if (vectorp (nth 1 (nth 3 cmd)))
(aref (nth 1 (nth 3 cmd)) 0)
(key-description (nth 1 (nth 3 cmd)))))
"\n")
(if (>= (prog2 (forward-char -1)
(current-column)
(forward-char 1))
(frame-width))
(fill-region top (point))))
(insert "Press C-q to quote control characters like RET"
" and TAB.\n"
(if (stringp cmd)
cmd
(if (vectorp (nth 1 (nth 3 cmd)))
(aref (nth 1 (nth 3 cmd)) 1)
(nth 1 (nth 3 cmd)))))))
(calc-show-edit-buffer)
(forward-line (if keys 2 1)))))
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
(kys (nth 3 (nth 3 cmd))))
(calc-edit-mode
(list 'calc-edit-macro-finish-edit cmdname kys)
t (format (concat
"Editing keyboard macro (%s, bound to %s).\n"
"Original keys: %s \n")
cmdname kys (elt (nth 1 (nth 3 cmd)) 0)))
(insert str "\n")
(calc-edit-format-macro-buffer)
(calc-show-edit-buffer)))
(t (let* ((func (calc-stack-command-p cmd))
(defn (and func
(symbolp func)
(get func 'calc-user-defn))))
(get func 'calc-user-defn)))
(kys (concat "z" (char-to-string (car def))))
(intcmd (symbol-name (cdr def)))
(algcmd (substring (symbol-name func) 9)))
(if (and defn (calc-valid-formula-func func))
(progn
(let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
(calc-edit-mode (list 'calc-finish-formula-edit
(list 'quote func)))
(insert (math-showing-full-precision
(math-format-nice-expr defn (frame-width)))
"\n"))
(calc-edit-mode
(list 'calc-finish-formula-edit (list 'quote func))
nil
(format (concat
"Editing formula (%s, %s, bound to %s).\n"
"Original formula: %s\n")
intcmd algcmd kys niceexpr))
(insert (math-showing-full-precision
niceexpr)
"\n"))
(calc-show-edit-buffer))
(error "That command's definition cannot be edited")))))))
(defun calc-finish-macro-edit (def keys)
(forward-line 1)
(if (and keys (looking-at "\n")) (forward-line 1))
(let* ((true-str (buffer-substring (point) (point-max)))
(str true-str))
(if keys (setq str (edmacro-parse-keys str)))
(if (symbolp (cdr def))
(if (stringp (symbol-function (cdr def)))
(fset (cdr def) str)
(let ((mac (cdr (nth 3 (symbol-function (cdr def))))))
(if (vectorp (car mac))
(progn
(aset (car mac) 0 (if keys true-str (key-description str)))
(aset (car mac) 1 str))
(setcar mac str))))
(setcdr def str))))
;; Formatting the macro buffer
(defun calc-edit-macro-repeats ()
(goto-char calc-edit-top)
(while
(re-search-forward "^\\([0-9]+\\)\\*" nil t)
(setq num (string-to-int (match-string 1)))
(setq line (buffer-substring (point) (line-end-position)))
(goto-char (line-beginning-position))
(kill-line 1)
(while (> num 0)
(insert line "\n")
(setq num (1- num)))))
(defun calc-edit-macro-adjust-buffer ()
(calc-edit-macro-repeats)
(goto-char calc-edit-top)
(while (re-search-forward "^RET$" nil t)
(delete-char 1))
(goto-char calc-edit-top)
(while (and (re-search-forward "^$" nil t)
(not (= (point) (point-max))))
(delete-char 1)))
(defun calc-edit-macro-command ()
"Return the command on the current line in a Calc macro editing buffer."
(let ((beg (line-beginning-position))
(end (save-excursion
(if (search-forward ";;" (line-end-position) 1)
(forward-char -2))
(skip-chars-backward " \t")
(point))))
(buffer-substring beg end)))
(defun calc-edit-macro-command-type ()
"Return the type of command on the current line in a Calc macro editing buffer."
(let ((beg (save-excursion
(if (search-forward ";;" (line-end-position) t)
(progn
(skip-chars-forward " \t")
(point)))))
(end (save-excursion
(goto-char (line-end-position))
(skip-chars-backward " \t")
(point))))
(if beg
(buffer-substring beg end)
"")))
(defun calc-edit-macro-combine-alg-ent ()
"Put an entire algebraic entry on a single line."
(let ((line (calc-edit-macro-command))
(type (calc-edit-macro-command-type))
curline
match)
(goto-char (line-beginning-position))
(kill-line 1)
(setq curline (calc-edit-macro-command))
(while (and curline
(not (string-equal "RET" curline))
(not (setq match (string-match "<return>" curline))))
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string "SPC" " SPC "
(replace-regexp-in-string " " "" line)))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
(insert ";; " type "\n")
(if match
(insert "RET\t\t\t;; calc-enter\n"))))
(defun calc-edit-macro-combine-ext-command ()
"Put an entire extended command on a single line."
(let ((cmdbeg (calc-edit-macro-command))
(line "")
(type (calc-edit-macro-command-type))
curline
match)
(goto-char (line-beginning-position))
(kill-line 1)
(setq curline (calc-edit-macro-command))
(while (and curline
(not (string-equal "RET" curline))
(not (setq match (string-match "<return>" curline))))
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
(insert cmdbeg " " line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
(insert ";; " type "\n")
(if match
(insert "RET\t\t\t;; calc-enter\n"))))
(defun calc-edit-macro-combine-var-name ()
"Put an entire variable name on a single line."
(let ((line (calc-edit-macro-command))
curline
match)
(goto-char (line-beginning-position))
(kill-line 1)
(if (member line '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
(insert line "\t\t\t;; calc quick variable\n")
(setq curline (calc-edit-macro-command))
(while (and curline
(not (string-equal "RET" curline))
(not (setq match (string-match "<return>" curline))))
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
(insert ";; calc variable\n")
(if match
(insert "RET\t\t\t;; calc-enter\n")))))
(defun calc-edit-macro-combine-digits ()
"Put an entire sequence of digits on a single line."
(let ((line (calc-edit-macro-command))
curline)
(goto-char (line-beginning-position))
(kill-line 1)
(while (string-equal (calc-edit-macro-command-type) "calcDigit-start")
(setq line (concat line (calc-edit-macro-command)))
(kill-line 1))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
(insert ";; calc digits\n")))
(defun calc-edit-format-macro-buffer ()
"Rewrite the Calc macro editing buffer."
(calc-edit-macro-adjust-buffer)
(goto-char calc-edit-top)
(let ((type (calc-edit-macro-command-type)))
(while (not (string-equal type ""))
(cond
((or
(string-equal type "calc-algebraic-entry")
(string-equal type "calc-auto-algebraic-entry"))
(calc-edit-macro-combine-alg-ent))
((string-equal type "calc-execute-extended-command")
(calc-edit-macro-combine-ext-command))
((string-equal type "calcDigit-start")
(calc-edit-macro-combine-digits))
((or
(string-equal type "calc-store")
(string-equal type "calc-store-into")
(string-equal type "calc-store-neg")
(string-equal type "calc-store-plus")
(string-equal type "calc-store-minus")
(string-equal type "calc-store-div")
(string-equal type "calc-store-times")
(string-equal type "calc-store-power")
(string-equal type "calc-store-concat")
(string-equal type "calc-store-inv")
(string-equal type "calc-store-dec")
(string-equal type "calc-store-incr")
(string-equal type "calc-store-exchange")
(string-equal type "calc-unstore")
(string-equal type "calc-recall")
(string-equal type "calc-let")
(string-equal type "calc-permanent-variable"))
(forward-line 1)
(calc-edit-macro-combine-var-name))
((or
(string-equal type "calc-copy-variable")
(string-equal type "calc-declare-variable"))
(forward-line 1)
(calc-edit-macro-combine-var-name)
(calc-edit-macro-combine-var-name))
(t (forward-line 1)))
(setq type (calc-edit-macro-command-type))))
(goto-char calc-edit-top))
;; Finish editing the macro
(defun calc-edit-macro-pre-finish-edit ()
(goto-char calc-edit-top)
(while (re-search-forward "\\(^\\| \\)RET\\($\\|\t\\| \\)" nil t)
(search-backward "RET")
(delete-char 3)
(insert "<return>")))
(defvar calc-edit-top)
(defun calc-edit-macro-finish-edit (cmdname key)
"Finish editing a Calc macro.
Redefine the corresponding command."
(interactive)
(let ((cmd (intern cmdname)))
(calc-edit-macro-pre-finish-edit)
(let* ((str (buffer-substring calc-edit-top (point-max)))
(mac (edmacro-parse-keys str t)))
(if (= (length mac) 0)
(fmakunbound cmd)
(fset cmd
(list 'lambda '(arg)
'(interactive "P")
(list 'calc-execute-kbd-macro
(vector (key-description mac)
mac)
'arg key)))))))
(defun calc-finish-formula-edit (func)
(let ((buf (current-buffer))
(str (buffer-substring (point) (point-max)))
(str (buffer-substring calc-edit-top (point-max)))
(start (point))
(body (calc-valid-formula-func func)))
(set-buffer calc-original-buffer)
@ -979,6 +1127,8 @@
(calc-execute-kbd-macro last-kbd-macro arg))
(defun calc-execute-kbd-macro (mac arg &rest prefix)
(if calc-keep-args-flag
(calc-keep-args))
(if (and (vectorp mac) (> (length mac) 0) (stringp (aref mac 0)))
(setq mac (or (aref mac 1)
(aset mac 1 (progn (and (fboundp 'edit-kbd-macro)

3
lisp/calc/calc-sel.el
View File

@ -677,10 +677,11 @@
;; The variable calc-edit-disp-trail is local to calc-edit-finish,
;; in calc-yank.el.
(defvar calc-edit-disp-trail)
(defvar calc-edit-top)
(defun calc-finish-selection-edit (num sel reselect)
(let ((buf (current-buffer))
(str (buffer-substring (point) (point-max)))
(str (buffer-substring calc-edit-top (point-max)))
(start (point)))
(switch-to-buffer calc-original-buffer)
(let ((val (math-read-expr str)))

4
lisp/calc/calc-store.el
View File

@ -397,7 +397,7 @@
(setq calc-last-edited-variable var)
(calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
t
(concat "Editing " (calc-var-name var)))
(concat "Editing variable `" (calc-var-name var) "'. "))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))
@ -482,7 +482,7 @@
(setq rp nil)))
(not rp)))))
(calc-unread-command ?\C-a)
(setq decl (read-string (format "Declare: %s to be: " var)
(setq decl (read-string (format "Declare: %s to be: " (calc-var-name var))
(and rp
(math-format-flat-expr (nth 2 (car dp)) 0))))
(setq decl (and (string-match "[^ \t]" decl)

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

@ -30,6 +30,8 @@
(require 'calc-ext)
(require 'calc-macs)
(eval-when-compile
(require 'calc-alg))
;;; Units operations.

26
lisp/calc/calc-yank.el
View File

@ -430,6 +430,7 @@
(defvar calc-edit-handler)
(defvar calc-restore-trail)
(defvar calc-allow-ret)
(defvar calc-edit-top)
(defun calc-edit-mode (&optional handler allow-ret title)
"Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
@ -459,15 +460,21 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
(make-local-variable 'calc-allow-ret)
(setq calc-allow-ret allow-ret)
(erase-buffer)
(let ((inhibit-read-only t))
(erase-buffer))
(add-hook 'kill-buffer-hook (lambda ()
(let ((calc-edit-handler nil))
(calc-edit-finish t))
(message "(Cancelled)")) t t)
(insert (or title title "Calc Edit Mode")
". Press `C-c C-c'"
(if allow-ret "" " or RET")
" to finish, `C-x k RET' to cancel.\n")))
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
"Press `C-c C-c'"
(if allow-ret "" " or RET")
" to finish, `C-x k RET' to cancel.\n\n")
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
(make-local-variable 'calc-edit-top)
(setq calc-edit-top (point))))
(put 'calc-edit-mode 'mode-class 'special)
(defun calc-show-edit-buffer ()
@ -484,8 +491,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(if win
(delete-window win))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(forward-line 1)))
(goto-char calc-edit-top)))
(defun calc-edit-return ()
(interactive)
@ -519,9 +525,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(set-buffer original)
(not (eq major-mode 'calc-mode))))
(error "Original calculator buffer has been corrupted")))
(goto-char (point-min))
(when (looking-at "Calc Edit\\|Editing ")
(forward-line 1))
(goto-char calc-edit-top)
(if (buffer-modified-p)
(eval calc-edit-handler))
(if one-window
@ -546,7 +550,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(defun calc-finish-stack-edit (num)
(let ((buf (current-buffer))
(str (buffer-substring (point) (point-max)))
(str (buffer-substring calc-edit-top (point-max)))
(start (point))
pos)
(if (and (integerp num) (> num 1))

376
lisp/calc/calc.el
View File

@ -206,8 +206,8 @@
(require 'calc-macs)
;;;###autoload
(defvar calc-settings-file user-init-file
"*File in which to record permanent settings; default is `user-init-file'.")
(defvar calc-settings-file (convert-standard-filename "~/.calc.el")
"*File in which to record permanent settings.")
(defvar calc-bug-address "belanger@truman.edu"
"Address of the author of Calc, for use by `report-calc-bug'.")
@ -241,128 +241,102 @@ scientific notation in calc-mode.")
(defvar calc-loaded-settings-file nil
"t if `calc-settings-file' has been loaded yet.")
(defvar calc-always-load-extensions)
(defvar calc-line-numbering)
(defvar calc-line-breaking)
(defvar calc-display-just)
(defvar calc-display-origin)
(defvar calc-number-radix)
(defvar calc-leading-zeros)
(defvar calc-group-digits)
(defvar calc-group-char)
(defvar calc-point-char)
(defvar calc-frac-format)
(defvar calc-prefer-frac)
(defvar calc-hms-format)
(defvar calc-date-format)
(defvar calc-float-format)
(defvar calc-full-float-format)
(defvar calc-complex-format)
(defvar calc-complex-mode)
(defvar calc-infinite-mode)
(defvar calc-display-strings)
(defvar calc-matrix-just)
(defvar calc-break-vectors)
(defvar calc-full-vectors)
(defvar calc-full-trail-vectors)
(defvar calc-vector-commas)
(defvar calc-vector-brackets)
(defvar calc-matrix-brackets)
(defvar calc-language)
(defvar calc-language-option)
(defvar calc-left-label)
(defvar calc-right-label)
(defvar calc-word-size)
(defvar calc-previous-modulo)
(defvar calc-simplify-mode)
(defvar calc-auto-recompute)
(defvar calc-display-raw)
(defvar calc-internal-prec)
(defvar calc-angle-mode)
(defvar calc-algebraic-mode)
(defvar calc-incomplete-algebraic-mode)
(defvar calc-symbolic-mode)
(defvar calc-matrix-mode)
(defvar calc-shift-prefix)
(defvar calc-window-height)
(defvar calc-display-trail)
(defvar calc-show-selections)
(defvar calc-use-selections)
(defvar calc-assoc-selections)
(defvar calc-display-working-message)
(defvar calc-auto-why)
(defvar calc-timing)
(defvar calc-mode-save-mode)
(defvar calc-standard-date-formats)
(defvar calc-autorange-units)
(defvar calc-was-keypad-mode)
(defvar calc-full-mode)
(defvar calc-user-parse-tables)
(defvar calc-gnuplot-default-device)
(defvar calc-gnuplot-default-output)
(defvar calc-gnuplot-print-device)
(defvar calc-gnuplot-print-output)
(defvar calc-gnuplot-geometry)
(defvar calc-graph-default-resolution)
(defvar calc-graph-default-resolution-3d)
(defvar calc-invocation-macro)
(defvar calc-show-banner)
(defconst calc-mode-var-list '(
(calc-always-load-extensions nil
"If non-nil, load the calc-ext module automatically when calc is loaded.")
(defvar calc-mode-var-list '()
"List of variables used in customizing GNU Calc.")
(calc-line-numbering t
"If non-nil, display line numbers in Calculator stack.")
(defmacro defcalcmodevar (var defval &optional doc)
`(progn
(defvar ,var ,defval ,doc)
(add-to-list 'calc-mode-var-list (list (quote ,var) ,defval))))
(calc-line-breaking t
"If non-nil, break long values across multiple lines in Calculator stack.")
(defun calc-mode-var-list-restore-default-values ()
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
calc-mode-var-list))
(calc-display-just nil
"If nil, stack display is left-justified.
(defun calc-mode-var-list-restore-saved-values ()
(let ((newvarlist '()))
(save-excursion
(let (pos
(file (substitute-in-file-name calc-settings-file)))
(when (and
(file-regular-p file)
(set-buffer (find-file-noselect file))
(goto-char (point-min))
(search-forward ";;; Mode settings stored by Calc" nil t)
(progn
(forward-line 1)
(setq pos (point))
(search-forward "\n;;; End of mode settings" nil t)))
(beginning-of-line)
(calc-mode-var-list-restore-default-values)
(eval-region pos (point))
(let ((varlist calc-mode-var-list))
(while varlist
(let ((var (car varlist)))
(setq newvarlist
(cons (list (car var) (symbol-value (car var)))
newvarlist)))
(setq varlist (cdr varlist)))))))
(if newvarlist
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
newvarlist)
(calc-mode-var-list-restore-default-values))))
(defcalcmodevar calc-always-load-extensions nil
"If non-nil, load the calc-ext module automatically when calc is loaded.")
(defcalcmodevar calc-line-numbering t
"If non-nil, display line numbers in Calculator stack.")
(defcalcmodevar calc-line-breaking t
"If non-nil, break long values across multiple lines in Calculator stack.")
(defcalcmodevar calc-display-just nil
"If nil, stack display is left-justified.
If `right', stack display is right-justified.
If `center', stack display is centered.")
(calc-display-origin nil
"Horizontal origin of displayed stack entries.
(defcalcmodevar calc-display-origin nil
"Horizontal origin of displayed stack entries.
In left-justified mode, this is effectively indentation. (Default 0).
In right-justified mode, this is effectively window width.
In centered mode, center of stack entry is placed here.")
(calc-number-radix 10
"Radix for entry and display of numbers in calc-mode, 2-36.")
(defcalcmodevar calc-number-radix 10
"Radix for entry and display of numbers in calc-mode, 2-36.")
(calc-leading-zeros nil
"If non-nil, leading zeros are provided to pad integers to calc-word-size.")
(defcalcmodevar calc-leading-zeros nil
"If non-nil, leading zeros are provided to pad integers to calc-word-size.")
(calc-group-digits nil
"If non-nil, group digits in large displayed integers by inserting spaces.
(defcalcmodevar calc-group-digits nil
"If non-nil, group digits in large displayed integers by inserting spaces.
If an integer, group that many digits at a time.
If t, use 4 for binary and hex, 3 otherwise.")
(calc-group-char ","
"The character (in the form of a string) to be used for grouping digits.
(defcalcmodevar calc-group-char ","
"The character (in the form of a string) to be used for grouping digits.
This is used only when calc-group-digits mode is on.")
(calc-point-char "."
"The character (in the form of a string) to be used as a decimal point.")
(defcalcmodevar calc-point-char "."
"The character (in the form of a string) to be used as a decimal point.")
(calc-frac-format (":" nil)
"Format of displayed fractions; a string of one or two of \":\" or \"/\".")
(defcalcmodevar calc-frac-format '(":" nil)
"Format of displayed fractions; a string of one or two of \":\" or \"/\".")
(calc-prefer-frac nil
"If non-nil, prefer fractional over floating-point results.")
(defcalcmodevar calc-prefer-frac nil
"If non-nil, prefer fractional over floating-point results.")
(calc-hms-format "%s@ %s' %s\""
"Format of displayed hours-minutes-seconds angles, a format string.
(defcalcmodevar calc-hms-format "%s@ %s' %s\""
"Format of displayed hours-minutes-seconds angles, a format string.
String must contain three %s marks for hours, minutes, seconds respectively.")
(calc-date-format ((H ":" mm C SS pp " ")
Www " " Mmm " " D ", " YYYY)
"Format of displayed date forms.")
(defcalcmodevar calc-date-format '((H ":" mm C SS pp " ")
Www " " Mmm " " D ", " YYYY)
"Format of displayed date forms.")
(calc-float-format (float 0)
"Format to use for display of floating-point numbers in calc-mode.
(defcalcmodevar calc-float-format '(float 0)
"Format to use for display of floating-point numbers in calc-mode.
Must be a list of one of the following forms:
(float 0) Floating point format, display full precision.
(float N) N > 0: Floating point format, at most N significant figures.
@ -375,54 +349,54 @@ Must be a list of one of the following forms:
(eng N) N > 0: Engineering notation, N significant figures.
(eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.")
(calc-full-float-format (float 0)
"Format to use when full precision must be displayed.")
(defcalcmodevar calc-full-float-format '(float 0)
"Format to use when full precision must be displayed.")
(calc-complex-format nil
"Format to use for display of complex numbers in calc-mode. Must be one of:
(defcalcmodevar calc-complex-format nil
"Format to use for display of complex numbers in calc-mode. Must be one of:
nil Use (x, y) form.
i Use x + yi form.
j Use x + yj form.")
(calc-complex-mode cplx
"Preferred form, either `cplx' or `polar', for complex numbers.")
(defcalcmodevar calc-complex-mode 'cplx
"Preferred form, either `cplx' or `polar', for complex numbers.")
(calc-infinite-mode nil
"If nil, 1 / 0 is left unsimplified.
(defcalcmodevar calc-infinite-mode nil
"If nil, 1 / 0 is left unsimplified.
If 0, 1 / 0 is changed to inf (zeros are considered positive).
Otherwise, 1 / 0 is changed to uinf (undirected infinity).")
(calc-display-strings nil
"If non-nil, display vectors of byte-sized integers as strings.")
(defcalcmodevar calc-display-strings nil
"If non-nil, display vectors of byte-sized integers as strings.")
(calc-matrix-just center
"If nil, vector elements are left-justified.
(defcalcmodevar calc-matrix-just 'center
"If nil, vector elements are left-justified.
If `right', vector elements are right-justified.
If `center', vector elements are centered.")
(calc-break-vectors nil
"If non-nil, display vectors one element per line.")
(defcalcmodevar calc-break-vectors nil
"If non-nil, display vectors one element per line.")
(calc-full-vectors t
"If non-nil, display long vectors in full. If nil, use abbreviated form.")
(defcalcmodevar calc-full-vectors t
"If non-nil, display long vectors in full. If nil, use abbreviated form.")
(calc-full-trail-vectors t
"If non-nil, display long vectors in full in the trail.")
(defcalcmodevar calc-full-trail-vectors t
"If non-nil, display long vectors in full in the trail.")
(calc-vector-commas ","
"If non-nil, separate elements of displayed vectors with this string.")
(defcalcmodevar calc-vector-commas ","
"If non-nil, separate elements of displayed vectors with this string.")
(calc-vector-brackets "[]"
"If non-nil, surround displayed vectors with these characters.")
(defcalcmodevar calc-vector-brackets "[]"
"If non-nil, surround displayed vectors with these characters.")
(calc-matrix-brackets (R O)
"A list of code-letter symbols that control \"big\" matrix display.
(defcalcmodevar calc-matrix-brackets '(R O)
"A list of code-letter symbols that control \"big\" matrix display.
If `R' is present, display inner brackets for matrices.
If `O' is present, display outer brackets for matrices (above/below).
If `C' is present, display outer brackets for matrices (centered).")
(calc-language nil
"Language or format for entry and display of stack values. Must be one of:
(defcalcmodevar calc-language nil
"Language or format for entry and display of stack values. Must be one of:
nil Use standard Calc notation.
flat Use standard Calc notation, one-line format.
big Display formulas in 2-d notation (enter w/std notation).
@ -431,27 +405,28 @@ If `C' is present, display outer brackets for matrices (centered).")
pascal Use Pascal language notation.
fortran Use Fortran language notation.
tex Use TeX notation.
latex Use LaTeX notation.
eqn Use eqn notation.
math Use Mathematica(tm) notation.
maple Use Maple notation.")
(calc-language-option nil
"Numeric prefix argument for the command that set `calc-language'.")
(defcalcmodevar calc-language-option nil
"Numeric prefix argument for the command that set `calc-language'.")
(calc-left-label ""
"Label to display at left of formula.")
(defcalcmodevar calc-left-label ""
"Label to display at left of formula.")
(calc-right-label ""
"Label to display at right of formula.")
(defcalcmodevar calc-right-label ""
"Label to display at right of formula.")
(calc-word-size 32
"Minimum number of bits per word, if any, for binary operations in calc-mode.")
(defcalcmodevar calc-word-size 32
"Minimum number of bits per word, if any, for binary operations in calc-mode.")
(calc-previous-modulo nil
"Most recently used value of M in a modulo form.")
(defcalcmodevar calc-previous-modulo nil
"Most recently used value of M in a modulo form.")
(calc-simplify-mode nil
"Type of simplification applied to results.
(defcalcmodevar calc-simplify-mode nil
"Type of simplification applied to results.
If `none', results are not simplified when pushed on the stack.
If `num', functions are simplified only when args are constant.
If nil, only fast simplifications are applied.
@ -460,69 +435,69 @@ If `alg', `math-simplify' is applied.
If `ext', `math-simplify-extended' is applied.
If `units', `math-simplify-units' is applied.")
(calc-auto-recompute t
"If non-nil, recompute evalto's automatically when necessary.")
(defcalcmodevar calc-auto-recompute t
"If non-nil, recompute evalto's automatically when necessary.")
(calc-display-raw nil
"If non-nil, display shows unformatted Lisp exprs. (For debugging)")
(defcalcmodevar calc-display-raw nil
"If non-nil, display shows unformatted Lisp exprs. (For debugging)")
(calc-internal-prec 12
"Number of digits of internal precision for calc-mode calculations.")
(defcalcmodevar calc-internal-prec 12
"Number of digits of internal precision for calc-mode calculations.")
(calc-angle-mode deg
"If deg, angles are in degrees; if rad, angles are in radians.
(defcalcmodevar calc-angle-mode 'deg
"If deg, angles are in degrees; if rad, angles are in radians.
If hms, angles are in degrees-minutes-seconds.")
(calc-algebraic-mode nil
"If non-nil, numeric entry accepts whole algebraic expressions.
(defcalcmodevar calc-algebraic-mode nil
"If non-nil, numeric entry accepts whole algebraic expressions.
If nil, algebraic expressions must be preceded by \"'\".")
(calc-incomplete-algebraic-mode nil
"Like calc-algebraic-mode except only affects ( and [ keys.")
(defcalcmodevar calc-incomplete-algebraic-mode nil
"Like calc-algebraic-mode except only affects ( and [ keys.")
(calc-symbolic-mode nil
"If non-nil, inexact numeric computations like sqrt(2) are postponed.
(defcalcmodevar calc-symbolic-mode nil
"If non-nil, inexact numeric computations like sqrt(2) are postponed.
If nil, computations on numbers always yield numbers where possible.")
(calc-matrix-mode nil
"If `matrix', variables are assumed to be matrix-valued.
(defcalcmodevar calc-matrix-mode nil
"If `matrix', variables are assumed to be matrix-valued.
If a number, variables are assumed to be NxN matrices.
If `scalar', variables are assumed to be scalar-valued.
If nil, symbolic math routines make no assumptions about variables.")
(calc-shift-prefix nil
"If non-nil, shifted letter keys are prefix keys rather than normal meanings.")
(defcalcmodevar calc-shift-prefix nil
"If non-nil, shifted letter keys are prefix keys rather than normal meanings.")
(calc-window-height 7
"Initial height of Calculator window.")
(defcalcmodevar calc-window-height 7
"Initial height of Calculator window.")
(calc-display-trail t
"If non-nil, M-x calc creates a window to display Calculator trail.")
(defcalcmodevar calc-display-trail t
"If non-nil, M-x calc creates a window to display Calculator trail.")
(calc-show-selections t
"If non-nil, selected sub-formulas are shown by obscuring rest of formula.
(defcalcmodevar calc-show-selections t
"If non-nil, selected sub-formulas are shown by obscuring rest of formula.
If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.")
(calc-use-selections t
"If non-nil, commands operate only on selected portions of formulas.
(defcalcmodevar calc-use-selections t
"If non-nil, commands operate only on selected portions of formulas.
If nil, selections displayed but ignored.")
(calc-assoc-selections t
"If non-nil, selection hides deep structure of associative formulas.")
(defcalcmodevar calc-assoc-selections t
"If non-nil, selection hides deep structure of associative formulas.")
(calc-display-working-message lots
"If non-nil, display \"Working...\" for potentially slow Calculator commands.")
(defcalcmodevar calc-display-working-message 'lots
"If non-nil, display \"Working...\" for potentially slow Calculator commands.")
(calc-auto-why maybe
"If non-nil, automatically execute a \"why\" command to explain odd results.")
(defcalcmodevar calc-auto-why 'maybe
"If non-nil, automatically execute a \"why\" command to explain odd results.")
(calc-timing nil
"If non-nil, display timing information on each slow command.")
(defcalcmodevar calc-timing nil
"If non-nil, display timing information on each slow command.")
(calc-mode-save-mode local)
(defcalcmodevar calc-mode-save-mode 'local)
(calc-standard-date-formats
("N"
(defcalcmodevar calc-standard-date-formats
'("N"
"<H:mm:SSpp >Www Mmm D, YYYY"
"D Mmm YYYY<, h:mm:SS>"
"Www Mmm BD< hh:mm:ss> YYYY"
@ -533,40 +508,32 @@ If nil, selections displayed but ignored.")
"j<, h:mm:SS>"
"YYddd< hh:mm:ss>"))
(calc-autorange-units nil)
(defcalcmodevar calc-autorange-units nil)
(calc-was-keypad-mode nil)
(defcalcmodevar calc-was-keypad-mode nil)
(calc-full-mode nil)
(defcalcmodevar calc-full-mode nil)
(calc-user-parse-tables nil)
(defcalcmodevar calc-user-parse-tables nil)
(calc-gnuplot-default-device "default")
(defcalcmodevar calc-gnuplot-default-device "default")
(calc-gnuplot-default-output "STDOUT")
(defcalcmodevar calc-gnuplot-default-output "STDOUT")
(calc-gnuplot-print-device "postscript")
(defcalcmodevar calc-gnuplot-print-device "postscript")
(calc-gnuplot-print-output "auto")
(defcalcmodevar calc-gnuplot-print-output "auto")
(calc-gnuplot-geometry nil)
(defcalcmodevar calc-gnuplot-geometry nil)
(calc-graph-default-resolution 15)
(defcalcmodevar calc-graph-default-resolution 15)
(calc-graph-default-resolution-3d 5)
(defcalcmodevar calc-graph-default-resolution-3d 5)
(calc-invocation-macro nil)
(defcalcmodevar calc-invocation-macro nil)
(calc-show-banner t
"*If non-nil, show a friendly greeting above the stack."))
"List of variables (and default values) used in customizing GNU Calc.")
(mapcar (function (lambda (v)
(or (boundp (car v))
(set (car v) (nth 1 v)))
(if (nth 2 v)
(put (car v) 'variable-documentation (nth 2 v)))))
calc-mode-var-list)
(defcalcmodevar calc-show-banner t
"*If non-nil, show a friendly greeting above the stack.")
(defconst calc-local-var-list '(calc-stack
calc-stack-top
@ -738,6 +705,7 @@ If nil, selections displayed but ignored.")
(defvar math-eval-rules-cache-tag t)
(defvar math-radix-explicit-format t)
(defvar math-expr-function-mapping nil)
(defvar math-expr-special-function-mapping nil)
(defvar math-expr-variable-mapping nil)
(defvar math-read-expr-quotes nil)
(defvar math-working-step nil)
@ -1028,7 +996,7 @@ Notations: 3.14e6 3.14 * 10^6
(equal calc-settings-file user-init-file)
(progn
(setq calc-loaded-settings-file t)
(load calc-settings-file t))) ; t = missing-ok
(load (file-name-sans-extension calc-settings-file) t))) ; t = missing-ok
(let ((p command-line-args))
(while p
(and (equal (car p) "-f")
@ -1402,6 +1370,7 @@ See calc-keypad for details."
(if calc-leading-zeros "Zero " "")
(cond ((null calc-language) "")
((eq calc-language 'tex) "TeX ")
((eq calc-language 'latex) "LaTeX ")
(t (concat
(capitalize (symbol-name calc-language))
" ")))
@ -3252,9 +3221,13 @@ See calc-keypad for details."
("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
("\\evalto")
("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
("\\begin" begenv)
("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
("\\{" punc "[") ("\\}" punc "]")
))
("\\{" punc "[") ("\\}" punc "]")))
(defconst math-latex-ignore-words
(append math-tex-ignore-words
'(("\\begin" begenv))))
(defconst math-eqn-ignore-words
'( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
@ -3262,8 +3235,7 @@ See calc-keypad for details."
("right" ("floor") ("ceil"))
("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
("above" punc ",")
))
("above" punc ",")))
(defconst math-standard-opers
'( ( "_" calcFunc-subscr 1200 1201 )

116
lisp/calc/calccomp.el
View File

@ -79,7 +79,8 @@
(defun math-compose-expr (a prec)
(let ((math-compose-level (1+ math-compose-level)))
(let ((math-compose-level (1+ math-compose-level))
spfn)
(cond
((or (and (eq a math-comp-selected) a)
(and math-comp-tagged
@ -89,10 +90,13 @@
(list 'tag a (math-compose-expr a prec))))
((and (not (consp a)) (not (integerp a)))
(concat "'" (prin1-to-string a)))
((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
(setq spfn (cdr spfn))
(funcall (car spfn) a spfn))
((math-scalarp a)
(if (or (eq (car-safe a) 'frac)
(and (nth 1 calc-frac-format) (Math-integerp a)))
(if (memq calc-language '(tex eqn math maple c fortran pascal))
(if (memq calc-language '(tex latex eqn math maple c fortran pascal))
(let ((aa (math-adjust-fraction a))
(calc-frac-format nil))
(math-compose-expr (list '/
@ -265,34 +269,44 @@
(append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a))
'(" }"))
(if (and (eq calc-language 'eqn)
(math-matrixp a))
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}"))
(if (and (eq calc-language 'maple)
(math-matrixp a))
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(if (and (eq calc-language 'latex)
(math-matrixp a))
(if (memq calc-language-option '(-2 0 2))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a))
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a))
'(" \\end{pmatrix}")))
(if (and (eq calc-language 'eqn)
(math-matrixp a))
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}"))
(if (and (eq calc-language 'maple)
(math-matrixp a))
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")")
(list 'horiz
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")")
(list 'horiz
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket))))
math-comp-vector-prec)
math-comp-right-bracket)))))
(list 'horiz
math-comp-left-bracket
(math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...")
math-comp-comma (if (memq calc-language '(tex latex))
" \\ldots" " ...")
math-comp-comma " "
(list 'break math-compose-level)
(math-compose-expr (nth (1- (length a)) a)
@ -326,12 +340,14 @@
(let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
(if v
(symbol-name (car v))
(if (and (eq calc-language 'tex)
(if (and (memq calc-language '(tex latex))
calc-language-option
(not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
(symbol-name (nth 1 a))))
(format "\\hbox{%s}" (symbol-name (nth 1 a)))
(if (eq calc-language 'latex)
(format "\\text{%s}" (symbol-name (nth 1 a)))
(format "\\hbox{%s}" (symbol-name (nth 1 a))))
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
@ -359,7 +375,7 @@
(if (eq calc-language 'maple) ""
(if (memq (nth 1 a) '(0 1)) "(" "["))
(math-compose-expr (nth 2 a) 0)
(if (eq calc-language 'tex) " \\ldots "
(if (memq calc-language '(tex latex)) " \\ldots "
(if (eq calc-language 'eqn) " ... " " .. "))
(math-compose-expr (nth 3 a) 0)
(if (eq calc-language 'maple) ""
@ -404,7 +420,7 @@
(math-compose-expr (nth 2 a) 0)
"]]"))
((and (eq (car a) 'calcFunc-sqrt)
(eq calc-language 'tex))
(memq calc-language '(tex latex)))
(list 'horiz
"\\sqrt{"
(math-compose-expr (nth 1 a) 0)
@ -440,7 +456,7 @@
(math-comp-height a1)
a1 '(rule ?-) a2)))
((and (memq (car a) '(calcFunc-sum calcFunc-prod))
(eq calc-language 'tex)
(memq calc-language '(tex latex))
(= (length a) 5))
(list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
"_{" (math-compose-expr (nth 2 a) 0)
@ -495,7 +511,7 @@
(integerp (nth 2 a)))
(let ((c (math-compose-expr (nth 1 a) -1)))
(if (> prec (nth 2 a))
(if (eq calc-language 'tex)
(if (memq calc-language '(tex latex))
(list 'horiz "\\left( " c " \\right)")
(if (eq calc-language 'eqn)
(list 'horiz "{left ( " c " right )}")
@ -633,13 +649,13 @@
(make-list (nth 1 a) c))))))
((and (eq (car a) 'calcFunc-evalto)
(setq calc-any-evaltos t)
(memq calc-language '(tex eqn))
(memq calc-language '(tex latex eqn))
(= math-compose-level (if math-comp-tagged 2 1))
(= (length a) 3))
(list 'horiz
(if (eq calc-language 'tex) "\\evalto " "evalto ")
(if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
(math-compose-expr (nth 1 a) 0)
(if (eq calc-language 'tex) " \\to " " -> ")
(if (memq calc-language '(tex latex)) " \\to " " -> ")
(math-compose-expr (nth 2 a) 0)))
(t
(let ((op (and (not (eq calc-language 'unform))
@ -651,7 +667,7 @@
(/= (nth 3 op) -1))
(cond
((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
(if (and (eq calc-language 'tex)
(if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(if (eq (car-safe a) '/)
(list 'horiz "{" (math-compose-expr a -1) "}")
@ -668,7 +684,7 @@
(math-compose-expr a -1)
" right )}")))
(list 'horiz "(" (math-compose-expr a 0) ")"))))
((and (eq calc-language 'tex)
((and (memq calc-language '(tex latex))
(memq (car a) '(/ calcFunc-choose calcFunc-evalto))
(>= prec 0))
(list 'horiz "{" (math-compose-expr a -1) "}"))
@ -694,7 +710,7 @@
(and (equal (car op) "^")
(eq (math-comp-first-char lhs) ?-)
(setq lhs (list 'horiz "(" lhs ")")))
(and (eq calc-language 'tex)
(and (memq calc-language '(tex latex))
(or (equal (car op) "^") (equal (car op) "_"))
(not (and (stringp rhs) (= (length rhs) 1)))
(setq rhs (list 'horiz "{" rhs "}")))
@ -761,7 +777,7 @@
((or (> prec (or (nth 4 op) (nth 2 op)))
(and (not (eq (assoc (car op) math-expr-opers) op))
(> prec 0))) ; don't write x% + y
(if (and (eq calc-language 'tex)
(if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( "
(math-compose-expr a -1)
@ -786,7 +802,7 @@
((and op (= (length a) 2) (= (nth 2 op) -1))
(cond
((eq (nth 3 op) 0)
(let ((lr (and (eq calc-language 'tex)
(let ((lr (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat (nth 1 a))))))
(list 'horiz
(if lr "\\left" "")
@ -799,7 +815,7 @@
(if lr "\\right" "")
(car (nth 1 (memq op math-expr-opers))))))
((> prec (or (nth 4 op) (nth 3 op)))
(if (and (eq calc-language 'tex)
(if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( "
(math-compose-expr a -1)
@ -836,6 +852,7 @@
( pascal . math-compose-pascal )
( fortran . math-compose-fortran )
( tex . math-compose-tex )
( latex . math-compose-latex )
( eqn . math-compose-eqn )
( math . math-compose-math )
( maple . math-compose-maple ))))
@ -866,20 +883,22 @@
(symbol-name func))))
(if (memq calc-language '(c fortran pascal maple))
(setq func (math-to-underscores func)))
(if (and (eq calc-language 'tex)
(if (and (memq calc-language '(tex latex))
calc-language-option
(not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
(if (< (prefix-numeric-value calc-language-option) 0)
(setq func (format "\\%s" func))
(setq func (format "\\hbox{%s}" func))))
(setq func (if (eq calc-language 'latex)
(format "\\text{%s}" func)
(format "\\hbox{%s}" func)))))
(if (and (eq calc-language 'eqn)
(string-match "[^']'+\\'" func))
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
(cond ((and (eq calc-language 'tex)
(cond ((and (eq calc-language '(tex latex))
(or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "\\left( "
@ -889,11 +908,13 @@
(not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "{left ( "
right " right )}"))
((and (or (and (eq calc-language 'tex)
((and (or (and (memq calc-language '(tex latex))
(eq (aref func 0) ?\\))
(and (eq calc-language 'eqn)
(memq (car a) math-eqn-special-funcs)))
(not (string-match "\\hbox{" func))
(not (or
(string-match "\\hbox{" func)
(string-match "\\text{" func)))
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
@ -968,7 +989,7 @@
(if (<= count 0)
(if (< count 0)
(math-compose-rows (cdr a) -1 nil)
(cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")
(cons (concat (if (memq calc-language '(tex latex)) " \\ldots" " ...")
math-comp-comma)
(math-compose-rows (cdr a) -1 nil)))
(cons (list 'horiz
@ -983,9 +1004,8 @@
(defun math-compose-tex-matrix (a)
(if (cdr a)
(cons (math-compose-vector (cdr (car a)) " & " 0)
(cons " \\\\ "
(math-compose-tex-matrix (cdr a))))
(cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
(math-compose-tex-matrix (cdr a)))
(list (math-compose-vector (cdr (car a)) " & " 0))))
(defun math-compose-eqn-matrix (a)

79
lisp/case-table.el
View File

@ -1,6 +1,6 @@
;;; case-table.el --- code to extend the character set and support case tables
;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
;; Copyright (C) 1988, 1994, 2005 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
@ -62,11 +62,26 @@
(describe-vector description)
(help-mode)))))
(defun get-upcase-table (case-table)
"Return the upcase table of CASE-TABLE."
(or (char-table-extra-slot case-table 0)
;; Setup all extra slots of CASE-TABLE by temporarily selecting
;; it as the standard case table.
(let ((old (standard-case-table)))
(unwind-protect
(progn
(set-standard-case-table case-table)
(char-table-extra-slot case-table 0))
(or (eq case-table old)
(set-standard-case-table old))))))
(defun copy-case-table (case-table)
(let ((copy (copy-sequence case-table)))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table.
(set-char-table-extra-slot copy 0 nil)
(let ((copy (copy-sequence case-table))
(up (char-table-extra-slot case-table 0)))
;; Clear out the extra slots (except for upcase table) so that
;; they will be recomputed from the main (downcase) table.
(if up
(set-char-table-extra-slot copy 0 (copy-sequence up)))
(set-char-table-extra-slot copy 1 nil)
(set-char-table-extra-slot copy 2 nil)
copy))
@ -87,9 +102,11 @@ indicate left and right delimiters."
(setq r (set-case-syntax-1 r))
(aset table l l)
(aset table r r)
(let ((up (get-upcase-table table)))
(aset up l l)
(aset up r r))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table.
(set-char-table-extra-slot table 0 nil)
;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry l (concat "(" (char-to-string r) " ")
@ -103,14 +120,49 @@ This sets the entries for characters UC and LC in TABLE, which is a string
that will be used as the downcase part of a case table.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
(unless (= (charset-bytes (char-charset uc))
(charset-bytes (char-charset lc)))
(error "Can't casify chars with different `charset-bytes' values"))
(setq uc (set-case-syntax-1 uc))
(setq lc (set-case-syntax-1 lc))
(aset table uc lc)
(aset table lc lc)
(set-char-table-extra-slot table 0 nil)
(let ((up (get-upcase-table table)))
(aset up uc uc)
(aset up lc uc))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry lc "w " (standard-syntax-table))
(modify-syntax-entry uc "w " (standard-syntax-table)))
(defun set-upcase-syntax (uc lc table)
"Make character UC an upcase of character LC.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
(setq uc (set-case-syntax-1 uc))
(setq lc (set-case-syntax-1 lc))
(aset table lc lc)
(let ((up (get-upcase-table table)))
(aset up uc uc)
(aset up lc uc))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry lc "w " (standard-syntax-table))
(modify-syntax-entry uc "w " (standard-syntax-table)))
(defun set-downcase-syntax (uc lc table)
"Make character LC a downcase of character UC.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
(setq uc (set-case-syntax-1 uc))
(setq lc (set-case-syntax-1 lc))
(aset table uc lc)
(aset table lc lc)
(let ((up (get-upcase-table table)))
(aset up uc uc))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry lc "w " (standard-syntax-table))
@ -124,7 +176,10 @@ It also modifies `standard-syntax-table'.
SYNTAX should be \" \", \"w\", \".\" or \"_\"."
(setq c (set-case-syntax-1 c))
(aset table c c)
(set-char-table-extra-slot table 0 nil)
(let ((up (get-upcase-table table)))
(aset up c c))
;; Clear out the extra slots so that they will be
;; recomputed from the main (downcase) table and upcase table.
(set-char-table-extra-slot table 1 nil)
(set-char-table-extra-slot table 2 nil)
(modify-syntax-entry c syntax (standard-syntax-table)))

4
lisp/comint.el
View File

@ -788,7 +788,9 @@ buffer. The hook `comint-exec-hook' is run after each exec."
(defun comint-insert-input (&optional event)
"In a Comint buffer, set the current input to the previous input at point."
(interactive "e")
;; This doesn't use "e" because it is supposed to work
;; for events without parameters.
(interactive (list last-input-event))
(if event (mouse-set-point event))
(let ((pos (point)))
(if (not (eq (get-char-property pos 'field) 'input))

141
lisp/cus-edit.el
View File

@ -1,6 +1,7 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
;; Copyright (C) 1996,97,1999,2000,01,02,03,2004 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
@ -243,7 +244,6 @@
(defgroup customize '((widgets custom-group))
"Customization of the Customization support."
:link '(custom-manual "(elisp)Customization")
:prefix "custom-"
:group 'help)
@ -899,8 +899,6 @@ then prompt for the MODE to customize."
(let (
;; Copied from `custom-buffer-create-other-window'.
(pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
(pop-to-buffer name))
@ -1182,19 +1180,10 @@ links: groups have links to subgroups."
(const links))
:group 'custom-buffer)
;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from
;; the window.
(defun custom-bury-buffer (buffer)
(with-current-buffer buffer
(bury-buffer)))
(defcustom custom-buffer-done-function 'custom-bury-buffer
"*Function called to remove a Custom buffer when the user is done with it.
Called with one argument, the buffer to remove."
:type '(choice (function-item :tag "Bury buffer" custom-bury-buffer)
(function-item :tag "Kill buffer" kill-buffer)
(function :tag "Other"))
:version "21.1"
(defcustom custom-buffer-done-kill nil
"*Non-nil means exiting a Custom buffer should kill it."
:type 'boolean
:version "21.4"
:group 'custom-buffer)
(defcustom custom-buffer-indent 3
@ -1247,8 +1236,6 @@ SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
(unless name (setq name "*Customization*"))
(let ((pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
(pop-to-buffer (custom-get-fresh-buffer name))
@ -1266,9 +1253,9 @@ This button will have a menu with all three reset operations."
:group 'custom-buffer)
(defun Custom-buffer-done (&rest ignore)
"Remove current buffer by calling `custom-buffer-done-function'."
"Exit current Custom buffer according to `custom-buffer-done-kill'."
(interactive)
(funcall custom-buffer-done-function (current-buffer)))
(quit-window custom-buffer-done-kill))
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
@ -1354,13 +1341,9 @@ Un-customize all values in this buffer. They get their standard settings."
:tag "Finish"
:help-echo
(lambda (&rest ignore)
(cond
((eq custom-buffer-done-function
'custom-bury-buffer)
"Bury this buffer")
((eq custom-buffer-done-function 'kill-buffer)
"Kill this buffer")
(t "Finish with this buffer")))
(if custom-buffer-done-kill
"Kill this buffer"
"Bury this buffer"))
:action #'Custom-buffer-done)
(widget-insert "\n\n")
(message "Creating customization items...")
@ -3699,35 +3682,57 @@ The default is nil, which means to use your init file
as specified by `user-init-file'. If the value is not nil,
it should be an absolute file name.
To make this feature work, you'll need to put something in your
init file to specify the value of `custom-file'. Just
customizing the variable won't suffice, because Emacs won't know
which file to load unless the init file sets `custom-file'.
You can set this option through Custom, if you carefully read the
last paragraph below. However, usually it is simpler to write
something like the following in your init file:
When you change this variable, look in the previous custom file
\(usually your init file) for the forms `(custom-set-variables ...)'
and `(custom-set-faces ...)', and copy them (whichever ones you find)
to the new custom file. This will preserve your existing customizations."
:type '(choice (const :tag "Your Emacs init file" nil) file)
\(setq custom-file \"~/.emacs-custom.el\")
\(load custom-file)
Note that both lines are necessary: the first line tells Custom to
save all customizations in this file, but does not load it.
When you change this variable outside Custom, look in the
previous custom file \(usually your init file) for the
forms `(custom-set-variables ...)' and `(custom-set-faces ...)',
and copy them (whichever ones you find) to the new custom file.
This will preserve your existing customizations.
If you save this option using Custom, Custom will write all
currently saved customizations, including the new one for this
option itself, into the file you specify, overwriting any
`custom-set-variables' and `custom-set-faces' forms already
present in that file. It will not delete any customizations from
the old custom file. You should do that manually if that is what you
want. You also have to put something like `\(load \"CUSTOM-FILE\")
in your init file, where CUSTOM-FILE is the actual name of the
file. Otherwise, Emacs will not load the file when it starts up,
and hence will not set `custom-file' to that file either."
:type '(choice (const :tag "Your Emacs init file" nil)
(file :format "%t:%v%d"
:doc
"Please read entire docstring below before setting \
this through Custom.
Click om \"More\" \(or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
(defun custom-file ()
"Return the file name for saving customizations."
(setq custom-file
(or custom-file
(let ((user-init-file user-init-file)
(default-init-file
(if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
(when (null user-init-file)
(if (or (file-exists-p default-init-file)
(and (eq system-type 'windows-nt)
(file-exists-p "~/_emacs")))
;; Started with -q, i.e. the file containing
;; Custom settings hasn't been read. Saving
;; settings there would overwrite other settings.
(error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
(setq user-init-file default-init-file))
user-init-file))))
(or custom-file
(let ((user-init-file user-init-file)
(default-init-file
(if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
(when (null user-init-file)
(if (or (file-exists-p default-init-file)
(and (eq system-type 'windows-nt)
(file-exists-p "~/_emacs")))
;; Started with -q, i.e. the file containing
;; Custom settings hasn't been read. Saving
;; settings there would overwrite other settings.
(error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
(setq user-init-file default-init-file))
user-init-file)))
(defun custom-save-delete (symbol)
"Visit `custom-file' and delete all calls to SYMBOL from it.
@ -4051,23 +4056,23 @@ The format is suitable for use with `easy-menu-define'."
;;; The Custom Mode.
(defvar custom-mode-map nil
"Keymap for `custom-mode'.")
(unless custom-mode-map
(defvar custom-mode-map
;; This keymap should be dense, but a dense keymap would prevent inheriting
;; "\r" bindings from the parent map.
(setq custom-mode-map (make-sparse-keymap))
(set-keymap-parent custom-mode-map widget-keymap)
(suppress-keymap custom-mode-map)
(define-key custom-mode-map " " 'scroll-up)
(define-key custom-mode-map "\177" 'scroll-down)
(define-key custom-mode-map "\C-x\C-s" 'Custom-save)
(define-key custom-mode-map "q" 'Custom-buffer-done)
(define-key custom-mode-map "u" 'Custom-goto-parent)
(define-key custom-mode-map "n" 'widget-forward)
(define-key custom-mode-map "p" 'widget-backward)
(define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke))
;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
(let ((map (make-keymap)))
(set-keymap-parent map widget-keymap)
(suppress-keymap map)
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
(define-key map "\C-x\C-s" 'Custom-save)
(define-key map "q" 'Custom-buffer-done)
(define-key map "u" 'Custom-goto-parent)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
(define-key map [mouse-1] 'Custom-move-and-invoke)
map)
"Keymap for `custom-mode'.")
(defun Custom-move-and-invoke (event)
"Move to where you click, and if it is an active field, invoke it."
@ -4166,5 +4171,5 @@ if that value is non-nil."
(provide 'cus-edit)
;;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f
;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f
;;; cus-edit.el ends here

5
lisp/cus-face.el
View File

@ -53,6 +53,7 @@
(make-face-x-resource-internal face)))))
;; Don't record SPEC until we see it causes no errors.
(put face 'face-defface-spec spec)
(push (cons 'defface face) current-load-list)
(when (and doc (null (face-documentation face)))
(set-face-documentation face (purecopy doc)))
(custom-handle-all-keywords face args 'custom-face)
@ -198,11 +199,11 @@
(:foreground
(color :tag "Foreground"
:help-echo "Set foreground color."))
:help-echo "Set foreground color (name or #RRGGBB hex spec)."))
(:background
(color :tag "Background"
:help-echo "Set background color."))
:help-echo "Set background color (name or #RRGGBB hex spec)."))
(:stipple
(choice :tag "Stipple"

11
lisp/cus-start.el
View File

@ -41,6 +41,17 @@
(gc-cons-threshold alloc integer)
(undo-limit undo integer)
(undo-strong-limit undo integer)
(undo-outer-limit undo
(choice integer
(const :tag "No limit"
:format "%t\n%d"
:doc
"With this choice, \
the undo info for the current command never gets discarded.
This should only be chosen under exceptional circumstances,
since it could result in memory overflow and make Emacs crash."
nil))
"21.4")
(garbage-collection-messages alloc boolean)
;; buffer.c
(mode-line-format modeline sexp) ;Hard to do right.

44
lisp/custom.el
View File

@ -168,7 +168,7 @@ set to nil, as the value is no longer rogue."
;; Do the actual initialization.
(unless custom-dont-initialize
(funcall initialize symbol default)))
(push (cons 'defvar symbol) current-load-list)
(push symbol current-load-list)
(run-hooks 'custom-define-hook)
symbol)
@ -710,44 +710,46 @@ in every Customization buffer.")
(put 'custom-local-buffer 'permanent-local t)
(defun custom-set-variables (&rest args)
"Initialize variables according to user preferences.
The settings are registered as theme `user'.
"Install user customizations of variable values specified in ARGS.
These settings are registered as theme `user'.
The arguments should each be a list of the form:
(SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
(SYMBOL EXP [NOW [REQUEST [COMMENT]]])
The unevaluated VALUE is stored as the saved value for SYMBOL.
If NOW is present and non-nil, VALUE is also evaluated and bound as
the default value for the SYMBOL.
This stores EXP (without evaluating it) as the saved value for SYMBOL.
If NOW is present and non-nil, then also evaluate EXP and set
the default value for the SYMBOL to the value of EXP.
REQUEST is a list of features we must 'require for SYMBOL.
REQUEST is a list of features we must require in order to
handle SYMBOL properly.
COMMENT is a comment string about SYMBOL."
(apply 'custom-theme-set-variables 'user args))
(defun custom-theme-set-variables (theme &rest args)
"Initialize variables according to settings specified by args.
Records the settings as belonging to THEME.
"Initialize variables for theme THEME according to settings in ARGS.
Each of the arguments in ARGS should be a list of this form:
The arguments should be a list where each entry has the form:
(SYMBOL EXP [NOW [REQUEST [COMMENT]]])
(SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
This stores EXP (without evaluating it) as the saved value for SYMBOL.
If NOW is present and non-nil, then also evaluate EXP and set
the default value for the SYMBOL to the value of EXP.
The unevaluated VALUE is stored as the saved value for SYMBOL.
If NOW is present and non-nil, VALUE is also evaluated and bound as
the default value for the SYMBOL.
REQUEST is a list of features we must 'require for SYMBOL.
REQUEST is a list of features we must require in order to
handle SYMBOL properly.
COMMENT is a comment string about SYMBOL.
Several properties of THEME and SYMBOL are used in the process:
If THEME property `theme-immediate' is non-nil, this is equivalent of
providing the NOW argument to all symbols in the argument list: SYMBOL
is bound to the evaluated VALUE. The only difference is SYMBOL property
If THEME's property `theme-immediate' is non-nil, this is equivalent of
providing the NOW argument to all symbols in the argument list:
evaluate each EXP and set the corresponding SYMBOL. However,
there's a difference in the handling of SYMBOL's property
`force-value': if NOW is non-nil, SYMBOL's property `force-value' is set to
the symbol `rogue', else if THEME's property `theme-immediate' is non-nil,
FACE's property `force-face' is set to the symbol `immediate'.
SYMBOL's property `force-value' is set to the symbol `immediate'.
VALUE itself is saved unevaluated as SYMBOL property `saved-value' and
EXP itself is saved unevaluated as SYMBOL property `saved-value' and
in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
(custom-check-theme theme)
(let ((immediate (get theme 'theme-immediate)))

6
lisp/descr-text.el
View File

@ -1,10 +1,10 @@
;;; descr-text.el --- describe text mode
;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2003, 2004
;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
;; Keywords: faces, i18n, Unicode, multilingual
;; This file is part of GNU Emacs.
@ -217,7 +217,7 @@ otherwise."
(defcustom describe-char-unicodedata-file nil
"Location of Unicode data file.
This is the UnicodeData.txt file from the Unicode consortium, used for
diagnostics. If it is non-nil `describe-char-after' will print data
diagnostics. If it is non-nil `describe-char' will print data
looked up from it. This facility is mostly of use to people doing
multilingual development.

125
lisp/desktop.el
View File

@ -198,7 +198,7 @@ Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
search-ring-yank-pointer
regexp-search-ring
regexp-search-ring-yank-pointer)
"List of global variables to clear by `desktop-clear'.
"List of global variables that `desktop-clear' will clear.
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."
@ -267,6 +267,27 @@ Possible values are:
:group 'desktop
:version "21.4")
(defcustom desktop-restore-eager t
"Number of buffers to restore immediately.
Remaining buffers are restored lazily (when Emacs is idle).
If value is t, all buffers are restored immediately."
:type '(choice (const t) integer)
:group 'desktop
:version "21.4")
(defcustom desktop-lazy-verbose t
"Verbose reporting of lazily created buffers."
:type 'boolean
:group 'desktop
:version "21.4")
(defcustom desktop-lazy-idle-delay 5
"Idle delay before starting to create buffers.
See `desktop-restore-eager'."
:type 'integer
:group 'desktop
:version "21.4")
;;;###autoload
(defvar desktop-save-buffer nil
"When non-nil, save buffer status in desktop file.
@ -365,6 +386,7 @@ This kills all buffers except for internal ones and those matching
`desktop-clear-preserve-buffers'. Furthermore, it clears the
variables listed in `desktop-globals-to-clear'."
(interactive)
(desktop-lazy-abort)
(dolist (var desktop-globals-to-clear)
(if (symbolp var)
(eval `(setq-default ,var nil))
@ -625,12 +647,13 @@ See also `desktop-base-file-name'."
(setq locals (cdr locals)))
ll)))
(buffer-list)))
(eager desktop-restore-eager)
(buf (get-buffer-create "*desktop*")))
(set-buffer buf)
(erase-buffer)
(insert
";; -*- coding: emacs-mule; -*-\n"
";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
@ -645,14 +668,21 @@ See also `desktop-base-file-name'."
(insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
(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)
(when (apply 'desktop-save-buffer-p l)
(insert "("
(if (or (not (integerp eager))
(unless (zerop eager)
(setq eager (1- eager))
t))
"desktop-create-buffer"
"desktop-append-buffer-args")
" "
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))
@ -670,6 +700,11 @@ This function also sets `desktop-dirname' to nil."
(when (file-exists-p filename)
(delete-file filename)))))
(defvar desktop-buffer-args-list nil
"List of args for `desktop-create-buffer'.")
(defvar desktop-lazy-timer nil)
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-read (&optional dirname)
@ -706,6 +741,7 @@ It returns t if a desktop file was loaded, nil otherwise."
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0))
(setq desktop-lazy-timer nil)
;; Evaluate desktop buffer.
(load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
;; `desktop-create-buffer' puts buffers at end of the buffer list.
@ -717,11 +753,15 @@ It returns t if a desktop file was loaded, nil otherwise."
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(run-hooks 'desktop-after-read-hook)
(message "Desktop: %d buffer%s restored%s."
(message "Desktop: %d buffer%s restored%s%s."
desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
(format ", %d failed to restore" desktop-buffer-fail-count)
"")
(if desktop-buffer-args-list
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
t)
;; No desktop file found.
@ -917,6 +957,69 @@ directory DIRNAME."
(cons 'case-replace cr)
(cons 'overwrite-mode (car mim)))))
(defun desktop-append-buffer-args (&rest args)
"Append ARGS at end of `desktop-buffer-args-list'
ARGS must be an argument list for `desktop-create-buffer'."
(setq desktop-buffer-args-list (nconc desktop-buffer-args-list (list args)))
(unless desktop-lazy-timer
(setq desktop-lazy-timer
(run-with-idle-timer desktop-lazy-idle-delay t 'desktop-idle-create-buffers))))
(defun desktop-lazy-create-buffer ()
"Pop args from `desktop-buffer-args-list', create buffer and bury it."
(when desktop-buffer-args-list
(let* ((remaining (length desktop-buffer-args-list))
(args (pop desktop-buffer-args-list))
(buffer-name (nth 2 args))
(msg (format "Desktop lazily opening %s (%s remaining)..."
buffer-name remaining)))
(when desktop-lazy-verbose
(message msg))
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0))
(apply 'desktop-create-buffer args)
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(bury-buffer (get-buffer buffer-name))
(when desktop-lazy-verbose
(message "%s%s" msg (if (> desktop-buffer-ok-count 0) "done" "failed")))))))
(defun desktop-idle-create-buffers ()
"Create buffers until the user does something, then stop.
If there are no buffers left to create, kill the timer."
(let ((repeat 1))
(while (and repeat desktop-buffer-args-list)
(save-window-excursion
(desktop-lazy-create-buffer))
(setq repeat (sit-for 0.2))
(unless desktop-buffer-args-list
(cancel-timer desktop-lazy-timer)
(setq desktop-lazy-timer nil)
(message "Lazy desktop load complete")
(sit-for 3)
(message "")))))
(defun desktop-lazy-complete ()
"Run the desktop load to completion."
(interactive)
(let ((desktop-lazy-verbose t))
(while desktop-buffer-args-list
(save-window-excursion
(desktop-lazy-create-buffer)))
(message "Lazy desktop load complete")))
(defun desktop-lazy-abort ()
"Abort lazy loading of the desktop."
(interactive)
(when desktop-lazy-timer
(cancel-timer desktop-lazy-timer)
(setq desktop-lazy-timer nil))
(when desktop-buffer-args-list
(setq desktop-buffer-args-list nil)
(when (interactive-p)
(message "Lazy desktop load aborted"))))
;; ----------------------------------------------------------------------------
;; When `desktop-save-mode' is non-nil and "--no-desktop" is not specified on the
;; command line, we do the rest of what it takes to use desktop, but do it

49
lisp/dired.el
View File

@ -200,22 +200,6 @@ with the buffer narrowed to the listing."
;; Note this can't simply be run inside function `dired-ls' as the hook
;; functions probably depend on the dired-subdir-alist to be OK.
;; Fixme: This should use mailcap.
(defcustom dired-view-command-alist
'(("\\.\\(ps\\|ps_pages\\|eps\\)\\'" . "gv %s")
("\\.pdf\\'" . "xpdf %s")
;; ("\\.pod\\'" . "perldoc %s")
("\\.\\(jpe?g\\|gif\\|png\\)\\'" . "eog %s")
("\\.dvi\\'" . "xdvi %s"))
"Alist specifying how to view special types of files.
Each element has the form (REGEXP . SHELL-COMMAND).
When the file name matches REGEXP, `dired-view-file'
invokes SHELL-COMMAND to view the file, processing it through `format'.
Use `%s' in SHELL-COMMAND to specify where to put the file name."
:group 'dired
:type '(alist :key-type regexp :value-type string)
:version "21.4")
;; Internal variables
(defvar dired-marker-char ?* ; the answer is 42
@ -1213,8 +1197,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
;; misc
(define-key map "?" 'dired-summary)
(define-key map "\177" 'dired-unmark-backward)
(define-key map "\C-_" 'dired-undo)
(define-key map "\C-xu" 'dired-undo)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
;; Make menu bar items.
@ -1666,41 +1650,20 @@ Creates a buffer if necessary."
(progn
(select-window window)
(dired-other-window file)))
(let (cmd)
;; Look for some other way to view a certain file.
(dolist (elt dired-view-command-alist)
(if (string-match (car elt) file)
(setq cmd (cdr elt))))
(if cmd
(call-process shell-file-name nil 0 nil
"-c"
(concat (format cmd (shell-quote-argument file))
" &"))
(select-window window)
(find-file-other-window (file-name-sans-versions file t)))))))
(select-window window)
(find-file-other-window (file-name-sans-versions file t)))))
(defun dired-view-file ()
"In Dired, examine a file in view mode, returning to dired when done.
When file is a directory, show it in this buffer if it is inserted.
Some kinds of files are displayed using external viewer programs;
see `dired-view-command-alist'. Otherwise, display it in another buffer."
Otherwise, display it in another buffer."
(interactive)
(let ((file (dired-get-file-for-visit)))
(if (file-directory-p file)
(or (and (cdr dired-subdir-alist)
(dired-goto-subdir file))
(dired file))
(let (cmd)
;; Look for some other way to view a certain file.
(dolist (elt dired-view-command-alist)
(if (string-match (car elt) file)
(setq cmd (cdr elt))))
(if cmd
(call-process shell-file-name nil 0 nil
"-c"
(concat (format cmd (shell-quote-argument file))
" &"))
(view-file file))))))
(view-file file))))
(defun dired-find-file-other-window ()
"In Dired, visit this file or directory in another window."

4
lisp/ebuff-menu.el
View File

@ -149,7 +149,9 @@ Letters do not insert themselves; instead, they are commands.
Entry to this mode via command `electric-buffer-list' calls the value of
`electric-buffer-menu-mode-hook'."
(kill-all-local-variables)
(let ((saved header-line-format))
(kill-all-local-variables)
(setq header-line-format saved))
(use-local-map electric-buffer-menu-mode-map)
(setq mode-name "Electric Buffer Menu")
(setq mode-line-buffer-identification "Electric Buffer List")

20
lisp/electric.el
View File

@ -144,31 +144,17 @@
(buf (get-buffer buffer))
(one-window (one-window-p t))
(pop-up-windows t)
(pop-up-frames nil)
(target-height)
(lines))
(pop-up-frames nil))
(if (not buf)
(error "Buffer %s does not exist" buffer)
(with-current-buffer buf
(setq lines (count-lines (point-min) (point-max)))
(setq target-height
(min (max (if max-height (min max-height (1+ lines)) (1+ lines))
window-min-height)
(save-window-excursion
(delete-other-windows)
(1- (window-height (selected-window)))))))
(cond ((and (eq (window-buffer win) buf))
(select-window win))
(one-window
(pop-to-buffer buffer)
(setq win (selected-window))
(enlarge-window (- target-height (window-height win))))
(setq win (selected-window)))
(t
(switch-to-buffer buf)))
(if (and (not max-height)
(> target-height (window-height (selected-window))))
(progn (goto-char (window-start win))
(enlarge-window (- target-height (window-height win)))))
(fit-window-to-buffer win max-height)
(goto-char (point-min))
win)))

4
lisp/emacs-lisp/autoload.el
View File

@ -135,7 +135,7 @@ or macro definition or a defcustom)."
(defun autoload-trim-file-name (file)
;; Returns a relative pathname of FILE
;; Returns a relative file path for FILE
;; starting from the directory that loaddefs.el is in.
;; That is normally a directory in load-path,
;; which means Emacs will be able to find FILE when it looks.
@ -273,7 +273,7 @@ are used."
output-end)
;; If the autoload section we create here uses an absolute
;; pathname for FILE in its header, and then Emacs is installed
;; file name for FILE in its header, and then Emacs is installed
;; under a different path on another system,
;; `update-autoloads-here' won't be able to find the files to be
;; autoloaded. So, if FILE is in the same directory or a

2
lisp/emacs-lisp/elint.el
View File

@ -29,7 +29,7 @@
;; mispellings and undefined variables, although it can also catch
;; function calls with the wrong number of arguments.
;; Before using, call `elint-initialize' to set up som argument
;; Before using, call `elint-initialize' to set up some argument
;; data. This takes a while. Then call elint-current-buffer or
;; elint-defun to lint a buffer or a defun.

189
lisp/emacs-lisp/find-func.el
View File

@ -1,6 +1,6 @@
;;; find-func.el --- find the definition of the Emacs Lisp function near point
;; Copyright (C) 1997, 1999, 2001, 2004 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1999, 2001, 2004, 2005 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@ -76,16 +76,37 @@ Please send improvements and fixes to the maintainer."
:version "21.1")
(defcustom find-variable-regexp
(concat"^\\s-*(def[^umag]\\(\\w\\|\\s_\\)+\\*?" find-function-space-re "%s\\(\\s-\\|$\\)")
(concat"^\\s-*(def[^fumag]\\(\\w\\|\\s_\\)+\\*?" find-function-space-re "%s\\(\\s-\\|$\\)")
"The regexp used by `find-variable' to search for a variable definition.
It should match right up to the variable name. The default value
avoids `defun', `defmacro', `defalias', `defadvice', `defgroup'.
Note it must contain a `%s' at the place where `format'
should insert the variable name. The default value
avoids `defun', `defmacro', `defalias', `defadvice', `defgroup', `defface'.
Please send improvements and fixes to the maintainer."
:type 'regexp
:group 'find-function
:version "21.1")
(defcustom find-face-regexp
(concat"^\\s-*(defface" find-function-space-re "%s\\(\\s-\\|$\\)")
"The regexp used by `find-face' to search for a face definition.
Note it must contain a `%s' at the place where `format'
should insert the face name.
Please send improvements and fixes to the maintainer."
:type 'regexp
:group 'find-function
:version "21.4")
(defvar find-function-regexp-alist
'((nil . find-function-regexp)
(defvar . find-variable-regexp)
(defface . find-face-regexp))
"Alist mapping definition types into regexp variables.
Each regexp variable's value should actually be a format string
to be used to substitute the desired symbol name into the regexp.")
(put 'find-function-regexp-alist 'risky-local-variable t)
(defcustom find-function-source-path nil
"The default list of directories where `find-function' searches.
@ -136,9 +157,9 @@ See the functions `find-function' and `find-variable'."
If nil, do not try to find the source code of functions and variables
defined in C.")
(defun find-function-C-source (fun-or-var file variable-p)
(defun find-function-C-source (fun-or-var file type)
"Find the source location where SUBR-OR-VAR is defined in FILE.
VARIABLE-P should be non-nil for a variable or nil for a subroutine."
TYPE should be nil to find a function, or `defvar' to find a variable."
(unless find-function-C-source-directory
(setq find-function-C-source-directory
(read-directory-name "Emacs C source dir: " nil nil t)))
@ -146,12 +167,12 @@ VARIABLE-P should be non-nil for a variable or nil for a subroutine."
(unless (file-readable-p file)
(error "The C source file %s is not available"
(file-name-nondirectory file)))
(unless variable-p
(unless type
(setq fun-or-var (indirect-function fun-or-var)))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(unless (re-search-forward
(if variable-p
(if type
(concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
(regexp-quote (symbol-name fun-or-var))
"\"")
@ -175,10 +196,12 @@ VARIABLE-P should be non-nil for a variable or nil for a subroutine."
(condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
;;;###autoload
(defun find-function-search-for-symbol (symbol variable-p library)
"Search for SYMBOL.
If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
`find-variable-regexp' is used. The search is done in library LIBRARY."
(defun find-function-search-for-symbol (symbol type library)
"Search for SYMBOL's definition of type TYPE in LIBRARY.
If TYPE is nil, look for a function definition.
Otherwise, TYPE specifies the kind of definition,
and it is interpreted via `find-function-regexp-alist'.
The search is done in the source for library LIBRARY."
(if (null library)
(error "Don't know where `%s' is defined" symbol))
;; Some functions are defined as part of the construct
@ -186,14 +209,13 @@ If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
(while (and (symbolp symbol) (get symbol 'definition-name))
(setq symbol (get symbol 'definition-name)))
(if (string-match "\\`src/\\(.*\\.c\\)\\'" library)
(find-function-C-source symbol (match-string 1 library) variable-p)
(find-function-C-source symbol (match-string 1 library) type)
(if (string-match "\\.el\\(c\\)\\'" library)
(setq library (substring library 0 (match-beginning 1))))
(let* ((filename (find-library-name library)))
(let* ((filename (find-library-name library))
(regexp-symbol (cdr (assq type find-function-regexp-alist))))
(with-current-buffer (find-file-noselect filename)
(let ((regexp (format (if variable-p
find-variable-regexp
find-function-regexp)
(let ((regexp (format (symbol-value regexp-symbol)
(regexp-quote (symbol-name symbol))))
(case-fold-search))
(with-syntax-table emacs-lisp-mode-syntax-table
@ -245,55 +267,53 @@ in `load-path'."
((symbol-file function 'defun)))))
(find-function-search-for-symbol function nil library))))
(defalias 'function-at-point 'function-called-at-point)
(defun find-function-read (&optional variable-p)
(defun find-function-read (&optional type)
"Read and return an interned symbol, defaulting to the one near point.
If the optional VARIABLE-P is nil, then a function is gotten
defaulting to the value of the function `function-at-point', otherwise
a variable is asked for, with the default coming from
`variable-at-point'."
(let ((symb (funcall (if variable-p
'variable-at-point
'function-at-point)))
If TYPE is nil, insist on a symbol with a function definition.
Otherwise TYPE should be `defvar' or `defface'.
If TYPE is nil, defaults using `function-called-at-point',
otherwise uses `variable-at-point'."
(let ((symb (if (null type)
(function-called-at-point)
(if (eq type 'defvar)
(variable-at-point)
(variable-at-point t))))
(predicate (cdr (assq type '((nil . fboundp) (defvar . boundp)
(defface . facep)))))
(prompt (cdr (assq type '((nil . "function") (defvar . "variable")
(defface . "face")))))
(enable-recursive-minibuffers t)
val)
(if (equal symb 0)
(setq symb nil))
(setq val (if variable-p
(completing-read
(concat "Find variable"
(if symb
(format " (default %s)" symb))
": ")
obarray 'boundp t nil)
(completing-read
(concat "Find function"
(if symb
(format " (default %s)" symb))
": ")
obarray 'fboundp t nil)))
(setq val (completing-read
(concat "Find "
prompt
(if symb
(format " (default %s)" symb))
": ")
obarray predicate t nil))
(list (if (equal val "")
symb
(intern val)))))
(defun find-function-do-it (symbol variable-p switch-fn)
(defun find-function-do-it (symbol type switch-fn)
"Find Emacs Lisp SYMBOL in a buffer and display it.
If VARIABLE-P is nil, a function definition is searched for, otherwise
a variable definition is searched for. The start of a definition is
centered according to the variable `find-function-recenter-line'.
See also `find-function-after-hook' It is displayed with function SWITCH-FN.
TYPE is nil to search for a function definition,
or else `defvar' or `defface'.
Point is saved in the buffer if it is one of the current buffers."
The variable `find-function-recenter-line' controls how
to recenter the display. SWITCH-FN is the function to call
to display and select the buffer.
See also `find-function-after-hook'.
Set mark before moving, if the buffer already existed."
(let* ((orig-point (point))
(orig-buf (window-buffer))
(orig-buffers (buffer-list))
(buffer-point (save-excursion
(funcall (if variable-p
'find-variable-noselect
'find-function-noselect)
symbol)))
(find-definition-noselect symbol type)))
(new-buf (car buffer-point))
(new-point (cdr buffer-point)))
(when buffer-point
@ -309,9 +329,9 @@ Point is saved in the buffer if it is one of the current buffers."
"Find the definition of the FUNCTION near point.
Finds the Emacs Lisp library containing the definition of the function
near point (selected by `function-at-point') in a buffer and
places point before the definition. Point is saved in the buffer if
it is one of the current buffers.
near point (selected by `function-called-at-point') in a buffer and
places point before the definition.
Set mark before moving, if the buffer already existed.
The library where FUNCTION is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
@ -340,15 +360,15 @@ See `find-function' for more details."
"Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
Finds the Emacs Lisp library containing the definition of SYMBOL
in a buffer and the point of the definition. The buffer is
not selected.
in a buffer, and the point of the definition. It does not switch
to the buffer or display it.
The library where VARIABLE is defined is searched for in FILE or
`find-function-source-path', if non nil, otherwise in `load-path'."
(if (not variable)
(error "You didn't specify a variable"))
(let ((library (or file (symbol-file variable 'defvar))))
(find-function-search-for-symbol variable 'variable library)))
(find-function-search-for-symbol variable 'defvar library)))
;;;###autoload
(defun find-variable (variable)
@ -356,35 +376,70 @@ The library where VARIABLE is defined is searched for in FILE or
Finds the Emacs Lisp library containing the definition of the variable
near point (selected by `variable-at-point') in a buffer and
places point before the definition. Point is saved in the buffer if
it is one of the current buffers.
places point before the definition.
Set mark before moving, if the buffer already existed.
The library where VARIABLE is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read 'variable))
(find-function-do-it variable t 'switch-to-buffer))
(interactive (find-function-read 'defvar))
(find-function-do-it variable 'defvar 'switch-to-buffer))
;;;###autoload
(defun find-variable-other-window (variable)
"Find, in another window, the definition of VARIABLE near point.
See `find-variable' for more details."
(interactive (find-function-read 'variable))
(find-function-do-it variable t 'switch-to-buffer-other-window))
(interactive (find-function-read 'defvar))
(find-function-do-it variable 'defvar 'switch-to-buffer-other-window))
;;;###autoload
(defun find-variable-other-frame (variable)
"Find, in annother frame, the definition of VARIABLE near point.
See `find-variable' for more details."
(interactive (find-function-read 'variable))
(find-function-do-it variable t 'switch-to-buffer-other-frame))
(interactive (find-function-read 'defvar))
(find-function-do-it variable 'defvar 'switch-to-buffer-other-frame))
;;;###autoload
(defun find-definition-noselect (symbol type &optional file)
"Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
TYPE says what type of definition: nil for a function,
`defvar' or `defface' for a variable or face. This functoin
does not switch to the buffer or display it.
The library where SYMBOL is defined is searched for in FILE or
`find-function-source-path', if non nil, otherwise in `load-path'."
(if (not symbol)
(error "You didn't specify a symbol"))
(if (null type)
(find-function-noselect symbol)
(let ((library (or file (symbol-file symbol type))))
(find-function-search-for-symbol symbol type library))))
;; For symmetry, this should be called find-face; but some programs
;; assume that, if that name is defined, it means something else.
;;;###autoload
(defun find-face-definition (face)
"Find the definition of FACE. FACE defaults to the name near point.
Finds the Emacs Lisp library containing the definition of the face
near point (selected by `variable-at-point') in a buffer and
places point before the definition.
Set mark before moving, if the buffer already existed.
The library where FACE is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read 'defface))
(find-function-do-it face 'defface 'switch-to-buffer))
;;;###autoload
(defun find-function-on-key (key)
"Find the function that KEY invokes. KEY is a string.
Point is saved if FUNCTION is in the current buffer."
Set mark before moving, if the buffer already existed."
(interactive "kFind function on key: ")
(let (defn)
(save-excursion
@ -412,7 +467,7 @@ Point is saved if FUNCTION is in the current buffer."
(defun find-function-at-point ()
"Find directly the function at point in the other window."
(interactive)
(let ((symb (function-at-point)))
(let ((symb (function-called-at-point)))
(when symb
(find-function-other-window symb))))
@ -437,5 +492,5 @@ Point is saved if FUNCTION is in the current buffer."
(provide 'find-func)
;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
;;; find-func.el ends here

7
lisp/emacs-lisp/lisp-mnt.el
View File

@ -304,9 +304,14 @@ If FILE is nil, execute BODY in the current buffer."
(if ,filesym
(with-temp-buffer
(insert-file-contents ,filesym)
(lisp-mode)
,@body)
(save-excursion
,@body)))))
;; Switching major modes is too drastic, so just switch
;; temporarily to the Lisp mode syntax table.
(with-syntax-table lisp-mode-syntax-table
,@body))))))
(put 'lm-with-file 'lisp-indent-function 1)
(put 'lm-with-file 'edebug-form-spec t)

17
lisp/emacs-lisp/lisp-mode.el
View File

@ -1,6 +1,6 @@
;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004
;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -602,7 +602,7 @@ Reinitialize the face according to the `defface' specification."
(boundp (cadr form)))
;; Force variable to be re-set.
`(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
(setq ,(nth 1 form) ,(nth 2 form))))
(setq-default ,(nth 1 form) ,(nth 2 form))))
;; `defcustom' is now macroexpanded to
;; `custom-declare-variable' with a quoted value arg.
((and (eq (car form) 'custom-declare-variable)
@ -881,11 +881,11 @@ which has a non-nil property `lisp-indent-function',
that specifies how to do the indentation. The property value can be
* `defun', meaning indent `defun'-style;
* an integer N, meaning indent the first N arguments specially
like ordinary function arguments and then indent any further
aruments like a body;
like ordinary function arguments and then indent any further
arguments like a body;
* a function to call just as this function was called.
If that function returns nil, that means it doesn't specify
the indentation.
If that function returns nil, that means it doesn't specify
the indentation.
This function also returns nil meaning don't specify the indentation."
(let ((normal-indent (current-column)))
@ -921,7 +921,7 @@ This function also returns nil meaning don't specify the indentation."
(lisp-indent-specform method state
indent-point normal-indent))
(method
(funcall method state indent-point)))))))
(funcall method indent-point state)))))))
(defvar lisp-body-indent 2
"Number of columns to indent the second line of a `(def...)' form.")
@ -1125,7 +1125,8 @@ ENDPOS is encountered."
(set-marker endmark nil))))
(defun indent-pp-sexp (&optional arg)
"Indent each line of the list or, with prefix ARG, pretty-printify the list."
"Indent each line of the list starting just after point, or prettyprint it.
A prefix argument specifies pretty-printing."
(interactive "P")
(if arg
(save-excursion

12
lisp/emacs-lisp/lisp.el
View File

@ -140,18 +140,18 @@ A negative argument means move backward but still to a less deep spot."
(setq arg (- arg inc)))))
(defun kill-sexp (&optional arg)
"Kill the sexp (balanced expression) following the cursor.
With ARG, kill that many sexps after the cursor.
Negative arg -N means kill N sexps before the cursor."
"Kill the sexp (balanced expression) following point.
With ARG, kill that many sexps after point.
Negative arg -N means kill N sexps before point."
(interactive "p")
(let ((opoint (point)))
(forward-sexp (or arg 1))
(kill-region opoint (point))))
(defun backward-kill-sexp (&optional arg)
"Kill the sexp (balanced expression) preceding the cursor.
With ARG, kill that many sexps before the cursor.
Negative arg -N means kill N sexps after the cursor."
"Kill the sexp (balanced expression) preceding point.
With ARG, kill that many sexps before point.
Negative arg -N means kill N sexps after point."
(interactive "p")
(kill-sexp (- (or arg 1))))

8
lisp/emacs-lisp/re-builder.el
View File

@ -1,6 +1,6 @@
;;; re-builder.el --- building Regexps with visual feedback
;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
@ -61,12 +61,12 @@
;; even the auto updates go all the way. Forcing an update overrides
;; this limit allowing an easy way to see all matches.
;; Currently `re-builder' understands four different forms of input,
;; namely `read', `string', `sregex' and `lisp-re' syntax. Read
;; Currently `re-builder' understands five different forms of input,
;; namely `read', `string', `rx', `sregex' and `lisp-re' syntax. Read
;; syntax and string syntax are both delimited by `"'s and behave
;; according to their name. With the `string' syntax there's no need
;; to escape the backslashes and double quotes simplifying the editing
;; somewhat. The other two allow editing of symbolic regular
;; somewhat. The other three allow editing of symbolic regular
;; expressions supported by the packages of the same name. (`lisp-re'
;; is a package by me and its support may go away as it is nearly the
;; same as the `sregex' package in Emacs)

113
lisp/facemenu.el
View File

@ -471,50 +471,81 @@ These special properties include `invisible', `intangible' and `read-only'."
col)))
;;;###autoload
(defun list-colors-display (&optional list)
(defun list-colors-display (&optional list buffer-name)
"Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
colors to display. Otherwise, this command computes a list
of colors that the current display can handle."
colors to display. Otherwise, this command computes a list of
colors that the current display can handle. If the optional
argument BUFFER-NAME is nil, it defaults to *Colors*."
(interactive)
(when (and (null list) (> (display-color-cells) 0))
(setq list (defined-colors))
;; Delete duplicate colors.
;; Identify duplicate colors by the name rather than the color
;; value. For example, on MS-Windows, logical colors are added to
;; the list that might have the same value but have different
;; names and meanings. For example, `SystemMenuText' (the color
;; w32 uses for the text in menu entries) and `SystemWindowText'
;; (the default color w32 uses for the text in windows and
;; dialogs) may be the same display color and be adjacent in the
;; list. Detecting duplicates by name insures that both of these
;; colors remain despite identical color values.
(let ((l list))
(while (cdr l)
(if (facemenu-color-name-equal (car l) (car (cdr l)))
(setcdr l (cdr (cdr l)))
(setq l (cdr l)))))
(setq list (list-colors-duplicates (defined-colors)))
(when (memq (display-visual-class) '(gray-scale pseudo-color direct-color))
;; Don't show more than what the display can handle.
(let ((lc (nthcdr (1- (display-color-cells)) list)))
(if lc
(setcdr lc nil)))))
(with-output-to-temp-buffer "*Colors*"
(with-output-to-temp-buffer (or buffer-name "*Colors*")
(save-excursion
(set-buffer standard-output)
(let (s)
(while list
(setq s (point))
(insert (car list))
(indent-to 20)
(put-text-property s (point) 'face
(cons 'background-color (car list)))
(setq s (point))
(insert " " (car list) "\n")
(put-text-property s (point) 'face
(cons 'foreground-color (car list)))
(setq list (cdr list)))))))
(setq truncate-lines t)
(if temp-buffer-show-function
(list-colors-print list)
;; Call list-colors-print from temp-buffer-show-hook
;; to get the right value of window-width in list-colors-print
;; after the buffer is displayed.
(add-hook 'temp-buffer-show-hook
(lambda () (list-colors-print list)) nil t)))))
(defun list-colors-print (list)
(dolist (color list)
(if (consp color)
(if (cdr color)
(setq color (sort color (lambda (a b)
(string< (downcase a)
(downcase b))))))
(setq color (list color)))
(put-text-property
(prog1 (point)
(insert (car color))
(indent-to 22))
(point)
'face (cons 'background-color (car color)))
(put-text-property
(prog1 (point)
(insert " " (if (cdr color)
(mapconcat 'identity (cdr color) ", ")
(car color)))
(indent-to (max (- (window-width) 8) 44))
(insert (apply 'format " #%02x%02x%02x"
(mapcar (lambda (c) (lsh c -8))
(color-values (car color)))))
(insert "\n"))
(point)
'face (cons 'foreground-color (car color))))
(goto-char (point-min)))
(defun list-colors-duplicates (&optional list)
"Return a list of colors with grouped duplicate colors.
If a color has no duplicates, then the element of the returned list
has the form '(COLOR-NAME). The element of the returned list with
duplicate colors has the form '(COLOR-NAME DUPLICATE-COLOR-NAME ...).
This function uses the predicate `facemenu-color-equal' to compare
color names. If the optional argument LIST is non-nil, it should
be a list of colors to display. Otherwise, this function uses
a list of colors that the current display can handle."
(let* ((list (mapcar 'list (or list (defined-colors))))
(l list))
(while (cdr l)
(if (and (facemenu-color-equal (car (car l)) (car (car (cdr l))))
(not (and (boundp 'w32-default-color-map)
(not (assoc (car (car l)) w32-default-color-map)))))
(progn
(setcdr (car l) (cons (car (car (cdr l))) (cdr (car l))))
(setcdr l (cdr (cdr l))))
(setq l (cdr l))))
list))
(defun facemenu-color-equal (a b)
"Return t if colors A and B are the same color.
@ -525,22 +556,6 @@ determine the correct answer."
(cond ((equal a b) t)
((equal (color-values a) (color-values b)))))
(defun facemenu-color-name-equal (a b)
"Return t if colors A and B are the same color.
A and B should be strings naming colors. These names are
downcased, stripped of spaces and the string `grey' is turned
into `gray'. This accommodates alternative spellings of colors
found commonly in the list. It returns nil if the colors differ."
(progn
(setq a (replace-regexp-in-string "grey" "gray"
(replace-regexp-in-string " " ""
(downcase a)))
b (replace-regexp-in-string "grey" "gray"
(replace-regexp-in-string " " ""
(downcase b))))
(equal a b)))
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.
If START is nil or START to END is empty, add FACE to next typed character

32
lisp/faces.el
View File

@ -730,7 +730,9 @@ and `:slant'. When called interactively, prompt for the face and font."
(defun set-face-background (face color &optional frame)
"Change the background color of face FACE to COLOR (a string).
FRAME nil or not specified means change face on all frames.
When called interactively, prompt for the face and color."
COLOR can be a system-defined color name (see `list-colors-display')
or a hex spec of the form #RRGGBB.
When called interactively, prompts for the face and color."
(interactive (read-face-and-attribute :background))
(set-face-attribute face frame :background (or color 'unspecified)))
@ -738,7 +740,9 @@ When called interactively, prompt for the face and color."
(defun set-face-foreground (face color &optional frame)
"Change the foreground color of face FACE to COLOR (a string).
FRAME nil or not specified means change face on all frames.
When called interactively, prompt for the face and color."
COLOR can be a system-defined color name (see `list-colors-display')
or a hex spec of the form #RRGGBB.
When called interactively, prompts for the face and color."
(interactive (read-face-and-attribute :foreground))
(set-face-attribute face frame :foreground (or color 'unspecified)))
@ -1139,15 +1143,26 @@ Value is a list (FACE NEW-VALUE) where FACE is the face read
;; conflict with Lucid, which uses that name differently.
(defvar help-xref-stack)
(defun list-faces-display ()
(defun list-faces-display (&optional regexp)
"List all faces, using the same sample text in each.
The sample text is a string that comes from the variable
`list-faces-sample-text'."
(interactive)
`list-faces-sample-text'.
If REGEXP is non-nil, list only those faces with names matching
this regular expression. When called interactively with a prefix
arg, prompt for a regular expression."
(interactive (list (and current-prefix-arg
(read-string "List faces matching regexp: "))))
(let ((faces (sort (face-list) #'string-lessp))
(face nil)
(frame (selected-frame))
disp-frame window face-name)
(when (> (length regexp) 0)
(setq faces
(delq nil
(mapcar (lambda (f)
(when (string-match regexp (symbol-name f))
f))
faces))))
(with-output-to-temp-buffer "*Faces*"
(save-excursion
(set-buffer standard-output)
@ -1160,9 +1175,7 @@ The sample text is a string that comes from the variable
"\\[help-follow] on a face name to customize it\n"
"or on its sample text for a description of the face.\n\n")))
(setq help-xref-stack nil)
(while faces
(setq face (car faces))
(setq faces (cdr faces))
(dolist (face faces)
(setq face-name (symbol-name face))
(insert (format "%25s " face-name))
;; Hyperlink to a customization buffer for the face. Using
@ -1204,6 +1217,7 @@ The sample text is a string that comes from the variable
(copy-face (car faces) (car faces) frame disp-frame)
(setq faces (cdr faces)))))))
(defun describe-face (face &optional frame)
"Display the properties of face FACE on FRAME.
Interactively, FACE defaults to the faces of the character after point

282
lisp/files.el
View File

@ -1,7 +1,7 @@
;;; files.el --- file input and output commands for Emacs
;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,03,2004
;;; Free Software Foundation, Inc.
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
@ -1856,8 +1856,14 @@ mode function to use. FUNCTION will be called, unless it is nil.
If the element has the form (REGEXP FUNCTION NON-NIL), then after
calling FUNCTION (if it's not nil), we delete the suffix that matched
REGEXP and search the list again for another match.")
REGEXP and search the list again for another match.
If the file name matches `inhibit-first-line-modes-regexps',
then `auto-mode-alist' is not processed.
See also `interpreter-mode-alist', which detects executable script modes
based on the interpreters they specify to run,
and `magic-mode-alist', which determines modes based on file contents.")
(defvar interpreter-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (awk-mode
@ -1902,11 +1908,13 @@ REGEXP and search the list again for another match.")
("guile" . scheme-mode)
("clisp" . lisp-mode)))
"Alist mapping interpreter names to major modes.
This alist applies to files whose first line starts with `#!'.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
Each element looks like (INTERPRETER . MODE).
The car of each element is compared with
the name of the interpreter specified in the first line.
If it matches, mode MODE is selected.")
If it matches, mode MODE is selected.
See also `auto-mode-alist'.")
(defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
"List of regexps; if one matches a file name, don't look for `-*-'.")
@ -1935,12 +1943,14 @@ with that interpreter in `interpreter-mode-alist'.")
(concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<"
comment-re "*"
"\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?"
"[Hh][Tt][Mm][Ll]")) . html-mode)
"[Hh][Tt][Mm][Ll]"))
. html-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
(comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)")))
(concat "\\s *<" comment-re "*!DOCTYPE ")) . sgml-mode)
(concat "\\s *<" comment-re "*!DOCTYPE "))
. sgml-mode)
("%![^V]" . ps-mode)
("# xmcd " . conf-unix-mode))
"Alist of buffer beginnings vs. corresponding major mode functions.
@ -2202,93 +2212,86 @@ is specified, returning t if it is specified."
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(if (let ((case-fold-search t))
(and (search-forward "Local Variables:" nil t)
(or (eq enable-local-variables t)
mode-only
(and enable-local-variables
(save-window-excursion
(switch-to-buffer (current-buffer))
(save-excursion
(beginning-of-line)
(set-window-start (selected-window) (point)))
(y-or-n-p (format "Set local variables as specified at end of %s? "
(if buffer-file-name
(file-name-nondirectory
buffer-file-name)
(concat "buffer "
(buffer-name))))))))))
(let (prefix suffix beg
(enable-local-eval enable-local-eval))
;; The prefix is what comes before "local variables:" in its line.
;; The suffix is what comes after "local variables:" in its line.
(skip-chars-forward " \t")
(or (eolp)
(setq suffix (buffer-substring (point)
(progn (end-of-line) (point)))))
(goto-char (match-beginning 0))
(or (bolp)
(setq prefix
(buffer-substring (point)
(progn (beginning-of-line) (point)))))
(when (let ((case-fold-search t))
(and (search-forward "Local Variables:" nil t)
(or (eq enable-local-variables t)
mode-only
(and enable-local-variables
(save-window-excursion
(switch-to-buffer (current-buffer))
(save-excursion
(beginning-of-line)
(set-window-start (selected-window) (point)))
(y-or-n-p (format "Set local variables as specified at end of %s? "
(if buffer-file-name
(file-name-nondirectory
buffer-file-name)
(concat "buffer "
(buffer-name))))))))))
(skip-chars-forward " \t")
(let ((enable-local-eval enable-local-eval)
;; suffix is what comes after "local variables:" in its line.
(suffix
(concat
(regexp-quote (buffer-substring (point) (line-end-position)))
"$"))
;; prefix is what comes before "local variables:" in its line.
(prefix
(concat "^" (regexp-quote
(buffer-substring (line-beginning-position)
(match-beginning 0)))))
beg)
(setq prefix (if prefix (regexp-quote prefix) "^"))
(if suffix (setq suffix (concat (regexp-quote suffix) "$")))
(forward-line 1)
(let ((startpos (point))
endpos
(thisbuf (current-buffer)))
(save-excursion
(if (not (re-search-forward
(concat (or prefix "")
"[ \t]*End:[ \t]*"
(or suffix ""))
nil t))
(error "Local variables list is not properly terminated"))
(beginning-of-line)
(setq endpos (point)))
(forward-line 1)
(let ((startpos (point))
endpos
(thisbuf (current-buffer)))
(save-excursion
(if (not (re-search-forward
(concat prefix "[ \t]*End:[ \t]*" suffix)
nil t))
(error "Local variables list is not properly terminated"))
(beginning-of-line)
(setq endpos (point)))
(with-temp-buffer
(insert-buffer-substring thisbuf startpos endpos)
(goto-char (point-min))
(subst-char-in-region (point) (point-max)
?\^m ?\n)
(while (not (eobp))
;; Discard the prefix, if any.
(if prefix
(if (looking-at prefix)
(delete-region (point) (match-end 0))
(error "Local variables entry is missing the prefix")))
(end-of-line)
;; Discard the suffix, if any.
(if suffix
(if (looking-back suffix)
(delete-region (match-beginning 0) (point))
(error "Local variables entry is missing the suffix")))
(forward-line 1))
(goto-char (point-min))
(with-temp-buffer
(insert-buffer-substring thisbuf startpos endpos)
(goto-char (point-min))
(subst-char-in-region (point) (point-max) ?\^m ?\n)
(while (not (eobp))
;; Discard the prefix.
(if (looking-at prefix)
(delete-region (point) (match-end 0))
(error "Local variables entry is missing the prefix"))
(end-of-line)
;; Discard the suffix.
(if (looking-back suffix)
(delete-region (match-beginning 0) (point))
(error "Local variables entry is missing the suffix"))
(forward-line 1))
(goto-char (point-min))
(while (not (eobp))
;; Find the variable name; strip whitespace.
(skip-chars-forward " \t")
(setq beg (point))
(skip-chars-forward "^:\n")
(if (eolp) (error "Missing colon in local variables entry"))
(skip-chars-backward " \t")
(let* ((str (buffer-substring beg (point)))
(var (read str))
val)
;; Read the variable value.
(skip-chars-forward "^:")
(forward-char 1)
(setq val (read (current-buffer)))
(if mode-only
(if (eq var 'mode)
(setq mode-specified t))
;; Set the variable. "Variables" mode and eval are funny.
(with-current-buffer thisbuf
(hack-one-local-variable var val))))
(forward-line 1)))))))
(while (not (eobp))
;; Find the variable name; strip whitespace.
(skip-chars-forward " \t")
(setq beg (point))
(skip-chars-forward "^:\n")
(if (eolp) (error "Missing colon in local variables entry"))
(skip-chars-backward " \t")
(let* ((str (buffer-substring beg (point)))
(var (read str))
val)
;; Read the variable value.
(skip-chars-forward "^:")
(forward-char 1)
(setq val (read (current-buffer)))
(if mode-only
(if (eq var 'mode)
(setq mode-specified t))
;; Set the variable. "Variables" mode and eval are funny.
(with-current-buffer thisbuf
(hack-one-local-variable var val))))
(forward-line 1)))))))
(unless mode-only
(run-hooks 'hack-local-variables-hook))
mode-specified))
@ -2841,13 +2844,18 @@ ignored."
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory' or
`small-temporary-file-directory'."
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and /tmp."
(not (or (let ((comp (compare-strings temporary-file-directory 0 nil
name 0 nil)))
;; Directory is under temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length temporary-file-directory)))))
(let ((comp (compare-strings "/tmp" 0 nil
name 0 nil)))
;; Directory is under /tmp.
(and (not (eq comp t))
(< comp (- (length "/tmp")))))
(if small-temporary-file-directory
(let ((comp (compare-strings small-temporary-file-directory
0 nil
@ -3271,11 +3279,12 @@ Before and after saving the buffer, this function runs
;; but inhibited if one of write-file-functions returns non-nil.
;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-1 ()
(if save-buffer-coding-system
(let ((coding-system-for-write save-buffer-coding-system))
(prog1
(if save-buffer-coding-system
(let ((coding-system-for-write save-buffer-coding-system))
(basic-save-buffer-2))
(basic-save-buffer-2))
(basic-save-buffer-2))
(setq buffer-file-coding-system-explicit last-coding-system-used))
(setq buffer-file-coding-system-explicit last-coding-system-used)))
;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
@ -4546,47 +4555,54 @@ normally equivalent short `-D' option is just passed on to
(when (if (stringp switches)
(string-match "--dired\\>" switches)
(member "--dired" switches))
;; The following overshoots by one line for an empty
;; directory listed with "--dired", but without "-a"
;; switch, where the ls output contains a
;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
;; We take care of that case later.
(forward-line -2)
(when (looking-at "//SUBDIRED//")
(delete-region (point) (progn (forward-line 1) (point)))
(forward-line -1))
(when (looking-at "//DIRED//")
(let ((end (line-end-position))
(linebeg (point))
error-lines)
;; Find all the lines that are error messages,
;; and record the bounds of each one.
(goto-char (point-min))
(while (< (point) linebeg)
(or (eql (following-char) ?\s)
(push (list (point) (line-end-position)) error-lines))
(forward-line 1))
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
(forward-word 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
(if (looking-at "//DIRED//")
(let ((end (line-end-position))
(linebeg (point))
error-lines)
;; Find all the lines that are error messages,
;; and record the bounds of each one.
(goto-char beg)
(while (< (point) linebeg)
(or (eql (following-char) ?\s)
(push (list (point) (line-end-position)) error-lines))
(forward-line 1))
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
(forward-word 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines))
(end (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines))
(end (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines)))
(if (memq (char-after end) '(?\n ?\ ))
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t)
;; It seems that we can't trust ls's output as to
;; byte positions of filenames.
(put-text-property beg (point) 'dired-filename nil)
(end-of-line))))
(goto-char end)
(beginning-of-line)
(delete-region (point) (progn (forward-line 2) (point))))
(forward-line 1)
(if (looking-at "//DIRED-OPTIONS//")
(delete-region (point) (progn (forward-line 1) (point)))
(forward-line 1))))
error-lines)))
(if (memq (char-after end) '(?\n ?\ ))
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t)
;; It seems that we can't trust ls's output as to
;; byte positions of filenames.
(put-text-property beg (point) 'dired-filename nil)
(end-of-line))))
(goto-char end)
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point))))
;; Take care of the case where the ls output contains a
;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
;; and we went one line too far back (see above).
(forward-line 1))
(if (looking-at "//DIRED-OPTIONS//")
(delete-region (point) (progn (forward-line 1) (point)))))
;; Now decode what read if necessary.
(let ((coding (or coding-system-for-read

8
lisp/font-core.el
View File

@ -1,7 +1,7 @@
;;; font-core.el --- Core interface to font-lock
;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001, 02, 2003
;; Free Software Foundation, Inc.
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
;; 2002, 2003, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: languages, faces
@ -202,6 +202,7 @@ this function onto `change-major-mode-hook'."
;; Only do hard work if the mode has specified stuff in
;; `font-lock-defaults'.
(when (or font-lock-defaults
(and (boundp 'font-lock-keywords) font-lock-keywords)
(cdr (assq major-mode font-lock-defaults-alist)))
(font-lock-mode-internal mode)))
@ -295,6 +296,5 @@ means that Font Lock mode is turned on for buffers in C and C++ modes only."
(provide 'font-core)
;; arch-tag: f8c286e1-02f7-41d9-b89b-1b67780aed71
;;; font-core.el ends here
;;; arch-tag: f8c286e1-02f7-41d9-b89b-1b67780aed71

62
lisp/gnus/ChangeLog
View File

@ -1,9 +1,45 @@
2005-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space.
2005-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
* message.el (message-beginning-of-line): Change the behavior when
invoked between BOL and : so that it first moves backward.
2005-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-setup-buffer): Kill and re-create the
article buffer when editing of the article is discarded.
(gnus-article-prepare): Revert.
2005-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-prepare):
Remove message-strip-forbidden-properties from the local hook.
2005-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
* mml.el (mml-generate-mime-1): Convert string into unibyte when
inserting " *mml*" buffer's contents into a unibyte temp buffer.
2005-01-20 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-insert-part): Switch the multibyteness of data
which will be inserted according to the multibyteness of a buffer
rather than the type of contents. Suggested by ARISAWA Akihiro
<ari@mbf.ocn.ne.jp>.
2005-01-05 Reiner Steib <Reiner.Steib@gmx.de>
* spam.el (spam-face): New face. Don't use `gnus-splash-face'
which is unreadable in some setups.
2004-12-27 Simon Josefsson <jas@extundo.com>
* mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used
when mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME)
and we have trailing white space. Reported by Werner Koch
<wk@gnupg.org>.
* mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when
mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) and we have
trailing white space. Reported by Werner Koch <wk@gnupg.org>.
2004-12-17 Kim F. Storm <storm@cua.dk>
@ -46,8 +82,8 @@
2004-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-group.el (gnus-group-make-rss-group): Use
gnus-group-make-group instead of gnus-group-unsubscribe-group.
* gnus-group.el (gnus-group-make-rss-group):
Use gnus-group-make-group instead of gnus-group-unsubscribe-group.
* gnus-start.el (gnus-setup-news): Honor user's setting to
gnus-message-archive-method. Suggested by Lute Kamstra
@ -376,11 +412,10 @@
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore
servers that are offline. Avoids having gnus-agent-toggle-plugged
first ask if you want to open a server and then, even when you
responded with no, asking if you want to synchronize the server's
flags.
* gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers
that are offline. Avoids having gnus-agent-toggle-plugged first ask if
you want to open a server and then, even when you responded with no,
asking if you want to synchronize the server's flags.
(gnus-agent-synchronize-flags-server): Rewrite read loop to handle
multi-line expressions.
(gnus-agent-synchronize-group-flags): New internal function.
@ -528,9 +563,8 @@
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-start.el (gnus-convert-old-newsrc): Only write the
conversion message to newsrc-dribble when an actual conversion is
performed.
* gnus-start.el (gnus-convert-old-newsrc): Only write the conversion
message to newsrc-dribble when an actual conversion is performed.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>

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

@ -1,5 +1,5 @@
;;; gnus-art.el --- article mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -3711,6 +3711,8 @@ commands:
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
;; Prevent recent Emacsen from displaying non-break space as "\ ".
(set (make-local-variable 'show-nonbreak-escape) nil)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
@ -3743,14 +3745,19 @@ commands:
(mm-enable-multibyte)
(setq major-mode 'gnus-original-article-mode)
(make-local-variable 'gnus-original-article))
(if (get-buffer name)
(if (and (get-buffer name)
(with-current-buffer name
(if gnus-article-edit-mode
(if (y-or-n-p "Article mode edit in progress; discard? ")
(progn
(set-buffer-modified-p nil)
(gnus-kill-buffer name)
(message "")
nil)
(error "Action aborted"))
t)))
(save-excursion
(set-buffer name)
(when (and gnus-article-edit-mode
(buffer-modified-p)
(not
(y-or-n-p "Article mode edit in progress; discard? ")))
(error "Action aborted"))
(set (make-local-variable 'gnus-article-edit-mode) nil)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)

8
lisp/gnus/imap.el
View File

@ -1,5 +1,5 @@
;;; imap.el --- imap library
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2005
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
@ -69,7 +69,7 @@
;; imap-message-append, imap-envelope-from
;; imap-body-lines
;;
;; It is my hope that theese commands should be pretty self
;; It is my hope that these commands should be pretty self
;; explanatory for someone that know IMAP. All functions have
;; additional documentation on how to invoke them.
;;
@ -325,7 +325,7 @@ for doing the actual authentication.")
(defvar imap-error nil
"Error codes from the last command.")
;; Internal constants. Change theese and die.
;; Internal constants. Change these and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
@ -1456,7 +1456,7 @@ or 'unseen. The IMAP command tag is returned."
(defun imap-fetch (uids props &optional receive nouidfetch buffer)
"Fetch properties PROPS from message set UIDS from server in BUFFER.
UIDS can be a string, number or a list of numbers. If RECEIVE
is non-nil return theese properties."
is non-nil return these properties."
(with-current-buffer (or buffer (current-buffer))
(when (imap-ok-p (imap-send-command-wait
(format "%sFETCH %s %s" (if nouidfetch "" "UID ")

20
lisp/gnus/message.el
View File

@ -1,5 +1,5 @@
;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -800,7 +800,7 @@ variable isn't used."
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
(defcustom message-generate-headers-first '(references)
"Which headers should be generated before starting to compose a message.
If `t', generate all required headers. This can also be a list of headers to
If t, generate all required headers. This can also be a list of headers to
generate. The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
@ -5295,10 +5295,10 @@ outside the message header or if the option `message-beginning-of-line'
is nil.
If point is in the message header and on a (non-continued) header
line, move point to the beginning of the header value. If point
is already there, move point to beginning of line. Therefore,
repeated calls will toggle point between beginning of field and
beginning of line."
line, move point to the beginning of the header value or the beginning of line,
whichever is closer. If point is already at beginning of line, move point to
beginning of header value. Therefore, repeated calls will toggle point
between beginning of field and beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
(when (and (interactive-p) (boundp zrs))
@ -5309,9 +5309,9 @@ beginning of line."
(bol (progn (beginning-of-line n) (point)))
(eol (gnus-point-at-eol))
(eoh (re-search-forward ": *" eol t)))
(if (or (not eoh) (equal here eoh))
(goto-char bol)
(goto-char eoh)))
(goto-char
(if (and eoh (or (< eoh here) (= bol here)))
eoh bol)))
(beginning-of-line n)))
(defun message-buffer-name (type &optional to group)
@ -6880,5 +6880,5 @@ regexp VARSTR."
;; coding: iso-8859-1
;; End:
;;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;;; message.el ends here

27
lisp/gnus/mm-decode.el
View File

@ -1,5 +1,5 @@
;;; mm-decode.el --- Functions for decoding MIME things
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -1032,27 +1032,10 @@ external if displayed external."
(defun mm-insert-part (handle)
"Insert the contents of HANDLE in the current buffer."
(let ((cur (current-buffer)))
(save-excursion
(if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(prog1
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp))))
(mm-with-unibyte-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(prog1
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp))))))))
(save-excursion
(insert (if (mm-multibyte-p)
(mm-string-as-multibyte (mm-get-part handle))
(mm-get-part handle)))))
(defun mm-file-name-delete-whitespace (file-name)
"Remove all whitespace characters from FILE-NAME."

6
lisp/gnus/mml.el
View File

@ -1,5 +1,5 @@
;;; mml.el --- A package for parsing and validating MML documents
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -472,7 +472,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(mm-with-unibyte-buffer
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
(insert (with-current-buffer (cdr (assq 'buffer cont))
(mm-with-unibyte-current-buffer
(buffer-string)))))
((and (setq filename (cdr (assq 'filename cont)))
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read mm-binary-coding-system))

14
lisp/gnus/spam.el
View File

@ -298,7 +298,19 @@ All unmarked article in such group receive the spam mark on group entry."
:type '(radio (const nil) regexp)
:group 'spam)
(defcustom spam-face 'gnus-splash-face
(defface spam-face
'((((class color) (type tty) (background dark))
(:foreground "gray80" :background "gray50"))
(((class color) (type tty) (background light))
(:foreground "gray50" :background "gray80"))
(((class color) (background dark))
(:foreground "ivory2"))
(((class color) (background light))
(:foreground "ivory4"))
(t :inverse-video t))
"Face for spam-marked articles.")
(defcustom spam-face 'spam-face
"Face for spam-marked articles."
:type 'face
:group 'spam)

1
lisp/help-at-pt.el
View File

@ -146,6 +146,7 @@ This is done by setting a timer, if none is currently active."
(run-with-idle-timer
help-at-pt-timer-delay t #'help-at-pt-maybe-display))))
;;;###autoload
(defcustom help-at-pt-display-when-idle 'never
"*Automatically show local help on point-over.
If the value is t, the string obtained from any `kbd-help' or

21
lisp/help-fns.el
View File

@ -216,6 +216,14 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
(intern (upcase name))))))
arglist)))
;;; Could be this, if we make symbol-file do the work below.
;;; (defun help-C-file-name (subr-or-var kind)
;;; "Return the name of the C file where SUBR-OR-VAR is defined.
;;; KIND should be `var' for a variable or `subr' for a subroutine."
;;; (symbol-file (if (symbolp subr-or-var) subr-or-var
;;; (subr-name subr-or-var))
;;; (if (eq kind 'var) 'defvar 'defun)))
(defun help-C-file-name (subr-or-var kind)
"Return the name of the C file where SUBR-OR-VAR is defined.
KIND should be `var' for a variable or `subr' for a subroutine."
@ -231,8 +239,8 @@ KIND should be `var' for a variable or `subr' for a subroutine."
(let ((file (catch 'loop
(while t
(let ((pnt (search-forward (concat "" name "\n"))))
(re-search-backward "S\\(.*\\)")
(let ((file (match-string 1)))
(re-search-backward "S\\(.*\\)")
(let ((file (match-string 1)))
(if (member file build-files)
(throw 'loop file)
(goto-char pnt))))))))
@ -463,9 +471,10 @@ face (according to `face-differs-from-default-p')."
;; Variables
;;;###autoload
(defun variable-at-point ()
(defun variable-at-point (&optional any-symbol)
"Return the bound variable symbol found around point.
Return 0 if there is no such symbol."
Return 0 if there is no such symbol.
If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(or (condition-case ()
(with-syntax-table emacs-lisp-mode-syntax-table
(save-excursion
@ -479,12 +488,12 @@ Return 0 if there is no such symbol."
(error nil))
(let* ((str (find-tag-default))
(sym (if str (intern-soft str))))
(if (and sym (boundp sym))
(if (and sym (or any-symbol (boundp sym)))
sym
(save-match-data
(when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
(setq sym (intern-soft (match-string 1 str)))
(and (boundp sym) sym)))))
(and (or any-symbol (boundp sym)) sym)))))
0))
;;;###autoload

2
lisp/help-macro.el
View File

@ -121,7 +121,7 @@ and then returns."
(if three-step-help
(progn
(setq key (let ((overriding-local-map local-map))
(read-key-sequence nil)))
(read-key-sequence nil)))
;; Make the HELP key translate to C-h.
(if (lookup-key function-key-map key)
(setq key (lookup-key function-key-map key)))

4
lisp/hi-lock.el
View File

@ -294,6 +294,10 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
(when (and (not hi-lock-mode-prev) hi-lock-mode)
(add-hook 'find-file-hooks 'hi-lock-find-file-hook)
(add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
(when (eq nil font-lock-defaults)
(setq font-lock-defaults '(nil)))
(unless font-lock-mode
(font-lock-mode 1))
(define-key-after menu-bar-edit-menu [hi-lock]
(cons "Regexp Highlighting" hi-lock-menu))
(dolist (buffer (buffer-list))

6
lisp/hilit-chg.el
View File

@ -1,6 +1,6 @@
;;; hilit-chg.el --- minor mode displaying buffer changes with special face
;; Copyright (C) 1998, 2000 Free Software Foundation, Inc.
;; Copyright (C) 1998, 2000, 2005 Free Software Foundation, Inc.
;; Author: Richard Sharman <rsharman@pobox.com>
;; Keywords: faces
@ -392,8 +392,6 @@ Otherwise, this list will be constructed when needed from
;; These shouldn't be changed!
;; Autoload for the benefit of `make-mode-line-mouse-sensitive'.
;;;###autoload
(defvar highlight-changes-mode nil)
(defvar hilit-chg-list nil)
(defvar hilit-chg-string " ??")
@ -1163,5 +1161,5 @@ from `global-highlight-changes' when turning on global Highlight Changes mode."
(provide 'hilit-chg)
;;; arch-tag: de00301d-5bad-44da-aa82-e0e010b0c463
;; arch-tag: de00301d-5bad-44da-aa82-e0e010b0c463
;;; hilit-chg.el ends here

2
lisp/image.el
View File

@ -263,7 +263,7 @@ The image is automatically split into ROW x COLS slices."
(setq x (+ x dx))))
(setq x 0.0
y (+ y dy))
(insert (propertize "\n" 'line-height 0)))))
(insert (propertize "\n" 'line-height t)))))

18
lisp/imenu.el
View File

@ -532,7 +532,7 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).")
(push item keep-at-top)
(setq menulist (delq item menulist))))
(if imenu-sort-function
(setq menulist (sort menulist imenu-sort-function)))
(setq menulist (sort (copy-sequence menulist) imenu-sort-function)))
(if (> (length menulist) imenu-max-items)
(setq menulist
(mapcar
@ -817,32 +817,30 @@ depending on PATTERNS."
(setq start (point))
(goto-char (match-end index))
(setq beg (match-beginning index))
(goto-char beg)
;; Go to the start of the match.
;; That's the official position of this definition.
(goto-char start)
(imenu-progress-message prev-pos nil t)
;; Add this sort of submenu only when we've found an
;; item for it, avoiding empty, duff menus.
(unless (assoc menu-title index-alist)
(push (list menu-title) index-alist))
(if imenu-use-markers
(setq beg (copy-marker beg)))
(setq start (copy-marker start)))
(let ((item
(if function
(nconc (list (match-string-no-properties index)
beg function)
start function)
rest)
(cons (match-string-no-properties index)
beg)))
start)))
;; This is the desired submenu,
;; starting with its title (or nil).
(menu (assoc menu-title index-alist)))
;; Insert the item unless it is already present.
(unless (member item (cdr menu))
(setcdr menu
(cons item (cdr menu)))))
;; Move to the start of the entire match,
;; to ensure we keep moving backwards
;; as long as the match is nonempty.
(goto-char start))))
(cons item (cdr menu))))))))
(set-syntax-table old-table)))
(imenu-progress-message prev-pos 100 t)
;; Sort each submenu by position.

11
lisp/info-look.el
View File

@ -1,7 +1,7 @@
;;; info-look.el --- major-mode-sensitive Info index lookup facility
;; An older version of this was known as libc.el.
;; Copyright (C) 1995,96,97,98,99,2001,03,04 Free Software Foundation, Inc.
;; Copyright (C) 1995,96,97,98,99,2001,03,04,05 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
;; (did not show signs of life (Nov 2001) -stef)
@ -634,8 +634,15 @@ Return nil if there is nothing appropriate in the buffer near point."
:regexp "\\(struct \\|union \\|enum \\)?[_a-zA-Z][_a-zA-Z0-9]*"
:doc-spec '(("(libc)Function Index" nil
"^[ \t]+-+ \\(Function\\|Macro\\): .*\\<" "\\>")
;; prefix/suffix has to match things like
;; " -- Macro: int F_DUPFD"
;; " -- Variable: char * tzname [2]"
;; "`DBL_MAX'" (texinfo @table)
;; suffix "\\>" is not used because that sends DBL_MAX to
;; DBL_MAX_EXP ("_" is a non-word char)
("(libc)Variable Index" nil
"^[ \t]+-+ \\(Variable\\|Macro\\): .*\\<" "\\>")
"^\\([ \t]+-+ \\(Variable\\|Macro\\): .*\\<\\|`\\)"
"\\( \\|'?$\\)")
("(libc)Type Index" nil
"^[ \t]+-+ Data Type: \\<" "\\>")
("(termcap)Var Index" nil

57
lisp/info.el
View File

@ -47,6 +47,10 @@
"Stack of info nodes user has visited.
Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
(defvar Info-history-forward nil
"Stack of info nodes user has visited with `Info-history-back' command.
Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
(defvar Info-history-list nil
"List of all info nodes user has visited.
Each element of list is a list (FILENAME NODENAME).")
@ -1295,7 +1299,8 @@ any double quotes or backslashes must be escaped (\\\",\\\\)."
;; Add a new unique history item to full history list
(let ((new-history (list Info-current-file Info-current-node)))
(setq Info-history-list
(cons new-history (delete new-history Info-history-list))))
(cons new-history (delete new-history Info-history-list)))
(setq Info-history-forward nil))
(if (not (eq Info-fontify-maximum-menu-size nil))
(Info-fontify-node))
(Info-display-images-node)
@ -1731,18 +1736,38 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(goto-char p)
(Info-restore-point Info-history))))
(defun Info-last ()
"Go back to the last node visited."
(defun Info-history-back ()
"Go back in the history to the last node visited."
(interactive)
(or Info-history
(error "This is the first Info node you looked at"))
(let (filename nodename opoint)
(let ((history-forward
(cons (list Info-current-file Info-current-node (point))
Info-history-forward))
filename nodename opoint)
(setq filename (car (car Info-history)))
(setq nodename (car (cdr (car Info-history))))
(setq opoint (car (cdr (cdr (car Info-history)))))
(setq Info-history (cdr Info-history))
(Info-find-node filename nodename)
(setq Info-history (cdr Info-history))
(setq Info-history-forward history-forward)
(goto-char opoint)))
(defalias 'Info-last 'Info-history-back)
(defun Info-history-forward ()
"Go forward in the history of visited nodes."
(interactive)
(or Info-history-forward
(error "This is the last Info node you looked at"))
(let ((history-forward (cdr Info-history-forward))
filename nodename opoint)
(setq filename (car (car Info-history-forward)))
(setq nodename (car (cdr (car Info-history-forward))))
(setq opoint (car (cdr (cdr (car Info-history-forward)))))
(Info-find-node filename nodename)
(setq Info-history-forward history-forward)
(goto-char opoint)))
;;;###autoload
@ -2894,12 +2919,13 @@ if point is in a menu item description, follow that menu item."
(define-key Info-mode-map "g" 'Info-goto-node)
(define-key Info-mode-map "h" 'Info-help)
(define-key Info-mode-map "i" 'Info-index)
(define-key Info-mode-map "l" 'Info-last)
(define-key Info-mode-map "l" 'Info-history-back)
(define-key Info-mode-map "L" 'Info-history)
(define-key Info-mode-map "m" 'Info-menu)
(define-key Info-mode-map "n" 'Info-next)
(define-key Info-mode-map "p" 'Info-prev)
(define-key Info-mode-map "q" 'Info-exit)
(define-key Info-mode-map "r" 'Info-history-forward)
(define-key Info-mode-map "s" 'Info-search)
(define-key Info-mode-map "S" 'Info-search-case-sensitively)
;; For consistency with Rmail.
@ -2913,6 +2939,7 @@ if point is in a menu item description, follow that menu item."
(define-key Info-mode-map "," 'Info-index-next)
(define-key Info-mode-map "\177" 'Info-scroll-down)
(define-key Info-mode-map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key Info-mode-map [follow-link] 'mouse-face)
)
(defun Info-check-pointer (item)
@ -2951,8 +2978,10 @@ if point is in a menu item description, follow that menu item."
:help "Search for another occurrence of regular expression"]
["Go to Node..." Info-goto-node
:help "Go to a named node"]
["Last" Info-last :active Info-history
:help "Go to the last node you were at"]
["Back in history" Info-history-back :active Info-history
:help "Go back in history to the last node you were at"]
["Forward in history" Info-history-forward :active Info-history-forward
:help "Go forward in history"]
["History" Info-history :active Info-history-list
:help "Go to menu of visited nodes"]
["Table of Contents" Info-toc
@ -2980,7 +3009,8 @@ if point is in a menu item description, follow that menu item."
(tool-bar-local-item-from-menu 'Info-prev "left_arrow" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-next "right_arrow" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-up "up_arrow" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-last "undo" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-history-back "back_arrow" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-history-forward "fwd_arrow" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-goto-node "jump_to" map Info-mode-map)
@ -3100,7 +3130,8 @@ Selecting other nodes:
Picking a menu item causes another node to be selected.
\\[Info-directory] Go to the Info directory node.
\\[Info-follow-reference] Follow a cross reference. Reads name of reference.
\\[Info-last] Move to the last node you were at.
\\[Info-history-back] Move back in history to the last node you were at.
\\[Info-history-forward] Move forward in history to the node you returned from after using \\[Info-history-back].
\\[Info-history] Go to menu of visited nodes.
\\[Info-toc] Go to table of contents of the current Info file.
\\[Info-top-node] Go to the Top node of this file.
@ -3157,6 +3188,7 @@ Advanced commands:
(make-local-variable 'Info-tag-table-buffer)
(setq Info-tag-table-buffer nil)
(make-local-variable 'Info-history)
(make-local-variable 'Info-history-forward)
(make-local-variable 'Info-index-alternatives)
(setq header-line-format
(if Info-use-header-line
@ -3368,7 +3400,7 @@ COMMAND must be a symbol or string."
(message "Found %d other entr%s. Use %s to see %s."
(1- num-matches)
(if (> num-matches 2) "ies" "y")
(substitute-command-keys "\\[Info-last]")
(substitute-command-keys "\\[Info-history-back]")
(if (> num-matches 2) "them" "it")))))
(error "Couldn't find documentation for %s" command))))
@ -3453,6 +3485,7 @@ Preserve text properties."
(define-key keymap [header-line mouse-2] 'Info-next)
(define-key keymap [header-line down-mouse-1] 'ignore)
(define-key keymap [mouse-2] 'Info-next)
(define-key keymap [follow-link] 'mouse-face)
keymap)
"Keymap to put on the Next link in the text or the header line.")
@ -3462,6 +3495,7 @@ Preserve text properties."
(define-key keymap [header-line mouse-2] 'Info-prev)
(define-key keymap [header-line down-mouse-1] 'ignore)
(define-key keymap [mouse-2] 'Info-prev)
(define-key keymap [follow-link] 'mouse-face)
keymap)
"Keymap to put on the Prev link in the text or the header line.")
@ -3472,6 +3506,7 @@ Preserve text properties."
(define-key keymap [header-line mouse-2] 'Info-up)
(define-key keymap [header-line down-mouse-1] 'ignore)
(define-key keymap [mouse-2] 'Info-up)
(define-key keymap [follow-link] 'mouse-face)
keymap)
"Keymap to put on the Up link in the text or the header line.")
@ -3506,7 +3541,7 @@ Preserve text properties."
(put-text-property tbeg nend 'mouse-face 'highlight)
(put-text-property tbeg nend
'help-echo
(concat "Go to node "
(concat "mouse-2: Go to node "
(buffer-substring nbeg nend)))
;; Always set up the text property keymap.
;; It will either be used in the buffer

6
lisp/international/characters.el
View File

@ -447,6 +447,7 @@
(set-case-syntax-pair ?,FO(B ?,Fo(B tbl)
(set-case-syntax-pair ?,FP(B ?,Fp(B tbl)
(set-case-syntax-pair ?,FQ(B ?,Fq(B tbl)
(set-upcase-syntax ?,FS(B ?,Fr(B tbl)
(set-case-syntax-pair ?,FS(B ?,Fs(B tbl)
(set-case-syntax-pair ?,FT(B ?,Ft(B tbl)
(set-case-syntax-pair ?,FU(B ?,Fu(B tbl)
@ -481,6 +482,7 @@
(set-case-syntax-pair ?$,1&(B ?$,1'?(B tbl)
(set-case-syntax-pair ?$,1' (B ?$,1'@(B tbl)
(set-case-syntax-pair ?$,1'!(B ?$,1'A(B tbl)
(set-upcase-syntax ?$,1'#(B ?$,1'B(B tbl)
(set-case-syntax-pair ?$,1'#(B ?$,1'C(B tbl)
(set-case-syntax-pair ?$,1'$(B ?$,1'D(B tbl)
(set-case-syntax-pair ?$,1'%(B ?$,1'E(B tbl)
@ -882,10 +884,12 @@
(set-case-syntax-pair
(decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl))
(setq c (1+ c)))
;;(set-downcase-syntax ?$,1 P(B ?i tbl)
;;(set-upcase-syntax ?I ?$,1 Q(B tbl)
(set-case-syntax-pair ?$,1 R(B ?$,1 S(B tbl)
(set-case-syntax-pair ?$,1 T(B ?$,1 U(B tbl)
(set-case-syntax-pair ?$,1 V(B ?$,1 W(B tbl)
;;; (set-case-syntax-pair ?$,1!8(B ?,A(B tbl) ; these two have different length!
(set-case-syntax-pair ?$,1!8(B ?,A(B tbl)
(set-case-syntax-pair ?$,1!9(B ?$,1!:(B tbl)
(set-case-syntax-pair ?$,1!;(B ?$,1!<(B tbl)
(set-case-syntax-pair ?$,1!=(B ?$,1!>(B tbl)

4
lisp/international/encoded-kb.el
View File

@ -126,9 +126,7 @@ The following key sequence may cause multilingual text insertion."
(defun encoded-kbd-iso2022-single-shift (ignore)
(let ((char (encoded-kbd-last-key)))
(aset encoded-kbd-iso2022-invocations 2
(aref encoded-kbd-iso2022-designations
(if (= char ?\216) 2 3))))
(aset encoded-kbd-iso2022-invocations 2 (if (= char ?\216) 2 3)))
"")
(defun encoded-kbd-self-insert-iso2022-7bit (ignore)

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

@ -1,6 +1,6 @@
;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
@ -1865,12 +1865,14 @@ specifies the character set for the major languages of Western Europe."
;; different there.
(or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
(progn
;; Make non-line-break space display as a plain space.
;; Most X fonts do the wrong thing for code 160.
(aset standard-display-table 160 [32])
;; With luck, non-Latin-1 fonts are more recent and so don't
;; have this bug.
(aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
;; Most X fonts used to do the wrong thing for latin-1 code 160.
(unless (and (eq window-system 'x)
;; XFree86 4 has fixed the fonts.
(string= "The XFree86 Project, Inc" (x-server-vendor))
(> (aref (number-to-string (nth 2 (x-server-version))) 0)
?3))
;; Make non-line-break space display as a plain space.
(aset standard-display-table 160 [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
@ -1878,23 +1880,7 @@ specifies the character set for the major languages of Western Europe."
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
(aset standard-display-table 146 [39])
;; XFree86 4 has changed most of the fonts from their designed
;; versions such that `' no longer appears as balanced quotes.
;; Assume it has iso10646 fonts installed, so we can display
;; balanced quotes.
(when (and (eq window-system 'x)
(string= "The XFree86 Project, Inc" (x-server-vendor))
(> (aref (number-to-string (nth 2 (x-server-version))) 0)
?3))
;; We suppress these setting for the moment because the
;; above assumption is wrong.
;; (aset standard-display-table ?' [?$,1ry(B])
;; (aset standard-display-table ?` [?$,1rx(B])
;; The fonts don't have the relevant bug.
(aset standard-display-table 160 nil)
(aset standard-display-table (make-char 'latin-iso8859-1 160)
nil)))))
(aset standard-display-table 146 [39]))))
(defun set-language-environment-coding-systems (language-name
&optional eol-type)
@ -1955,8 +1941,7 @@ of `buffer-file-coding-system' set by this function."
(setq language-name (symbol-name language-name)))
(dolist (feature (get-language-info language-name 'features))
(require feature))
(let ((doc (get-language-info language-name 'documentation))
pos)
(let ((doc (get-language-info language-name 'documentation)))
(help-setup-xref (list #'describe-language-environment language-name)
(interactive-p))
(with-output-to-temp-buffer (help-buffer)

240
lisp/isearch.el
View File

@ -1,7 +1,7 @@
;;; isearch.el --- incremental search minor mode
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1999,
;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
;; Maintainer: FSF
@ -120,11 +120,6 @@ a tab, a carriage return (control-M), a newline, and `]+'."
:type 'regexp
:group 'isearch)
(defcustom search-highlight t
"*Non-nil means incremental search highlights the current match."
:type 'boolean
:group 'isearch)
(defcustom search-invisible 'open
"If t incremental search can match hidden text.
nil means don't match invisible text.
@ -199,6 +194,98 @@ Default value, nil, means edit the string instead."
:type 'boolean
:group 'isearch)
;;; isearch highlight customization.
(defcustom search-highlight t
"*Non-nil means incremental search highlights the current match."
:type 'boolean
:group 'isearch)
(defface isearch
'((((class color) (min-colors 88) (background light))
;; The background must not be too dark, for that means
;; the character is hard to see when the cursor is there.
(:background "magenta2" :foreground "lightskyblue1"))
(((class color) (min-colors 88) (background dark))
(:background "palevioletred2" :foreground "brown4"))
(((class color) (min-colors 16))
(:background "magenta4" :foreground "cyan1"))
(((class color) (min-colors 8))
(:background "magenta4" :foreground "cyan1"))
(t (:inverse-video t)))
"Face for highlighting Isearch matches."
:group 'isearch)
(defvar isearch 'isearch)
(defcustom isearch-lazy-highlight t
"*Controls the lazy-highlighting during incremental search.
When non-nil, all text in the buffer matching the current search
string is highlighted lazily (see `lazy-highlight-initial-delay'
and `lazy-highlight-interval')."
:type 'boolean
:group 'lazy-highlight
:group 'isearch)
;;; Lazy highlight customization.
(defgroup lazy-highlight nil
"Lazy highlighting feature for matching strings."
:prefix "lazy-highlight-"
:version "21.1"
:group 'isearch
:group 'matching)
(defcustom lazy-highlight-cleanup t
"*Controls whether to remove extra highlighting after a search.
If this is nil, extra highlighting can be \"manually\" removed with
\\[isearch-lazy-highlight-cleanup]."
:type 'boolean
:group 'lazy-highlight)
(defvaralias 'isearch-lazy-highlight-cleanup 'lazy-highlight-cleanup)
(make-obsolete-variable 'isearch-lazy-highlight-cleanup 'lazy-highlight-cleanup)
(defcustom lazy-highlight-initial-delay 0.25
"*Seconds to wait before beginning to lazily highlight all matches."
:type 'number
:group 'lazy-highlight)
(defvaralias 'isearch-lazy-highlight-initial-delay 'lazy-highlight-initial-delay)
(make-obsolete-variable 'isearch-lazy-highlight-initial-delay 'lazy-highlight-initial-delay)
(defcustom lazy-highlight-interval 0 ; 0.0625
"*Seconds between lazily highlighting successive matches."
:type 'number
:group 'lazy-highlight)
(defvaralias 'isearch-lazy-highlight-interval 'lazy-highlight-interval)
(make-obsolete-variable 'isearch-lazy-highlight-interval 'lazy-highlight-interval)
(defcustom lazy-highlight-max-at-a-time 20
"*Maximum matches to highlight at a time (for `lazy-highlight').
Larger values may reduce isearch's responsiveness to user input;
smaller values make matches highlight slowly.
A value of nil means highlight all matches."
:type '(choice (const :tag "All" nil)
(integer :tag "Some"))
:group 'lazy-highlight)
(defvaralias 'isearch-lazy-highlight-max-at-a-time 'lazy-highlight-max-at-a-time)
(make-obsolete-variable 'isearch-lazy-highlight-max-at-a-time 'lazy-highlight-max-at-a-time)
(defface lazy-highlight
'((((class color) (min-colors 88) (background light))
(:background "paleturquoise"))
(((class color) (min-colors 88) (background dark))
(:background "paleturquoise4"))
(((class color) (min-colors 16))
(:background "turquoise3"))
(((class color) (min-colors 8))
(:background "turquoise3"))
(t (:underline t)))
"Face for lazy highlighting of matches other than the current one."
:group 'lazy-highlight)
(put 'isearch-lazy-highlight-face 'face-alias 'lazy-highlight)
(defvar lazy-highlight-face 'lazy-highlight)
(defvaralias 'isearch-lazy-highlight-face 'lazy-highlight-face)
(make-obsolete-variable 'isearch-lazy-highlight-face 'lazy-highlight-face)
;; Define isearch-mode keymap.
(defvar isearch-mode-map
@ -648,7 +735,7 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(if (< isearch-other-end (point)) ; isearch-forward?
(isearch-highlight isearch-other-end (point))
(isearch-highlight (point) isearch-other-end))
(isearch-dehighlight nil))
(isearch-dehighlight))
))
(setq ;; quit-flag nil not for isearch-mode
isearch-adjusted nil
@ -676,8 +763,8 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(setq overriding-terminal-local-map nil)
;; (setq pre-command-hook isearch-old-pre-command-hook) ; for lemacs
(setq minibuffer-message-timeout isearch-original-minibuffer-message-timeout)
(isearch-dehighlight t)
(isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
(isearch-dehighlight)
(isearch-lazy-highlight-cleanup lazy-highlight-cleanup)
(let ((found-start (window-start (selected-window)))
(found-point (point)))
(if isearch-window-configuration
@ -2146,31 +2233,8 @@ Can be changed via `isearch-search-fun-function' for special needs."
(setq isearch-hidden t)))))))
;; Highlighting
(defvar isearch-overlay nil)
(defun isearch-highlight (beg end)
(unless (null search-highlight)
(cond (isearch-overlay
;; Overlay already exists, just move it.
(move-overlay isearch-overlay beg end (current-buffer)))
(t
;; Overlay doesn't exist, create it.
(setq isearch-overlay (make-overlay beg end))
(overlay-put isearch-overlay 'face isearch)
(overlay-put isearch-overlay 'priority 1) ;higher than lazy overlays
))))
(defun isearch-dehighlight (totally)
(when isearch-overlay
(delete-overlay isearch-overlay)))
;; General utilities
(defun isearch-no-upper-case-p (string regexp-flag)
"Return t if there are no upper case chars in STRING.
If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
@ -2202,12 +2266,33 @@ since they have special meaning in a regexp."
(append char-or-events unread-command-events)))
;; Highlighting
(defvar isearch-overlay nil)
(defun isearch-highlight (beg end)
(unless (null search-highlight)
(cond (isearch-overlay
;; Overlay already exists, just move it.
(move-overlay isearch-overlay beg end (current-buffer)))
(t
;; Overlay doesn't exist, create it.
(setq isearch-overlay (make-overlay beg end))
(overlay-put isearch-overlay 'face isearch)
(overlay-put isearch-overlay 'priority 1) ;higher than lazy overlays
))))
(defun isearch-dehighlight ()
(when isearch-overlay
(delete-overlay isearch-overlay)))
;; isearch-lazy-highlight feature
;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
;; When active, *every* match for the current search string is
;; highlighted: the current one using the normal isearch match color
;; and all the others using `isearch-lazy-highlight-face'. The extra
;; and all the others using `isearch-lazy-highlight'. The extra
;; highlighting makes it easier to anticipate where the cursor will
;; land each time you press C-s or C-r to repeat a pending search.
;; Highlighting of these additional matches happens in a deferred
@ -2227,81 +2312,6 @@ since they have special meaning in a regexp."
;; - the variable `isearch-invalid-regexp' is expected to be true
;; iff `isearch-string' is an invalid regexp.
(defgroup isearch-lazy-highlight nil
"Lazy highlighting feature for incremental search."
:prefix "isearch-lazy-highlight-"
:version "21.1"
:group 'isearch)
(defcustom isearch-lazy-highlight t
"*Controls the lazy-highlighting during incremental searches.
When non-nil, all text in the buffer matching the current search
string is highlighted lazily (see `isearch-lazy-highlight-initial-delay'
and `isearch-lazy-highlight-interval')."
:type 'boolean
:group 'isearch-lazy-highlight)
(defcustom isearch-lazy-highlight-cleanup t
"*Controls whether to remove extra highlighting after a search.
If this is nil, extra highlighting can be \"manually\" removed with
\\[isearch-lazy-highlight-cleanup]."
:type 'boolean
:group 'isearch-lazy-highlight)
(defcustom isearch-lazy-highlight-initial-delay 0.25
"*Seconds to wait before beginning to lazily highlight all matches."
:type 'number
:group 'isearch-lazy-highlight)
(defcustom isearch-lazy-highlight-interval 0 ; 0.0625
"*Seconds between lazily highlighting successive matches."
:type 'number
:group 'isearch-lazy-highlight)
(defcustom isearch-lazy-highlight-max-at-a-time 20
"*Maximum matches to highlight at a time (for `isearch-lazy-highlight').
Larger values may reduce isearch's responsiveness to user input;
smaller values make matches highlight slowly.
A value of nil means highlight all matches."
:type '(choice (const :tag "All" nil)
(integer :tag "Some"))
:group 'isearch-lazy-highlight)
(defgroup isearch-faces nil
"Lazy highlighting feature for incremental search."
:version "21.1"
:group 'isearch)
(defface isearch
'((((class color) (min-colors 88) (background light))
;; The background must not be too dark, for that means
;; the character is hard to see when the cursor is there.
(:background "magenta2" :foreground "lightskyblue1"))
(((class color) (min-colors 88) (background dark))
(:background "palevioletred2" :foreground "brown4"))
(((class color) (min-colors 16))
(:background "magenta4" :foreground "cyan1"))
(((class color) (min-colors 8))
(:background "magenta4" :foreground "cyan1"))
(t (:inverse-video t)))
"Face for highlighting Isearch matches."
:group 'isearch-faces)
(defvar isearch 'isearch)
(defface isearch-lazy-highlight-face
'((((class color) (min-colors 88) (background light))
(:background "paleturquoise"))
(((class color) (min-colors 88) (background dark))
(:background "paleturquoise4"))
(((class color) (min-colors 16))
(:background "turquoise3"))
(((class color) (min-colors 8))
(:background "turquoise3"))
(t (:underline t)))
"Face for lazy highlighting of Isearch matches other than the current one."
:group 'isearch-faces)
(defvar isearch-lazy-highlight-face 'isearch-lazy-highlight-face)
(defvar isearch-lazy-highlight-overlays nil)
(defvar isearch-lazy-highlight-wrapped nil)
(defvar isearch-lazy-highlight-start nil)
@ -2316,11 +2326,11 @@ A value of nil means highlight all matches."
(defun isearch-lazy-highlight-cleanup (&optional force)
"Stop lazy highlighting and remove extra highlighting from current buffer.
FORCE non-nil means do it whether or not `isearch-lazy-highlight-cleanup'
FORCE non-nil means do it whether or not `lazy-highlight-cleanup'
is nil. This function is called when exiting an incremental search if
`isearch-lazy-highlight-cleanup' is non-nil."
`lazy-highlight-cleanup' is non-nil."
(interactive '(t))
(if (or force isearch-lazy-highlight-cleanup)
(if (or force lazy-highlight-cleanup)
(while isearch-lazy-highlight-overlays
(delete-overlay (car isearch-lazy-highlight-overlays))
(setq isearch-lazy-highlight-overlays
@ -2330,7 +2340,7 @@ is nil. This function is called when exiting an incremental search if
(setq isearch-lazy-highlight-timer nil)))
(defun isearch-lazy-highlight-new-loop ()
"Cleanup any previous `isearch-lazy-highlight' loop and begin a new one.
"Cleanup any previous `lazy-highlight' loop and begin a new one.
This happens when `isearch-update' is invoked (which can cause the
search string to change or the window to scroll)."
(when (and (null executing-kbd-macro)
@ -2361,7 +2371,7 @@ search string to change or the window to scroll)."
isearch-lazy-highlight-wrapped nil)
(unless (equal isearch-string "")
(setq isearch-lazy-highlight-timer
(run-with-idle-timer isearch-lazy-highlight-initial-delay nil
(run-with-idle-timer lazy-highlight-initial-delay nil
'isearch-lazy-highlight-update))))))
(defun isearch-lazy-highlight-search ()
@ -2382,7 +2392,7 @@ Attempt to do the search exactly the way the pending isearch would."
(defun isearch-lazy-highlight-update ()
"Update highlighting of other matches for current search."
(let ((max isearch-lazy-highlight-max-at-a-time)
(let ((max lazy-highlight-max-at-a-time)
(looping t)
nomore)
(with-local-quit
@ -2441,7 +2451,7 @@ Attempt to do the search exactly the way the pending isearch would."
(goto-char (window-end)))))))
(unless nomore
(setq isearch-lazy-highlight-timer
(run-at-time isearch-lazy-highlight-interval nil
(run-at-time lazy-highlight-interval nil
'isearch-lazy-highlight-update)))))))))
(defun isearch-resume (search regexp word forward message case-fold)

21
lisp/loadhist.el
View File

@ -51,9 +51,26 @@ a buffer with no associated file, or an `eval-region', return nil."
(error "%S is not a currently loaded feature" feature)
(car (feature-symbols feature))))
(defun file-loadhist-lookup (file)
"Return the `load-history' element for FILE."
;; First look for FILE as given.
(let ((symbols (assoc file load-history)))
;; Try converting a library name to an absolute file name.
(and (null symbols)
(let ((absname (find-library-name file)))
(if (not (equal absname file))
(setq symbols (cdr (assoc absname load-history))))))
;; Try converting an absolute file name to a library name.
(and (null symbols) (string-match "[.]el\\'" file)
(let ((libname (file-name-nondirectory file)))
(string-match "[.]el\\'" libname)
(setq libname (substring libname 0 (match-beginning 0)))
(setq symbols (cdr (assoc libname load-history)))))
symbols))
(defun file-provides (file)
"Return the list of features provided by FILE."
(let ((symbols (cdr (assoc file load-history)))
(let ((symbols (file-loadhist-lookup file))
provides)
(mapc (lambda (x)
(if (and (consp x) (eq (car x) 'provide))
@ -63,7 +80,7 @@ a buffer with no associated file, or an `eval-region', return nil."
(defun file-requires (file)
"Return the list of features required by FILE."
(let ((symbols (cdr (assoc file load-history)))
(let ((symbols (file-loadhist-lookup file))
requires)
(mapc (lambda (x)
(if (and (consp x) (eq (car x) 'require))

24
lisp/mail/mailabbrev.el
View File

@ -305,10 +305,19 @@ If DEFINITION contains multiple addresses, separate them with commas."
end (string-match "\"[ \t,]*" definition start))
(setq end (string-match "[ \t,]+" definition start)))
(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
(setq result (cons (substring definition start end) result))
(setq start (and end
(/= (match-end 0) L)
(match-end 0))))
(let ((tem (substring definition start end)))
;; Advance the loop past this address.
(setq start (and end
(/= (match-end 0) L)
(match-end 0)))
;; If the full name contains a problem character, quote it.
(when (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" tem)
(if (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
(match-string 1 tem))
(setq tem (replace-regexp-in-string
"\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2"
tem))))
(push tem result)))
(setq definition (mapconcat (function identity)
(nreverse result)
mail-alias-separator-string)))
@ -485,7 +494,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
;; the usual syntax table.
(or (and (integerp last-command-char)
(eq (char-syntax last-command-char) ?_))
(or (eq (char-syntax last-command-char) ?_)
;; Don't expand on @.
(memq last-command-char '(?@ ?. ?% ?! ?_ ?-))))
(let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
;; Use this table so that abbrevs can have hyphens in them.
(set-syntax-table mail-abbrev-syntax-table)
@ -610,7 +621,8 @@ Don't use this command in Lisp programs!
(interactive "P")
(if (looking-at "[ \t]*\n") (expand-abbrev))
(setq this-command 'end-of-buffer)
(end-of-buffer arg))
(with-no-warnings
(end-of-buffer arg)))
(eval-after-load "sendmail"
'(progn

305
lisp/mail/rmail.el
View File

@ -1,6 +1,6 @@
;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000, 01, 2004
;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000,01,2004,2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -91,6 +91,9 @@
:prefix "rmail-edit-"
:group 'rmail)
(defgroup rmail-obsolete nil
"Rmail obsolete customization variables."
:group 'rmail)
(defcustom rmail-movemail-program nil
"If non-nil, name of program for fetching new mail."
@ -98,15 +101,46 @@
:type '(choice (const nil) string))
(defcustom rmail-pop-password nil
"*Password to use when reading mail from a POP server, if required."
"*Password to use when reading mail from POP server. Please, use rmail-remote-password instead."
:type '(choice (string :tag "Password")
(const :tag "Not Required" nil))
:group 'rmail-retrieve)
:group 'rmail-obsolete)
(defcustom rmail-pop-password-required nil
"*Non-nil if a password is required when reading mail using POP."
"*Non-nil if a password is required when reading mail from a POP server. Please, use rmail-remote-password-required instead."
:type 'boolean
:group 'rmail-retrieve)
:group 'rmail-obsolete)
(defcustom rmail-remote-password nil
"*Password to use when reading mail from a remote server. This setting is ignored for mailboxes whose URL already contains a password."
:type '(choice (string :tag "Password")
(const :tag "Not Required" nil))
:set-after '(rmail-pop-password)
:set #'(lambda (symbol value)
(set-default symbol
(if (and (not value)
(boundp 'rmail-pop-password)
rmail-pop-password)
rmail-pop-password
value))
(setq rmail-pop-password nil))
:group 'rmail-retrieve
:version "21.3.50.1")
(defcustom rmail-remote-password-required nil
"*Non-nil if a password is required when reading mail from a remote server."
:type 'boolean
:set-after '(rmail-pop-password-required)
:set #'(lambda (symbol value)
(set-default symbol
(if (and (not value)
(boundp 'rmail-pop-password-required)
rmail-pop-password-required)
rmail-pop-password-required
value))
(setq rmail-pop-password-required nil))
:group 'rmail-retrieve
:version "21.3.50.1")
(defcustom rmail-movemail-flags nil
"*List of flags to pass to movemail.
@ -116,13 +150,14 @@ or `-k' to enable Kerberos authentication."
:group 'rmail-retrieve
:version "20.3")
(defvar rmail-pop-password-error "invalid usercode or password\\|
unknown user name or bad password"
"Regular expression matching incorrect-password POP server error messages.
(defvar rmail-remote-password-error "invalid usercode or password\\|
unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE"
"Regular expression matching incorrect-password POP or IMAP server error
messages.
If you get an incorrect-password error that this expression does not match,
please report it with \\[report-emacs-bug].")
(defvar rmail-encoded-pop-password nil)
(defvar rmail-encoded-remote-password nil)
(defcustom rmail-preserve-inbox nil
"*Non-nil if incoming mail should be left in the user's inbox,
@ -130,6 +165,67 @@ rather than deleted, after it is retrieved."
:type 'boolean
:group 'rmail-retrieve)
(defcustom rmail-movemail-search-path nil
"*List of directories to search for movemail (in addition to `exec-path')."
:group 'rmail-retrieve
:type '(repeat (directory)))
(defun rmail-probe (prog)
"Determine what flavor of movemail PROG is by executing it with --version
command line option and analyzing its output."
(with-temp-buffer
(let ((tbuf (current-buffer)))
(buffer-disable-undo tbuf)
(call-process prog nil tbuf nil "--version")
(if (not (buffer-modified-p tbuf))
;; Should not happen...
nil
(goto-char (point-min))
(cond
((looking-at ".*movemail: invalid option")
'emacs) ;; Possibly...
((looking-at "movemail (GNU Mailutils .*)")
'mailutils)
(t
;; FIXME:
'emacs))))))
(defun rmail-autodetect ()
"Determine and return the flavor of `movemail' program in use. If
rmail-movemail-program is set, use it. Otherwise, look for `movemail'
in the path constructed by appending rmail-movemail-search-path,
exec-path and exec-directory."
(if rmail-movemail-program
(rmail-probe rmail-movemail-program)
(catch 'scan
(dolist (dir (append rmail-movemail-search-path exec-path
(list exec-directory)))
(when (and dir (file-accessible-directory-p dir))
(let ((progname (expand-file-name "movemail" dir)))
(when (and (not (file-directory-p progname))
(file-executable-p progname))
(let ((x (rmail-probe progname)))
(when x
(setq rmail-movemail-program progname)
(throw 'scan x))))))))))
(defvar rmail-movemail-variant-in-use nil
"The movemail variant currently in use. Known variants are:
`emacs' Means any implementation, compatible with the native Emacs one.
This is the default;
`mailutils' Means GNU mailutils implementation, capable of handling full
mail URLs as the source mailbox;")
;;;###autoload
(defun rmail-movemail-variant-p (&rest variants)
"Return t if the current movemail variant is any of VARIANTS.
Currently known variants are 'emacs and 'mailutils."
(when (not rmail-movemail-variant-in-use)
;; Autodetect
(setq rmail-movemail-variant-in-use (rmail-autodetect)))
(not (null (member rmail-movemail-variant-in-use variants))))
;;;###autoload
(defcustom rmail-dont-reply-to-names nil "\
*A regexp specifying addresses to prune from a reply message.
@ -1516,6 +1612,40 @@ It returns t if it got any new messages."
;; Don't leave the buffer screwed up if we get a disk-full error.
(or found (rmail-show-message)))))
(defun rmail-parse-url (file)
"Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to
a remote mailbox, PASSWORD is the password if it should be
supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
is non-nil if the user has supplied the password interactively.
"
(if (string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
(let (got-password supplied-password
(proto (match-string 1 file))
(user (match-string 3 file))
(pass (match-string 5 file))
(host (substring file (or (match-end 2)
(+ 3 (match-end 1))))))
(if (not pass)
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
(setq supplied-password (rmail-get-remote-password
(string-equal proto "imap")))))
(if (rmail-movemail-variant-p 'emacs)
(if (string-equal proto "pop")
(list (concat "po:" user ":" host)
t
(or pass supplied-password)
got-password)
(error "Emacs movemail does not support %s protocol" proto))
(list file
(or (string-equal proto "pop") (string-equal proto "imap"))
supplied-password
got-password)))
(list file nil nil nil)))
(defun rmail-insert-inbox-text (files renamep)
;; Detect a locked file now, so that we avoid moving mail
;; out of the real inbox file. (That could scare people.)
@ -1524,10 +1654,15 @@ It returns t if it got any new messages."
(file-name-nondirectory buffer-file-name)))
(let (file tofile delete-files movemail popmail got-password password)
(while files
;; Handle POP mailbox names specially; don't expand as filenames
;; Handle remote mailbox names specially; don't expand as filenames
;; in case the userid contains a directory separator.
(setq file (car files))
(setq popmail (string-match "^po:" file))
(let ((url-data (rmail-parse-url file)))
(setq file (nth 0 url-data))
(setq popmail (nth 1 url-data))
(setq password (nth 2 url-data))
(setq got-password (nth 3 url-data)))
(if popmail
(setq renamep t)
(setq file (file-truename
@ -1535,7 +1670,12 @@ It returns t if it got any new messages."
(setq tofile (expand-file-name
;; Generate name to move to from inbox name,
;; in case of multiple inboxes that need moving.
(concat ".newmail-" (file-name-nondirectory file))
(concat ".newmail-"
(file-name-nondirectory
(if (memq system-type '(windows-nt cygwin))
;; cannot have "po:" in file name
(substring file 3)
file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
;; if that is on a full disk and this rmail
@ -1560,18 +1700,7 @@ It returns t if it got any new messages."
(setq file (expand-file-name (user-login-name)
file)))))
(cond (popmail
(if rmail-pop-password-required
(progn (setq got-password (not (rmail-have-password)))
(setq password (rmail-get-pop-password))))
(if (memq system-type '(windows-nt cygwin))
;; cannot have "po:" in file name
(setq tofile
(expand-file-name
(concat ".newmail-pop-"
(file-name-nondirectory (substring file 3)))
(file-name-directory
(expand-file-name buffer-file-name)))))
(message "Getting mail from post office ..."))
(message "Getting mail from the remote server ..."))
((and (file-exists-p tofile)
(/= 0 (nth 7 (file-attributes tofile))))
(message "Getting mail from %s..." tofile))
@ -1603,50 +1732,59 @@ It returns t if it got any new messages."
(write-region (point) (point) file)
(file-error nil))))
(t
(let ((errors nil))
(unwind-protect
(save-excursion
(setq errors (generate-new-buffer " *rmail loss*"))
(buffer-disable-undo errors)
(let ((args
(append
(list (or rmail-movemail-program
(expand-file-name "movemail"
exec-directory))
nil errors nil)
(if rmail-preserve-inbox
(list "-p")
nil)
rmail-movemail-flags
(list file tofile)
(if password (list password) nil))))
(apply 'call-process args))
(if (not (buffer-modified-p errors))
;; No output => movemail won
nil
(set-buffer errors)
(subst-char-in-region (point-min) (point-max)
?\n ?\ )
(goto-char (point-max))
(skip-chars-backward " \t")
(delete-region (point) (point-max))
(goto-char (point-min))
(if (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
(beep t)
(message "movemail: %s"
(buffer-substring (point-min)
(point-max)))
;; If we just read the password, most likely it is
;; wrong. Otherwise, see if there is a specific
;; reason to think that the problem is a wrong passwd.
(if (or got-password
(re-search-forward rmail-pop-password-error
nil t))
(rmail-set-pop-password nil))
(sit-for 3)
nil))
(if errors (kill-buffer errors))))))
(with-temp-buffer
(let ((errors (current-buffer)))
(buffer-disable-undo errors)
(let ((args
(append
(list (or rmail-movemail-program
(expand-file-name "movemail"
exec-directory))
nil errors nil)
(if rmail-preserve-inbox
(list "-p")
nil)
(if (rmail-movemail-variant-p 'mailutils)
(append (list "--emacs") rmail-movemail-flags)
rmail-movemail-flags)
(list file tofile)
(if password (list password) nil))))
(apply 'call-process args))
(if (not (buffer-modified-p errors))
;; No output => movemail won
nil
(set-buffer errors)
(subst-char-in-region (point-min) (point-max)
?\n ?\ )
(goto-char (point-max))
(skip-chars-backward " \t")
(delete-region (point) (point-max))
(goto-char (point-min))
(if (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
(beep t)
;; If we just read the password, most likely it is
;; wrong. Otherwise, see if there is a specific
;; reason to think that the problem is a wrong passwd.
(if (or got-password
(re-search-forward rmail-remote-password-error
nil t))
(rmail-set-remote-password nil))
;; If using Mailutils, remove initial error code
;; abbreviation
(when (rmail-movemail-variant-p 'mailutils)
(goto-char (point-min))
(when (looking-at "[A-Z][A-Z0-9_]*:")
(delete-region (point-min) (match-end 0))))
(message "movemail: %s"
(buffer-substring (point-min)
(point-max)))
(sit-for 3)
nil)))))
;; At this point, TOFILE contains the name to read:
;; Either the alternate name (if we renamed)
;; or the actual inbox (if not renaming).
@ -3834,27 +3972,30 @@ TEXT and INDENT are not used."
; nor is it meant to be.
;;;###autoload
(defun rmail-set-pop-password (password)
"Set PASSWORD to be used for retrieving mail from a POP server."
(defun rmail-set-remote-password (password)
"Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
(interactive "sPassword: ")
(if password
(setq rmail-encoded-pop-password
(setq rmail-encoded-remote-password
(rmail-encode-string password (emacs-pid)))
(setq rmail-pop-password nil)
(setq rmail-encoded-pop-password nil)))
(setq rmail-remote-password nil)
(setq rmail-encoded-remote-password nil)))
(defun rmail-get-pop-password ()
"Get the password for retrieving mail from a POP server. If none
(defun rmail-get-remote-password (imap)
"Get the password for retrieving mail from a POP or IMAP server. If none
has been set, then prompt the user for one."
(if (not rmail-encoded-pop-password)
(progn (if (not rmail-pop-password)
(setq rmail-pop-password (read-passwd "POP password: ")))
(rmail-set-pop-password rmail-pop-password)
(setq rmail-pop-password nil)))
(rmail-encode-string rmail-encoded-pop-password (emacs-pid)))
(when (not rmail-encoded-remote-password)
(if (not rmail-remote-password)
(setq rmail-remote-password
(read-passwd (if imap
"IMAP password: "
"POP password: "))))
(rmail-set-remote-password rmail-remote-password)
(setq rmail-remote-password nil))
(rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
(defun rmail-have-password ()
(or rmail-pop-password rmail-encoded-pop-password))
(or rmail-remote-password rmail-encoded-remote-password))
(defun rmail-encode-string (string mask)
"Encode STRING with integer MASK, by taking the exclusive OR of the

88
lisp/man.el
View File

@ -415,13 +415,15 @@ Otherwise, the value is whatever the function
;; buttons
(define-button-type 'Man-xref-man-page
'action (lambda (button) (man-follow (button-label button)))
'help-echo "RET, mouse-2: display this man page")
'follow-link t
'help-echo "mouse-2, RET: display this man page")
(define-button-type 'Man-xref-header-file
'action (lambda (button)
(let ((w (button-get button 'Man-target-string)))
(unless (Man-view-header-file w)
(error "Cannot find header file: %s" w))))
'follow-link t
'help-echo "mouse-2: display this header file")
(define-button-type 'Man-xref-normal-file
@ -433,6 +435,7 @@ Otherwise, the value is whatever the function
(view-file f)
(error "Cannot read a file: %s" f))
(error "Cannot find a file: %s" f))))
'follow-link t
'help-echo "mouse-2: display this file")
@ -694,6 +697,7 @@ all sections related to a subject, put something appropriate into the
(setq buffer (generate-new-buffer bufname))
(save-excursion
(set-buffer buffer)
(setq buffer-undo-list t)
(setq Man-original-frame (selected-frame))
(setq Man-arguments man-args))
(let ((process-environment (copy-sequence process-environment))
@ -822,6 +826,7 @@ Same for the ANSI bold and normal escape sequences."
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((faces nil)
(buffer-undo-list t)
(start (point)))
;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html
;; suggests many codes, but we only handle:
@ -853,46 +858,47 @@ Same for the ANSI bold and normal escape sequences."
(delete-region (match-beginning 0) (match-end 0))
(setq start (point))))
;; Other highlighting.
(if (< (buffer-size) (position-bytes (point-max)))
;; Multibyte characters exist.
(progn
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face Man-underline-face))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face Man-underline-face))))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face Man-underline-face))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
(put-text-property (1- (point)) (point) 'face Man-underline-face))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1")
(put-text-property (1- (point)) (point) 'face Man-overstrike-face))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
(put-text-property (1- (point)) (point) 'face 'bold))
(goto-char (point-min))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
(replace-match "+")
(put-text-property (1- (point)) (point) 'face 'bold))
(goto-char (point-min))
;; Try to recognize common forms of cross references.
(Man-highlight-references)
(Man-softhyphen-to-minus)
(goto-char (point-min))
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
'face Man-overstrike-face))
(let ((buffer-undo-list t))
(if (< (buffer-size) (position-bytes (point-max)))
;; Multibyte characters exist.
(progn
(goto-char (point-min))
(while (search-forward "__\b\b" nil t)
(backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face Man-underline-face))
(goto-char (point-min))
(while (search-forward "\b\b__" nil t)
(backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face Man-underline-face))))
(goto-char (point-min))
(while (search-forward "_\b" nil t)
(backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face Man-underline-face))
(goto-char (point-min))
(while (search-forward "\b_" nil t)
(backward-delete-char 2)
(put-text-property (1- (point)) (point) 'face Man-underline-face))
(goto-char (point-min))
(while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
(replace-match "\\1")
(put-text-property (1- (point)) (point) 'face Man-overstrike-face))
(goto-char (point-min))
(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
(replace-match "o")
(put-text-property (1- (point)) (point) 'face 'bold))
(goto-char (point-min))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
(replace-match "+")
(put-text-property (1- (point)) (point) 'face 'bold))
(goto-char (point-min))
;; Try to recognize common forms of cross references.
(Man-highlight-references)
(Man-softhyphen-to-minus)
(goto-char (point-min))
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
'face Man-overstrike-face)))
(message "%s man page formatted" Man-arguments))
(defun Man-highlight-references ()

64
lisp/mouse.el
View File

@ -1,6 +1,6 @@
;;; mouse.el --- window system-independent mouse support
;; Copyright (C) 1993, 94, 95, 1999, 2000, 2001, 2002, 2003, 2004
;; Copyright (C) 1993, 94, 95, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -397,7 +397,6 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
(start-nwindows (count-windows t))
(old-selected-window (selected-window))
(minibuffer (frame-parameter nil 'minibuffer))
(mouse-autoselect-window nil)
should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
(track-mouse
(progn
@ -435,7 +434,7 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
(cond ((integerp event)
(setq done t))
((eq (car event) 'switch-frame)
((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
@ -582,7 +581,7 @@ resized by dragging their header-line."
;; unknown event.
(cond ((integerp event)
(setq done t))
((eq (car event) 'switch-frame)
((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
@ -754,11 +753,11 @@ remains active. Otherwise, it remains until the next input event.
If the click is in the echo area, display the `*Messages*' buffer."
(interactive "e")
(let ((w (posn-window (event-start start-event)))
(mouse-autoselect-window nil))
(if (not (or (not (window-minibuffer-p w))
(minibuffer-window-active-p w)))
(let ((w (posn-window (event-start start-event))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w)))
(save-excursion
;; Swallow the up-event.
(read-event)
(set-buffer "*Messages*")
(goto-char (point-max))
@ -773,21 +772,24 @@ If the click is in the echo area, display the `*Messages*' buffer."
A clickable link is identified by one of the following methods:
1) If the character at POS has a non-nil `follow-link' text or
overlay property, the value of that property is returned.
- If the character at POS has a non-nil `follow-link' text or
overlay property, use the value of that property determines what
to do.
2) If there is a local key-binding or a keybinding at position
POS for the `follow-link' event, the binding of that event
determines whether POS is inside a link:
- If there is a local key-binding or a keybinding at position POS
for the `follow-link' event, the binding of that event determines
what to do.
- If the binding is `mouse-face', POS is inside a link if there
The resulting value determine whether POS is inside a link:
- If the value is `mouse-face', POS is inside a link if there
is a non-nil `mouse-face' property at POS. Return t in this case.
- If the binding is a function, FUNC, POS is inside a link if
- If the value is a function, FUNC, POS is inside a link if
the call \(FUNC POS) returns non-nil. Return the return value
from that call.
- Otherwise, return the binding of the `follow-link' binding.
- Otherwise, return the value itself.
The return value is interpreted as follows:
@ -801,16 +803,17 @@ click is the local or global binding of that event.
- Otherwise, the mouse-1 event is translated into a mouse-2 event
at the same position."
(or (get-char-property pos 'follow-link)
(save-excursion
(goto-char pos)
(let ((b (key-binding [follow-link] nil t)))
(cond
((eq b 'mouse-face)
(and (get-char-property pos 'mouse-face) t))
((functionp b)
(funcall b pos))
(t b))))))
(let ((action
(or (get-char-property pos 'follow-link)
(save-excursion
(goto-char pos)
(key-binding [follow-link] nil t)))))
(cond
((eq action 'mouse-face)
(and (get-char-property pos 'mouse-face) t))
((functionp action)
(funcall action pos))
(t action))))
(defun mouse-drag-region-1 (start-event)
(mouse-minibuffer-check start-event)
@ -858,8 +861,8 @@ at the same position."
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
(if (eq (car-safe event) 'switch-frame)
(memq (car-safe event) '(switch-frame select-window))))
(if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))
@ -1153,6 +1156,7 @@ If MODE is 2 then do the same for lines."
(move-overlay mouse-drag-overlay (point) (mark t)))
(catch 'mouse-show-mark
;; In this loop, execute scroll bar and switch-frame events.
;; Should we similarly handle `select-window' events? --Stef
;; Also ignore down-events that are undefined.
(while (progn (setq event (read-event))
(setq events (append events (list event)))
@ -1476,9 +1480,9 @@ The function returns a non-nil value if it creates a secondary selection."
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
(memq (car-safe event) '(switch-frame select-window))))
(if (eq (car-safe event) 'switch-frame)
(if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))

2
lisp/net/eudc.el
View File

@ -1214,7 +1214,7 @@ queries the server for the existing fields and displays a corresponding form."
;;; Load the options file
(if (and (not noninteractive)
(and (locate-library eudc-options-file)
(message "")) ; Remove modeline message
(progn (message "") t)) ; Remove modeline message
(not (featurep 'eudc-options-file)))
(load eudc-options-file))

57
lisp/net/tramp-smb.el
View File

@ -172,7 +172,7 @@ This variable is local to each buffer.")
(set-file-modes . tramp-smb-not-handled)
(set-visited-file-modtime . tramp-smb-not-handled)
(shell-command . tramp-smb-not-handled)
;; `substitute-in-file-name' performed by default handler
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . tramp-smb-not-handled)
(verify-visited-file-modtime . tramp-smb-not-handled)
@ -617,6 +617,13 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
(delete-file filename))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for tramp files.
Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
(condition-case nil
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(error filename)))
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname confirm)
"Like `write-region' for tramp files."
@ -1084,54 +1091,6 @@ Return the difference in the format of a time value."
(- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
;; Must be corrected.
(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion)
"Changes \"$\" back to \"$$\" in minibuffer."
(if (funcall PC-completion-as-file-name-predicate)
(progn
;; Substitute file names
(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
(funcall 'minibuffer-prompt-end))
(point-min)))
(end (point-max))
(str (substitute-in-file-name (buffer-substring beg end))))
(delete-region beg end)
(insert str)
(ad-set-arg 2 (point)))
;; Do `PC-do-completion' without substitution
(let* (save)
(fset 'save (symbol-function 'substitute-in-file-name))
(unwind-protect
(progn
(fset 'substitute-in-file-name (symbol-function 'identity))
ad-do-it)
(fset 'substitute-in-file-name (symbol-function 'save))))
;; Expand "$"
(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21
(funcall 'minibuffer-prompt-end))
(point-min)))
(end (point-max))
(str (buffer-substring beg end)))
(delete-region beg end)
(insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str)
(replace-match "$$" nil nil str 1)
str))))
;; No file names. Behave unchanged.
ad-do-it))
;; Activate advice. Recent Emacsen don't need that.
(when (functionp 'PC-do-completion)
(condition-case nil
(substitute-in-file-name "C$/")
(error
(ad-activate 'PC-do-completion))))
(provide 'tramp-smb)
;;; TODO:

68
lisp/net/tramp-util.el
View File

@ -1,9 +1,9 @@
;;; -*- coding: iso-2022-7bit; -*-
;;; tramp-util.el --- Misc utility functions to use with Tramp
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Author: kai.grossjohann@gmx.net
;; Keywords: comm, extensions, processes
;; This file is free software; you can redistribute it and/or modify
@ -32,6 +32,60 @@
(require 'compile)
(require 'tramp)
;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
;; specific functions, like compilation.
;; The key remapping works since Emacs 21.4 only. Unknown for XEmacs.
(when (fboundp 'define-minor-mode)
(defvar tramp-minor-mode-map (make-sparse-keymap)
"Keymap for Tramp minor mode.")
(define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
:group 'tramp
:global nil
:init-value nil
:lighter " Tramp"
:keymap tramp-minor-mode-map
(setq tramp-minor-mode
(and tramp-minor-mode (tramp-tramp-file-p default-directory))))
(add-hook 'find-file-hooks 'tramp-minor-mode t)
(add-hook 'dired-mode-hook 'tramp-minor-mode t)
(defun tramp-remap-command (old-command new-command)
"Replaces bindings of OLD-COMMAND by NEW-COMMAND.
If remapping functionality for keymaps is defined, this happens for all
bindings. Otherwise, only bindings active during invocation are taken
into account. XEmacs menubar bindings are not changed by this."
(if (functionp 'command-remapping)
;; Emacs 21.4
(eval
`(define-key tramp-minor-mode-map [remap ,old-command] new-command))
;; previous Emacs 21 versions.
(mapcar
'(lambda (x)
(define-key tramp-minor-mode-map x new-command))
(where-is-internal old-command))))
(tramp-remap-command 'compile 'tramp-compile)
(tramp-remap-command 'recompile 'tramp-recompile)
;; XEmacs has an own mimic for menu entries
(when (fboundp 'add-menu-button)
(funcall 'add-menu-button
'("Tools" "Compile")
["Compile..."
(command-execute (if tramp-minor-mode 'tramp-compile 'compile))
:active (fboundp 'compile)])
(funcall 'add-menu-button
'("Tools" "Compile")
["Repeat Compilation"
(command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
:active (fboundp 'compile)])))
;; Utility functions.
(defun tramp-compile (command)
"Compile on remote host."
(interactive
@ -49,6 +103,16 @@
(setq default-directory d)))
(tramp-handle-shell-command command (get-buffer "*Compilation*"))
(pop-to-buffer (get-buffer "*Compilation*"))
(tramp-minor-mode 1)
(compilation-minor-mode 1))
(defun tramp-recompile ()
"Re-compile on remote host."
(interactive)
(save-some-buffers (not compilation-ask-about-save) nil)
(tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
(pop-to-buffer (get-buffer "*Compilation*"))
(tramp-minor-mode 1)
(compilation-minor-mode 1))
(provide 'tramp-util)

9
lisp/net/tramp-vc.el
View File

@ -130,7 +130,8 @@ See `vc-do-command' for more information."
(save-excursion
(save-window-excursion
;; Actually execute remote command
(shell-command
;; `shell-command' cannot be used; it isn't magic in XEmacs.
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t)
;;(tramp-wait-for-output)
@ -190,7 +191,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(let ((w32-quote-process-args t))
(when (eq okstatus 'async)
(message "Tramp doesn't do async commands, running synchronously."))
(setq status (shell-command
;; `shell-command' cannot be used; it isn't magic in XEmacs.
(setq status (tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t))
(when (or (not (integerp status))
@ -285,7 +287,8 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(save-excursion
(save-window-excursion
;; Actually execute remote command
(shell-command
;; `shell-command' cannot be used; it isn't magic in XEmacs.
(tramp-handle-shell-command
(mapconcat 'tramp-shell-quote-argument
(append (list command) args (list localname)) " ")
(get-buffer-create"*vc-info*"))

88
lisp/net/tramp.el
View File

@ -1,7 +1,7 @@
;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: kai.grossjohann@gmx.net
;; Keywords: comm, processes
@ -912,6 +912,15 @@ The answer will be provided by `tramp-action-terminal', which see."
:group 'tramp
:type 'regexp)
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
"Regular expression matching keep-date problems in (s)cp operations.
Copying has been performed successfully already, so this message can
be ignored safely."
:group 'tramp
:type 'regexp)
(defcustom tramp-process-alive-regexp
""
"Regular expression indicating a process has finished.
@ -2500,7 +2509,7 @@ if the remote host can't provide the modtime."
(fa2 (file-attributes file2)))
(if (and (not (equal (nth 5 fa1) '(0 0)))
(not (equal (nth 5 fa2) '(0 0))))
(< 0 (tramp-time-diff (nth 5 fa1) (nth 5 fa2)))
(> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
;; If one of them is the dont-know value, then we can
;; still try to run a shell command on the remote host.
;; However, this only works if both files are Tramp
@ -2822,10 +2831,8 @@ if the remote host can't provide the modtime."
;; At least one file a tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
(let ((modes (file-modes filename)))
(tramp-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date)
(set-file-modes newname modes))
(tramp-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date)
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date))))
@ -2973,8 +2980,9 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
(when keep-date
(when (and (not (null modtime))
(not (equal modtime '(0 0))))
(tramp-touch newname modtime))
(set-file-modes newname (file-modes filename))))
(tramp-touch newname modtime)))
;; Set the mode.
(set-file-modes newname (file-modes filename)))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
(delete-file filename))))
@ -2994,15 +3002,34 @@ If KEEP-DATE is non-nil, preserve the time stamp when copying."
"Unknown operation `%s', must be `copy' or `rename'"
op)))))
(save-excursion
(tramp-barf-unless-okay
(tramp-send-command
multi-method method user host
(format "%s %s %s"
cmd
(tramp-shell-quote-argument localname1)
(tramp-shell-quote-argument localname2))
nil 'file-error
"Copying directly failed, see buffer `%s' for details."
(buffer-name)))))
(tramp-shell-quote-argument localname2)))
(tramp-wait-for-output)
(goto-char (point-min))
(unless
(or
(and (eq op 'copy) keep-date
;; Mask cp -f error.
(re-search-forward tramp-operation-not-permitted-regexp nil t))
(zerop (tramp-send-command-and-check
multi-method method user host nil nil)))
(pop-to-buffer (current-buffer))
(signal 'file-error
(format "Copying directly failed, see buffer `%s' for details."
(buffer-name)))))
;; Set the mode.
;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
;; where available?
(unless (or (eq op 'rename) keep-date)
(set-file-modes
(tramp-make-tramp-file-name multi-method method user host localname2)
(file-modes
(tramp-make-tramp-file-name
multi-method method user host localname1))))))
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
"Invoke rcp program to copy.
@ -3122,7 +3149,11 @@ be a local filename. The method used must be an out-of-band method."
tramp-actions-copy-out-of-band))
(kill-buffer trampbuf)
(tramp-message
5 "Transferring %s to file %s...done" filename newname))
5 "Transferring %s to file %s...done" filename newname)
;; Set the mode.
(unless keep-date
(set-file-modes newname (file-modes filename))))
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
@ -4074,7 +4105,9 @@ ARGS are the arguments OPERATION has been called with."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
; COMMAND
((member operation
(list 'dired-call-process 'shell-command
(list 'dired-call-process-command
; Emacs only
'shell
; Post Emacs 21.3 only
'process-file
; XEmacs only
@ -4908,7 +4941,10 @@ USER the array of user names, HOST the array of host names."
(defun tramp-get-buffer (multi-method method user host)
"Get the connection buffer to be used for USER at HOST using METHOD."
(get-buffer-create (tramp-buffer-name multi-method method user host)))
(with-current-buffer
(get-buffer-create (tramp-buffer-name multi-method method user host))
(setq buffer-undo-list t)
(current-buffer)))
(defun tramp-debug-buffer-name (multi-method method user host)
"A name for the debug buffer for USER at HOST using METHOD."
@ -4922,7 +4958,11 @@ USER the array of user names, HOST the array of host names."
(defun tramp-get-debug-buffer (multi-method method user host)
"Get the debug buffer for USER at HOST using METHOD."
(get-buffer-create (tramp-debug-buffer-name multi-method method user host)))
(with-current-buffer
(get-buffer-create
(tramp-debug-buffer-name multi-method method user host))
(setq buffer-undo-list t)
(current-buffer)))
(defun tramp-find-executable (multi-method method user host
progname dirlist ignore-tilde)
@ -5214,8 +5254,16 @@ The terminal type can be configured with `tramp-terminal-type'."
((or (and (memq (process-status p) '(stop exit))
(not (zerop (process-exit-status p))))
(memq (process-status p) '(signal)))
(tramp-message 9 "Process has died.")
(throw 'tramp-action 'process-died))
;; `scp' could have copied correctly, but set modes could have failed.
;; This can be ignored.
(goto-char (point-min))
(if (re-search-forward tramp-operation-not-permitted-regexp nil t)
(progn
(tramp-message 10 "'set mode' error ignored.")
(tramp-message 9 "Process has finished.")
(throw 'tramp-action 'ok))
(tramp-message 9 "Process has died.")
(throw 'tramp-action 'process-died)))
(t nil)))
;; The following functions are specifically for multi connections.
@ -6336,7 +6384,7 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
(save-excursion
(goto-char start-point)
(when (looking-at (regexp-quote tramp-last-cmd))
(delete-region (point) (forward-line 1)))))
(delete-region (point) (progn (forward-line 1) (point))))))
;; Add output to debug buffer if appropriate.
(when tramp-debug-buffer
(append-to-buffer

2
lisp/net/trampver.el
View File

@ -30,7 +30,7 @@
;; are auto-frobbed from configure.ac, so you should edit that file and run
;; "autoconf && ./configure" to change them.
(defconst tramp-version "2.0.46"
(defconst tramp-version "2.0.47"
"This version of Tramp.")
(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"

8
lisp/pcomplete.el
View File

@ -946,8 +946,10 @@ generate the completions list. This means that the hook
(unless (fboundp 'event-matches-key-specifier-p)
(defalias 'event-matches-key-specifier-p 'eq))
(unless (fboundp 'read-event)
(defsubst read-event (&optional prompt)
(if (fboundp 'read-event)
(defsubst pcomplete-read-event (&optional prompt)
(read-event prompt))
(defsubst pcomplete-read-event (&optional prompt)
(aref (read-key-sequence prompt) 0)))
(unless (fboundp 'event-basic-type)
@ -969,7 +971,7 @@ Typing SPC flushes the help buffer."
(prog1
(catch 'done
(while (with-current-buffer (get-buffer "*Completions*")
(setq event (read-event)))
(setq event (pcomplete-read-event)))
(cond
((event-matches-key-specifier-p event ? )
(set-window-configuration pcomplete-last-window-config)

3
lisp/play/decipher.el
View File

@ -305,7 +305,8 @@ The most useful commands are:
(setq case-fold-search nil)) ;Case is significant when searching
(use-local-map decipher-mode-map)
(set-syntax-table decipher-mode-syntax-table)
(decipher-read-alphabet)
(unless (= (point-min) (point-max))
(decipher-read-alphabet))
(set (make-local-variable 'font-lock-defaults)
'(decipher-font-lock-keywords t))
;; Make the buffer writable when we exit Decipher mode:

6
lisp/progmodes/compile.el
View File

@ -985,8 +985,9 @@ Returns the compilation buffer created."
(setq mode-line-process ":run")
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(let ((status (call-process shell-file-name nil outbuf nil "-c"
command)))
(let* ((buffer-read-only nil) ; call-process needs to modify outbuf
(status (call-process shell-file-name nil outbuf nil "-c"
command)))
(cond ((numberp status)
(compilation-handle-exit 'exit status
(if (zerop status)
@ -1003,6 +1004,7 @@ exited abnormally with code %d\n"
;; fontified, so fontify it now.
(let ((font-lock-verbose nil)) ; shut up font-lock messages
(font-lock-fontify-buffer))
(set-buffer-modified-p nil)
(message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/...
(setq default-directory thisdir))

18
lisp/progmodes/ebrowse.el
View File

@ -780,16 +780,16 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
(defun ebrowse-class-in-tree (class tree)
"Search for a class with name CLASS in TREE.
Return the class found, if any. This function is used during the load
phase where classes appended to a file replace older class
information."
If CLASS is found, return the tail of TREE starting at CLASS. This function
is used during the load phase where classes appended to a file replace older
class information."
(let ((tclass (ebrowse-ts-class class))
found)
(while (and tree (not found))
(let ((root (car tree)))
(when (string= (ebrowse-qualified-class-name (ebrowse-ts-class root))
(let ((root-ptr tree))
(when (string= (ebrowse-qualified-class-name (ebrowse-ts-class (car root-ptr)))
(ebrowse-qualified-class-name tclass))
(setq found root))
(setq found root-ptr))
(setq tree (cdr tree))))
found))
@ -903,10 +903,10 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree."
(let ((gc-cons-threshold 2000000))
(while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
(let* ((root (read (current-buffer)))
(old-root (ebrowse-class-in-tree root tree)))
(old-root-ptr (ebrowse-class-in-tree root tree)))
(ebrowse-show-progress "Reading data" (null tree))
(if old-root
(setf (car old-root) root)
(if old-root-ptr
(setcar old-root-ptr root)
(push root tree)))))
(garbage-collect)
(list header tree)))

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

@ -33,24 +33,34 @@
;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar
;; (see the GDB Graphical Interface section in the Emacs info manual).
;; Start the debugger with M-x gdba.
;; By default, M-x gdb will start the debugger. However, if you have customised
;; gud-gdb-command-name, then start it with M-x gdba.
;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim
;; Kingdon and uses GDB's annotation interface. You don't need to know about
;; annotations to use this mode as a debugger, but if you are interested
;; developing the mode itself, then see the Annotations section in the GDB
;; info manual.
;; This file has evolved from gdba.el that was included with GDB 5.0 and
;; written by Tom Lord and Jim Kingdon. It uses GDB's annotation interface.
;; You don't need to know about annotations to use this mode as a debugger,
;; but if you are interested developing the mode itself, then see the
;; Annotations section in the GDB info manual.
;;
;; GDB developers plan to make the annotation interface obsolete. A new
;; interface called GDB/MI (machine interface) has been designed to replace
;; it. Some GDB/MI commands are used in this file through the CLI command
;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
;; primary interface to GDB. It is still under development and is part of a
;; process to migrate Emacs from annotations to GDB/MI.
;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included with
;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is
;; still under development and is part of a process to migrate Emacs from
;; annotations to GDB/MI.
;;
;; Known Bugs:
;;
;; TODO:
;; 1) Use MI command -data-read-memory for memory window.
;; 2) Highlight changed register values (use MI commands
;; -data-list-register-values and -data-list-changed-registers instead
;; of 'info registers'.
;; 3) Use tree-widget.el instead of the speedbar for watch-expressions?
;; 4) Mark breakpoint locations on scroll-bar of source buffer?
;; 5) After release of 21.4 use '-var-list-children --all-values'
;; and '-stack-list-locals 2' which need GDB 6.1 onwards.
;;; Code:
@ -58,6 +68,7 @@
(defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
(defvar gdb-previous-address nil)
(defvar gdb-memory-address "main")
(defvar gdb-previous-frame nil)
(defvar gdb-current-frame nil)
(defvar gdb-current-stack-level nil)
@ -169,13 +180,13 @@ detailed description of this mode.
(defvar gdb-debug-log nil)
(defcustom gdb-enable-debug-log nil
"Non-nil means record the process input and output in `gdb-debug-log'."
"Non-nil means record the process input and output in `gdb-debug-log'."
:type 'boolean
:group 'gud
:version "21.4")
(defcustom gdb-use-inferior-io-buffer nil
"Non-nil means display output from the inferior in a separate buffer."
"Non-nil means display output from the inferior in a separate buffer."
:type 'boolean
:group 'gud
:version "21.4")
@ -210,15 +221,20 @@ detailed description of this mode.
"\C-u" "Continue to current line or address.")
(define-key gud-minor-mode-map [left-margin mouse-1]
'gdb-mouse-toggle-breakpoint)
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-1]
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-margin mouse-3]
'gdb-mouse-toggle-breakpoint)
; (define-key gud-minor-mode-map [left-fringe mouse-3]
; 'gdb-mouse-toggle-breakpoint)
(setq comint-input-sender 'gdb-send)
;;
;; (re-)initialize
(setq gdb-current-address "main")
(setq gdb-previous-address nil)
(setq gdb-memory-address "main")
(setq gdb-previous-frame nil)
(setq gdb-current-frame nil)
(setq gdb-current-stack-level nil)
@ -273,15 +289,8 @@ detailed description of this mode.
`(lambda () (gdb-var-create-handler ,expr))))))
(select-window (get-buffer-window gud-comint-buffer 0)))
(defun gdb-goto-info ()
"Go to Emacs info node: GDB Graphical Interface."
(interactive)
(select-frame (make-frame))
(require 'info)
(Info-goto-node "(emacs)GDB Graphical Interface"))
(defconst gdb-var-create-regexp
"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
(defun gdb-var-create-handler (expr)
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
@ -328,7 +337,7 @@ detailed description of this mode.
`(lambda () (gdb-var-list-children-handler ,varnum)))))
(defconst gdb-var-list-children-regexp
"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"")
(defun gdb-var-list-children-handler (varnum)
(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
@ -832,6 +841,7 @@ happens to be appropriate."
(gdb-invalidate-breakpoints)
(gdb-invalidate-assembler)
(gdb-invalidate-registers)
(gdb-invalidate-memory)
(gdb-invalidate-locals)
(gdb-invalidate-threads)
(unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
@ -1038,7 +1048,8 @@ happens to be appropriate."
(defvar gdb-cdir nil "Compilation directory.")
(defconst breakpoint-xpm-data "/* XPM */
(defconst breakpoint-xpm-data
"/* XPM */
static char *magick[] = {
/* columns rows colors chars-per-pixel */
\"10 10 2 1\",
@ -1059,7 +1070,7 @@ static char *magick[] = {
"XPM data used for breakpoint icon.")
(defconst breakpoint-enabled-pbm-data
"P1
"P1
10 10\",
0 0 0 0 1 1 1 1 0 0 0 0
0 0 0 1 1 1 1 1 1 0 0 0
@ -1074,7 +1085,7 @@ static char *magick[] = {
"PBM data used for enabled breakpoint icon.")
(defconst breakpoint-disabled-pbm-data
"P1
"P1
10 10\",
0 0 1 0 1 0 1 0 0 0
0 1 0 1 0 1 0 1 0 0
@ -1116,8 +1127,7 @@ static char *magick[] = {
;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
(defun gdb-info-breakpoints-custom ()
(let ((flag))
;;
(let ((flag) (bptno))
;; remove all breakpoint-icons in source buffers but not assembler buffer
(dolist (buffer (buffer-list))
(with-current-buffer buffer
@ -1131,12 +1141,13 @@ static char *magick[] = {
(forward-line 1)
(if (looking-at "[^\t].*breakpoint")
(progn
(looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
(setq flag (char-after (match-beginning 1)))
(looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
(setq bptno (match-string 1))
(setq flag (char-after (match-beginning 2)))
(beginning-of-line)
(if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
(if (re-search-forward "in.*at\\s-+" nil t)
(progn
(looking-at "\\(\\S-*\\):\\([0-9]+\\)")
(looking-at "\\(\\S-+\\):\\([0-9]+\\)")
(let ((line (match-string 2)) (buffer-read-only nil)
(file (match-string 1)))
(add-text-properties (point-at-bol) (point-at-eol)
@ -1153,12 +1164,12 @@ static char *magick[] = {
;; only want one breakpoint icon at each location
(save-excursion
(goto-line (string-to-number line))
(gdb-put-breakpoint-icon (eq flag ?y)))))))))
(gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
(end-of-line)))))
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
(defun gdb-mouse-toggle-breakpoint (event)
"Toggle breakpoint in left fringe/margin with mouse click."
(defun gdb-mouse-set-clear-breakpoint (event)
"Set/clear breakpoint in left fringe/margin with mouse click."
(interactive "e")
(mouse-minibuffer-check event)
(let ((posn (event-end event)))
@ -1172,6 +1183,31 @@ static char *magick[] = {
(gud-remove nil)
(gud-break nil)))))))
(defun gdb-mouse-toggle-breakpoint (event)
"Enable/disable breakpoint in left fringe/margin with mouse click."
(interactive "e")
(mouse-minibuffer-check event)
(let ((posn (event-end event)))
(if (numberp (posn-point posn))
(with-selected-window (posn-window posn)
(save-excursion
(goto-char (posn-point posn))
(if
; (or
(posn-object posn)
; (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
; 'breakpoint))
(gdb-enqueue-input
(list
(let ((bptno (get-text-property
0 'gdb-bptno (car (posn-string posn)))))
(concat
(if (get-text-property
0 'gdb-enabled (car (posn-string posn)))
"disable "
"enable ")
bptno "\n")) 'ignore))))))))
(defun gdb-breakpoints-buffer-name ()
(with-current-buffer gud-comint-buffer
(concat "*breakpoints of " (gdb-get-target-string) "*")))
@ -1209,7 +1245,7 @@ static char *magick[] = {
(define-key map "d" 'gdb-delete-breakpoint)
(define-key map "q" 'kill-this-buffer)
(define-key map "\r" 'gdb-goto-breakpoint)
(define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
(define-key map [mouse-2] 'gdb-goto-breakpoint)
map))
(defun gdb-breakpoints-mode ()
@ -1227,7 +1263,7 @@ static char *magick[] = {
'gdbmi-invalidate-breakpoints))
(defun gdb-toggle-breakpoint ()
"Enable/disable the breakpoint at current line."
"Enable/disable breakpoint at current line."
(interactive)
(save-excursion
(beginning-of-line 1)
@ -1257,13 +1293,14 @@ static char *magick[] = {
(concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
(error "Not recognized as break/watchpoint line")))
(defun gdb-goto-breakpoint ()
(defun gdb-goto-breakpoint (&optional event)
"Display the breakpoint location specified at current line."
(interactive)
(interactive (list last-input-event))
(if event (mouse-set-point event))
(save-excursion
(beginning-of-line 1)
(if (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
(looking-at ".*in\\s-+\\S-+\\s-+at\\s-+\\(\\S-*\\):\\([0-9]+\\)")
(looking-at ".*in.*at\\s-+\\(\\S-*\\):\\([0-9]+\\)")
(looking-at
"[0-9]+\\s-*\\S-*\\s-*\\S-*\\s-*.\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)"))
(let ((line (match-string 2))
@ -1277,14 +1314,8 @@ static char *magick[] = {
(goto-line (string-to-number line))
(set-window-point window (point))))))
(error "Not recognized as break/watchpoint line"))))
(defun gdb-mouse-goto-breakpoint (event)
"Display the breakpoint location that you click on."
(interactive "e")
(mouse-set-point event)
(gdb-goto-breakpoint))
;;
;; Frames buffer. This displays a perpetually correct bactracktrace
;; (from the command `where').
;;
@ -1338,7 +1369,7 @@ static char *magick[] = {
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
(define-key map "\r" 'gdb-frames-select)
(define-key map [mouse-2] 'gdb-frames-mouse-select)
(define-key map [mouse-2] 'gdb-frames-select)
map))
(defun gdb-frames-mode ()
@ -1362,20 +1393,15 @@ static char *magick[] = {
(n (or (and pos (match-string-no-properties 1)) "0")))
n)))
(defun gdb-frames-select ()
(defun gdb-frames-select (&optional event)
"Select the frame and display the relevant source."
(interactive)
(interactive (list last-input-event))
(if event (mouse-set-point event))
(gdb-enqueue-input
(list (concat gdb-server-prefix "frame " (gdb-get-frame-number) "\n") 'ignore))
(gud-display-frame))
(defun gdb-frames-mouse-select (event)
"Select the frame you click on and display the relevant source."
(interactive "e")
(mouse-set-point event)
(gdb-frames-select))
;;
;; Threads buffer. This displays a selectable thread list.
;;
(gdb-set-buffer-rules 'gdb-threads-buffer
@ -1420,7 +1446,7 @@ static char *magick[] = {
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
(define-key map "\r" 'gdb-threads-select)
(define-key map [mouse-2] 'gdb-threads-mouse-select)
(define-key map [mouse-2] 'gdb-threads-select)
map))
(defun gdb-threads-mode ()
@ -1440,20 +1466,15 @@ static char *magick[] = {
(re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
(match-string-no-properties 1)))
(defun gdb-threads-select ()
(defun gdb-threads-select (&optional event)
"Select the thread and display the relevant source."
(interactive)
(interactive (list last-input-event))
(if event (mouse-set-point event))
(gdb-enqueue-input
(list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
(gud-display-frame))
(defun gdb-threads-mouse-select (event)
"Select the thread you click on and display the relevant source."
(interactive "e")
(mouse-set-point event)
(gdb-threads-select))
;;
;; Registers buffer.
;;
(gdb-set-buffer-rules 'gdb-registers-buffer
@ -1502,8 +1523,268 @@ static char *magick[] = {
(let ((special-display-regexps (append special-display-regexps '(".*")))
(special-display-frame-alist gdb-frame-parameters))
(display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))))
;; Memory buffer.
;;
(defcustom gdb-memory-repeat-count 32
"Number of data items in memory window."
:type 'integer
:group 'gud
:version "21.4")
(defcustom gdb-memory-format "x"
"Display format of data items in memory window."
:type '(choice (const :tag "Hexadecimal" "x")
(const :tag "Signed decimal" "d")
(const :tag "Unsigned decimal" "u")
(const :tag "Octal" "o")
(const :tag "Binary" "t"))
:group 'gud
:version "21.4")
(defcustom gdb-memory-unit "w"
"Unit size of data items in memory window."
:type '(choice (const :tag "Byte" "b")
(const :tag "Halfword" "h")
(const :tag "Word" "w")
(const :tag "Giant word" "g"))
:group 'gud
:version "21.4")
(gdb-set-buffer-rules 'gdb-memory-buffer
'gdb-memory-buffer-name
'gdb-memory-mode)
(def-gdb-auto-updated-buffer gdb-memory-buffer
gdb-invalidate-memory
(concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
gdb-read-memory-handler
gdb-read-memory-custom)
(defun gdb-read-memory-custom ())
(defvar gdb-memory-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map "q" 'kill-this-buffer)
map))
(defun gdb-memory-set-address (event)
"Set the start memory address."
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
(let ((arg (read-from-minibuffer "Memory address: ")))
(setq gdb-memory-address arg))
(gdb-invalidate-memory)))
(defun gdb-memory-set-repeat-count (event)
"Set the number of data items in memory window."
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
(let* ((arg (read-from-minibuffer "Repeat count: "))
(count (string-to-int arg)))
(if (< count 0)
(error "Non-negative numbers only")
(customize-set-variable 'gdb-memory-repeat-count count)
(gdb-invalidate-memory)))))
(defun gdb-memory-format-binary ()
"Set the display format to binary."
(interactive)
(customize-set-variable 'gdb-memory-format "t")
(gdb-invalidate-memory))
(defun gdb-memory-format-octal ()
"Set the display format to octal."
(interactive)
(customize-set-variable 'gdb-memory-format "o")
(gdb-invalidate-memory))
(defun gdb-memory-format-unsigned ()
"Set the display format to unsigned decimal."
(interactive)
(customize-set-variable 'gdb-memory-format "u")
(gdb-invalidate-memory))
(defun gdb-memory-format-signed ()
"Set the display format to decimal."
(interactive)
(customize-set-variable 'gdb-memory-format "d")
(gdb-invalidate-memory))
(defun gdb-memory-format-hexadecimal ()
"Set the display format to hexadecimal."
(interactive)
(customize-set-variable 'gdb-memory-format "x")
(gdb-invalidate-memory))
(defvar gdb-memory-format-keymap
(let ((map (make-sparse-keymap)))
(define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
map)
"Keymap to select format in the header line.")
(defvar gdb-memory-format-menu (make-sparse-keymap "Format")
"Menu of display formats in the header line.")
(define-key gdb-memory-format-menu [binary]
'(menu-item "Binary" gdb-memory-format-binary
:button (:radio . (equal gdb-memory-format "t"))))
(define-key gdb-memory-format-menu [octal]
'(menu-item "Octal" gdb-memory-format-octal
:button (:radio . (equal gdb-memory-format "o"))))
(define-key gdb-memory-format-menu [unsigned]
'(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
:button (:radio . (equal gdb-memory-format "u"))))
(define-key gdb-memory-format-menu [signed]
'(menu-item "Signed Decimal" gdb-memory-format-signed
:button (:radio . (equal gdb-memory-format "d"))))
(define-key gdb-memory-format-menu [hexadecimal]
'(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
:button (:radio . (equal gdb-memory-format "x"))))
(defun gdb-memory-format-menu (event)
(interactive "@e")
(x-popup-menu event gdb-memory-format-menu))
(defun gdb-memory-format-menu-1 (event)
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
(let* ((selection (gdb-memory-format-menu event))
(binding (and selection (lookup-key gdb-memory-format-menu
(vector (car selection))))))
(if binding (call-interactively binding)))))
(defun gdb-memory-unit-giant ()
"Set the unit size to giant words (eight bytes)."
(interactive)
(customize-set-variable 'gdb-memory-unit "g")
(gdb-invalidate-memory))
(defun gdb-memory-unit-word ()
"Set the unit size to words (four bytes)."
(interactive)
(customize-set-variable 'gdb-memory-unit "w")
(gdb-invalidate-memory))
(defun gdb-memory-unit-halfword ()
"Set the unit size to halfwords (two bytes)."
(interactive)
(customize-set-variable 'gdb-memory-unit "h")
(gdb-invalidate-memory))
(defun gdb-memory-unit-byte ()
"Set the unit size to bytes."
(interactive)
(customize-set-variable 'gdb-memory-unit "b")
(gdb-invalidate-memory))
(defvar gdb-memory-unit-keymap
(let ((map (make-sparse-keymap)))
(define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
map)
"Keymap to select units in the header line.")
(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
"Menu of units in the header line.")
(define-key gdb-memory-unit-menu [giantwords]
'(menu-item "Giant words" gdb-memory-unit-giant
:button (:radio . (equal gdb-memory-unit "g"))))
(define-key gdb-memory-unit-menu [words]
'(menu-item "Words" gdb-memory-unit-word
:button (:radio . (equal gdb-memory-unit "w"))))
(define-key gdb-memory-unit-menu [halfwords]
'(menu-item "Halfwords" gdb-memory-unit-halfword
:button (:radio . (equal gdb-memory-unit "h"))))
(define-key gdb-memory-unit-menu [bytes]
'(menu-item "Bytes" gdb-memory-unit-byte
:button (:radio . (equal gdb-memory-unit "b"))))
(defun gdb-memory-unit-menu (event)
(interactive "@e")
(x-popup-menu event gdb-memory-unit-menu))
(defun gdb-memory-unit-menu-1 (event)
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
(let* ((selection (gdb-memory-unit-menu event))
(binding (and selection (lookup-key gdb-memory-unit-menu
(vector (car selection))))))
(if binding (call-interactively binding)))))
;;from make-mode-line-mouse-map
(defun gdb-make-header-line-mouse-map (mouse function) "\
Return a keymap with single entry for mouse key MOUSE on the header line.
MOUSE is defined to run function FUNCTION with no args in the buffer
corresponding to the mode line clicked."
(let ((map (make-sparse-keymap)))
(define-key map (vector 'header-line mouse) function)
(define-key map (vector 'header-line 'down-mouse-1) 'ignore)
map))
(defun gdb-memory-mode ()
"Major mode for examining memory.
\\{gdb-memory-mode-map}"
(kill-all-local-variables)
(setq major-mode 'gdb-memory-mode)
(setq mode-name "Memory")
(setq buffer-read-only t)
(use-local-map gdb-memory-mode-map)
(setq header-line-format
'(:eval
(concat
"Read address: "
(propertize gdb-memory-address
'face font-lock-warning-face
'help-echo (purecopy "mouse-1: Set memory address")
'local-map (purecopy (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-address)))
" Repeat Count: "
(propertize (number-to-string gdb-memory-repeat-count)
'face font-lock-warning-face
'help-echo (purecopy "mouse-1: Set repeat count")
'local-map (purecopy (gdb-make-header-line-mouse-map
'mouse-1
#'gdb-memory-set-repeat-count)))
" Display Format: "
(propertize gdb-memory-format
'face font-lock-warning-face
'help-echo (purecopy "mouse-3: Select display format")
'local-map gdb-memory-format-keymap)
" Unit Size: "
(propertize gdb-memory-unit
'face font-lock-warning-face
'help-echo (purecopy "mouse-3: Select unit size")
'local-map gdb-memory-unit-keymap))))
(run-mode-hooks 'gdb-memory-mode-hook)
'gdb-invalidate-memory)
(defun gdb-memory-buffer-name ()
(with-current-buffer gud-comint-buffer
(concat "*memory of " (gdb-get-target-string) "*")))
(defun gdb-display-memory-buffer ()
"Display memory contents."
(interactive)
(gdb-display-buffer
(gdb-get-create-buffer 'gdb-memory-buffer)))
(defun gdb-frame-memory-buffer ()
"Display memory contents in a new frame."
(interactive)
(let ((special-display-regexps (append special-display-regexps '(".*")))
(special-display-frame-alist gdb-frame-parameters))
(display-buffer (gdb-get-create-buffer 'gdb-memory-buffer))))
;; Locals buffer.
;;
(gdb-set-buffer-rules 'gdb-locals-buffer
@ -1614,6 +1895,7 @@ static char *magick[] = {
`(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
(define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
(define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
(define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
(define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
@ -1624,8 +1906,9 @@ static char *magick[] = {
(define-key gud-menu-map [displays]
`(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
(define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
(define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
(define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
(define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
(define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
(define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
(define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
@ -1707,7 +1990,7 @@ of the inferior. Non-nil means display the layout shown for
:version "21.4")
(defun gdb-many-windows (arg)
"Toggle the number of windows in the basic arrangement."
"Toggle the number of windows in the basic arrangement."
(interactive "P")
(setq gdb-many-windows
(if (null arg)
@ -1777,14 +2060,15 @@ buffers."
PUTSTRING is displayed by putting an overlay into the current buffer with a
`before-string' STRING that has a `display' property whose value is
PUTSTRING."
(let ((gdb-string "x")
(let ((string (make-string 1 ?x))
(buffer (current-buffer)))
(setq putstring (copy-sequence putstring))
(let ((overlay (make-overlay pos pos buffer))
(prop (or dprop
(list (list 'margin 'left-margin) putstring))))
(put-text-property 0 (length gdb-string) 'display prop gdb-string)
(put-text-property 0 (length string) 'display prop string)
(overlay-put overlay 'put-break t)
(overlay-put overlay 'before-string gdb-string))))
(overlay-put overlay 'before-string string))))
;;from remove-images
(defun gdb-remove-strings (start end &optional buffer)
@ -1793,25 +2077,30 @@ Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
BUFFER nil or omitted means use the current buffer."
(unless buffer
(setq buffer (current-buffer)))
(let ((overlays (overlays-in start end)))
(while overlays
(let ((overlay (car overlays)))
(dolist (overlay (overlays-in start end))
(when (overlay-get overlay 'put-break)
(delete-overlay overlay)))
(setq overlays (cdr overlays)))))
(delete-overlay overlay))))
(defun gdb-put-breakpoint-icon (enabled)
(defun gdb-put-breakpoint-icon (enabled bptno)
(let ((start (progn (beginning-of-line) (- (point) 1)))
(end (progn (end-of-line) (+ (point) 1))))
(end (progn (end-of-line) (+ (point) 1)))
(putstring (if enabled "B" "b")))
(add-text-properties
0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt")
putstring)
(if enabled (add-text-properties
0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
(add-text-properties
0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
(gdb-remove-breakpoint-icons start end)
(if (display-images-p)
(if (>= (car (window-fringes)) 8)
(gdb-put-string
nil (1+ start)
`(left-fringe breakpoint
,(if enabled
'breakpoint-enabled-bitmap-face
'breakpoint-disabled-bitmap-face)))
,(if enabled
'breakpoint-enabled-bitmap-face
'breakpoint-disabled-bitmap-face)))
(when (< left-margin-width 2)
(save-current-buffer
(setq left-margin-width 2)
@ -1838,7 +2127,9 @@ BUFFER nil or omitted means use the current buffer."
(:type pbm :data
,breakpoint-disabled-pbm-data
:ascent 100))))))
(+ start 1) nil 'left-margin))
(+ start 1)
putstring
'left-margin))
(when (< left-margin-width 2)
(save-current-buffer
(setq left-margin-width 2)
@ -1846,7 +2137,7 @@ BUFFER nil or omitted means use the current buffer."
(set-window-margins
(get-buffer-window (current-buffer) 0)
left-margin-width right-margin-width))))
(gdb-put-string (if enabled "B" "b") (1+ start)))))
(gdb-put-string putstring (1+ start)))))
(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
(gdb-remove-strings start end)
@ -1875,7 +2166,7 @@ BUFFER nil or omitted means use the current buffer."
(defun gdb-assembler-custom ()
(let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
(pos 1) (address) (flag))
(pos 1) (address) (flag) (bptno))
(with-current-buffer buffer
(if (not (equal gdb-current-address "main"))
(progn
@ -1897,16 +2188,17 @@ BUFFER nil or omitted means use the current buffer."
(if (looking-at "[^\t].*breakpoint")
(progn
(looking-at
"[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
(setq flag (char-after (match-beginning 1)))
(setq address (match-string 2))
"\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x\\(\\S-+\\)")
(setq bptno (match-string 1))
(setq flag (char-after (match-beginning 2)))
(setq address (match-string 3))
;; remove leading 0s from output of info break.
(if (string-match "^0+\\(.*\\)" address)
(setq address (match-string 1 address)))
(with-current-buffer buffer
(goto-char (point-min))
(if (re-search-forward address nil t)
(gdb-put-breakpoint-icon (eq flag ?y))))))))
(gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
(if (not (equal gdb-current-address "main"))
(set-window-point (get-buffer-window buffer 0) pos))))

6
lisp/progmodes/grep.el
View File

@ -527,7 +527,8 @@ This command uses a special history list for its arguments, so you can
easily repeat a find command."
(interactive
(progn
(unless grep-find-command
(unless (and grep-command
(or (not grep-use-null-device) (eq grep-use-null-device t)))
(grep-compute-defaults))
(if grep-find-command
(list (read-from-minibuffer "Run find (like this): "
@ -541,6 +542,9 @@ easily repeat a find command."
(let ((null-device nil)) ; see grep
(grep command-args))))
;;;###autoload
(defalias 'find-grep 'grep-find)
(defun grep-expand-command-macros (command &optional regexp files dir excl case-fold)
"Patch grep COMMAND replacing <D>, etc."
(setq command

14
lisp/progmodes/gud.el
View File

@ -91,9 +91,17 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist."
"Non-nil if debuggee is running.
Used to grey out relevant toolbar icons.")
(defun gud-goto-info ()
"Go to relevant Emacs info node."
(interactive)
(select-frame (make-frame))
(require 'info)
(if (memq gud-minor-mode '(gdbmi gdba))
(Info-goto-node "(emacs)GDB Graphical Interface")
(Info-goto-node "(emacs)Debuggers")))
(easy-mmode-defmap gud-menu-map
'(([help] menu-item "Help" gdb-goto-info
:enable (memq gud-minor-mode '(gdbmi gdba)))
'(([help] "Info" . gud-goto-info)
([refresh] "Refresh" . gud-refresh)
([run] menu-item "Run" gud-run
:enable (and (not gud-running)
@ -172,7 +180,7 @@ Used to grey out relevant toolbar icons.")
(gud-nexti . "gud-ni")
(gud-up . "gud-up")
(gud-down . "gud-down")
(gdb-goto-info . "help"))
(gud-goto-info . "info"))
map)
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map)))))

3
lisp/progmodes/hideshow.el
View File

@ -5,7 +5,7 @@
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
;; Maintainer-Version: 5.58.2.3
;; Maintainer-Version: 5.58.2.4
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
;; This file is part of GNU Emacs.
@ -233,7 +233,6 @@
;;; Code:
(require 'easymenu)
(eval-when-compile (require 'cl))
;;---------------------------------------------------------------------------
;; user-configurable variables

8
lisp/progmodes/perl-mode.el
View File

@ -1,6 +1,6 @@
;;; perl-mode.el --- Perl code editing commands for GNU Emacs
;; Copyright (C) 1990, 1994, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1990, 1994, 2003, 2005 Free Software Foundation, Inc.
;; Author: William F. Mann
;; Maintainer: FSF
@ -408,7 +408,7 @@ existing comment, moves to end-of-line, or if at end-of-line already,
create a new comment."
:type 'boolean)
(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"
"*Lines starting with this regular expression are not auto-indented."
:type 'regexp)
@ -769,7 +769,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'."
(skip-chars-forward " \t\f\n")
(cond ((looking-at ";?#")
(forward-line 1) t)
((looking-at "\\(\\w\\|\\s_\\)+:")
((looking-at "\\(\\w\\|\\s_\\)+:[^:]")
(save-excursion
(end-of-line)
(setq colon-line-end (point)))
@ -929,5 +929,5 @@ With argument, repeat that many times; negative args move backward."
(provide 'perl-mode)
;;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826
;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826
;;; perl-mode.el ends here

48
lisp/progmodes/scheme.el
View File

@ -1,6 +1,7 @@
;;; scheme.el --- Scheme (and DSSSL) editing mode
;; Copyright (C) 1986, 87, 88, 97, 1998 Free Software Foundation, Inc.
;; Copyright (C) 1986, 1987, 1988, 1997, 1998, 2005
;; Free Software Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
;; Adapted-by: Dave Love <d.love@dl.ac.uk>
@ -144,6 +145,7 @@
(setq outline-regexp ";;; \\|(....")
(make-local-variable 'comment-start)
(setq comment-start ";")
(set (make-local-variable 'comment-add) 1)
(make-local-variable 'comment-start-skip)
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
@ -171,17 +173,11 @@
(defvar scheme-mode-line-process "")
(defvar scheme-mode-map nil
"Keymap for Scheme mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
(unless scheme-mode-map
(let ((map (make-sparse-keymap "Scheme")))
(setq scheme-mode-map (make-sparse-keymap))
(set-keymap-parent scheme-mode-map lisp-mode-shared-map)
(define-key scheme-mode-map [menu-bar] (make-sparse-keymap))
(define-key scheme-mode-map [menu-bar scheme]
(cons "Scheme" map))
(defvar scheme-mode-map
(let ((smap (make-sparse-keymap))
(map (make-sparse-keymap "Scheme")))
(set-keymap-parent smap lisp-mode-shared-map)
(define-key smap [menu-bar scheme] (cons "Scheme" map))
(define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
(define-key map [uncomment-region]
'("Uncomment Out Region" . (lambda (beg end)
@ -192,7 +188,10 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(define-key map [indent-line] '("Indent Line" . lisp-indent-line))
(put 'comment-region 'menu-enable 'mark-active)
(put 'uncomment-region 'menu-enable 'mark-active)
(put 'indent-region 'menu-enable 'mark-active)))
(put 'indent-region 'menu-enable 'mark-active)
smap)
"Keymap for Scheme mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
;; Used by cmuscheme
(defun scheme-mode-commands (map)
@ -222,14 +221,11 @@ Entry to this mode calls the value of `scheme-mode-hook'
if that value is non-nil."
(interactive)
(kill-all-local-variables)
(scheme-mode-initialize)
(scheme-mode-variables)
(run-hooks 'scheme-mode-hook))
(defun scheme-mode-initialize ()
(use-local-map scheme-mode-map)
(setq major-mode 'scheme-mode)
(setq mode-name "Scheme"))
(setq mode-name "Scheme")
(scheme-mode-variables)
(run-mode-hooks 'scheme-mode-hook))
(defgroup scheme nil
"Editing Scheme code"
@ -346,7 +342,7 @@ See `run-hooks'."
"Default expressions to highlight in Scheme modes.")
;;;###autoload
(defun dsssl-mode ()
(define-derived-mode dsssl-mode scheme-mode "DSSSL"
"Major mode for editing DSSSL code.
Editing commands are similar to those of `lisp-mode'.
@ -357,20 +353,16 @@ Blank lines separate paragraphs. Semicolons start comments.
Entering this mode runs the hooks `scheme-mode-hook' and then
`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
that variable's value is a string."
(interactive)
(kill-all-local-variables)
(use-local-map scheme-mode-map)
(scheme-mode-initialize)
(make-local-variable 'page-delimiter)
(setq page-delimiter "^;;;" ; ^L not valid SGML char
major-mode 'dsssl-mode
mode-name "DSSSL")
;; Insert a suitable SGML declaration into an empty buffer.
;; FIXME: This should use `auto-insert-alist' instead.
(and (zerop (buffer-size))
(stringp dsssl-sgml-declaration)
(not buffer-read-only)
(insert dsssl-sgml-declaration))
(scheme-mode-variables)
(setq font-lock-defaults '(dsssl-font-lock-keywords
nil t (("+-*/.<>=?$%_&~^:" . "w"))
beginning-of-defun
@ -378,9 +370,7 @@ that variable's value is a string."
(set (make-local-variable 'imenu-case-fold-search) nil)
(setq imenu-generic-expression dsssl-imenu-generic-expression)
(set (make-local-variable 'imenu-syntax-alist)
'(("+-*/.<>=?$%_&~^:" . "w")))
(run-hooks 'scheme-mode-hook)
(run-hooks 'dsssl-mode-hook))
'(("+-*/.<>=?$%_&~^:" . "w"))))
;; Extra syntax for DSSSL. This isn't separated from Scheme, but
;; shouldn't cause much trouble in scheme-mode.
@ -558,5 +548,5 @@ that variable's value is a string."
(provide 'scheme)
;;; arch-tag: a8f06bc1-ad11-42d2-9e36-ce651df37a90
;; arch-tag: a8f06bc1-ad11-42d2-9e36-ce651df37a90
;;; scheme.el ends here

88
lisp/progmodes/sh-script.el
View File

@ -1,6 +1,6 @@
;;; sh-script.el --- shell-script editing commands for Emacs
;; Copyright (C) 1993, 94, 95, 96, 97, 1999, 2001, 03, 2004
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2001, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
@ -448,6 +448,7 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c=" 'sh-set-indent)
(define-key map "\C-c<" 'sh-learn-line-indent)
(define-key map "\C-c>" 'sh-learn-buffer-indent)
(define-key map "\C-c\C-\\" 'sh-backslash-region)
(define-key map "=" 'sh-assignment)
(define-key map "\C-c+" 'sh-add)
@ -837,7 +838,7 @@ See `sh-feature'.")
(defconst sh-st-symbol (string-to-syntax "_"))
(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
(defconst sh-here-doc-open-re "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|\\s_\\)+\\).*\\(\n\\)")
(defconst sh-here-doc-open-re "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\)+\\).*\\(\n\\)")
(defvar sh-here-doc-markers nil)
(make-variable-buffer-local 'sh-here-doc-markers)
@ -1183,6 +1184,16 @@ This is for the rc shell."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-backslash-column 48
"*Column in which `sh-backslash-region' inserts backslashes."
:type 'integer
:group 'sh)
(defcustom sh-backslash-align t
"*If non-nil, `sh-backslash-region' will align backslashes."
:type 'boolean
:group 'sh)
;; Internal use - not designed to be changed by the user:
(defun sh-mkword-regexpr (word)
@ -3547,7 +3558,78 @@ The document is bounded by `sh-here-document-word'."
(if (re-search-forward sh-end-of-command nil t)
(goto-char (match-end 1))))
;; Backslashification. Stolen from make-mode.el.
(defun sh-backslash-region (from to delete-flag)
"Insert, align, or delete end-of-line backslashes on the lines in the region.
With no argument, inserts backslashes and aligns existing backslashes.
With an argument, deletes the backslashes.
This function does not modify the last line of the region if the region ends
right at the start of the following line; it does not modify blank lines
at the start of the region. So you can put the region around an entire
shell command and conveniently use this command."
(interactive "r\nP")
(save-excursion
(goto-char from)
(let ((column sh-backslash-column)
(endmark (make-marker)))
(move-marker endmark to)
;; Compute the smallest column number past the ends of all the lines.
(if sh-backslash-align
(progn
(if (not delete-flag)
(while (< (point) to)
(end-of-line)
(if (= (preceding-char) ?\\)
(progn (forward-char -1)
(skip-chars-backward " \t")))
(setq column (max column (1+ (current-column))))
(forward-line 1)))
;; Adjust upward to a tab column, if that doesn't push
;; past the margin.
(if (> (% column tab-width) 0)
(let ((adjusted (* (/ (+ column tab-width -1) tab-width)
tab-width)))
(if (< adjusted (window-width))
(setq column adjusted))))))
;; Don't modify blank lines at start of region.
(goto-char from)
(while (and (< (point) endmark) (eolp))
(forward-line 1))
;; Add or remove backslashes on all the lines.
(while (and (< (point) endmark)
;; Don't backslashify the last line
;; if the region ends right at the start of the next line.
(save-excursion
(forward-line 1)
(< (point) endmark)))
(if (not delete-flag)
(sh-append-backslash column)
(sh-delete-backslash))
(forward-line 1))
(move-marker endmark nil))))
(defun sh-append-backslash (column)
(end-of-line)
;; Note that "\\\\" is needed to get one backslash.
(if (= (preceding-char) ?\\)
(progn (forward-char -1)
(delete-horizontal-space)
(indent-to column (if sh-backslash-align nil 1)))
(indent-to column (if sh-backslash-align nil 1))
(insert "\\")))
(defun sh-delete-backslash ()
(end-of-line)
(or (bolp)
(progn
(forward-char -1)
(if (looking-at "\\\\")
(delete-region (1+ (point))
(progn (skip-chars-backward " \t") (point)))))))
(provide 'sh-script)
;;; arch-tag: eccd8b72-f337-4fc2-ae86-18155a69d937
;; arch-tag: eccd8b72-f337-4fc2-ae86-18155a69d937
;;; sh-script.el ends here

10
lisp/rect.el
View File

@ -127,14 +127,14 @@ the function is called."
))
(defun delete-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(delete-region (point)
(progn (move-to-column endcol 'coerce)
(point)))))
(defun delete-extract-rectangle-line (startcol endcol lines fill)
(let ((pt (point-at-eol)))
(if (< (move-to-column startcol (or fill 'coerce)) startcol)
(if (< (move-to-column startcol (if fill t 'coerce)) startcol)
(setcdr lines (cons (spaces-string (- endcol startcol))
(cdr lines)))
;; else
@ -284,13 +284,13 @@ on the right side of the rectangle."
(goto-char start))
(defun open-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(unless (and (not fill)
(= (point) (point-at-eol)))
(indent-to endcol))))
(defun delete-whitespace-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(unless (= (point) (point-at-eol))
(delete-region (point) (progn (skip-syntax-forward " ") (point))))))
@ -371,7 +371,7 @@ rectangle which were empty."
(defun clear-rectangle-line (startcol endcol fill)
(let ((pt (point-at-eol)))
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(if (and (not fill)
(<= (save-excursion (goto-char pt) (current-column)) endcol))
(delete-region (point) pt)

83
lisp/replace.el
View File

@ -64,6 +64,27 @@ strings or patterns."
:group 'matching
:version "21.4")
(defcustom query-replace-highlight t
"*Non-nil means to highlight matches during query replacement."
:type 'boolean
:group 'matching)
(defcustom query-replace-lazy-highlight t
"*Controls the lazy-highlighting during query replacements.
When non-nil, all text in the buffer matching the current match
is highlighted lazily using isearch lazy highlighting (see
`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
:type 'boolean
:group 'lazy-highlight
:group 'matching
:version "21.4")
(defface query-replace
'((t (:inherit isearch)))
"Face for highlighting query replacement matches."
:group 'matching
:version "21.4")
(defun query-replace-descr (string)
(mapconcat 'isearch-text-char-description string ""))
@ -736,9 +757,12 @@ Compatibility function for \\[next-error] invocations."
(interactive "p")
;; we need to run occur-find-match from within the Occur buffer
(with-current-buffer
;; Choose the buffer and make it current.
(if (next-error-buffer-p (current-buffer))
(current-buffer)
(next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))
(next-error-find-buffer nil nil
(lambda ()
(eq major-mode 'occur-mode))))
(goto-char (cond (reset (point-min))
((< argp 0) (line-beginning-position))
@ -799,9 +823,10 @@ If the value is nil, don't highlight the buffer names specially."
(setq count (+ count (if forwardp -1 1)))
(setq beg (line-beginning-position)
end (line-end-position))
(if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode
(if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
(text-property-not-all beg end 'fontified t))
(jit-lock-fontify-now beg end))
(if (fboundp 'jit-lock-fontify-now)
(jit-lock-fontify-now beg end)))
(push
(funcall (if keep-props
#'buffer-substring
@ -918,17 +943,20 @@ See also `multi-occur'."
(defun occur-1 (regexp nlines bufs &optional buf-name)
(unless buf-name
(setq buf-name "*Occur*"))
(let ((occur-buf (get-buffer-create buf-name))
(made-temp-buf nil)
(let (occur-buf
(active-bufs (delq nil (mapcar #'(lambda (buf)
(when (buffer-live-p buf) buf))
bufs))))
;; Handle the case where one of the buffers we're searching is the
;; *Occur* buffer itself.
(when (memq occur-buf bufs)
(setq occur-buf (with-current-buffer occur-buf
(clone-buffer "*Occur-temp*"))
made-temp-buf t))
;; output buffer. Just rename it.
(when (member buf-name (mapcar 'buffer-name active-bufs))
(with-current-buffer (get-buffer buf-name)
(rename-uniquely)))
;; Now find or create the output buffer.
;; If we just renamed that buffer, we will make a new one here.
(setq occur-buf (get-buffer-create buf-name))
(with-current-buffer occur-buf
(setq buffer-read-only nil)
(occur-mode)
@ -948,12 +976,6 @@ See also `multi-occur'."
(if (zerop count) "no" (format "%d" count))
(if (= count 1) "" "es")
regexp))
;; If we had to make a temporary buffer, make it the *Occur*
;; buffer now.
(when made-temp-buf
(with-current-buffer (get-buffer buf-name)
(kill-buffer (current-buffer)))
(rename-buffer buf-name))
(setq occur-revert-arguments (list regexp nlines bufs)
buffer-read-only t)
(if (> count 0)
@ -1008,9 +1030,11 @@ See also `multi-occur'."
endpt (line-end-position)))
(setq marker (make-marker))
(set-marker marker matchbeg)
(if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode
(if (and keep-props
(if (boundp 'jit-lock-mode) jit-lock-mode)
(text-property-not-all begpt endpt 'fontified t))
(jit-lock-fontify-now begpt endpt))
(if (fboundp 'jit-lock-fontify-now)
(jit-lock-fontify-now begpt endpt)))
(setq curstring (buffer-substring begpt endpt))
;; Depropertize the string, and maybe
;; highlight the matches
@ -1601,27 +1625,6 @@ make, or the user didn't cancel the call."
(if (= replace-count 1) "" "s")))
(and keep-going stack)))
(defcustom query-replace-highlight t
"*Non-nil means to highlight matches during query replacement."
:type 'boolean
:group 'matching)
(defcustom query-replace-lazy-highlight t
"*Controls the lazy-highlighting during query replacements.
When non-nil, all text in the buffer matching the current match
is highlighted lazily using isearch lazy highlighting (see
`isearch-lazy-highlight-initial-delay' and
`isearch-lazy-highlight-interval')."
:type 'boolean
:group 'matching
:version "21.4")
(defface query-replace
'((t (:inherit isearch)))
"Face for highlighting query replacement matches."
:group 'matching
:version "21.4")
(defvar replace-overlay nil)
(defun replace-highlight (beg end)
@ -1638,7 +1641,7 @@ is highlighted lazily using isearch lazy highlighting (see
(when replace-overlay
(delete-overlay replace-overlay))
(when query-replace-lazy-highlight
(isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
(isearch-lazy-highlight-cleanup lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil)))
;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4

133
lisp/ses.el
View File

@ -1,6 +1,6 @@
;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
;; Copyright (C) 2002,03,04 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@ -405,26 +405,6 @@ for safety. This is a macro to prevent propagate-on-load viruses."
(setq ses--header-row row)
t)
(defmacro ses-dotimes-msg (spec msg &rest body)
"(ses-dotimes-msg (VAR LIMIT) MSG BODY...): Like `dotimes', but
a message is emitted using MSG every second or so during the loop."
(let ((msgvar (make-symbol "msg"))
(limitvar (make-symbol "limit"))
(var (car spec))
(limit (cadr spec)))
`(let ((,limitvar ,limit)
(,msgvar ,msg))
(setq ses-start-time (float-time))
(message ,msgvar)
(setq ,msgvar (concat ,msgvar " (%d%%)"))
(dotimes (,var ,limitvar)
(ses-time-check ,msgvar '(/ (* ,var 100) ,limitvar))
,@body)
(message nil))))
(put 'ses-dotimes-msg 'lisp-indent-function 2)
(def-edebug-spec ses-dotimes-msg ((symbolp form) form body))
(defmacro ses-dorange (curcell &rest body)
"Execute BODY repeatedly, with the variables `row' and `col' set to each
cell in the range specified by CURCELL. The range is available in the
@ -535,7 +515,7 @@ for this spreadsheet."
(defun ses-create-cell-variable-range (minrow maxrow mincol maxcol)
"Create buffer-local variables for cells. This is undoable."
(push `(ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
(push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
buffer-undo-list)
(let (sym xrow xcol)
(dotimes (row (1+ (- maxrow minrow)))
@ -556,16 +536,16 @@ for this spreadsheet."
(dotimes (col (1+ (- maxcol mincol)))
(setq sym (ses-create-cell-symbol (+ row minrow) (+ col mincol)))
(if (boundp sym)
(push `(ses-set-with-undo ,sym ,(symbol-value sym))
(push `(apply ses-set-with-undo ,sym ,(symbol-value sym))
buffer-undo-list))
(kill-local-variable sym))))
(push `(ses-create-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
(push `(apply ses-create-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol)
buffer-undo-list))
(defun ses-reset-header-string ()
"Flags the header string for update. Upon undo, the header string will be
updated again."
(push '(ses-reset-header-string) buffer-undo-list)
(push '(apply ses-reset-header-string) buffer-undo-list)
(setq ses--header-hscroll -1))
;;Split this code off into a function to avoid coverage-testing difficulties
@ -1218,7 +1198,8 @@ the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR
to each symbol."
(let (reform)
(let (mycell newval)
(ses-dotimes-msg (row ses--numrows) "Relocating formulas..."
(dotimes-with-progress-reporter
(row ses--numrows) "Relocating formulas..."
(dotimes (col ses--numcols)
(setq ses-relocate-return nil
mycell (ses-get-cell row col)
@ -1246,7 +1227,8 @@ to each symbol."
(cond
((and (<= rowincr 0) (<= colincr 0))
;;Deletion of rows and/or columns
(ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
(dotimes-with-progress-reporter
(row (- ses--numrows minrow)) "Relocating variables..."
(setq myrow (+ row minrow))
(dotimes (col (- ses--numcols mincol))
(setq mycol (+ col mincol)
@ -1262,7 +1244,8 @@ to each symbol."
(let ((disty (1- ses--numrows))
(distx (1- ses--numcols))
myrow mycol)
(ses-dotimes-msg (row (- ses--numrows minrow)) "Relocating variables..."
(dotimes-with-progress-reporter
(row (- ses--numrows minrow)) "Relocating variables..."
(setq myrow (- disty row))
(dotimes (col (- ses--numcols mincol))
(setq mycol (- distx col)
@ -1296,38 +1279,39 @@ to each symbol."
;; Undo control
;;----------------------------------------------------------------------------
(defadvice undo-more (around ses-undo-more activate preactivate)
"Define a meaning for conses in buffer-undo-list whose car is a symbol
other than t or nil. To undo these, apply the car--a function--to the
cdr--its arglist."
(let ((ses-count (ad-get-arg 0)))
(catch 'undo
(dolist (ses-x pending-undo-list)
(unless ses-x
;;End of undo boundary
(setq ses-count (1- ses-count))
(if (<= ses-count 0)
;;We've seen enough boundaries - stop undoing
(throw 'undo nil)))
(and (consp ses-x) (symbolp (car ses-x)) (fboundp (car ses-x))
;;Undo using apply
(apply (car ses-x) (cdr ses-x)))))
(if (not (eq major-mode 'ses-mode))
ad-do-it
;;Here is some extra code for SES mode.
(setq ses--deferred-narrow
(or ses--deferred-narrow (ses-narrowed-p)))
(widen)
(condition-case x
ad-do-it
(error
;;Restore narrow if appropriate
(ses-command-hook)
(signal (car x) (cdr x)))))))
;; This should be unnecessary, because the feature is now built in.
;;; (defadvice undo-more (around ses-undo-more activate preactivate)
;;; "Define a meaning for conses in buffer-undo-list whose car is a symbol
;;; other than t or nil. To undo these, apply the car--a function--to the
;;; cdr--its arglist."
;;; (let ((ses-count (ad-get-arg 0)))
;;; (catch 'undo
;;; (dolist (ses-x pending-undo-list)
;;; (unless ses-x
;;; ;;End of undo boundary
;;; (setq ses-count (1- ses-count))
;;; (if (<= ses-count 0)
;;; ;;We've seen enough boundaries - stop undoing
;;; (throw 'undo nil)))
;;; (and (consp ses-x) (symbolp (car ses-x)) (fboundp (car ses-x))
;;; ;;Undo using apply
;;; (apply (car ses-x) (cdr ses-x)))))
;;; (if (not (eq major-mode 'ses-mode))
;;; ad-do-it
;;; ;;Here is some extra code for SES mode.
;;; (setq ses--deferred-narrow
;;; (or ses--deferred-narrow (ses-narrowed-p)))
;;; (widen)
;;; (condition-case x
;;; ad-do-it
;;; (error
;;; ;;Restore narrow if appropriate
;;; (ses-command-hook)
;;; (signal (car x) (cdr x)))))))
(defun ses-begin-change ()
"For undo, remember current buffer-position before we start changing hidden
stuff."
"For undo, remember point before we start changing hidden stuff."
(let ((inhibit-read-only t))
(insert-and-inherit "X")
(delete-region (1- (point)) (point))))
@ -1341,8 +1325,8 @@ stuff."
(equal (symbol-value sym) newval)
(not (stringp newval)))
(push (if (boundp sym)
`(ses-set-with-undo ,sym ,(symbol-value sym))
`(ses-unset-with-undo ,sym))
`(apply ses-set-with-undo ,sym ,(symbol-value sym))
`(apply ses-unset-with-undo ,sym))
buffer-undo-list)
(set sym newval)
t))
@ -1350,13 +1334,13 @@ stuff."
(defun ses-unset-with-undo (sym)
"Set SYM to be unbound. This is undoable."
(when (1value (boundp sym)) ;;Always bound, except after a programming error
(push `(ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
(push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
(makunbound sym)))
(defun ses-aset-with-undo (array idx newval)
"Like aset, but undoable. Result is t if element has changed"
(unless (equal (aref array idx) newval)
(push `(ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
(push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list)
(aset array idx newval)
t))
@ -1475,7 +1459,7 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
(put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
;;Create intangible properties, which also indicate which cell the text
;;came from.
(ses-dotimes-msg (row ses--numrows) "Finding cells..."
(dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
(dotimes (col ses--numcols)
(setq pos end
sym (ses-cell-symbol row col))
@ -1724,7 +1708,7 @@ print area if NONARROW is nil."
;;find the data area when inserting or deleting *skip* values for cells
(dotimes (row ses--numrows)
(insert-and-inherit ses--blank-line))
(ses-dotimes-msg (row ses--numrows) "Reprinting..."
(dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
(if (eq (ses-cell-value row 0) '*skip*)
;;Column deletion left a dangling skip
(ses-set-cell row 0 'value nil))
@ -1809,11 +1793,13 @@ cells."
;;Reconstruct reference lists.
(let (x yrow ycol)
;;Delete old reference lists
(ses-dotimes-msg (row ses--numrows) "Deleting references..."
(dotimes-with-progress-reporter
(row ses--numrows) "Deleting references..."
(dotimes (col ses--numcols)
(ses-set-cell row col 'references nil)))
;;Create new reference lists
(ses-dotimes-msg (row ses--numrows) "Computing references..."
(dotimes-with-progress-reporter
(row ses--numrows) "Computing references..."
(dotimes (col ses--numcols)
(dolist (ref (ses-formula-references (ses-cell-formula row col)))
(setq x (ses-sym-rowcol ref)
@ -2073,14 +2059,14 @@ before current one."
(ses-set-parameter 'ses--numrows (+ ses--numrows count))
;;Insert each row
(ses-goto-print row 0)
(ses-dotimes-msg (x count) "Inserting row..."
(dotimes-with-progress-reporter (x count) "Inserting row..."
;;Create a row of empty cells. The `symbol' fields will be set by
;;the call to ses-relocate-all.
(setq newrow (make-vector ses--numcols nil))
(dotimes (col ses--numcols)
(aset newrow col (ses-make-cell)))
(setq ses--cells (ses-vector-insert ses--cells row newrow))
(push `(ses-vector-delete ses--cells ,row 1) buffer-undo-list)
(push `(apply ses-vector-delete ses--cells ,row 1) buffer-undo-list)
(insert ses--blank-line))
;;Insert empty lines in cell data area (will be replaced by
;;ses-relocate-all)
@ -2162,7 +2148,7 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER
(ses-create-cell-variable-range 0 (1- ses--numrows)
ses--numcols (+ ses--numcols count -1))
;;Insert each column.
(ses-dotimes-msg (x count) "Inserting column..."
(dotimes-with-progress-reporter (x count) "Inserting column..."
;;Create a column of empty cells. The `symbol' fields will be set by
;;the call to ses-relocate-all.
(ses-adjust-print-width col (1+ width))
@ -2220,7 +2206,7 @@ from the current one."
(ses-begin-change)
(ses-set-parameter 'ses--numcols (- ses--numcols count))
(ses-adjust-print-width col (- width))
(ses-dotimes-msg (row ses--numrows) "Deleting column..."
(dotimes-with-progress-reporter (row ses--numrows) "Deleting column..."
;;Delete lines from cell data area
(ses-goto-data row col)
(ses-delete-line count)
@ -2331,7 +2317,10 @@ hard to override how mouse-1 works."
(eq (get-text-property beg 'read-only) 'ses)
(eq (get-text-property (1- end) 'read-only) 'ses)))
ad-do-it ;Normal copy-region-as-kill
(kill-new (ses-copy-region beg end))))
(kill-new (ses-copy-region beg end))
(if transient-mark-mode
(setq deactivate-mark t))
nil))
(defun ses-copy-region (beg end)
"Treat the region as rectangular. Convert the intangible attributes to
@ -2466,7 +2455,7 @@ formulas are to be inserted without relocation."
(colincr (- (cdr rowcol) (cdr first)))
(pos 0)
myrow mycol x)
(ses-dotimes-msg (row needrows) "Yanking..."
(dotimes-with-progress-reporter (row needrows) "Yanking..."
(setq myrow (+ row (car rowcol)))
(dotimes (col needcols)
(setq mycol (+ col (cdr rowcol))

168
lisp/simple.el
View File

@ -1,7 +1,7 @@
;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2001, 2002, 2003, 2004
;; 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -647,15 +647,16 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point."
(skip-chars-backward " \t")
(constrain-to-field nil orig-pos)))))
(defun just-one-space ()
"Delete all spaces and tabs around point, leaving one space."
(interactive "*")
(defun just-one-space (&optional n)
"Delete all spaces and tabs around point, leaving one space (or N spaces)."
(interactive "*p")
(let ((orig-pos (point)))
(skip-chars-backward " \t")
(constrain-to-field nil orig-pos)
(if (= (following-char) ? )
(forward-char 1)
(insert ? ))
(dotimes (i (or n 1))
(if (= (following-char) ?\ )
(forward-char 1)
(insert ?\ )))
(delete-region
(point)
(progn
@ -899,7 +900,7 @@ display the result of expression evaluation."
(if (and (integerp value)
(or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
(eq this-command last-command)
(and (boundp 'edebug-active) edebug-active)))
(if (boundp 'edebug-active) edebug-active)))
(let ((char-string
(if (or (and (boundp 'edebug-active) edebug-active)
(memq this-command '(eval-last-sexp eval-print-last-sexp)))
@ -1234,6 +1235,10 @@ Return 0 if current buffer is not a mini-buffer."
(defvar undo-no-redo nil
"If t, `undo' doesn't go through redo entries.")
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.
t if we undid all the way to the end of it.")
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
@ -1257,14 +1262,15 @@ as an argument limits undo to changes within the current region."
(setq this-command 'undo-start)
(unless (and (eq last-command 'undo)
;; If something (a timer or filter?) changed the buffer
;; since the previous command, don't continue the undo seq.
(let ((list buffer-undo-list))
(while (eq (car list) nil)
(setq list (cdr list)))
;; If the last undo record made was made by undo
;; it shows nothing else happened in between.
(gethash list undo-equiv-table)))
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
;; since the previous command, don't continue the undo seq.
(let ((list buffer-undo-list))
(while (eq (car list) nil)
(setq list (cdr list)))
;; If the last undo record made was made by undo
;; it shows nothing else happened in between.
(gethash list undo-equiv-table))))
(setq undo-in-region
(if transient-mark-mode mark-active (and arg (not (numberp arg)))))
(if undo-in-region
@ -1339,9 +1345,6 @@ Contrary to `undo', this will not redo a previous undo."
;; no idea whereas to bind it. Any suggestion welcome. -stef
;; (define-key ctl-x-map "U" 'undo-only)
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
(defvar undo-in-progress nil
"Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")
@ -1350,12 +1353,14 @@ Some change-hooks test this variable to do something different.")
"Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
(or (listp pending-undo-list)
(error (format "No further undo information%s"
(if (and transient-mark-mode mark-active)
" for region" ""))))
(let ((undo-in-progress t))
(setq pending-undo-list (primitive-undo count pending-undo-list))))
(setq pending-undo-list (primitive-undo count pending-undo-list))
(if (null pending-undo-list)
(setq pending-undo-list t))))
;; Deep copy of a list
(defun undo-copy-list (list)
@ -1520,33 +1525,76 @@ is not *inside* the region START...END."
'(0 . 0)))
'(0 . 0)))
(defcustom undo-ask-before-discard t
"If non-nil ask about discarding undo info for the current command.
Normally, Emacs discards the undo info for the current command if
it exceeds `undo-outer-limit'. But if you set this option
non-nil, it asks in the echo area whether to discard the info.
If you answer no, there a slight risk that Emacs might crash, so
only do it if you really want to undo the command.
This option is mainly intended for debugging. You have to be
careful if you use it for other purposes. Garbage collection is
inhibited while the question is asked, meaning that Emacs might
leak memory. So you should make sure that you do not wait
excessively long before answering the question."
:type 'boolean
:group 'undo
:version "21.4")
(defvar undo-extra-outer-limit nil
"If non-nil, an extra level of size that's ok in an undo item.
We don't ask the user about truncating the undo list until the
current item gets bigger than this amount.")
current item gets bigger than this amount.
This variable only matters if `undo-ask-before-discard' is non-nil.")
(make-variable-buffer-local 'undo-extra-outer-limit)
;; When the first undo batch in an undo list is longer than undo-outer-limit,
;; this function gets called to ask the user what to do.
;; Garbage collection is inhibited around the call,
;; so it had better not do a lot of consing.
;; When the first undo batch in an undo list is longer than
;; undo-outer-limit, this function gets called to warn the user that
;; the undo info for the current command was discarded. Garbage
;; collection is inhibited around the call, so it had better not do a
;; lot of consing.
(setq undo-outer-limit-function 'undo-outer-limit-truncate)
(defun undo-outer-limit-truncate (size)
(when (or (null undo-extra-outer-limit)
(> size undo-extra-outer-limit))
;; Don't ask the question again unless it gets even bigger.
;; This applies, in particular, if the user quits from the question.
;; Such a quit quits out of GC, but something else will call GC
;; again momentarily. It will call this function again,
;; but we don't want to ask the question again.
(setq undo-extra-outer-limit (+ size 50000))
(if (let (use-dialog-box)
(yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
(buffer-name) size)))
(progn (setq buffer-undo-list nil)
(setq undo-extra-outer-limit nil)
t)
nil)))
(if undo-ask-before-discard
(when (or (null undo-extra-outer-limit)
(> size undo-extra-outer-limit))
;; Don't ask the question again unless it gets even bigger.
;; This applies, in particular, if the user quits from the question.
;; Such a quit quits out of GC, but something else will call GC
;; again momentarily. It will call this function again,
;; but we don't want to ask the question again.
(setq undo-extra-outer-limit (+ size 50000))
(if (let (use-dialog-box track-mouse executing-kbd-macro )
(yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
(buffer-name) size)))
(progn (setq buffer-undo-list nil)
(setq undo-extra-outer-limit nil)
t)
nil))
(display-warning '(undo discard-info)
(concat
(format "Buffer %s undo info was %d bytes long.\n"
(buffer-name) size)
"The undo info was discarded because it exceeded \
`undo-outer-limit'.
This is normal if you executed a command that made a huge change
to the buffer. In that case, to prevent similar problems in the
future, set `undo-outer-limit' to a value that is large enough to
cover the maximum size of normal changes you expect a single
command to make, but not so large that it might exceed the
maximum memory allotted to Emacs.
If you did not execute any such command, the situation is
probably due to a bug and you should report it.
You can disable the popping up of this buffer by adding the entry
\(undo discard-info) to the user option `warning-suppress-types'.\n")
:warning)
(setq buffer-undo-list nil)
t))
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
@ -3012,10 +3060,10 @@ Does not set point. Does nothing if mark ring is empty."
(when mark-ring
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
(deactivate-mark)
(move-marker (car mark-ring) nil)
(if (null (mark t)) (ding))
(setq mark-ring (cdr mark-ring))))
(setq mark-ring (cdr mark-ring)))
(deactivate-mark))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark (&optional arg)
@ -3182,10 +3230,31 @@ Outline mode sets this."
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec)))))
;; Perform vertical scrolling of tall images if necessary.
(defun line-move (arg &optional noerror to-end)
(if auto-window-vscroll
(let ((forward (> arg 0))
(part (nth 2 (pos-visible-in-window-p (point) nil t))))
(if (and (consp part)
(> (setq part (if forward (cdr part) (car part))) 0))
(set-window-vscroll nil
(if forward
(+ (window-vscroll nil t)
(min part
(* (frame-char-height) arg)))
(max 0
(- (window-vscroll nil t)
(min part
(* (frame-char-height) (- arg))))))
t)
(set-window-vscroll nil 0)
(line-move-1 arg noerror to-end)))
(line-move-1 arg noerror to-end)))
;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
;; The value is t if we can move the specified number of lines.
(defun line-move (arg &optional noerror to-end)
(defun line-move-1 (arg &optional noerror to-end)
;; Don't run any point-motion hooks, and disregard intangibility,
;; for intermediate positions.
(let ((inhibit-point-motion-hooks t)
@ -3594,7 +3663,7 @@ With argument, do this that many times."
The place mark goes is the same place \\[forward-word] would
move to with the same argument.
Interactively, if this command is repeated
or (in Transient Mark mode) if the mark is active,
or (in Transient Mark mode) if the mark is active,
it marks the next ARG words after the ones already marked."
(interactive "P\np")
(cond ((and allow-extend
@ -4004,7 +4073,7 @@ when it is off screen)."
(setq matching-paren
(let ((syntax (syntax-after blinkpos)))
(and (consp syntax)
(eq (car syntax) 4)
(eq (logand (car syntax) 255) 4)
(cdr syntax)))
mismatch
(or (null matching-paren)
@ -4119,7 +4188,7 @@ specification for `play-sound'."
(play-sound sound)))
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
(defcustom read-mail-command 'rmail
"*Your preference for a mail reading package.
This is used by some keybindings which support reading mail.
@ -4261,7 +4330,7 @@ Each action has the form (FUNCTION . ARGS)."
(list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-frame yank-action send-actions))
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
@ -4324,7 +4393,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
;; Force a thorough redisplay for the case that the variable
;; has an effect on the display, like `tab-width' has.
(force-mode-line-update))
;; Define the major mode for lists of completions.
(defvar completion-list-mode-map nil
@ -4332,6 +4401,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
(or completion-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'mouse-choose-completion)
(define-key map [follow-link] 'mouse-face)
(define-key map [down-mouse-2] nil)
(define-key map "\C-m" 'choose-completion)
(define-key map "\e\e\e" 'delete-completion-window)

12
lisp/speedbar.el
View File

@ -1,6 +1,7 @@
;;; speedbar.el --- quick access to files and tags in a frame
;;; Copyright (C) 1996, 97, 98, 99, 2000, 01 Free Software Foundation
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2005
;; Free Software Foundation
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.11a
@ -170,6 +171,8 @@
;; - More functions to create buttons and options
;; - Timeout directories we haven't visited in a while.
;;; Code:
(require 'assoc)
(require 'easymenu)
@ -201,7 +204,6 @@
:prefix "speedbar-"
:group 'speedbar)
;;; Code:
(defvar speedbar-initial-expansion-mode-alist
'(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
speedbar-buffer-buttons)
@ -373,7 +375,7 @@ is attached to."
(symbol :tag "Property")
(sexp :tag "Value"))))
(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
(defcustom speedbar-use-imenu-flag (fboundp 'imenu)
"*Non-nil means use imenu for file parsing. nil to use etags.
XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
use etags instead. Etags support is not as robust as imenu support."
@ -3749,7 +3751,7 @@ functions to do caching and flushing if appropriate."
nil
(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
(eval-when-compile (condition-case nil (require 'imenu) (error nil)))
(defun speedbar-fetch-dynamic-imenu (file)
"Load FILE into a buffer, and generate tags using Imenu.
@ -4359,5 +4361,5 @@ If we have an image associated with it, use that image."
;; run load-time hooks
(run-hooks 'speedbar-load-hook)
;;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5
;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5
;;; speedbar.el ends here

6
lisp/startup.el
View File

@ -877,12 +877,6 @@ opening the first frame (e.g. open a connection to the server).")
(sit-for 1))
(setq user-init-file source))))
(when (stringp custom-file)
(unless (assoc custom-file load-history)
;; If the .emacs file has set `custom-file' but hasn't
;; loaded the file yet, let's load it.
(load custom-file t t)))
(unless inhibit-default-init
(let ((inhibit-startup-message nil))
;; Users are supposed to be told their rights.

31
lisp/subr.el
View File

@ -1,7 +1,7 @@
;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
;; 2004 Free Software Foundation, Inc.
;; 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@ -2723,7 +2723,7 @@ you call it."
(defun make-progress-reporter (message min-value max-value
&optional current-value
min-change min-time)
"Return progress reporter object usage with `progress-reporter-update'.
"Return progress reporter object to be used with `progress-reporter-update'.
MESSAGE is shown in the echo area. When at least 1% of operation
is complete, the exact percentage will be appended to the
@ -2812,5 +2812,32 @@ change the displayed message."
"Print reporter's message followed by word \"done\" in echo area."
(message "%sdone" (aref (cdr reporter) 3)))
(defmacro dotimes-with-progress-reporter (spec message &rest body)
"Loop a certain number of times and report progress in the echo area.
Evaluate BODY with VAR bound to successive integers running from
0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get
the return value (nil if RESULT is omitted).
At each iteration MESSAGE followed by progress percentage is
printed in the echo area. After the loop is finished, MESSAGE
followed by word \"done\" is printed. This macro is a
convenience wrapper around `make-progress-reporter' and friends.
\(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
(let ((temp (make-symbol "--dotimes-temp--"))
(temp2 (make-symbol "--dotimes-temp2--"))
(start 0)
(end (nth 1 spec)))
`(let ((,temp ,end)
(,(car spec) ,start)
(,temp2 (make-progress-reporter ,message ,start ,end)))
(while (< ,(car spec) ,temp)
,@body
(progress-reporter-update ,temp2
(setq ,(car spec) (1+ ,(car spec)))))
(progress-reporter-done ,temp2)
nil ,@(cdr (cdr spec)))))
;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here

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