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

Merged in changes from CVS HEAD

Browse Source 
Patches applied:

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-41
   Make fringe-drawing stuff compile without a window-system

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

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

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

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

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

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

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

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

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


git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-59
This commit is contained in:
Karoly Lorentey 2004-01-22 15:37:19 +00:00
commit 2a36494c42
57 changed files with 2037 additions and 583 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
etc/NEWS
View File

@ -14,6 +14,9 @@ so we will look at it and add it to the manual.
* Installation Changes in Emacs 21.4 * Installation Changes in Emacs 21.4
---
** A Bulgarian translation of the Emacs Tutorial is available.
** You can build Emacs with Gtk+ widgets by specifying `--with-x-toolkit=gtk' ** You can build Emacs with Gtk+ widgets by specifying `--with-x-toolkit=gtk'
when you run configure. This requires Gtk+ 2.0 or newer. This port when you run configure. This requires Gtk+ 2.0 or newer. This port
provides a way to display multilingual text in menus (with some caveats). provides a way to display multilingual text in menus (with some caveats).
@ -79,10 +82,32 @@ See the files mac/README and mac/INSTALL for build instructions.
--- ---
** A French translation of the Emacs Tutorial is available. ** A French translation of the Emacs Tutorial is available.
** Building with -DENABLE_CHECKING does not automatically build with union
types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4 * Changes in Emacs 21.4
** On window systems, lines which are exactly as wide as the window
(not counting the final newline character) are no longer broken into
two lines on the display (with just the newline on the second line).
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.
** The buffer boundaries (i.e. first and last line in the buffer) may now
be marked with bitmaps in the fringes. In addition, up and down
arrow bitmaps may be shown at the top and bottom of the right fringe
if the window can be scrolled in either direction.
This behavior is activated by setting the buffer-local variable
`indicate-buffer-boundaries' to a non-nil value. If value is t, both
boundaries and scrolling arrows are shown; any other non-nil value
shows only the buffer boundaries. The default value of this variable
is found in `default-indicate-buffer-boundaries'.
** New command `display-local-help' displays any local help at point ** New command `display-local-help' displays any local help at point
in the echo area. It is bound to `C-h .'. It normally displays the in the echo area. It is bound to `C-h .'. It normally displays the
same string that would be displayed on mouse-over using the same string that would be displayed on mouse-over using the
@ -1526,6 +1551,21 @@ use for the modifiers. For example, the following two lines swap
Meta and Alt: Meta and Alt:
(setq x-alt-keysym 'meta) (setq x-alt-keysym 'meta)
(setq x-meta-keysym 'alt) (setq x-meta-keysym 'alt)
+++
** vc-annotate-mode enhancements
In vc-annotate mode, you can now use the following key bindings for
enhanced functionality to browse the annotations of past revisions, or
to view diffs or log entries directly from vc-annotate-mode:
P: annotates the previous revision
N: annotates the next revision
J: annotates the revision at line
A: annotates the revision previous to line
D: shows the diff of the revision at line with its previous revision
L: shows the log of the revision at line
W: annotates the workfile (most up to date) version
* New modes and packages in 21.4 * New modes and packages in 21.4
@ -1750,6 +1790,15 @@ configuration files.
* Lisp Changes in Emacs 21.4 * Lisp Changes in Emacs 21.4
+++
** New function `delete-dups' destructively removes `equal' duplicates
from a list. Of several `equal' occurrences of an element in the list,
the last one is kept.
+++
** `declare' is now a macro. This change was made mostly for
documentation purposes and should have no real effect on Lisp code.
** The new hook `before-save-hook' is invoked by `basic-save-buffer' ** The new hook `before-save-hook' is invoked by `basic-save-buffer'
before saving buffers. This allows packages to perform various final before saving buffers. This allows packages to perform various final
tasks, for example; it can be used by the copyright package to make tasks, for example; it can be used by the copyright package to make

6
leim/ChangeLog
View File

@ -1,3 +1,9 @@
2004-01-22 Ognyan Kulev <ogi@fmi.uni-sofia.bg> (tiny change)
* quail/cyrillic.el ("bulgarian-phonetic"): Docstring fixed.
Duplicated entry removed.
("bulgarian-bds"): Docstring fixed.
2003-10-06 Dave Love <fx@gnu.org> 2003-10-06 Dave Love <fx@gnu.org>
* quail/latin-ltx.el: Several additions. * quail/latin-ltx.el: Several additions.

27
leim/quail/cyrillic.el
View File

@ -1169,12 +1169,15 @@ Unicode based."
The layout is similar to `cyrillic-translit', but all Bulgarian The layout is similar to `cyrillic-translit', but all Bulgarian
characters are typed with a single key. characters are typed with a single key.
Use /& for ,A'(B (Cyrillic paragraph) and /# for $,1uV(B." Use /& for ,A'(B (Cyrillic paragraph) and /# for $,1uV(B.
The letters $,1(G(B, $,1(H(B, $,1(I(B and $,1(N(B are not affected by Caps Lock."
nil t t t t nil nil nil nil nil t) nil t t t t nil nil nil nil nil t)
;; $,1(O(B $,1(2(B $,1(5(B $,1(@(B $,1(B(B $,1(J(B $,1(C(B $,1(8(B $,1(>(B $,1(?(B $,1(H(B $,1(I(B ;; $,1(G(B
;; $,1(0(B $,1(A(B $,1(4(B $,1(D(B $,1(3(B $,1(E(B $,1(9(B $,1(:(B $,1(;(B $,1(G(B ;; $,1(O(B $,1(2(B $,1(5(B $,1(@(B $,1(B(B $,1(J(B $,1(C(B $,1(8(B $,1(>(B $,1(?(B $,1(H(B $,1(I(B
;; $,1(N(B $,1(7(B $,1(L(B $,1(F(B $,1(6(B $,1(1(B $,1(=(B $,1(<(B ;; $,1(0(B $,1(A(B $,1(4(B $,1(D(B $,1(3(B $,1(E(B $,1(9(B $,1(:(B $,1(;(B $,1(N(B
;; $,1(7(B $,1(L(B $,1(F(B $,1(6(B $,1(1(B $,1(=(B $,1(<(B
(quail-define-rules (quail-define-rules
("/&" ?,A'(B) ("/&" ?,A'(B)
@ -1238,7 +1241,6 @@ Use /& for ,A'(B (Cyrillic paragraph) and /# for $,1uV(B."
("y" ?$,1(j(B) ("y" ?$,1(j(B)
("x" ?$,1(l(B) ("x" ?$,1(l(B)
("\\" ?$,1(n(B) ("\\" ?$,1(n(B)
("|" ?$,1(N(B)
("q" ?$,1(o(B)) ("q" ?$,1(o(B))
;; Based on an implementation by Ognyan Kulev <ogi@fmi.uni-sofia.bg>. ;; Based on an implementation by Ognyan Kulev <ogi@fmi.uni-sofia.bg>.
@ -1248,13 +1250,18 @@ Use /& for ,A'(B (Cyrillic paragraph) and /# for $,1uV(B."
"bulgarian-bds" "Bulgarian" "$,1(1(4(A(B" nil "bulgarian-bds" "Bulgarian" "$,1(1(4(A(B" nil
"Bulgarian standard keyboard layout (BDS) "Bulgarian standard keyboard layout (BDS)
This keyboard layout is standard for Bulgarian typewriters." This keyboard layout is standard for Bulgarian typewriters.
The letters $,1(F(B, $,1(<(B, $,1(G(B, $,1(@(B, $,1(;(B, $,1(1(B and $,1(K(B are not affected by Caps Lock.
In addition to original bulgarian typewriter layout, keys \ and |
are transformed into ' and $,1(K(B respectively."
nil t t t t nil nil nil nil nil t) nil t t t t nil nil nil nil nil t)
;; 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0$,1uV(B -I .V ;; () 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0$,1uV(B -I .V
;; ,$,1(k(B $,1(C(B $,1(5(B $,1(8(B $,1(H(B $,1(I(B $,1(:(B $,1(A(B $,1(4(B $,1(7(B $,1(F(B ;,A'(B ;; ,$,1(k(B $,1(C(B $,1(5(B $,1(8(B $,1(H(B $,1(I(B $,1(:(B $,1(A(B $,1(4(B $,1(7(B $,1(F(B ;,A'(B
;; $,1(l(B $,1(O(B $,1(0(B $,1(>(B $,1(6(B $,1(3(B $,1(B(B $,1(=(B $,1(2(B $,1(<(B $,1(G(B () ;; $,1(l(B $,1(O(B $,1(0(B $,1(>(B $,1(6(B $,1(3(B $,1(B(B $,1(=(B $,1(2(B $,1(<(B $,1(G(B '$,1(K(B
;; $,1(N(B $,1(9(B $,1(J(B $,1(M(B $,1(D(B $,1(E(B $,1(?(B $,1(@(B $,1(;(B $,1(1(B ;; $,1(N(B $,1(9(B $,1(J(B $,1(M(B $,1(D(B $,1(E(B $,1(?(B $,1(@(B $,1(;(B $,1(1(B
(quail-define-rules (quail-define-rules

19
lib-src/emacsclient.c
View File

@ -1,5 +1,5 @@
/* Client process that communicates with GNU Emacs acting as server. /* Client process that communicates with GNU Emacs acting as server.
Copyright (C) 1986, 1987, 1994, 1999, 2000, 2001, 2003 Copyright (C) 1986, 1987, 1994, 1999, 2000, 2001, 2003, 2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -438,9 +438,10 @@ main (argc, argv)
{ {
int sock_status = 0; int sock_status = 0;
int default_sock = !socket_name;
int saved_errno = 0; int saved_errno = 0;
if (! socket_name) if (default_sock)
{ {
socket_name = alloca (system_name_length + 100); socket_name = alloca (system_name_length + 100);
sprintf (socket_name, "/tmp/emacs%d-%s/server", sprintf (socket_name, "/tmp/emacs%d-%s/server",
@ -459,7 +460,7 @@ main (argc, argv)
/* See if the socket exists, and if it's owned by us. */ /* See if the socket exists, and if it's owned by us. */
sock_status = socket_status (server.sun_path); sock_status = socket_status (server.sun_path);
saved_errno = errno; saved_errno = errno;
if (sock_status) if (sock_status && default_sock)
{ {
/* Failing that, see if LOGNAME or USER exist and differ from /* Failing that, see if LOGNAME or USER exist and differ from
our euid. If so, look for a socket based on the UID our euid. If so, look for a socket based on the UID
@ -476,8 +477,18 @@ main (argc, argv)
if (pw && (pw->pw_uid != geteuid ())) if (pw && (pw->pw_uid != geteuid ()))
{ {
/* We're running under su, apparently. */ /* We're running under su, apparently. */
sprintf (server.sun_path, "/tmp/emacs%d-%s/server", sprintf (socket_name, "/tmp/emacs%d-%s/server",
(int) pw->pw_uid, system_name); (int) pw->pw_uid, system_name);
if (strlen (socket_name) < sizeof (server.sun_path))
strcpy (server.sun_path, socket_name);
else
{
fprintf (stderr, "%s: socket-name %s too long",
argv[0], socket_name);
exit (1);
}
sock_status = socket_status (server.sun_path); sock_status = socket_status (server.sun_path);
saved_errno = errno; saved_errno = errno;
} }

318
lisp/ChangeLog
View File

@ -1,22 +1,161 @@
2004-01-22 Kenichi Handa <handa@m17n.org>
* language/cyrillic.el (ccl-encode-windows-1251-font): Rearrange
code point (register r1) only for charset mule-unicode-0100-24ff.
2004-01-21 Markus Rost <rost@mathematik.uni-bielefeld.de>
* mail/rmail.el (rmail-convert-to-babyl-format): Avoid deleting
trailing white space and ensure a final newline.
* mail/rmail-spam-filter.el (rmail-use-spam-filter): Add autoload
cookie.
2004-01-21 Benjamin Rutt <brutt@bloomington.in.us>
* vc.el (vc-annotate-mode): Inherit from fundamental-mode and
activate view-mode explicitly.
2004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* term/x-win.el: Call menu-bar-enable-clipboard and make Paste
use clipboard first.
2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-mcvs.el (vc-mcvs-mode-line-string): Remove. Does not work.
(vc-mcvs-workfile-version): Manually macro expand vc-mcvs-cvs.
(vc-mcvs-cvs): Remove.
(vc-mcvs-command): Remove use of assert.
* outline.el (outline-insert-heading): Tighten up match.
(outline-demote, outline-move-subtree-down): Don't assume anything
about outline-regexp.
* textmodes/texinfo.el (texinfo-mode): Remove ^ from outline-regexp.
(texinfo-show-structure): Explicitly add ^, and simplify.
2004-01-20 Glenn Morris <gmorris@ast.cam.ac.uk>
* calendar/appt.el (appt-check): Restore usage of
appt-issue-message deleted in previous change.
(top-level): Activate package when loaded (needed for backwards
compatibility).
2004-01-20 Jesper Harder <harder@ifa.au.dk>
* mail/smtpmail.el (smtpmail-via-smtp): No need to add two bytes
following previous change to smtpmail-send-data.
2004-01-20 Benjamin Rutt <brutt@bloomington.in.us>
* vc.el (vc-default-previous-version): Doc enhancement.
(vc-default-next-version): New function.
(vc-print-log): New arg FOCUS-REV.
(vc-annotate-mode): Derive from view-mode.
(vc-annotate): New args REVISION, DISPLAY-MODE.
(vc-annotate-workfile-version, vc-annotate-extract-revision-at-line)
(vc-annotate-revision-at-line, vc-annotate-revision-previous-to-line)
(vc-annotate-show-log-revision-at-line, vc-annotate-warp-version)
(vc-annotate-show-diff-revision-at-line, vc-current-line)
(vc-annotate-prev-version, vc-annotate-next-version): New functions.
* vc-cvs.el (vc-cvs-annotate-extract-revision-at-line): New function.
2004-01-19 Karl Berry <karl@gnu.org>
* textmodes/texinfo.el: Use "Texinfo" consistently, no "TeXinfo"
or "TexInfo".
2004-01-19 Luc Teirlinck <teirllm@auburn.edu>
* subr.el (delete-dups): New function.
2004-01-19 Karl Berry <karl@gnu.org>
* textmodes/texinfo.el (texinfo-mode): Define outline-regexp to start
with ^, since that's what texinfo-show-structure
documentation says (plus it works much better in texinfo.txi).
2004-01-18 Jesper Harder <harder@ifa.au.dk>
* mail/smtpmail.el (smtpmail-send-data): Don't append spurious newline.
2004-01-18 David Ponce <david@dponce.com> (tiny change)
* progmodes/which-func.el (which-function-mode): Don't cancel
which-func-update-timer if not set.
2004-01-17 Thien-Thi Nguyen <ttn@gnu.org>
* calendar/diary-lib.el (diary-entry-time): Fix typo/bug:
Remove spurious left square bracket in XX:XXam regexp.
2004-01-16 Luc Teirlinck <teirllm@auburn.edu>
* progmodes/cc-defs.el: Do not require cl at run time.
2004-01-16 Richard M. Stallman <rms@gnu.org>
* emacs-lisp/cl.el (cl-cannot-unload): New function.
(cl-unload-hook): Defvar this to run cl-cannot-unload.
* mail/rmail.el (rmail-get-new-mail): New local rsf-number-of-spam.
Call rmail-spam-filter. Delete and expunge spam.
Print number of spam messages deleted.
Save and restore the deletion status of old messages when reading
new mail with spam filter, so that expunging spam does not expunge
msgs deleted by the user.
(rmail-only-expunge): Add an optional argument dont-show to
prevent showing message after expunge.
2004-01-15 Luc Teirlinck <teirllm@auburn.edu>
* emacs-lisp/cl.el (declare): Add `fmakunbound' for `declare'.
* subr.el (declare): New macro.
2004-01-15 Thien-Thi Nguyen <ttn@gnu.org>
* progmodes/scheme.el (scheme-font-lock-keywords-2): Add "force".
2004-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
* mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event):
Test window-system rather than system-type (for X11/Mac).
2004-01-12 Luc Teirlinck <teirllm@auburn.edu>
* emacs-lisp/bytecomp.el (compile-defun): Doc fix.
2004-01-12 Richard M. Stallman <rms@gnu.org>
* mail/rmail.el (rmail-convert-to-babyl-format):
Use mail-unquote-printable-region.
(rmail-hex-string-to-integer, rmail-decode-quoted-printable):
(rmail-hex-char-to-integer): Functions deleted.
* mail/mail-utils.el (mail-unquote-printable-hexdigit): Upcase CHAR.
(mail-unquote-printable-region): New arg NOERROR.
For invalid encoding, either signal an error to just return nil.
2004-01-11 Glenn Morris <gmorris@ast.cam.ac.uk> 2004-01-11 Glenn Morris <gmorris@ast.cam.ac.uk>
* calendar/appt.el: Update copyright and commentary. * calendar/appt.el: Update copyright and commentary.
(appt-issue-message): Delete (see appt-activate). (appt-issue-message): Make obsolete.
(appt-visible, appt-msg-window): Make obsolete, in favour of (appt-visible, appt-msg-window): Make obsolete, in favour of
appt-display-format. appt-display-format.
(appt-display-mode-line, appt-display-duration) (appt-display-mode-line, appt-display-duration)
(appt-display-diary, appt-time-msg-list, appt-mode-string) (appt-display-diary, appt-time-msg-list, appt-mode-string)
(appt-prev-comp-time, appt-display-count, appt-timer) (appt-prev-comp-time, appt-display-count, appt-timer)
(appt-convert-time): Doc change. (appt-convert-time): Doc change.
(appt-disp-window-function, appt-delete-window-function): Use (appt-disp-window-function, appt-delete-window-function):
defcustom rather than defvar. Use defcustom rather than defvar.
(appt-display-format): New variable. (appt-display-format): New variable.
(appt-display-message): New function with display code from (appt-display-message): New function with display code from appt-check.
appt-check. (appt-check): Add optional FORCE argument. Doc change.
(appt-check): Add optional FORCE argument. Doc change. Add Add appt-make-list to diary-hook if displaying diary.
appt-make-list to diary-hook if displaying diary. Remove Remove checking of view-diary-entries-initially.
checking of view-diary-entries-initially. Message Message display section removed to new function appt-display-message.
display section removed to new function appt-display-message.
(appt-display-window): Doc change. Remove unused internal var (appt-display-window): Doc change. Remove unused internal var
this-buffer. Do not beep, since appt-display-message does that. this-buffer. Do not beep, since appt-display-message does that.
(appt-make-list): Doc change. Use caar. (appt-make-list): Doc change. Use caar.
@ -27,12 +166,10 @@
functionality. functionality.
* calendar/cal-x.el: (calendar-one-frame-setup) * calendar/cal-x.el: (calendar-one-frame-setup)
(calendar-only-one-frame-setup, calendar-two-frame-setup): Doc (calendar-only-one-frame-setup, calendar-two-frame-setup): Doc change.
change.
* calendar/calendar.el: Update copyright. * calendar/calendar.el: Update copyright.
(view-diary-entries-initially, european-calendar-style): Doc (view-diary-entries-initially, european-calendar-style): Doc change.
change.
(calendar-setup): Make defcustom rather than defvar. (calendar-setup): Make defcustom rather than defvar.
(mark-visible-calendar-date): Initialize temp-face and faceinfo (mark-visible-calendar-date): Initialize temp-face and faceinfo
in let binding so local to function. in let binding so local to function.
@ -71,8 +208,7 @@
2004-01-07 Nick Roberts <nick@nick.uklinux.net> 2004-01-07 Nick Roberts <nick@nick.uklinux.net>
* progmodes/gud.el (gdb-first-prompt): Renamed from * progmodes/gud.el (gdb-first-prompt): Rename from gdb-first-pre-prompt
gdb-first-pre-prompt
* gdb-ui.el (gdba): Avoid duplication, use gdb-ann3. * gdb-ui.el (gdba): Avoid duplication, use gdb-ann3.
(gdb-ann3): Use GDB command "set width 0" to prevent word wrapping (gdb-ann3): Use GDB command "set width 0" to prevent word wrapping
@ -140,7 +276,7 @@
* textmodes/tex-mode.el (latex-find-indent): Avoid error at end of buf. * textmodes/tex-mode.el (latex-find-indent): Avoid error at end of buf.
* emacs-lisp/lisp-mnt.el (lm-section-end): require outline. * emacs-lisp/lisp-mnt.el (lm-section-end): Require outline.
* progmodes/grep.el (grep-mode-map): * progmodes/grep.el (grep-mode-map):
Don't remap next-line, previous-line. Don't remap next-line, previous-line.
@ -219,9 +355,9 @@
gud-n.*, gud-ni.*, gud-s.*, and gud-si.*, respectively, to avoid gud-n.*, gud-ni.*, gud-s.*, and gud-si.*, respectively, to avoid
file-name clashes on 8+3 filesystems. file-name clashes on 8+3 filesystems.
* emacs-lisp/tcover-unsafep.el, emacs-lisp/tcover-ses.el: Renamed * emacs-lisp/tcover-unsafep.el, emacs-lisp/tcover-ses.el:
from testcover-unsafep.el and testcover-ses.el to avoid file-name Renamed from testcover-unsafep.el and testcover-ses.el to avoid
clashes on 8+3 DOS filesystems. file-name clashes on 8+3 DOS filesystems.
2003-12-29 Richard M. Stallman <rms@gnu.org> 2003-12-29 Richard M. Stallman <rms@gnu.org>
@ -334,7 +470,7 @@
* xml.el (xml-get-attribute-or-nil): New function, like * xml.el (xml-get-attribute-or-nil): New function, like
xml-get-attribute, but returns nil if the attribute was not found. xml-get-attribute, but returns nil if the attribute was not found.
(xml-get-attribute): Converted to defsubst, uses (xml-get-attribute): Convert to defsubst, uses
xml-get-attribute-or-nil. xml-get-attribute-or-nil.
2003-12-29 Eli Zaretskii <eliz@elta.co.il> 2003-12-29 Eli Zaretskii <eliz@elta.co.il>
@ -370,8 +506,8 @@
2003-12-29 Kenichi Handa <handa@m17n.org> 2003-12-29 Kenichi Handa <handa@m17n.org>
* international/mule-cmds.el (reset-language-environment): Call * international/mule-cmds.el (reset-language-environment):
set-overriding-fontspec-internal with nil. Call set-overriding-fontspec-internal with nil.
(set-language-environment): Call set-overriding-fontspec-internal (set-language-environment): Call set-overriding-fontspec-internal
if the language environment specify `overriding-fontspec'. if the language environment specify `overriding-fontspec'.
(language-info-alist): Doc added. (language-info-alist): Doc added.
@ -461,12 +597,12 @@
2003-12-24 Kenichi Handa <handa@m17n.org> 2003-12-24 Kenichi Handa <handa@m17n.org>
* international/mule-cmds.el (set-default-coding-systems): Call * international/mule-cmds.el (set-default-coding-systems):
ucs-set-table-for-input for all buffers that don't have local Call ucs-set-table-for-input for all buffers that don't have local
value of buffer-file-coding-system. value of buffer-file-coding-system.
* international/ucs-tables.el (ucs-set-table-for-input): If * international/ucs-tables.el (ucs-set-table-for-input):
translation-table-for-encode is a symbol, get its If translation-table-for-encode is a symbol, get its
translation-table property. translation-table property.
2003-12-23 Luc Teirlinck <teirllm@auburn.edu> 2003-12-23 Luc Teirlinck <teirllm@auburn.edu>
@ -475,11 +611,11 @@
to `completing-read' on a recently fixed bug. to `completing-read' on a recently fixed bug.
* fringe.el (fringe-query-style): Suggest `?' in minibuffer prompt, * fringe.el (fringe-query-style): Suggest `?' in minibuffer prompt,
instead of SPACE, to get the list of possible fringe modes. SPACE instead of SPACE, to get the list of possible fringe modes.
only works if both `partial-completion-mode' and SPACE only works if both `partial-completion-mode' and
`completion-auto-help' are nil. `completion-auto-help' are nil.
* complete.el (PC-is-complete-p): delete. * complete.el (PC-is-complete-p): Delete.
(PC-do-completion): Replace all calls to `PC-is-complete-p' with (PC-do-completion): Replace all calls to `PC-is-complete-p' with
calls to `test-completion'. calls to `test-completion'.
@ -490,17 +626,15 @@
* gdb-ui.el (gdba, gdb-assembler-mode): Call the mode "Machine" as * gdb-ui.el (gdba, gdb-assembler-mode): Call the mode "Machine" as
a mode called "Assembler" already exists. a mode called "Assembler" already exists.
(gdb-use-colon-colon-notation, gdb-show-changed-values): New (gdb-use-colon-colon-notation, gdb-show-changed-values): New options.
options. (gud-watch): Use format option. Remove font properties from string.
(gud-watch): Use format option. Remove font properties from (gdb-var-create-handler, gdb-var-list-children-handler):
string. Don't bother about properties as there are none.
(gdb-var-create-handler, gdb-var-list-children-handler): Don't
bother about properties as there are none.
(gdb-var-create-handler, gdb-var-list-children-handler) (gdb-var-create-handler, gdb-var-list-children-handler)
(gdb-var-update-handler): Call gdb-var-evaluate-expression-handler (gdb-var-update-handler): Call gdb-var-evaluate-expression-handler
with two arguments. with two arguments.
(gdb-var-evaluate-expression-handler, gdb-post-prompt): Let (gdb-var-evaluate-expression-handler, gdb-post-prompt):
speedbar show value changes with a different font. Let speedbar show value changes with a different font.
(gdb-edit-value): New defun. (gdb-edit-value): New defun.
(gdb-clear-partial-output, gdb-clear-inferior-io) (gdb-clear-partial-output, gdb-clear-inferior-io)
(def-gdb-auto-update-handler): Use erase-buffer. (def-gdb-auto-update-handler): Use erase-buffer.
@ -523,11 +657,10 @@
(widget-type-default-get, widget-type-match): New functions. (widget-type-default-get, widget-type-match): New functions.
(lazy): New widget. (lazy): New widget.
(menu-choice, checklist, radio-button-choice, editable-list) (menu-choice, checklist, radio-button-choice, editable-list)
(group, documentation-string): Removed redundant (per 2003-10-25 (group, documentation-string): Remove redundant (per 2003-10-25
change) calls to `widget-children-value-delete'. change) calls to `widget-children-value-delete'.
(widget-choice-value-get, widget-choice-value-inline): Removed (widget-choice-value-get, widget-choice-value-inline): Remove.
functions. (menu-choice): Update widget.
(menu-choice): Updated widget.
2003-12-03 Kenichi Handa <handa@m17n.org> 2003-12-03 Kenichi Handa <handa@m17n.org>
@ -581,19 +714,18 @@
parameter for backward compatibility reasons. parameter for backward compatibility reasons.
(tramp-perl-file-attributes): Add a new parameter to Perl script (tramp-perl-file-attributes): Add a new parameter to Perl script
in order to handle uid/gid as strings, if desired. in order to handle uid/gid as strings, if desired.
(tramp-handle-file-truename, tramp-handle-file-symlink-p): Apply (tramp-handle-file-truename, tramp-handle-file-symlink-p):
`file-attributes' instead of `tramp-handle-file-attributes' in Apply `file-attributes' instead of `tramp-handle-file-attributes' in
order to make the function more general. order to make the function more general.
(tramp-handle-file-attributes): Replace proprietary optional (tramp-handle-file-attributes): Replace proprietary optional
parameter NONNUMERIC by the recently (Emacs 21.4) introduced parameter NONNUMERIC by the recently (Emacs 21.4) introduced ID-FORMAT.
ID-FORMAT.
(tramp-handle-file-attributes-with-perl): Handle parameter (tramp-handle-file-attributes-with-perl): Handle parameter
NONNUMERIC if set. This wasn't done in the past. NONNUMERIC if set. This wasn't done in the past.
(tramp-post-connection): Apply second parameter "$2" if (tramp-post-connection): Apply second parameter "$2" if
`tramp-remote-perl' is called. `tramp-remote-perl' is called.
* net/tramp-smb.el (tramp-smb-handle-delete-file): Correct * net/tramp-smb.el (tramp-smb-handle-delete-file):
cut'n'waste error (`filename' instead of `directory'). Correct cut'n'waste error (`filename' instead of `directory').
(tramp-smb-handle-directory-files-and-attributes) (tramp-smb-handle-directory-files-and-attributes)
(tramp-smb-handle-file-attributes): Add recently (Emacs 21.4) (tramp-smb-handle-file-attributes): Add recently (Emacs 21.4)
introduced parameter ID-FORMAT. introduced parameter ID-FORMAT.
@ -616,8 +748,8 @@
2003-11-30 Jonathan Yavner <jyavner@member.fsf.org> 2003-11-30 Jonathan Yavner <jyavner@member.fsf.org>
* subr.el (noreturn, 1value): New macros for test coverage. See * subr.el (noreturn, 1value): New macros for test coverage.
`testcover.el'. See `testcover.el'.
* emacs-lisp/edebug.el: Add def-edebug-spec for `noreturn' and `1value'. * emacs-lisp/edebug.el: Add def-edebug-spec for `noreturn' and `1value'.
@ -637,10 +769,20 @@
* cus-start.el (all): Add use-file-dialog. * cus-start.el (all): Add use-file-dialog.
2003-11-27 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/tex-mode.el (latex-mode): `tex-trailer' is not a regexp.
2003-11-27 Kim F. Storm <storm@cua.dk> 2003-11-27 Kim F. Storm <storm@cua.dk>
* subr.el (posn-object-x-y): New defun. * subr.el (posn-object-x-y): New defun.
2003-11-26 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/make-mode.el (makefile-font-lock-syntactic-keywords):
Don't use `space' for \\\n.
Be more selective as to which # are comment-starters.
2003-11-26 Luc Teirlinck <teirllm@auburn.edu> 2003-11-26 Luc Teirlinck <teirllm@auburn.edu>
* subr.el (number-sequence): Improve handling of floating point * subr.el (number-sequence): Improve handling of floating point
@ -747,14 +889,19 @@
(breakpoint-enabled-icon, breakpoint-disabled-icon): Set :ascent (breakpoint-enabled-icon, breakpoint-disabled-icon): Set :ascent
to 100 for icons to avoid increasing line height when shown. to 100 for icons to avoid increasing line height when shown.
2003-11-17 Jesper Harder <harder@ifa.au.dk> (tiny change)
* newcomment.el (comment-normalize-vars): Initialize properly if
comment-start was nil.
2003-11-19 Andreas Schwab <schwab@suse.de> 2003-11-19 Andreas Schwab <schwab@suse.de>
* simple.el (set-variable): Fix indentation. * simple.el (set-variable): Fix indentation.
2003-11-17 Kenichi Handa <handa@m17n.org> 2003-11-17 Kenichi Handa <handa@m17n.org>
* international/latin1-disp.el (latin1-display-ucs-per-lynx): Fix * international/latin1-disp.el (latin1-display-ucs-per-lynx):
docstring. Fix docstring.
2003-11-17 Jesper Harder <harder@ifa.au.dk> (tiny change) 2003-11-17 Jesper Harder <harder@ifa.au.dk> (tiny change)
@ -771,13 +918,13 @@
2003-11-16 Martin Stjernholm <bug-cc-mode@gnu.org> 2003-11-16 Martin Stjernholm <bug-cc-mode@gnu.org>
* cc-engine.el (c-guess-continued-construct, * cc-engine.el (c-guess-continued-construct)
c-guess-basic-syntax): Check a little more carefully if it's a (c-guess-basic-syntax): Check a little more carefully if it's a
function declaration when an unknown construct followed by a block function declaration when an unknown construct followed by a block
is found inside a statement context. This avoids macros followed is found inside a statement context. This avoids macros followed
by blocks to be taken as function declarations. by blocks to be taken as function declarations.
(c-guess-continued-construct): Changed the analysis of a statement (c-guess-continued-construct): Change the analysis of a statement
continuation with a brace open to `substatement-block', for continuation with a brace open to `substatement-block', for
consistency with recognized statements. consistency with recognized statements.
@ -785,9 +932,9 @@
start is in a position so that `c-beginning-of-statement-1' jumped start is in a position so that `c-beginning-of-statement-1' jumped
to the beginning of the same statement. to the beginning of the same statement.
* cc-fonts.el, cc-engine.el (c-forward-<>-arglist-recur): Don't * cc-fonts.el, cc-engine.el (c-forward-<>-arglist-recur):
accept binary operators in the arglist if we're in a function call Don't accept binary operators in the arglist if we're in a function
context, i.e. if `c-restricted-<>-arglists' is set. That avoids call context, i.e. if `c-restricted-<>-arglists' is set. That avoids
template recognition in cases like "if (a < b || c > d)". template recognition in cases like "if (a < b || c > d)".
(c-restricted-<>-arglists): New more appropriate name for (c-restricted-<>-arglists): New more appropriate name for
@ -805,7 +952,7 @@
instead of duplicating parts of it. This fixes bogus label instead of duplicating parts of it. This fixes bogus label
recognition. recognition.
* cc-align.el (c-gnu-impose-minimum): Reverted to the old method * cc-align.el (c-gnu-impose-minimum): Revert to the old method
of checking the context in which to apply the minimum indentation, of checking the context in which to apply the minimum indentation,
so that it isn't enforced in e.g. namespace blocks. so that it isn't enforced in e.g. namespace blocks.
@ -813,19 +960,18 @@
`c-gnu-impose-minimum'. It's defined close to `c-offsets-alist' `c-gnu-impose-minimum'. It's defined close to `c-offsets-alist'
to somewhat reduce the risk of becoming stale. to somewhat reduce the risk of becoming stale.
* cc-cmds.el, cc-engine.el (c-shift-line-indentation): Moved from * cc-cmds.el, cc-engine.el (c-shift-line-indentation): Move from
cc-cmds to cc-engine to allow use from cc-align. cc-cmds to cc-engine to allow use from cc-align.
* cc-engine.el (c-beginning-of-inheritance-list): Cope with fully * cc-engine.el (c-beginning-of-inheritance-list): Cope with fully
qualified identifiers containing "::". qualified identifiers containing "::".
* cc-defs.el (c-make-keywords-re): Added kludge for bug in * cc-defs.el (c-make-keywords-re): Add kludge for bug in
`regexp-opt' in Emacs 20 and XEmacs when strings contain newlines. `regexp-opt' in Emacs 20 and XEmacs when strings contain newlines.
* cc-vars.el (c-emacs-features): Use a space in front of the name * cc-vars.el (c-emacs-features): Use a space in front of the name
of the temporary buffer. That also avoids dumping problems in of the temporary buffer. That also avoids dumping problems in
XEmacs due to undo info being left around after the buffer is XEmacs due to undo info being left around after the buffer is killed.
killed.
* cc-engine.el (c-in-knr-argdecl): Look closer at the function * cc-engine.el (c-in-knr-argdecl): Look closer at the function
arglist to see if it's a K&R style declaration. arglist to see if it's a K&R style declaration.
@ -845,22 +991,21 @@
2003-11-14 Thien-Thi Nguyen <ttn@gnu.org> 2003-11-14 Thien-Thi Nguyen <ttn@gnu.org>
* diff-mode.el (diff-hunk-prev, diff-hunk-next): Support * diff-mode.el (diff-hunk-prev, diff-hunk-next):
operation while narrowed, with `diff-restrict-view'. Support operation while narrowed, with `diff-restrict-view'.
2003-11-14 Thien-Thi Nguyen <ttn@gnu.org> 2003-11-14 Thien-Thi Nguyen <ttn@gnu.org>
* emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): Take * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
additional optional arg NARROWFUN. For the generated functions: Add Take additional optional arg NARROWFUN. For the generated functions:
local var `was-narrowed-p'. Also, if NARROWFUN is specified, include Add local var `was-narrowed-p'. Also, if NARROWFUN is specified,
frags that arrange to check for and save narrowing state before the include frags that arrange to check for and save narrowing state before
move and then conditionally call NARROWFUN after the move. the move and then conditionally call NARROWFUN after the move.
2003-11-14 John Wiegley <johnw@newartisans.com> 2003-11-14 John Wiegley <johnw@newartisans.com>
* eshell/esh-var.el (eshell-parse-variable-ref): Added a backslash * eshell/esh-var.el (eshell-parse-variable-ref): Add a backslash
that was optional, but obviously missing based on surrounding that was optional, but obviously missing based on surrounding code.
code.
* eshell/esh-cmd.el (eshell-lisp-command): Do not late-convert * eshell/esh-cmd.el (eshell-lisp-command): Do not late-convert
string arguments to numbers unless the whole argument was seen as string arguments to numbers unless the whole argument was seen as
@ -868,16 +1013,16 @@
2003-11-14 Kenichi Handa <handa@m17n.org> 2003-11-14 Kenichi Handa <handa@m17n.org>
* international/mule.el (ctext-non-standard-encodings-alist): Fix * international/mule.el (ctext-non-standard-encodings-alist):
coding systems. Fix coding systems.
2003-11-10 Kenichi Handa <handa@m17n.org> 2003-11-10 Kenichi Handa <handa@m17n.org>
* language/kannada.el ("Kannada"): Add sample-text. * language/kannada.el ("Kannada"): Add sample-text.
* language/knd-util.el (kannada-compose-region) * language/knd-util.el (kannada-compose-region)
(kannada-compose-string, kannada-post-read-conversion): Add (kannada-compose-string, kannada-post-read-conversion):
autoload cookie. Add autoload cookie.
* international/quail.el (quail-completion): Change the message * international/quail.el (quail-completion): Change the message
"corresponding translations" to "corresponding characters". "corresponding translations" to "corresponding characters".
@ -906,8 +1051,8 @@
2003-11-07 Andreas Schwab <schwab@suse.de> 2003-11-07 Andreas Schwab <schwab@suse.de>
* progmodes/autoconf.el (autoconf-font-lock-keywords): Also * progmodes/autoconf.el (autoconf-font-lock-keywords):
highlight AH_*. Also highlight AH_*.
* xml.el (xml-parse-dtd): Fix misplaced paren. * xml.el (xml-parse-dtd): Fix misplaced paren.
@ -926,10 +1071,14 @@
* files.el (risky-local-variable-p): Make second argument optional. * files.el (risky-local-variable-p): Make second argument optional.
2003-11-03 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (add-hook): Fix last change.
2003-11-03 Eli Zaretskii <eliz@elta.co.il> 2003-11-03 Eli Zaretskii <eliz@elta.co.il>
* mail/rmail.el (rmail-convert-to-babyl-format): If * mail/rmail.el (rmail-convert-to-babyl-format):
base64-decode-region signals an error, catch it and silently If base64-decode-region signals an error, catch it and silently
ignore it. ignore it.
2003-11-01 Mark A. Hershberger <mah@everybody.org> 2003-11-01 Mark A. Hershberger <mah@everybody.org>
@ -938,8 +1087,7 @@
topmost element has closed. topmost element has closed.
(xml-ns-parse-ns-attrs, xml-ns-expand-el) (xml-ns-parse-ns-attrs, xml-ns-expand-el)
(xml-ns-expand-attr): New functions to do namespace handling. (xml-ns-expand-attr): New functions to do namespace handling.
(xml-intern-attrlist): Back-compatible handling of attribute (xml-intern-attrlist): Back-compatible handling of attribute names.
names.
(xml-parse-tag): Move namespace handling to seperate functions. (xml-parse-tag): Move namespace handling to seperate functions.
Now produces elements in the form ((:ns . "element") (attr-list) Now produces elements in the form ((:ns . "element") (attr-list)
children) instead of ('ns:element (attr-list) children). children) instead of ('ns:element (attr-list) children).
@ -979,10 +1127,8 @@
(isearch-lazy-highlight-new-loop): Pay attention to the window's (isearch-lazy-highlight-new-loop): Pay attention to the window's
end (thru isearch-lazy-highlight-window-end), not only its start. end (thru isearch-lazy-highlight-window-end), not only its start.
* simple.el (overriding-map-is-bound, saved-overriding-map): New * simple.el (overriding-map-is-bound, saved-overriding-map): New vars.
variables. (ensure-overriding-map-is-bound, restore-overriding-map): New funs.
(ensure-overriding-map-is-bound, restore-overriding-map): New
functions.
(universal-argument, universal-argument-more, negative-argument) (universal-argument, universal-argument-more, negative-argument)
(digit-argument, universal-argument-other-key): Minor changes. (digit-argument, universal-argument-other-key): Minor changes.

6
lisp/calendar/appt.el
View File

@ -341,7 +341,7 @@ displayed in a window:
;; get the first time off of the list ;; get the first time off of the list
;; and calculate the number of minutes until the appointment. ;; and calculate the number of minutes until the appointment.
(if appt-time-msg-list (if (and appt-issue-message appt-time-msg-list)
(let ((appt-comp-time (car (car (car appt-time-msg-list))))) (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
(setq min-to-app (- appt-comp-time cur-comp-time)) (setq min-to-app (- appt-comp-time cur-comp-time))
@ -659,6 +659,10 @@ ARG is positive, otherwise off."
(appt-check t)))) (appt-check t))))
;; This is needed for backwards compatibility. Feh.
(appt-activate 1)
(provide 'appt) (provide 'appt)
;;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347 ;;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347

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

@ -1118,7 +1118,7 @@ be used instead of a colon (:) to separate the hour and minute parts."
(if (equal ?a (downcase (aref s (match-beginning 2)))) (if (equal ?a (downcase (aref s (match-beginning 2))))
0 1200))) 0 1200)))
((string-match ; Hour and minute XX:XXam or XX:XXpm ((string-match ; Hour and minute XX:XXam or XX:XXpm
"\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.][\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
(+ (* 100 (% (string-to-int (+ (* 100 (% (string-to-int
(substring s (match-beginning 1) (match-end 1))) (substring s (match-beginning 1) (match-end 1)))
12)) 12))

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

@ -10,7 +10,7 @@
;;; This version incorporates changes up to version 2.10 of the ;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler. ;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.139 $") (defconst byte-compile-version "$Revision: 2.141 $")
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -75,7 +75,7 @@
;; User customization variables: ;; User customization variables:
;; ;;
;; byte-compile-verbose Whether to report the function currently being ;; byte-compile-verbose Whether to report the function currently being
;; compiled in the minibuffer; ;; compiled in the echo area;
;; byte-optimize Whether to do optimizations; this may be ;; byte-optimize Whether to do optimizations; this may be
;; t, nil, 'source, or 'byte; ;; t, nil, 'source, or 'byte;
;; byte-optimize-log Whether to report (in excruciating detail) ;; byte-optimize-log Whether to report (in excruciating detail)
@ -130,7 +130,7 @@
;; (baz 0)) ;; (baz 0))
;; ;;
;; o It is possible to open-code a function in the same file it is defined ;; o It is possible to open-code a function in the same file it is defined
;; in without having to load that file before compiling it. the ;; in without having to load that file before compiling it. The
;; byte-compiler has been modified to remember function definitions in ;; byte-compiler has been modified to remember function definitions in
;; the compilation environment in the same way that it remembers macro ;; the compilation environment in the same way that it remembers macro
;; definitions. ;; definitions.
@ -1658,7 +1658,7 @@ The value is non-nil if there were no errors, nil if errors."
;;;###autoload ;;;###autoload
(defun compile-defun (&optional arg) (defun compile-defun (&optional arg)
"Compile and evaluate the current top-level form. "Compile and evaluate the current top-level form.
Print the result in the minibuffer. Print the result in the echo area.
With argument, insert value in current buffer after the form." With argument, insert value in current buffer after the form."
(interactive "P") (interactive "P")
(save-excursion (save-excursion

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

@ -108,6 +108,10 @@ printer proceeds to the next function on the list.
This variable is not used at present, but it is defined in hopes that This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.") a future Emacs interpreter will be able to use it.")
(defvar cl-unload-hook '(cl-cannot-unload)
"Prevent unloading the feature `cl', since it does not work.")
(defun cl-cannot-unload ()
(error "Cannot unload the feature `cl'"))
;;; Predicates. ;;; Predicates.
@ -579,9 +583,10 @@ Keywords supported: :test :test-not :key"
"Non-nil means don't make CL functions autoload.") "Non-nil means don't make CL functions autoload.")
;;; Autoload the other portions of the package. ;;; Autoload the other portions of the package.
;; We want to replace the basic versions of dolist, dotimes below. ;; We want to replace the basic versions of dolist, dotimes, declare below.
(fmakunbound 'dolist) (fmakunbound 'dolist)
(fmakunbound 'dotimes) (fmakunbound 'dotimes)
(fmakunbound 'declare)
(mapcar (function (mapcar (function
(lambda (set) (lambda (set)
(let ((file (if cl-fake-autoloads "<none>" (car set)))) (let ((file (if cl-fake-autoloads "<none>" (car set))))

2
lisp/files.el
View File

@ -2429,7 +2429,7 @@ This makes the buffer visit that file, and marks it as not modified.
If you specify just a directory name as FILENAME, that means to use If you specify just a directory name as FILENAME, that means to use
the default file name but in that directory. You can also yank the default file name but in that directory. You can also yank
the default file name into the minibuffer to edit it, using M-n. the default file name into the minibuffer to edit it, using \\<minibuffer-local-map>\\[next-history-element].
If the buffer is not already visiting a file, the default file name If the buffer is not already visiting a file, the default file name
for the output file is the buffer name. for the output file is the buffer name.

2
lisp/gnus/mm-util.el
View File

@ -454,7 +454,7 @@ If the charset is `composition', return the actual one."
(mm-mule-charset-to-mime-charset charset))) (mm-mule-charset-to-mime-charset charset)))
(defun mm-delete-duplicates (list) (defun mm-delete-duplicates (list)
"Simple substitute for CL `delete-duplicates', testing with `equal'." "Simple substitute for CL `delete-duplicates', testing with `equal'."
(let (result head) (let (result head)
(while list (while list
(setq head (car list)) (setq head (car list))

10
lisp/language/cyrillic.el
View File

@ -476,11 +476,11 @@ Support for Russian using koi8-r and the russian-computer input method.")
(push elt ctext-non-standard-encodings-alist))) (push elt ctext-non-standard-encodings-alist)))
(define-ccl-program ccl-encode-windows-1251-font (define-ccl-program ccl-encode-windows-1251-font
'(0 `(0
((r1 <<= 7) ((if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
(r1 += r2) ((r1 <<= 7)
(translate-character encode-windows-1251 r0 r1) (r1 += r2)))
))) (translate-character encode-windows-1251 r0 r1))))
(add-to-list 'font-ccl-encoder-alist (add-to-list 'font-ccl-encoder-alist
'("microsoft-cp1251" . ccl-encode-windows-1251-font)) '("microsoft-cp1251" . ccl-encode-windows-1251-font))

4
lisp/loadhist.el
View File

@ -137,8 +137,8 @@ is nil, raise an error."
;; Try to avoid losing badly when hooks installed in critical ;; Try to avoid losing badly when hooks installed in critical
;; places go away. (Some packages install things on ;; places go away. (Some packages install things on
;; `kill-buffer-hook', `activate-menubar-hook' and the like.) ;; `kill-buffer-hook', `activate-menubar-hook' and the like.)
;; First off, provide a clean way for package `foo' to arrange ;; First off, provide a clean way for package FOO to arrange
;; this by defining `foo-unload-hook'. ;; this by adding hooks on the variable `FOO-unload-hook'.
(if unload-hook (if unload-hook
(run-hooks unload-hook) (run-hooks unload-hook)
;; Otherwise, do our best. Look through the obarray for symbols ;; Otherwise, do our best. Look through the obarray for symbols

55
lisp/mail/mail-utils.el
View File

@ -79,6 +79,7 @@ we add the wrapper characters =?ISO-8859-1?Q?....?=."
(concat result (substring string i)))))) (concat result (substring string i))))))
(defun mail-unquote-printable-hexdigit (char) (defun mail-unquote-printable-hexdigit (char)
(setq char (upcase char))
(if (>= char ?A) (if (>= char ?A)
(+ (- char ?A) 10) (+ (- char ?A) 10)
(- char ?0))) (- char ?0)))
@ -107,31 +108,41 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
(apply 'concat (nreverse (cons (substring string i) strings)))))) (apply 'concat (nreverse (cons (substring string i) strings))))))
;;;###autoload ;;;###autoload
(defun mail-unquote-printable-region (beg end &optional wrapper) (defun mail-unquote-printable-region (beg end &optional wrapper noerror)
"Undo the \"quoted printable\" encoding in buffer from BEG to END. "Undo the \"quoted printable\" encoding in buffer from BEG to END.
If the optional argument WRAPPER is non-nil, If the optional argument WRAPPER is non-nil,
we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=." we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
If NOERROR is non-nil, return t if successful."
(interactive "r\nP") (interactive "r\nP")
(save-match-data (let (failed)
(save-excursion (save-match-data
(save-restriction (save-excursion
(narrow-to-region beg end) (save-restriction
(goto-char (point-min)) (narrow-to-region beg end)
(when (and wrapper (goto-char (point-min))
(looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?")) (when (and wrapper
(delete-region (match-end 1) end) (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
(delete-region (point) (match-beginning 1))) (delete-region (match-end 1) end)
(while (re-search-forward "=\\(..\\|\n\\)" nil t) (delete-region (point) (match-beginning 1)))
(goto-char (match-end 0)) (while (re-search-forward "=\\(\\([0-9A-F][0-9A-F]\\)\\|[=\n]\\|..\\)" nil t)
(replace-match (goto-char (match-end 0))
(if (= (char-after (match-beginning 1)) ?\n) (cond ((= (char-after (match-beginning 1)) ?\n)
"" (replace-match ""))
(make-string 1 ((= (char-after (match-beginning 1)) ?=)
(+ (* 16 (mail-unquote-printable-hexdigit (replace-match "="))
(char-after (match-beginning 1)))) ((match-beginning 2)
(mail-unquote-printable-hexdigit (replace-match
(char-after (1+ (match-beginning 1))))))) (make-string 1
t t)))))) (+ (* 16 (mail-unquote-printable-hexdigit
(char-after (match-beginning 2))))
(mail-unquote-printable-hexdigit
(char-after (1+ (match-beginning 2))))))
t t))
(noerror
(setq failed t))
(t
(error "Malformed MIME quoted-printable message"))))
(not failed))))))
(eval-when-compile (require 'rfc822)) (eval-when-compile (require 'rfc822))

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

@ -84,6 +84,7 @@
"Spam filter for RMAIL, the mail reader for Emacs." "Spam filter for RMAIL, the mail reader for Emacs."
:group 'rmail) :group 'rmail)
;;;###autoload
(defcustom rmail-use-spam-filter nil (defcustom rmail-use-spam-filter nil
"*Non-nil to activate the rmail spam filter. "*Non-nil to activate the rmail spam filter.
Specify `rmail-spam-definitions-alist' to define what you consider spam Specify `rmail-spam-definitions-alist' to define what you consider spam

125
lisp/mail/rmail.el
View File

@ -1364,6 +1364,7 @@ It returns t if it got any new messages."
(while all-files (while all-files
(let ((opoint (point)) (let ((opoint (point))
(new-messages 0) (new-messages 0)
(rsf-number-of-spam 0)
(delete-files ()) (delete-files ())
;; If buffer has not changed yet, and has not been saved yet, ;; If buffer has not changed yet, and has not been saved yet,
;; don't replace the old backup file now. ;; don't replace the old backup file now.
@ -1446,11 +1447,59 @@ It returns t if it got any new messages."
(progn (goto-char opoint) (progn (goto-char opoint)
(if (or file-name rmail-inbox-list) (if (or file-name rmail-inbox-list)
(message "(No new mail has arrived)"))) (message "(No new mail has arrived)")))
(if (rmail-summary-exists) ;; check new messages to see if any of them is spam:
(if rmail-use-spam-filter
(let*
((old-messages (- rmail-total-messages new-messages))
(rsf-scanned-message-number (1+ old-messages))
;; save deletion flags of old messages: vector starts
;; at zero (is one longer that no of messages),
;; therefore take 1+ old-messages
(save-deleted
(substring rmail-deleted-vector 0 (1+
old-messages))))
;; set all messages to undeleted
(setq rmail-deleted-vector
(make-string (1+ rmail-total-messages) ?\ ))
(while (<= rsf-scanned-message-number
rmail-total-messages)
(progn
(if (not (rmail-spam-filter rsf-scanned-message-number))
(progn (setq rsf-number-of-spam (1+ rsf-number-of-spam)))
)
(setq rsf-scanned-message-number (1+ rsf-scanned-message-number))
))
(if (> rsf-number-of-spam 0)
(progn
(when (rmail-expunge-confirmed)
(rmail-only-expunge t))
))
(setq rmail-deleted-vector
(concat
save-deleted
(make-string (- rmail-total-messages old-messages)
?\ )))
))
(if (rmail-summary-exists)
(rmail-select-summary (rmail-select-summary
(rmail-update-summary))) (rmail-update-summary)))
(message "%d new message%s read" (message "%d new message%s read%s"
new-messages (if (= 1 new-messages) "" "s")) new-messages (if (= 1 new-messages) "" "s")
;; print out a message on number of spam messages found:
(if (and rmail-use-spam-filter (> rsf-number-of-spam 0))
(if (= 1 new-messages)
(format ", and found to be a spam message"
rsf-number-of-spam)
(if (> rsf-number-of-spam 1)
(format ", %d of which found to be spam messages"
rsf-number-of-spam)
(format ", one of which found to be a spam message"
rsf-number-of-spam)))
""))
(if (and rmail-use-spam-filter (> rsf-number-of-spam 0))
(progn (if rmail-spam-filter-beep (beep t))
(sleep-for rmail-spam-sleep-after-message)))
;; Move to the first new message ;; Move to the first new message
;; unless we have other unseen messages before it. ;; unless we have other unseen messages before it.
(rmail-show-message (rmail-first-unseen-message)) (rmail-show-message (rmail-first-unseen-message))
@ -1680,7 +1729,9 @@ It returns t if it got any new messages."
header-end t)))) header-end t))))
(if quoted-printable-header-field-end (if quoted-printable-header-field-end
(save-excursion (save-excursion
(rmail-decode-quoted-printable header-end (point)) (unless
(mail-unquote-printable-region header-end (point) nil t)
(message "Malformed MIME quoted-printable message"))
;; Change "quoted-printable" to "8bit", ;; Change "quoted-printable" to "8bit",
;; to reflect the decoding we just did. ;; to reflect the decoding we just did.
(goto-char quoted-printable-header-field-end) (goto-char quoted-printable-header-field-end)
@ -1825,7 +1876,10 @@ It returns t if it got any new messages."
(setq count (1+ count)) (setq count (1+ count))
(if quoted-printable-header-field-end (if quoted-printable-header-field-end
(save-excursion (save-excursion
(rmail-decode-quoted-printable header-end (point)) (unless
(mail-unquote-printable-region header-end (point) nil t)
(message "Malformed MIME quoted-printable message"))
;; Change "quoted-printable" to "8bit", ;; Change "quoted-printable" to "8bit",
;; to reflect the decoding we just did. ;; to reflect the decoding we just did.
(goto-char quoted-printable-header-field-end) (goto-char quoted-printable-header-field-end)
@ -1836,7 +1890,13 @@ It returns t if it got any new messages."
(when (when
(condition-case nil (condition-case nil
(progn (progn
(base64-decode-region (1+ header-end) (point)) (base64-decode-region
(1+ header-end)
(save-excursion
;; Prevent base64-decode-region
;; from removing newline characters.
(skip-chars-backward "\n\t ")
(point)))
t) t)
(error nil)) (error nil))
(goto-char header-end) (goto-char header-end)
@ -1854,6 +1914,7 @@ It returns t if it got any new messages."
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "\n\^_" nil t); single char (while (search-forward "\n\^_" nil t); single char
(replace-match "\n^_")))); 2 chars: "^" and "_" (replace-match "\n^_")))); 2 chars: "^" and "_"
(or (bolp) (newline)) ; in case we lost the final newline.
(insert ?\^_) (insert ?\^_)
(setq last-coding-system-used nil) (setq last-coding-system-used nil)
(or rmail-enable-mime (or rmail-enable-mime
@ -1887,45 +1948,6 @@ It returns t if it got any new messages."
(t (error "Cannot convert to babyl format"))))) (t (error "Cannot convert to babyl format")))))
count)) count))
(defun rmail-hex-char-to-integer (character)
"Return CHARACTER's value interpreted as a hex digit."
(if (and (>= character ?0) (<= character ?9))
(- character ?0)
(let ((ch (logior character 32)))
(if (and (>= ch ?a) (<= ch ?f))
(- ch (- ?a 10))
(error "Invalid hex digit `%c'" ch)))))
(defun rmail-hex-string-to-integer (hex-string)
"Return decimal integer for HEX-STRING."
(let ((hex-num 0)
(index 0))
(while (< index (length hex-string))
(setq hex-num (+ (* hex-num 16)
(rmail-hex-char-to-integer (aref hex-string index))))
(setq index (1+ index)))
hex-num))
(defun rmail-decode-quoted-printable (from to)
"Decode Quoted-Printable in the region between FROM and TO."
(interactive "r")
(goto-char from)
(or (markerp to)
(setq to (copy-marker to)))
(while (search-forward "=" to t)
(cond ((eq (following-char) ?\n)
(delete-char -1)
(delete-char 1))
((looking-at "[0-9A-F][0-9A-F]")
(let ((byte (rmail-hex-string-to-integer
(buffer-substring (point) (+ 2 (point))))))
(delete-region (1- (point)) (+ 2 (point)))
(insert byte)))
((looking-at "=")
(delete-char 1))
(t
(message "Malformed MIME quoted-printable message")))))
;; Delete the "From ..." line, creating various other headers with ;; Delete the "From ..." line, creating various other headers with
;; information from it if they don't already exist. Now puts the ;; information from it if they don't already exist. Now puts the
;; original line into a mail-from: header line for debugging and for ;; original line into a mail-from: header line for debugging and for
@ -3033,7 +3055,7 @@ See also user-option `rmail-confirm-expunge'."
(funcall rmail-confirm-expunge (funcall rmail-confirm-expunge
"Erase deleted messages from Rmail file? "))) "Erase deleted messages from Rmail file? ")))
(defun rmail-only-expunge () (defun rmail-only-expunge (&optional dont-show)
"Actually erase all deleted messages in the file." "Actually erase all deleted messages in the file."
(interactive) (interactive)
(set-buffer rmail-buffer) (set-buffer rmail-buffer)
@ -3112,11 +3134,12 @@ See also user-option `rmail-confirm-expunge'."
(message "Expunging deleted messages...done") (message "Expunging deleted messages...done")
(if (not win) (if (not win)
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
(rmail-show-message (if (not dont-show)
(if (zerop rmail-current-message) 1 nil)) (rmail-show-message
(if rmail-enable-mime (if (zerop rmail-current-message) 1 nil)
(goto-char (+ (point-min) opoint)) (if rmail-enable-mime
(goto-char (+ (point) opoint)))))) (goto-char (+ (point-min) opoint))
(goto-char (+ (point) opoint))))))))
(defun rmail-expunge () (defun rmail-expunge ()
"Erase deleted messages from Rmail file and summary buffer." "Erase deleted messages from Rmail file and summary buffer."

35
lisp/mail/smtpmail.el
View File

@ -680,13 +680,8 @@ This is relative to `smtpmail-queue-dir'.")
;; size estimate: ;; size estimate:
(+ (- (point-max) (point-min)) (+ (- (point-max) (point-min))
;; Add one byte for each change-of-line ;; Add one byte for each change-of-line
;; because or CR-LF representation: ;; because of CR-LF representation:
(count-lines (point-min) (point-max)) (count-lines (point-min) (point-max)))))
;; For some reason, an empty line is
;; added to the message. Maybe this
;; is a bug, but it can't hurt to add
;; those two bytes anyway:
2)))
"")) ""))
(body-part (body-part
(if (member '8bitmime supported-extensions) (if (member '8bitmime supported-extensions)
@ -858,31 +853,15 @@ This is relative to `smtpmail-queue-dir'.")
) )
(defun smtpmail-send-data (process buffer) (defun smtpmail-send-data (process buffer)
(let (let ((data-continue t) sending-data)
((data-continue t)
(sending-data nil)
this-line
this-line-end)
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-min))) (goto-char (point-min)))
(while data-continue (while data-continue
(with-current-buffer buffer (with-current-buffer buffer
(beginning-of-line) (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
(setq this-line (point)) (end-of-line 2)
(end-of-line) (setq data-continue (not (eobp))))
(setq this-line-end (point)) (smtpmail-send-data-1 process sending-data))))
(setq sending-data nil)
(setq sending-data (buffer-substring this-line this-line-end))
(if (/= (forward-line 1) 0)
(setq data-continue nil)))
(smtpmail-send-data-1 process sending-data)
)
)
)
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
"Get address list suitable for smtp RCPT TO: <address>." "Get address list suitable for smtp RCPT TO: <address>."

4
lisp/mwheel.el
View File

@ -58,7 +58,7 @@
'mouse-wheel-down-event) 'mouse-wheel-down-event)
(defcustom mouse-wheel-down-event (defcustom mouse-wheel-down-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well. ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
(if (memq system-type '(windows-nt macos darwin)) (if (memq window-system '(w32 mac))
'wheel-up 'wheel-up
(intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
mouse-wheel-down-button))) mouse-wheel-down-button)))
@ -72,7 +72,7 @@
'mouse-wheel-up-event) 'mouse-wheel-up-event)
(defcustom mouse-wheel-up-event (defcustom mouse-wheel-up-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well. ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
(if (memq system-type '(windows-nt macos darwin)) (if (memq window-system '(w32 mac))
'wheel-down 'wheel-down
(intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
mouse-wheel-up-button))) mouse-wheel-up-button)))

10
lisp/outline.el
View File

@ -1,6 +1,6 @@
;;; outline.el --- outline mode commands for Emacs ;;; outline.el --- outline mode commands for Emacs
;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 2001 ;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 01, 2004
;; Free Software Foundation, Inc. ;; Free Software Foundation, Inc.
;; Maintainer: FSF ;; Maintainer: FSF
@ -410,7 +410,8 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
(or (caar outline-heading-alist) "") (or (caar outline-heading-alist) "")
(match-string 0))))) (match-string 0)))))
(unless (or (string-match "[ \t]\\'" head) (unless (or (string-match "[ \t]\\'" head)
(not (string-match outline-regexp (concat head " ")))) (not (string-match (concat "\\`\\(?:" outline-regexp "\\)")
(concat head " "))))
(setq head (concat head " "))) (setq head (concat head " ")))
(unless (bolp) (end-of-line) (newline)) (unless (bolp) (end-of-line) (newline))
(insert head) (insert head)
@ -486,7 +487,8 @@ in the region."
;; Bummer!! There is no lower heading in the buffer. ;; Bummer!! There is no lower heading in the buffer.
;; Let's try to invent one by repeating the first char. ;; Let's try to invent one by repeating the first char.
(let ((new-head (concat (substring head 0 1) head))) (let ((new-head (concat (substring head 0 1) head)))
(if (string-match (concat "\\`" outline-regexp) new-head) (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
new-head)
;; Why bother checking that it is indeed lower level ? ;; Why bother checking that it is indeed lower level ?
new-head new-head
;; Didn't work: keep it as is so it's still a heading. ;; Didn't work: keep it as is so it's still a heading.
@ -557,7 +559,7 @@ the match data is set appropriately."
(defun outline-move-subtree-down (&optional arg) (defun outline-move-subtree-down (&optional arg)
"Move the currrent subtree down past ARG headlines of the same level." "Move the currrent subtree down past ARG headlines of the same level."
(interactive "p") (interactive "p")
(let ((re (concat "^" outline-regexp)) (let ((re (concat "^\\(?:" outline-regexp "\\)"))
(movfunc (if (> arg 0) 'outline-get-next-sibling (movfunc (if (> arg 0) 'outline-get-next-sibling
'outline-get-last-sibling)) 'outline-get-last-sibling))
(ins-point (make-marker)) (ins-point (make-marker))

2
lisp/progmodes/cc-defs.el
View File

@ -100,7 +100,7 @@
font-lock-keywords))) font-lock-keywords)))
(cc-load "cc-fix"))) (cc-load "cc-fix")))
(cc-external-require 'cl) (eval-when-compile (require 'cl))
;;; Variables also used at compile time. ;;; Variables also used at compile time.

2
lisp/progmodes/scheme.el
View File

@ -328,7 +328,7 @@ See `run-hooks'."
"do" "else" "for-each" "if" "lambda" "do" "else" "for-each" "if" "lambda"
"let" "let*" "let-syntax" "letrec" "letrec-syntax" "let" "let*" "let-syntax" "letrec" "letrec-syntax"
;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants: ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
"and" "or" "delay" "and" "or" "delay" "force"
;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother: ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
;;"quasiquote" "quote" "unquote" "unquote-splicing" ;;"quasiquote" "quote" "unquote" "unquote-splicing"
"map" "syntax" "syntax-rules") t) "map" "syntax" "syntax-rules") t)

3
lisp/progmodes/which-func.el
View File

@ -198,7 +198,8 @@ and off otherwise."
(or (eq which-func-modes t) (or (eq which-func-modes t)
(member major-mode which-func-modes)))))) (member major-mode which-func-modes))))))
;; Turn it off ;; Turn it off
(cancel-timer which-func-update-timer) (when (timerp which-func-update-timer)
(cancel-timer which-func-update-timer))
(setq which-func-update-timer nil) (setq which-func-update-timer nil)
(dolist (buf (buffer-list)) (dolist (buf (buffer-list))
(with-current-buffer buf (setq which-func-mode nil))))) (with-current-buffer buf (setq which-func-mode nil)))))

49
lisp/subr.el
View File

@ -65,7 +65,7 @@ The return value of this function is not used."
(defmacro noreturn (form) (defmacro noreturn (form)
"Evaluates FORM, with the expectation that the evaluation will signal an error "Evaluates FORM, with the expectation that the evaluation will signal an error
instead of returning to its caller. If FORM does return, an error is instead of returning to its caller. If FORM does return, an error is
signalled." signalled."
`(prog1 ,form `(prog1 ,form
(error "Form marked with `noreturn' did return"))) (error "Form marked with `noreturn' did return")))
@ -158,6 +158,12 @@ the return value (nil if RESULT is omitted).
(setq ,(car spec) (1+ ,(car spec)))) (setq ,(car spec) (1+ ,(car spec))))
,@(cdr (cdr spec))))) ,@(cdr (cdr spec)))))
(defmacro declare (&rest specs)
"Do not evaluate any arguments and return nil.
Treated as a declaration when used at the right place in a
`defmacro' form. \(See Info anchor `(elisp)Definition of declare'."
nil)
(defsubst caar (x) (defsubst caar (x)
"Return the car of the car of X." "Return the car of the car of X."
(car (car x))) (car (car x)))
@ -203,6 +209,21 @@ If N is bigger than the length of X, return X."
(if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
x)))) x))))
(defun delete-dups (list)
"Destructively return LIST, with `equal' duplicates removed.
LIST must be a proper list. The value of LIST after a call to
this function is undefined. Use \(setq LIST (delete-dups LIST))
if you want to store the return value in LIST. Of several
`equal' occurrences of an element in LIST, the last one is kept."
(while (member (car list) (cdr list))
(pop list))
(let ((tail list))
(while tail
(while (member (cadr tail) (cddr tail))
(setcdr tail (cddr tail)))
(pop tail)))
list)
(defun number-sequence (from &optional to inc) (defun number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO (both inclusive) as a list. "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
INC is the increment used between numbers in the sequence and defaults to 1. INC is the increment used between numbers in the sequence and defaults to 1.
@ -689,13 +710,13 @@ The return value is a positive integer."
(defsubst posn-window (position) (defsubst posn-window (position)
"Return the window in POSITION. "Return the window in POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 0 position)) (nth 0 position))
(defsubst posn-area (position) (defsubst posn-area (position)
"Return the window area recorded in POSITION, or nil for the text area. "Return the window area recorded in POSITION, or nil for the text area.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(let ((area (if (consp (nth 1 position)) (let ((area (if (consp (nth 1 position))
(car (nth 1 position)) (car (nth 1 position))
(nth 1 position)))) (nth 1 position))))
@ -704,7 +725,7 @@ and `event-end' functions."
(defsubst posn-point (position) (defsubst posn-point (position)
"Return the buffer location in POSITION. "Return the buffer location in POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(or (nth 5 position) (or (nth 5 position)
(if (consp (nth 1 position)) (if (consp (nth 1 position))
(car (nth 1 position)) (car (nth 1 position))
@ -713,18 +734,18 @@ and `event-end' functions."
(defsubst posn-x-y (position) (defsubst posn-x-y (position)
"Return the x and y coordinates in POSITION. "Return the x and y coordinates in POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 2 position)) (nth 2 position))
(defun posn-col-row (position) (defun posn-col-row (position)
"Return the nominal column and row in POSITION, measured in characters. "Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width and y coordinates in POSITION and the frame's default character width
and height. and height.
For a scroll-bar event, the result column is 0, and the row For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar. corresponds to the vertical position of the click in the scroll bar.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(let* ((pair (posn-x-y position)) (let* ((pair (posn-x-y position))
(window (posn-window position)) (window (posn-window position))
(area (posn-area position))) (area (posn-area position)))
@ -750,43 +771,43 @@ These are the actual row number in the window and character number in that row.
Return nil if POSITION does not contain the actual position; in that case Return nil if POSITION does not contain the actual position; in that case
`posn-col-row' can be used to get approximate values. `posn-col-row' can be used to get approximate values.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 6 position)) (nth 6 position))
(defsubst posn-timestamp (position) (defsubst posn-timestamp (position)
"Return the timestamp of POSITION. "Return the timestamp of POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 3 position)) (nth 3 position))
(defsubst posn-string (position) (defsubst posn-string (position)
"Return the string object of POSITION, or nil if a buffer position. "Return the string object of POSITION, or nil if a buffer position.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 4 position)) (nth 4 position))
(defsubst posn-image (position) (defsubst posn-image (position)
"Return the image object of POSITION, or nil if a not an image. "Return the image object of POSITION, or nil if a not an image.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 7 position)) (nth 7 position))
(defsubst posn-object (position) (defsubst posn-object (position)
"Return the object (image or string) of POSITION. "Return the object (image or string) of POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(or (posn-image position) (posn-string position))) (or (posn-image position) (posn-string position)))
(defsubst posn-object-x-y (position) (defsubst posn-object-x-y (position)
"Return the x and y coordinates relative to the object of POSITION. "Return the x and y coordinates relative to the object of POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 8 position)) (nth 8 position))
(defsubst posn-object-width-height (position) (defsubst posn-object-width-height (position)
"Return the pixel width and height of the object of POSITION. "Return the pixel width and height of the object of POSITION.
POSITION should be a list of the form returned by the `event-start' POSITION should be a list of the form returned by the `event-start'
and `event-end' functions." and `event-end' functions."
(nth 9 position)) (nth 9 position))

23
lisp/term/x-win.el
View File

@ -2330,6 +2330,15 @@ order until succeed.")
(or clip-text primary-text cut-text) (or clip-text primary-text cut-text)
)) ))
(defun x-clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive)
(let ((clipboard-text (x-get-selection 'CLIPBOARD))
(x-select-enable-clipboard t))
(if (and clipboard-text (> (length clipboard-text) 0))
(kill-new clipboard-text))
(yank)))
;;; Window system initialization. ;;; Window system initialization.
@ -2392,12 +2401,6 @@ order until succeed.")
;; generated from FONT. ;; generated from FONT.
(create-fontset-from-ascii-font font resolved-name "startup")))) (create-fontset-from-ascii-font font resolved-name "startup"))))
;; Sun expects the menu bar cut and paste commands to use the clipboard.
;; This has ,? to match both on Sunos and on Solaris.
(if (string-match "Sun Microsystems,? Inc\\."
(x-server-vendor))
(menu-bar-enable-clipboard))
;; Apply a geometry resource to the initial frame. Put it at the end ;; Apply a geometry resource to the initial frame. Put it at the end
;; of the alist, so that anything specified on the command line takes ;; of the alist, so that anything specified on the command line takes
;; precedence. ;; precedence.
@ -2463,6 +2466,14 @@ order until succeed.")
;; Turn on support for mouse wheels. ;; Turn on support for mouse wheels.
(mouse-wheel-mode 1) (mouse-wheel-mode 1)
;; Enable CLIPBOARD copy/paste through menu bar commands.
(menu-bar-enable-clipboard)
;; Override Paste so it looks at CLIPBOARD first.
(define-key menu-bar-edit-menu [paste]
(cons "Paste" (cons "Paste text from clipboard or kill ring"
'x-clipboard-yank)))
(setq x-initialized t)) (setq x-initialized t))
(add-to-list 'handle-args-function-alist '(x . x-handle-args)) (add-to-list 'handle-args-function-alist '(x . x-handle-args))

17
lisp/textmodes/texinfo.el
View File

@ -1,6 +1,6 @@
;;; texinfo.el --- major mode for editing Texinfo files ;;; texinfo.el --- major mode for editing Texinfo files
;; Copyright (C) 1985,88,89,90,91,92,93,96,97,2000,01,03 ;; Copyright (C) 1985,88,89,90,91,92,93,96,97,2000,01,03,04
;; Free Software Foundation, Inc. ;; Free Software Foundation, Inc.
;; Author: Robert J. Chassell ;; Author: Robert J. Chassell
@ -316,7 +316,7 @@ chapter."
(defvar texinfo-imenu-generic-expression (defvar texinfo-imenu-generic-expression
'((nil "^@\\(node\\|anchor\\)[ \t]+\\([^,\n]*\\)" 2) '((nil "^@\\(node\\|anchor\\)[ \t]+\\([^,\n]*\\)" 2)
("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
"Imenu generic expression for TexInfo mode. See `imenu-generic-expression'.") "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.")
(defvar texinfo-font-lock-syntactic-keywords (defvar texinfo-font-lock-syntactic-keywords
'(("\\(@\\)c\\(omment\\)?\\>" (1 "<")) '(("\\(@\\)c\\(omment\\)?\\>" (1 "<"))
@ -336,11 +336,11 @@ chapter."
"macro" "menu" "multitable" "quotation" "smalldisplay" "macro" "menu" "multitable" "quotation" "smalldisplay"
"smallexample" "smallformat" "smalllisp" "table" "tex" "smallexample" "smallformat" "smalllisp" "table" "tex"
"titlepage" "verbatim" "vtable") "titlepage" "verbatim" "vtable")
"List of TeXinfo environments.") "List of Texinfo environments.")
(defconst texinfo-environment-regexp (defconst texinfo-environment-regexp
(concat "^@" (regexp-opt (cons "end" texinfo-environments) t) "\\>") (concat "^@" (regexp-opt (cons "end" texinfo-environments) t) "\\>")
"Regexp for environment-like TexInfo list commands. "Regexp for environment-like Texinfo list commands.
Subexpression 1 is what goes into the corresponding `@end' statement.") Subexpression 1 is what goes into the corresponding `@end' statement.")
(defface texinfo-heading-face (defface texinfo-heading-face
@ -373,7 +373,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep) ;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep)
(,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t) (,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t)
".*\n") 0 texinfo-heading-face t)) ".*\n") 0 texinfo-heading-face t))
"Additional expressions to highlight in TeXinfo mode.") "Additional expressions to highlight in Texinfo mode.")
(defun texinfo-clone-environment (start end) (defun texinfo-clone-environment (start end)
(let ((endp nil)) (let ((endp nil))
@ -676,7 +676,7 @@ Puts point on a blank line between them."
(defvar texinfo-enable-quote-macros "@\\(code\\|samp\\|kbd\\)\\>") (defvar texinfo-enable-quote-macros "@\\(code\\|samp\\|kbd\\)\\>")
(defvar texinfo-enable-quote-envs '("example\\>" "lisp\\>")) (defvar texinfo-enable-quote-envs '("example\\>" "lisp\\>"))
(defun texinfo-insert-quote (&optional arg) (defun texinfo-insert-quote (&optional arg)
"Insert the appropriate quote mark for TeXinfo. "Insert the appropriate quote mark for Texinfo.
Usually inserts the value of `texinfo-open-quote' (normally ``) or Usually inserts the value of `texinfo-open-quote' (normally ``) or
`texinfo-close-quote' (normally ''), depending on the context. `texinfo-close-quote' (normally ''), depending on the context.
With prefix argument or inside @code or @example, inserts a plain \"." With prefix argument or inside @code or @example, inserts a plain \"."
@ -904,9 +904,8 @@ to jump to the corresponding spot in the Texinfo source file."
;; Second, create and format an *Occur* buffer ;; Second, create and format an *Occur* buffer
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if nodes-too (occur (concat "^\\(?:" (if nodes-too "@node\\>\\|")
(occur (concat "^@node\\>\\|" outline-regexp)) outline-regexp "\\)")))
(occur outline-regexp)))
(pop-to-buffer "*Occur*") (pop-to-buffer "*Occur*")
(goto-char (point-min)) (goto-char (point-min))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))

10
lisp/vc-cvs.el
View File

@ -5,7 +5,7 @@
;; Author: FSF (see vc.el for full credits) ;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; $Id: vc-cvs.el,v 1.66 2003/10/01 13:22:53 fx Exp $ ;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -625,6 +625,14 @@ systime, or nil if there is none."
(beginning-of-line nil) (beginning-of-line nil)
(vc-cvs-annotate-time)))))) (vc-cvs-annotate-time))))))
(defun vc-cvs-annotate-extract-revision-at-line ()
(save-excursion
(beginning-of-line)
(if (re-search-forward "^\\([0-9]+\\.[0-9]+\\(\\.[0-9]+\\)*\\) +("
(line-end-position) t)
(match-string-no-properties 1)
nil)))
;;; ;;;
;;; Snapshot system ;;; Snapshot system
;;; ;;;

25
lisp/vc-mcvs.el
View File

@ -1,6 +1,6 @@
;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system ;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
;; Copyright (C) 1995,98,99,2000,01,02,2003 Free Software Foundation, Inc. ;; Copyright (C) 1995,98,99,2000,01,02,03,2004 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits) ;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org> ;; Maintainer: Stefan Monnier <monnier@gnu.org>
@ -170,13 +170,6 @@ This is only meaningful if you don't use the implicit checkout model
0)) 0))
t))) t)))
(defmacro vc-mcvs-cvs (op file &rest args)
(declare (debug t))
`(,(intern (concat "vc-cvs-" (symbol-name op)))
(expand-file-name (vc-file-getprop ,file 'mcvs-inode)
(vc-file-getprop ,file 'mcvs-root))
,@args))
(defun vc-mcvs-state (file) (defun vc-mcvs-state (file)
;; This would assume the Meta-CVS sandbox is synchronized. ;; This would assume the Meta-CVS sandbox is synchronized.
;; (vc-mcvs-cvs state file)) ;; (vc-mcvs-cvs state file))
@ -215,19 +208,13 @@ This is only meaningful if you don't use the implicit checkout model
(goto-char (point-max)) (goto-char (point-max))
(widen))))))) (widen)))))))
(defun vc-mcvs-workfile-version (file) (vc-mcvs-cvs workfile-version file)) (defun vc-mcvs-workfile-version (file)
(vc-cvs-workfile-version
(expand-file-name (vc-file-getprop file 'mcvs-inode)
(vc-file-getprop file 'mcvs-root))))
(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model) (defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model)
(defun vc-mcvs-mode-line-string (file)
(let ((s (vc-mcvs-cvs mode-line-string file)))
(when s
(if (and (not (memq (vc-state file) '(up-to-date needs-patch)))
(string-match "\\`CVS-" s))
;; The CVS file is not in sync, so we need to adjust the state.
(concat "MCVS:" (substring s 4))
(concat "M" s)))))
;;; ;;;
;;; State-changing functions ;;; State-changing functions
;;; ;;;
@ -589,7 +576,7 @@ and that it passes `vc-mcvs-global-switches' to it before FLAGS."
;; We need to filter the output. ;; We need to filter the output.
;; The output of the filter uses filenames relative to the root, ;; The output of the filter uses filenames relative to the root,
;; so we need to change the default-directory. ;; so we need to change the default-directory.
(assert (equal default-directory (vc-mcvs-root file))) ;; (assert (equal default-directory (vc-mcvs-root file)))
(vc-do-command (vc-do-command
buffer okstatus "sh" nil "-c" buffer okstatus "sh" nil "-c"
(concat "mcvs " (concat "mcvs "

256
lisp/vc.el
View File

@ -7,7 +7,7 @@
;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; Keywords: tools ;; Keywords: tools
;; $Id: vc.el,v 1.361 2003/12/24 23:18:10 uid66361 Exp $ ;; $Id: vc.el,v 1.363 2004/01/21 11:05:51 uid65624 Exp $
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -347,6 +347,13 @@
;; time with hours, minutes, and seconds included. Probably safe to ;; time with hours, minutes, and seconds included. Probably safe to
;; ignore. Return the current-time, in units of fractional days. ;; ignore. Return the current-time, in units of fractional days.
;; ;;
;; - annotate-extract-revision-at-line ()
;;
;; Only required if `annotate-command' is defined for the backend.
;; Invoked from a buffer in vc-annotate-mode, return the revision
;; corresponding to the current line, or nil if there is no revision
;; corresponding to the current line.
;;
;; SNAPSHOT SYSTEM ;; SNAPSHOT SYSTEM
;; ;;
;; - create-snapshot (dir name branchp) ;; - create-snapshot (dir name branchp)
@ -392,7 +399,13 @@
;; ;;
;; - previous-version (file rev) ;; - previous-version (file rev)
;; ;;
;; Return the version number that precedes REV for FILE. ;; Return the version number that precedes REV for FILE, or nil if no such
;; version exists.
;;
;; - next-version (file rev)
;;
;; Return the version number that follows REV for FILE, or nil if no such
;; version exists.
;; ;;
;; - check-headers () ;; - check-headers ()
;; ;;
@ -631,6 +644,14 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
m) m)
"Local keymap used for VC-Annotate mode.") "Local keymap used for VC-Annotate mode.")
(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)
(define-key vc-annotate-mode-map "W" 'vc-annotate-workfile-version)
(defvar vc-annotate-mode-menu nil (defvar vc-annotate-mode-menu nil
"Local keymap used for VC-Annotate mode's menu bar menu.") "Local keymap used for VC-Annotate mode's menu bar menu.")
@ -714,9 +735,10 @@ The keys are \(BUFFER . BACKEND\). See also `vc-annotate-get-backend'.")
(substring rev (match-beginning 0) (match-end 0))) (substring rev (match-beginning 0) (match-end 0)))
(defun vc-default-previous-version (backend file rev) (defun vc-default-previous-version (backend file rev)
"Guess the version number immediately preceding REV for FILE. "Return the version number immediately preceding REV for FILE,
This default implementation works for <major>.<minor>-style version numbers or nil if there is no previous version. This default
as used by RCS and CVS." implementation works for <major>.<minor>-style version numbers as
used by RCS and CVS."
(let ((branch (vc-branch-part rev)) (let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-minor-part rev)))) (minor-num (string-to-number (vc-minor-part rev))))
(when branch (when branch
@ -731,6 +753,16 @@ as used by RCS and CVS."
;; return version of starting point ;; return version of starting point
(vc-branch-part branch)))))) (vc-branch-part branch))))))
(defun vc-default-next-version (backend file rev)
"Return the version number immediately following REV for FILE,
or nil if there is no next version. This default implementation
works for <major>.<minor>-style version numbers as used by RCS
and CVS."
(when (not (string= rev (vc-workfile-version file)))
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
;; File property caching ;; File property caching
(defun vc-clear-context () (defun vc-clear-context ()
@ -2285,11 +2317,13 @@ allowed and simply skipped)."
;; Miscellaneous other entry points ;; Miscellaneous other entry points
;;;###autoload ;;;###autoload
(defun vc-print-log () (defun vc-print-log (&optional focus-rev)
"List the change log of the current buffer in a window." "List the change log of the current buffer in a window. If
FOCUS-REV is non-nil, leave the point at that revision."
(interactive) (interactive)
(vc-ensure-vc-buffer) (vc-ensure-vc-buffer)
(let ((file buffer-file-name)) (let ((file buffer-file-name))
(or focus-rev (setq focus-rev (vc-workfile-version file)))
(vc-call print-log file) (vc-call print-log file)
(set-buffer "*vc*") (set-buffer "*vc*")
(pop-to-buffer (current-buffer)) (pop-to-buffer (current-buffer))
@ -2307,7 +2341,7 @@ allowed and simply skipped)."
;; move point to the log entry for the current version ;; move point to the log entry for the current version
(vc-call-backend ',(vc-backend file) (vc-call-backend ',(vc-backend file)
'show-log-entry 'show-log-entry
',(vc-workfile-version file)) ',focus-rev)
(set-buffer-modified-p nil))))) (set-buffer-modified-p nil)))))
(defun vc-default-show-log-entry (backend rev) (defun vc-default-show-log-entry (backend rev)
@ -2778,6 +2812,14 @@ Uses `rcs2log' which only works for RCS and CVS."
(defvar vc-annotate-ratio nil "Global variable.") (defvar vc-annotate-ratio nil "Global variable.")
(defvar vc-annotate-backend nil "Global variable.") (defvar vc-annotate-backend nil "Global variable.")
;; internal buffer-local variables
(defvar vc-annotate-parent-file nil)
(defvar vc-annotate-parent-rev nil)
(defvar vc-annotate-parent-display-mode nil)
(make-local-variable 'vc-annotate-parent-file)
(make-local-variable 'vc-annotate-parent-rev)
(make-local-variable 'vc-annotate-parent-display-mode)
(defconst vc-annotate-font-lock-keywords (defconst vc-annotate-font-lock-keywords
;; The fontification is done by vc-annotate-lines instead of font-lock. ;; The fontification is done by vc-annotate-lines instead of font-lock.
'((vc-annotate-lines))) '((vc-annotate-lines)))
@ -2797,6 +2839,7 @@ menu items."
(set (make-local-variable 'truncate-lines) t) (set (make-local-variable 'truncate-lines) t)
(set (make-local-variable 'font-lock-defaults) (set (make-local-variable 'font-lock-defaults)
'(vc-annotate-font-lock-keywords t)) '(vc-annotate-font-lock-keywords t))
(view-mode 1)
(vc-annotate-add-menu)) (vc-annotate-add-menu))
(defun vc-annotate-display-default (&optional ratio) (defun vc-annotate-display-default (&optional ratio)
@ -2885,7 +2928,23 @@ cover the range from the oldest annotation to the newest."
(unless (eq vc-annotate-display-mode 'fullscale) (unless (eq vc-annotate-display-mode 'fullscale)
(vc-annotate-display-select nil 'fullscale)) (vc-annotate-display-select nil 'fullscale))
:style toggle :selected :style toggle :selected
(eq vc-annotate-display-mode 'fullscale)]))) (eq vc-annotate-display-mode 'fullscale)])
(list "--")
(list ["Annotate previous revision"
(call-interactively 'vc-annotate-prev-version)])
(list ["Annotate next revision"
(call-interactively 'vc-annotate-next-version)])
(list ["Annotate revision at line"
(vc-annotate-revision-at-line)])
(list ["Annotate revision previous to line"
(vc-annotate-revision-previous-to-line)])
(list ["Annotate latest revision"
(vc-annotate-workfile-version)])
(list ["Show log of revision at line"
(vc-annotate-show-log-revision-at-line)])
(list ["Show diff of revision at line"
(vc-annotate-show-diff-revision-at-line)])))
;; Define the menu ;; Define the menu
(if (or (featurep 'easymenu) (load "easymenu" t)) (if (or (featurep 'easymenu) (load "easymenu" t))
(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
@ -2922,7 +2981,7 @@ use; you may override this using the second optional arg MODE."
;;;; the contents in BUFFER. ;;;; the contents in BUFFER.
;;;###autoload ;;;###autoload
(defun vc-annotate (prefix) (defun vc-annotate (prefix &optional revision display-mode)
"Display the edit history of the current file using colours. "Display the edit history of the current file using colours.
This command creates a buffer that shows, for each line of the current This command creates a buffer that shows, for each line of the current
@ -2949,19 +3008,24 @@ mode-specific menu. `vc-annotate-color-map' and
colors. `vc-annotate-background' specifies the background color." colors. `vc-annotate-background' specifies the background color."
(interactive "P") (interactive "P")
(vc-ensure-vc-buffer) (vc-ensure-vc-buffer)
(let* ((temp-buffer-name (concat "*Annotate " (buffer-name) "*")) (let* ((temp-buffer-name nil)
(temp-buffer-show-function 'vc-annotate-display-select) (temp-buffer-show-function 'vc-annotate-display-select)
(rev (vc-workfile-version buffer-file-name)) (rev (or revision (vc-workfile-version buffer-file-name)))
(bfn buffer-file-name)
(vc-annotate-version (vc-annotate-version
(if prefix (read-string (if prefix (read-string
(format "Annotate from version: (default %s) " rev) (format "Annotate from version: (default %s) " rev)
nil nil rev) nil nil rev)
rev))) rev)))
(if prefix (if display-mode
(setq vc-annotate-display-mode (setq vc-annotate-display-mode display-mode)
(float (string-to-number (if prefix
(read-string "Annotate span days: (default 20) " (setq vc-annotate-display-mode
nil nil "20"))))) (float (string-to-number
(read-string "Annotate span days: (default 20) "
nil nil "20"))))))
(setq temp-buffer-name (format "*Annotate %s (rev %s)*"
(buffer-name) vc-annotate-version))
(setq vc-annotate-backend (vc-backend buffer-file-name)) (setq vc-annotate-backend (vc-backend buffer-file-name))
(message "Annotating...") (message "Annotating...")
(if (not (vc-find-backend-function vc-annotate-backend 'annotate-command)) (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
@ -2972,6 +3036,12 @@ colors. `vc-annotate-background' specifies the background color."
buffer-file-name buffer-file-name
(get-buffer temp-buffer-name) (get-buffer temp-buffer-name)
vc-annotate-version)) vc-annotate-version))
(save-excursion
(set-buffer temp-buffer-name)
(setq vc-annotate-parent-file bfn)
(setq vc-annotate-parent-rev vc-annotate-version)
(setq vc-annotate-parent-display-mode vc-annotate-display-mode))
;; Don't use the temp-buffer-name until the buffer is created ;; Don't use the temp-buffer-name until the buffer is created
;; (only after `with-output-to-temp-buffer'.) ;; (only after `with-output-to-temp-buffer'.)
(setq vc-annotate-buffers (setq vc-annotate-buffers
@ -2979,6 +3049,150 @@ colors. `vc-annotate-background' specifies the background color."
(list (cons (get-buffer temp-buffer-name) vc-annotate-backend)))) (list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))
(message "Annotating... done"))) (message "Annotating... done")))
(defun vc-annotate-prev-version (prefix)
"Visit the annotation of the version previous to this one.
With a numeric prefix argument, annotate the version that many
versions previous."
(interactive "p")
(vc-annotate-warp-version (- 0 prefix)))
(defun vc-annotate-next-version (prefix)
"Visit the annotation of the version after this one.
With a numeric prefix argument, annotate the version that many
versions after."
(interactive "p")
(vc-annotate-warp-version prefix))
(defun vc-annotate-workfile-version ()
"Visit the annotation of the workfile version of this file."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let ((warp-rev (vc-workfile-version vc-annotate-parent-file)))
(if (equal warp-rev vc-annotate-parent-rev)
(message "Already at version %s" warp-rev)
(vc-annotate-warp-version warp-rev)))))
(defun vc-annotate-extract-revision-at-line ()
"Extract the revision number of the current line."
;; This function must be invoked from a buffer in vc-annotate-mode
(save-window-excursion
(vc-ensure-vc-buffer)
(setq vc-annotate-backend (vc-backend buffer-file-name)))
(vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
(defun vc-annotate-revision-at-line ()
"Visit the annotation of the version identified in the current line."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let ((rev-at-line (vc-annotate-extract-revision-at-line)))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(if (equal rev-at-line vc-annotate-parent-rev)
(message "Already at version %s" rev-at-line)
(vc-annotate-warp-version rev-at-line))))))
(defun vc-annotate-revision-previous-to-line ()
"Visit the annotation of the version before the version at line."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let ((rev-at-line (vc-annotate-extract-revision-at-line))
(prev-rev nil))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(setq prev-rev
(vc-call previous-version vc-annotate-parent-file rev-at-line))
(vc-annotate-warp-version prev-rev)))))
(defun vc-annotate-show-log-revision-at-line ()
"Visit the log of the version at line."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let ((rev-at-line (vc-annotate-extract-revision-at-line)))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(vc-print-log rev-at-line)))))
(defun vc-annotate-show-diff-revision-at-line ()
"Visit the diff of the version at line from its previous version."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let ((rev-at-line (vc-annotate-extract-revision-at-line))
(prev-rev nil))
(if (not rev-at-line)
(message "Cannot extract revision number from the current line")
(setq prev-rev
(vc-call previous-version vc-annotate-parent-file rev-at-line))
(if (not prev-rev)
(message "Cannot diff from any version prior to %s" rev-at-line)
(save-window-excursion
(vc-version-diff vc-annotate-parent-file prev-rev rev-at-line))
(switch-to-buffer "*vc-diff*"))))))
(defun vc-current-line ()
"Return the current buffer's line number."
(let ((oldpoint (point)) start)
(save-excursion
(save-restriction
(goto-char (point-min))
(widen)
(forward-line 0)
(setq start (point))
(goto-char oldpoint)
(forward-line 0)
(1+ (count-lines (point-min) (point)))))))
(defun vc-annotate-warp-version (revspec)
"Annotate the version described by REVSPEC.
If REVSPEC is a positive integer, warp that many versions
forward, if possible, otherwise echo a warning message. If
REVSPEC is a negative integer, warp that many versions backward,
if possible, otherwise echo a warning message. If REVSPEC is a
string, then it describes a revision number, so warp to that
revision."
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
(let* ((oldline (vc-current-line))
(revspeccopy revspec)
(newrev nil))
(cond
((and (integerp revspec) (> revspec 0))
(setq newrev vc-annotate-parent-rev)
(while (and (> revspec 0) newrev)
(setq newrev (vc-call next-version
vc-annotate-parent-file newrev))
(setq revspec (1- revspec)))
(if (not newrev)
(message "Cannot increment %d versions from version %s"
revspeccopy vc-annotate-parent-rev)))
((and (integerp revspec) (< revspec 0))
(setq newrev vc-annotate-parent-rev)
(while (and (< revspec 0) newrev)
(setq newrev (vc-call previous-version
vc-annotate-parent-file newrev))
(setq revspec (1+ revspec)))
(if (not newrev)
(message "Cannot decrement %d versions from version %s"
(- 0 revspeccopy) vc-annotate-parent-rev)))
((stringp revspec) (setq newrev revspec))
(t (error "Invalid argument to vc-annotate-warp-version")))
(when newrev
(save-window-excursion
(find-file vc-annotate-parent-file)
(vc-annotate nil newrev vc-annotate-parent-display-mode))
(kill-buffer (current-buffer)) ;; kill the buffer we started from
(switch-to-buffer (car (car (last vc-annotate-buffers))))
(goto-line (min oldline (progn (goto-char (point-max))
(previous-line)
(vc-current-line))))))))
(defun vc-annotate-car-last-cons (a-list) (defun vc-annotate-car-last-cons (a-list)
"Return car of last cons in association list A-LIST." "Return car of last cons in association list A-LIST."
(if (not (eq nil (cdr a-list))) (if (not (eq nil (cdr a-list)))

20
lispref/ChangeLog
View File

@ -1,3 +1,23 @@
2004-01-20 Luc Teirlinck <teirllm@auburn.edu>
* lists.texi (Sets And Lists): Add delete-dups.
2004-01-15 Luc Teirlinck <teirllm@auburn.edu>
* edebug.texi (Instrumenting Macro Calls): `declare' is not a
special form.
* macros.texi (Defining Macros): Update description of `declare',
which now is a macro.
(Wrong Time): Fix typos.
2004-01-14 Luc Teirlinck <teirllm@auburn.edu>
* compile.texi (Compilation Functions): Expand descriptions of
`compile-defun', `byte-compile-file', `byte-recompile-directory'
and `batch-byte-compile'. In particular, mention and describe
all optional arguments.
(Disassembly): Correct and clarify the description of `disassemble'.
2004-01-11 Luc Teirlinck <teirllm@auburn.edu> 2004-01-11 Luc Teirlinck <teirllm@auburn.edu>
* searching.texi: Various small changes in addition to the * searching.texi: Various small changes in addition to the

62
lispref/compile.texi
View File

@ -173,14 +173,18 @@ variable names and function names used by the function, except for
certain primitives that are coded as special instructions. certain primitives that are coded as special instructions.
@end defun @end defun
@deffn Command compile-defun @deffn Command compile-defun &optional arg
This command reads the defun containing point, compiles it, and This command reads the defun containing point, compiles it, and
evaluates the result. If you use this on a defun that is actually a evaluates the result. If you use this on a defun that is actually a
function definition, the effect is to install a compiled version of that function definition, the effect is to install a compiled version of that
function. function.
@code{compile-defun} normally displays the result of evaluation in the
echo area, but if @var{arg} is non-@code{nil}, it inserts the result
in the current buffer after the form it compiled.
@end deffn @end deffn
@deffn Command byte-compile-file filename @deffn Command byte-compile-file filename &optional load
This function compiles a file of Lisp code named @var{filename} into a This function compiles a file of Lisp code named @var{filename} into a
file of byte-code. The output file's name is made by changing the file of byte-code. The output file's name is made by changing the
@samp{.el} suffix into @samp{.elc}; if @var{filename} does not end in @samp{.el} suffix into @samp{.elc}; if @var{filename} does not end in
@ -193,8 +197,11 @@ batch is compiled, and written so that its compiled code will be
executed when the file is read. All comments are discarded when the executed when the file is read. All comments are discarded when the
input file is read. input file is read.
This command returns @code{t}. When called interactively, it prompts This command returns @code{t} if there were no errors and @code{nil}
for the file name. otherwise. When called interactively, it prompts for the file name.
If @var{load} is non-@code{nil}, this command loads the compiled file
after compiling it. Interactively, @var{load} is the prefix argument.
@example @example
@group @group
@ -215,20 +222,28 @@ for the file name.
@end example @end example
@end deffn @end deffn
@deffn Command byte-recompile-directory directory flag @deffn Command byte-recompile-directory directory &optional flag force
@cindex library compilation @cindex library compilation
This function recompiles every @samp{.el} file in @var{directory} that This command recompiles every @samp{.el} file in @var{directory} (or
needs recompilation. A file needs recompilation if a @samp{.elc} file its subdirectories) that needs recompilation. A file needs
exists but is older than the @samp{.el} file. recompilation if a @samp{.elc} file exists but is older than the
@samp{.el} file.
When a @samp{.el} file has no corresponding @samp{.elc} file, @var{flag} When a @samp{.el} file has no corresponding @samp{.elc} file,
says what to do. If it is @code{nil}, these files are ignored. If it @var{flag} says what to do. If it is @code{nil}, this command ignores
is non-@code{nil}, the user is asked whether to compile each such file. these files. If @var{flag} is 0, it compiles them. If it is neither
@code{nil} nor 0, it asks the user whether to compile each such file.
The returned value of this command is unpredictable. Interactively, @code{byte-recompile-directory} prompts for
@var{directory} and @var{flag} is the prefix argument.
If @var{force} is non-@code{nil}, this command recompiles every
@samp{.el} file that has a @samp{.elc} file.
The returned value is unpredictable.
@end deffn @end deffn
@defun batch-byte-compile @defun batch-byte-compile &optional noforce
This function runs @code{byte-compile-file} on files specified on the This function runs @code{byte-compile-file} on files specified on the
command line. This function must be used only in a batch execution of command line. This function must be used only in a batch execution of
Emacs, as it kills Emacs on completion. An error in one file does not Emacs, as it kills Emacs on completion. An error in one file does not
@ -236,6 +251,9 @@ prevent processing of subsequent files, but no output file will be
generated for it, and the Emacs process will terminate with a nonzero generated for it, and the Emacs process will terminate with a nonzero
status code. status code.
If @var{noforce} is non-@code{nil}, this function does not recompile
files that have an up-to-date @samp{.elc} file.
@example @example
% emacs -batch -f batch-byte-compile *.el % emacs -batch -f batch-byte-compile *.el
@end example @end example
@ -420,7 +438,7 @@ these messages.
defined are always ``located'' at the end of the file, so these defined are always ``located'' at the end of the file, so these
commands won't find the places they are really used. To do that, commands won't find the places they are really used. To do that,
you must search for the function names. you must search for the function names.
You can suppress the compiler warning for calling an undefined You can suppress the compiler warning for calling an undefined
function @var{func} by conditionalizing the function call on a function @var{func} by conditionalizing the function call on a
@code{fboundp} test, like this: @code{fboundp} test, like this:
@ -549,14 +567,16 @@ returns it as the value of the function.
ordinary Lisp variables, by transferring values between variables and ordinary Lisp variables, by transferring values between variables and
the stack. the stack.
@deffn Command disassemble object &optional stream @deffn Command disassemble object &optional buffer-or-name
This function prints the disassembled code for @var{object}. If This command displays the disassembled code for @var{object}. In
@var{stream} is supplied, then output goes there. Otherwise, the interactive use, or if @var{buffer-or-name} is @code{nil} or omitted,
disassembled code is printed to the stream @code{standard-output}. The the output goes in a buffer named @samp{*Disassemble*}. If
argument @var{object} can be a function name or a lambda expression. @var{buffer-or-name} is non-@code{nil}, it must be a buffer or the
name of an existing buffer. Then the output goes there, at point, and
point is left before the output.
As a special exception, if this function is used interactively, The argument @var{object} can be a function name, a lambda expression
it outputs to a buffer named @samp{*Disassemble*}. or a byte-code object.
@end deffn @end deffn
Here are two examples of using the @code{disassemble} function. We Here are two examples of using the @code{disassemble} function. We

4
lispref/edebug.texi
View File

@ -1091,7 +1091,7 @@ forms to be evaluated. For simple macros, the @var{specification}
often looks very similar to the formal argument list of the macro often looks very similar to the formal argument list of the macro
definition, but specifications are much more general than macro definition, but specifications are much more general than macro
arguments. @xref{Defining Macros}, for more explanation of arguments. @xref{Defining Macros}, for more explanation of
the @code{declare} special form. the @code{declare} form.
You can also define an edebug specification for a macro separately You can also define an edebug specification for a macro separately
from the macro definition with @code{def-edebug-spec}. Adding from the macro definition with @code{def-edebug-spec}. Adding
@ -1381,7 +1381,7 @@ all begin with the same symbol, you can usually work around this
constraint by factoring the symbol out of the alternatives, e.g., constraint by factoring the symbol out of the alternatives, e.g.,
@code{["foo" &or [first case] [second case] ...]}. @code{["foo" &or [first case] [second case] ...]}.
Most needs are satisfied by these two ways that bactracking is Most needs are satisfied by these two ways that backtracking is
automatically disabled, but occasionally it is useful to explicitly automatically disabled, but occasionally it is useful to explicitly
disable backtracking by using the @code{gate} specification. This is disable backtracking by using the @code{gate} specification. This is
useful when you know that no higher alternatives could apply. See the useful when you know that no higher alternatives could apply. See the

6
lispref/files.texi
View File

@ -416,9 +416,9 @@ calling @code{set-visited-file-name} does not.
@defopt before-save-hook @defopt before-save-hook
This normal hook runs before a buffer is saved in its visited file, This normal hook runs before a buffer is saved in its visited file,
regardless of whether that is done normally or by one of the hooks regardless of whether that is done normally or by one of the hooks
described above. One use of this hook is for the Copyright package; described above. For instance, the @file{copyright.el} program uses
it uses this hook to make sure the file has the current year in the this hook to make sure the file you are saving has the current year in
copyright header. its copyright notice.
@end defopt @end defopt
@c Emacs 19 feature @c Emacs 19 feature

17
lispref/lists.texi
View File

@ -1223,7 +1223,8 @@ useful example of @code{sort}.
A list can represent an unordered mathematical set---simply consider a A list can represent an unordered mathematical set---simply consider a
value an element of a set if it appears in the list, and ignore the value an element of a set if it appears in the list, and ignore the
order of the list. To form the union of two sets, use @code{append} (as order of the list. To form the union of two sets, use @code{append} (as
long as you don't mind having duplicate elements). Other useful long as you don't mind having duplicate elements). You can remove
@code{equal} duplicates using @code{delete-dups}. Other useful
functions for sets include @code{memq} and @code{delq}, and their functions for sets include @code{memq} and @code{delq}, and their
@code{equal} versions, @code{member} and @code{delete}. @code{equal} versions, @code{member} and @code{delete}.
@ -1431,6 +1432,20 @@ be a string and that it ignores differences in letter-case and text
representation: upper-case and lower-case letters are treated as representation: upper-case and lower-case letters are treated as
equal, and unibyte strings are converted to multibyte prior to equal, and unibyte strings are converted to multibyte prior to
comparison. comparison.
@end defun
@defun delete-dups list
This function destructively removes all @code{equal} duplicates from
@var{list} and returns the result. Of several @code{equal}
occurrences of an element in @var{list}, @code{delete-dups} keeps the
last one.
The value of @var{list} after a call to this function is undefined.
Usually, we store the return value back in @var{list}:
@example
(setq list (delete-dups list))
@end example
@end defun @end defun
See also the function @code{add-to-list}, in @ref{Setting Variables}, See also the function @code{add-to-list}, in @ref{Setting Variables},

25
lispref/macros.texi
View File

@ -210,10 +210,11 @@ called interactively.
which can specify how @key{TAB} should indent macro calls, and how to which can specify how @key{TAB} should indent macro calls, and how to
step through them for Edebug. step through them for Edebug.
@defspec declare @var{specs}... @anchor{Definition of declare}
This special form is used at top level in a macro definition to @defmac declare @var{specs}@dots{}
specify various additional information about it. Two kinds of A @code{declare} form is used in a macro definition to specify various
specification are currently supported: additional information about it. Two kinds of specification are
currently supported:
@table @code @table @code
@item (edebug @var{edebug-form-spec}) @item (edebug @var{edebug-form-spec})
@ -224,7 +225,17 @@ Specify how to step through macro calls for Edebug.
Specify how to indent calls to this macro. @xref{Indenting Macros}, Specify how to indent calls to this macro. @xref{Indenting Macros},
for more details. for more details.
@end table @end table
@end defspec
A @code{declare} form only has its special effect in the body of a
@code{defmacro} form if it immediately follows the documentation
string, if present, or the argument list otherwise. (Strictly
speaking, @emph{several} @code{declare} forms can follow the
documentation string or argument list, but since a @code{declare} form
can have several @var{specs}, they can always be combined into a
single form.) When used at other places in a @code{defmacro} form, or
outside a @code{defmacro} form, @code{declare} just returns @code{nil}
without evaluating any @var{specs}.
@end defmac
No macro absolutely needs a @code{declare} form, because that form No macro absolutely needs a @code{declare} form, because that form
has no effect on how the macro expands, on what the macro means in the has no effect on how the macro expands, on what the macro means in the
@ -356,9 +367,9 @@ trouble, and rules to follow to avoid trouble.
@node Wrong Time @node Wrong Time
@subsection Wrong Time @subsection Wrong Time
The most common problem in writing macros is doing too some of the The most common problem in writing macros is doing some of the
real work prematurely---while expanding the macro, rather than in the real work prematurely---while expanding the macro, rather than in the
expansion itself. For instance, one real package had this nmacro expansion itself. For instance, one real package had this macro
definition: definition:
@example @example

9
mac/ChangeLog
View File

@ -1,13 +1,16 @@
2004-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
* src/Emacs.r: Update TOO_MUCH_RAM error message.
2003-11-22 Lars Hansen <larsh@math.ku.dk> 2003-11-22 Lars Hansen <larsh@math.ku.dk>
* inc/grp.h: Added. * inc/grp.h: Added.
2003-11-02 Andrew Choi <akochoi@shaw.ca> 2003-11-02 Andrew Choi <akochoi@shaw.ca>
* src/Emacs.r [!TARGET_API_MAC_CARBON]: Don't define hfdr * src/Emacs.r [!TARGET_API_MAC_CARBON]: Don't define hfdr resource.
resource.
* Emacs.app/Contents/Resources/Emacs.rsrc: Remove. * Emacs.app/Contents/Resources/Emacs.rsrc: Remove.
2003-10-31 Andrew Choi <akochoi@shaw.ca> 2003-10-31 Andrew Choi <akochoi@shaw.ca>
* INSTALL: Add Nozomu Ando's changes to instructions for * INSTALL: Add Nozomu Ando's changes to instructions for

4
mac/INSTALL
View File

@ -1,6 +1,6 @@
* BUILDING EMACS ON MAC OS 8/9 AND MAC OS X -*- outline -*- * BUILDING EMACS ON MAC OS 8/9 AND MAC OS X -*- outline -*-
Copyright (c) 2001, 2002 Free Software Foundation, Inc. Copyright (c) 2001, 2002, 2004 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim Permission is granted to anyone to make or distribute verbatim
copies of this document as received, in any medium, provided that copies of this document as received, in any medium, provided that
@ -205,7 +205,7 @@ Emacs should build and run on a PowerMac running Mac OS 8.6 - 10.2.
You will need around 100 MB of disk space for the source files and You will need around 100 MB of disk space for the source files and
intermediate files. intermediate files.
It will not run on machines running Mac OS 8/9 with more than 256 MB It will not run on machines running Mac OS 8/9 with more than 512 MB
of physical or virtual memory. It does not have this restriction when of physical or virtual memory. It does not have this restriction when
it is run under Mac OS X. But the usual 128MB buffer limit of a it is run under Mac OS X. But the usual 128MB buffer limit of a
32-bit Emacs still exists. 32-bit Emacs still exists.

4
mac/src/Emacs.r
View File

@ -1,5 +1,5 @@
/* Resource definitions for GNU Emacs on the Macintosh. /* Resource definitions for GNU Emacs on the Macintosh.
Copyright (C) 1999, 2000 Free Software Foundation, Inc. Copyright (C) 1999, 2000, 2004 Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -174,7 +174,7 @@ resource 'DITL' (129, purgeable) {
{10, 60, 72, 278}, {10, 60, 72, 278},
StaticText { StaticText {
disabled, disabled,
"Emacs does not run on a Macintosh with more than 256 MB of physical or virtual memory" "Emacs does not run on a Macintosh with more than 512 MB of physical or virtual memory"
} }
} }
}; };

40
man/files.texi
View File

@ -1536,6 +1536,46 @@ range from red to blue spans the past 36 days instead of 360 days. A
stretch factor greater than 1 means the color range spans more than a stretch factor greater than 1 means the color range spans more than a
year. year.
From the annotate buffer, you can use the following keys to browse the
annotations of past revisions, view diffs, or view log entries:
@itemize @bullet
@item
Pressing @kbd{P} annotates the previous revision. It also takes a
numeric prefix argument, so for example @kbd{C-u 10 P} would take you
back 10 revisions.
@item
Pressing @kbd{N} annotates the next revision. It also takes a numeric
prefix argument, so for example @kbd{C-u 10 N} would take you forward
10 revisions.
@item
Pressing @kbd{J} annotates the revision at line (as denoted by the
version number on the same line).
@item
Pressing @kbd{A} annotates the revision previous to line (as denoted
by the version number on the same line). This is useful to see the
state the file was in before the change on the current line was made.
@item
Pressing @kbd{D} shows the diff of the revision at line with its
previous revision. This is useful to see what actually changed when
the revision denoted on the current line was committed.
@item
Pressing @kbd{L} shows the log of the revision at line. This is
useful to see the author's description of the changes that occured
when the revision denoted on the current line was committed.
@item
Pressing @kbd{W} annotates the workfile (most up to date) version. If
you used @kbd{P} and @kbd{N} to browse to other revisions, use this
key to return to the latest version.
@end itemize
@node Secondary VC Commands @node Secondary VC Commands
@subsection The Secondary Commands of VC @subsection The Secondary Commands of VC

9
src/.gitignore vendored
View File

@ -1,18 +1,19 @@
*-spd
*.core *.core
*.pdb
.gdb_history
Makefile Makefile
Makefile.c Makefile.c
TAGS-LISP TAGS-LISP
_gdbinit
bootstrap-emacs bootstrap-emacs
config.h config.h
config.stamp config.stamp
emacs emacs
emacs-* emacs-*
epaths.h epaths.h
gdb.ini
obj obj
prefix-args prefix-args
stamp-oldxmenu stamp-oldxmenu
temacs temacs
_gdbinit
gdb.ini
*-spd
*.pdb

220
src/ChangeLog
View File

@ -1,3 +1,164 @@
2004-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp.h [USE_LSB_TAG && !DECL_ALIGN]: Signal an error.
2004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* lisp.h: Add undef DECL_ALIGN.
2004-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
* process.c (wait_reading_process_input) [SYNC_INPUT]:
Check interrupt_input_pending explicitly.
* lisp.h (QUIT) [SYNC_INPUT]: Check interrupt_input_pending as well.
* keyboard.c (handle_async_input): New fun,
extracted from input_available_signal.
(input_available_signal, reinvoke_input_signal): Use it.
2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
* buffer.c (buffer_defaults, buffer_local_symbols): Use DECL_ALIGN.
* lisp.h [USE_LSB_TAG]: Add definitions for Lisp_Object value
manipulation macros for when tags are in the lower bits.
(struct Lisp_Free) [USE_LSB_TAG]: Add padding.
(DECL_ALIGN): New macro.
(DEFUN): Use it.
* lisp.h [ENABLE_CHECKING]: Don't force union type.
* s/darwin.h (__attribute__): Remove outdated workaround.
* macterm.c (main) [USE_LSB_TAG]: Don't range check the ram.
* alloc.c (lisp_malloc, lisp_align_malloc) [USE_LSB_TAG]:
Don't check range of malloc address.
(pure_alloc) [USE_LSB_TAG]: Enforce alignment.
* process.c (wait_reading_process_input): Lisp_Object/int mixup.
* dired.c (Ffile_attributes): Lisp_Object/int mixup.
2004-01-19 Kenichi Handa <handa@m17n.org>
* fontset.c (fontset_font_pattern): Fix previous change.
2004-01-16 Miles Bader <miles@gnu.ai.mit.edu>
* xdisp.c (Voverflow_newline_into_fringe)
(move_it_in_display_line_to, redisplay_internal)
(update_window_fringes, redisplay_window, display_line, window):
Add `#ifdef HAVE_WINDOW_SYSTEM' around fringe-drawing stuff, so
that it compiles without a window-system.
* dispnew.c (direct_output_for_insert, update_window): Likewise.
2004-01-16 Kim F. Storm <storm@cua.dk>
* buffer.h (struct buffer): New member indicate_buffer_boundaries.
* buffer.c (init_buffer_once): Set buffer_defaults and
buffer_local_flags for indicate_buffer_boundaries.
(syms_of_buffer): Defvar_per_buffer it, and defvar_lisp_nopro
default- variable for it.
* dispextern.h (struct glyph_row): New members left_fringe_bitmap,
right_fringe_bitmap, redraw_fringe_bitmaps_p for new fringe handling.
New members exact_window_width_line_p and cursor_in_fringe_p for
overflowing newlines into right fringe.
New members indicate_bob_p, indicate_top_line_p, indicate_eob_p,
and indicate_bottom_line_p for buffer boundaries and scrolling.
(enum fringe_bitmap_type): Add UP_ARROW_BITMAP, DOWN_ARROW_BITMAP,
FIRST_LINE_BITMAP, LAST_LINE_BITMAP, FILLED_BOX_CURSOR_BITMAP,
HOLLOW_BOX_CURSOR_BITMAP, BAR_CURSOR_BITMAP, HBAR_CURSOR_BITMAP,
and HOLLOW_SQUARE_BITMAP.
(draw_fringe_bitmap, draw_window_fringes, update_window_fringes):
Add prototypes.
* dispnew.c (row_equal_p, update_window_line): Compare fringe bitmaps
instead of related indicator fields.
Compare exact_window_width_line_p and cursor_in_mouse_face_p indicators.
(direct_output_for_insert): Handle exact width lines like
contined lines. Call update_window_fringes.
(update_window): Call update_window_fringes.
(scrolling_window): Don't skip desired rows with changed bitmaps.
Check if fringe bitmaps changes when assigning scrolled rows.
* xdisp.c (Voverflow_newline_into_fringe): New variable.
(IT_OVERFLOW_NEWLINE_INTO_FRINGE): New macro.
(move_it_in_display_line_to): Overflow newline into fringe for
rows that are exactly as wide as the window.
(up_arrow_bits, down_arrow_bits, first_line_bits, last_line_bits)
(filled_box_cursor_bits, hollow_box_cursor_bits, bar_cursor_bits)
(hbar_cursor_bits, hollow_square_bits): New fringe bitmaps.
(fringe_bitmaps): Add new bitmaps.
(draw_fringe_bitmap): Make extern. Remove WHICH arg.
Select proper bitmap for cursor in fringe when appropriate.
Handle alignment of bitmap to top or bottom of row.
(draw_row_fringe_bitmaps): Don't select bitmaps here; that is now
done by update_window_fringes.
(update_window_fringes, draw_window_fringes): New functions.
(redisplay_internal): Call update_window_fringes in case only
cursor row is updated.
(redisplay_window): Call update_window_fringes.
Explicitly call draw_window_fringes if redisplay was done using
the current matrix or the overlay arrow is in the window.
(try_window_reusing_current_matrix): Mark scrolled rows for
fringe update (to update buffer-boundaries / scrolling icons).
(find_last_unchanged_at_beg_row): Handle exact width lines line
continued lines.
(display_line): Overflow newline into fringe for rows that are
exactly as wide as the window. Don't append space for newline
in this case.
(notice_overwritten_cursor): Explicitly clear cursor bitmap
in fringe as if it had been overwritten.
(erase_phys_cursor): Erase cursor bitmap in fringe.
(syms_of_xdisp): Mark show-trailing-whitespace and
void-text-area-pointer as user options.
DEFVAR_LISP Voverflow_newline_into_fringe. Enable by default.
* xterm.c (x_update_window_end): Call draw_window_fringes.
(x_after_update_window_line): Just set redraw_fringe_bitmaps_p
in row instead of actually drawing fringe bitmaps.
(x_draw_fringe_bitmap): Handle bottom aligned bitmaps.
(x_draw_window_cursor): Draw cursor in fringe.
* w32term.c (x_update_window_end): Call draw_window_fringes.
(x_after_update_window_line): Just set redraw_fringe_bitmaps_p
in row instead of actually drawing fringe bitmaps.
(w32_draw_fringe_bitmap): Handle bottom aligned bitmaps.
(w32_draw_window_cursor): Draw cursor in fringe.
* macterm.c (x_update_window_end): Call draw_window_fringes.
(x_after_update_window_line): Just set redraw_fringe_bitmaps_p
in row instead of actually drawing fringe bitmaps.
(x_draw_fringe_bitmap): Handle bottom aligned bitmaps.
(mac_draw_window_cursor): Draw cursor in fringe.
2004-01-16 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* xterm.c (handle_one_xevent): Don't handle characters that are part
of an old style (XLookupString) compose sequence.
2004-01-15 Kenichi Handa <handa@m17n.org>
* search.c (Freplace_match): Use make_multibyte_string or
make_unibyte_string according to the buffer multibyteness.
2004-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
* alloc.c (struct interval_block, struct string_block)
(struct symbol_block, struct marker_block, live_string_p)
(live_cons_p, live_symbol_p, live_float_p, live_misc_p):
Better preserve alignment for objects in blocks.
(FLOAT_BLOCK_SIZE): Adjust for possible alignment padding.
* lread.c (defvar_per_buffer): Remove dead declaration.
* macterm.c (do_check_ram_size): Don't hardcode the lisp address
space size.
2004-01-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 2004-01-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* xmenu.c (popup_get_selection): Check new parameter down_on_keypress * xmenu.c (popup_get_selection): Check new parameter down_on_keypress
@ -61,7 +222,7 @@
* xdisp.c (note_mode_line_or_margin_highlight): Use modified * xdisp.c (note_mode_line_or_margin_highlight): Use modified
mode_line_string and marginal_area_string functions to handle mode_line_string and marginal_area_string functions to handle
both string object and image object properties. both string object and image object properties.
2004-01-06 Andreas Schwab <schwab@suse.de> 2004-01-06 Andreas Schwab <schwab@suse.de>
* syntax.c (skip_chars): Treat '-' at end of string as ordinary * syntax.c (skip_chars): Treat '-' at end of string as ordinary
@ -69,8 +230,8 @@
2004-01-02 Andreas Schwab <schwab@suse.de> 2004-01-02 Andreas Schwab <schwab@suse.de>
* macterm.c (emacs_options, x_initialized, same_x_server): Remove * macterm.c (emacs_options, x_initialized, same_x_server):
unused (and duplicated) definitions. Remove unused (and duplicated) definitions.
2004-01-02 Kim F. Storm <storm@cua.dk> 2004-01-02 Kim F. Storm <storm@cua.dk>
@ -100,8 +261,7 @@
2004-01-01 Jason Rumney <jasonr@gnu.org> 2004-01-01 Jason Rumney <jasonr@gnu.org>
* w32term.c (w32_text_out): Use s->font, for consistency with * w32term.c (w32_text_out): Use s->font, for consistency with callers.
callers.
2003-12-30 Luc Teirlinck <teirllm@auburn.edu> 2003-12-30 Luc Teirlinck <teirllm@auburn.edu>
@ -132,15 +292,13 @@
* fontset.c (Voverriding_fontspec_alist): New variable. * fontset.c (Voverriding_fontspec_alist): New variable.
(lookup_overriding_fontspec): New function. (lookup_overriding_fontspec): New function.
(fontset_ref_via_base): Call lookup_overriding_fontspec if (fontset_ref_via_base): Call lookup_overriding_fontspec if necessary.
necessary.
(fontset_font_pattern): Likewise. (fontset_font_pattern): Likewise.
(regulalize_fontname): New function. (regulalize_fontname): New function.
(Fset_fontset_font): Call regulalize_fontname. (Fset_fontset_font): Call regulalize_fontname.
(Fset_overriding_fontspec_internal): New function. (Fset_overriding_fontspec_internal): New function.
(syms_of_fontset): Initialize and staticprop (syms_of_fontset): Initialize and staticpro Voverriding_fontspec_alist.
Voverriding_fontspec_alist. Defsubr Defsubr Sset_overriding_fontspec_internal.
Sset_overriding_fontspec_internal.
* xfaces.c (face_font_available_p): New function. * xfaces.c (face_font_available_p): New function.
@ -197,7 +355,7 @@
(Vvoid_text_area_pointer): Replace Vshow_text_cursor_in_void. (Vvoid_text_area_pointer): Replace Vshow_text_cursor_in_void.
(QCmap, QCpointer, Qrect, Qcircle, Qpoly): New variables for (QCmap, QCpointer, Qrect, Qcircle, Qpoly): New variables for
image maps. image maps.
(x_y_to_hpos_vpos): Return glyph relative coordinates through (x_y_to_hpos_vpos): Return glyph relative coordinates through
new dx and dy args. new dx and dy args.
Remove buffer_only_p arg (always 0). Simplify code accordingly. Remove buffer_only_p arg (always 0). Simplify code accordingly.
(get_glyph_string_clip_rect): Draw cursor using glyph's rather (get_glyph_string_clip_rect): Draw cursor using glyph's rather
@ -207,9 +365,9 @@
(produce_image_glyph): Adjust it.ascent to minimum row ascent if (produce_image_glyph): Adjust it.ascent to minimum row ascent if
image glyph is alone on the last line. image glyph is alone on the last line.
(append_glyph, append_composite_glyph, produce_image_glyph) (append_glyph, append_composite_glyph, produce_image_glyph)
(append_stretch_glyph): Set glyph's ascent and descent. (append_stretch_glyph): Set glyph's ascent and descent.
(on_hot_spot_p): New function to check if position is inside an (on_hot_spot_p): New function to check if position is inside an
rectangular, circular, or polygon-shaped image hot-spot, rectangular, circular, or polygon-shaped image hot-spot,
(find_hot_spot): New function to search for image hot-spot. (find_hot_spot): New function to search for image hot-spot.
(Flookup_image_map): New defun to search for image hot-spot. (Flookup_image_map): New defun to search for image hot-spot.
(define_frame_cursor1): New aux function to determine frame pointer. (define_frame_cursor1): New aux function to determine frame pointer.
@ -277,8 +435,7 @@
(Fread_minibuffer, Fread_no_blanks_input): Adapt to changes in (Fread_minibuffer, Fread_no_blanks_input): Adapt to changes in
read_minibuf. read_minibuf.
(Fcompleting_read): Delete code moved into read_minibuf. (Fcompleting_read): Delete code moved into read_minibuf.
(Ftest_completion): Make it handle obarrays and hash tables (Ftest_completion): Make it handle obarrays and hash tables correctly.
correctly.
2003-12-03 Kenichi Handa <handa@m17n.org> 2003-12-03 Kenichi Handa <handa@m17n.org>
@ -429,10 +586,8 @@
2003-11-22 Lars Hansen <larsh@math.ku.dk> 2003-11-22 Lars Hansen <larsh@math.ku.dk>
* w32.c (struct the_group): Added. * w32.c (struct the_group, getgrgid): Add.
(getgrgid): Added. * mac.c (struct my_group, getgrgid): Add.
* mac.c (struct my_group): Added.
(getgrgid): Added.
2003-11-21 Luc Teirlinck <teirllm@auburn.edu> 2003-11-21 Luc Teirlinck <teirllm@auburn.edu>
@ -440,18 +595,19 @@
2003-11-21 Lars Hansen <larsh@math.ku.dk> 2003-11-21 Lars Hansen <larsh@math.ku.dk>
* dired.c (Ffile_attributes): Parameter ID-FORMAT added and * dired.c (Ffile_attributes): Add parameter ID-FORMAT and
included in call to file name handler. Numeric UID and GID include in call to file name handler. Optionally translate numeric
optionally translated to strings. Docstring updated. UID and GID to strings. Update docstring.
(directory_files_internal): Parameter ID-FORMAT added. (directory_files_internal): Add parameter ID-FORMAT.
(Fdirectory_files_and_attributes): Parameter ID-FORMAT added and (Fdirectory_files_and_attributes): Add parameter ID-FORMAT and
included in call to file name handler and call to include in call to file name handler and call to
directory_files_internal. Docstring updated. (Fdirectory_files): directory_files_internal. Update Docstring.
Dummy parameter added in call to directory_files_internal. (Fdirectory_files): Add dummy parameter in call to
* lisp.h (Qinteger): Added. (Qinteger_or_floatp, directory_files_internal.
Qinteger_or_float_or_marker_p): Removed. (Ffile_attributes): * lisp.h (Qinteger): Add.
Parameter added. (Qinteger_or_floatp, Qinteger_or_float_or_marker_p): Remove.
* data.c (Qinteger): Exported. (Ffile_attributes): Add parameter.
* data.c (Qinteger): Export.
2003-11-21 Luc Teirlinck <teirllm@auburn.edu> 2003-11-21 Luc Teirlinck <teirllm@auburn.edu>
@ -1788,7 +1944,7 @@
* gtkutil.c: Include keyboard.h, charset.h, coding.h. * gtkutil.c: Include keyboard.h, charset.h, coding.h.
(xg_create_frame_widgets): Use ENCODE_UTF_8. (xg_create_frame_widgets): Use ENCODE_UTF_8.
* xterm.c (Qutf_8): Moved to coding.c * xterm.c (Qutf_8): Move to coding.c
* xmenu.c (ENCODE_MENU_STRING): New. * xmenu.c (ENCODE_MENU_STRING): New.
(list_of_panes, list_of_items, digest_single_submenu, xmenu_show): (list_of_panes, list_of_items, digest_single_submenu, xmenu_show):

35
src/alloc.c
View File

@ -1,5 +1,5 @@
/* Storage allocation and gc for GNU Emacs Lisp interpreter. /* Storage allocation and gc for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002, 2003 Copyright (C) 1985,86,88,93,94,95,97,98,1999,2000,01,02,03,2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -599,6 +599,7 @@ lisp_malloc (nbytes, type)
val = (void *) malloc (nbytes); val = (void *) malloc (nbytes);
#ifndef USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp /* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be, object's pointer, and it needs to be,
that's equivalent to running out of memory. */ that's equivalent to running out of memory. */
@ -613,6 +614,7 @@ lisp_malloc (nbytes, type)
val = 0; val = 0;
} }
} }
#endif
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
if (val && type != MEM_TYPE_NON_LISP) if (val && type != MEM_TYPE_NON_LISP)
@ -773,6 +775,7 @@ lisp_align_malloc (nbytes, type)
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif #endif
#ifndef USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp /* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be, that's equivalent to object's pointer, and it needs to be, that's equivalent to
running out of memory. */ running out of memory. */
@ -789,6 +792,7 @@ lisp_align_malloc (nbytes, type)
memory_full (); memory_full ();
} }
} }
#endif
/* Initialize the blocks and put them on the free list. /* Initialize the blocks and put them on the free list.
Is `base' was not properly aligned, we can't use the last block. */ Is `base' was not properly aligned, we can't use the last block. */
@ -1105,8 +1109,9 @@ uninterrupt_malloc ()
struct interval_block struct interval_block
{ {
struct interval_block *next; /* Place `intervals' first, to preserve alignment. */
struct interval intervals[INTERVAL_BLOCK_SIZE]; struct interval intervals[INTERVAL_BLOCK_SIZE];
struct interval_block *next;
}; };
/* Current interval block. Its `next' pointer points to older /* Current interval block. Its `next' pointer points to older
@ -1344,8 +1349,9 @@ struct sblock
struct string_block struct string_block
{ {
struct string_block *next; /* Place `strings' first, to preserve alignment. */
struct Lisp_String strings[STRING_BLOCK_SIZE]; struct Lisp_String strings[STRING_BLOCK_SIZE];
struct string_block *next;
}; };
/* Head and tail of the list of sblock structures holding Lisp string /* Head and tail of the list of sblock structures holding Lisp string
@ -2126,8 +2132,10 @@ make_uninit_multibyte_string (nchars, nbytes)
by GC are put on a free list to be reallocated before allocating by GC are put on a free list to be reallocated before allocating
any new float cells from the latest float_block. */ any new float cells from the latest float_block. */
#define FLOAT_BLOCK_SIZE \ #define FLOAT_BLOCK_SIZE \
(((BLOCK_BYTES - sizeof (struct float_block *)) * CHAR_BIT) \ (((BLOCK_BYTES - sizeof (struct float_block *) \
/* The compiler might add padding at the end. */ \
- (sizeof (struct Lisp_Float) - sizeof (int))) * CHAR_BIT) \
/ (sizeof (struct Lisp_Float) * CHAR_BIT + 1)) / (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
#define GETMARKBIT(block,n) \ #define GETMARKBIT(block,n) \
@ -2754,8 +2762,9 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
struct symbol_block struct symbol_block
{ {
struct symbol_block *next; /* Place `symbols' first, to preserve alignment. */
struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next;
}; };
/* Current symbol block and index of first unused Lisp_Symbol /* Current symbol block and index of first unused Lisp_Symbol
@ -2846,8 +2855,9 @@ Its value and function definition are void, and its property list is nil. */)
struct marker_block struct marker_block
{ {
struct marker_block *next; /* Place `markers' first, to preserve alignment. */
union Lisp_Misc markers[MARKER_BLOCK_SIZE]; union Lisp_Misc markers[MARKER_BLOCK_SIZE];
struct marker_block *next;
}; };
struct marker_block *marker_block; struct marker_block *marker_block;
@ -3428,6 +3438,7 @@ live_string_p (m, p)
must not be on the free-list. */ must not be on the free-list. */
return (offset >= 0 return (offset >= 0
&& offset % sizeof b->strings[0] == 0 && offset % sizeof b->strings[0] == 0
&& offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
&& ((struct Lisp_String *) p)->data != NULL); && ((struct Lisp_String *) p)->data != NULL);
} }
else else
@ -3452,8 +3463,8 @@ live_cons_p (m, p)
one of the unused cells in the current cons block, one of the unused cells in the current cons block,
and not be on the free-list. */ and not be on the free-list. */
return (offset >= 0 return (offset >= 0
&& offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
&& offset % sizeof b->conses[0] == 0 && offset % sizeof b->conses[0] == 0
&& offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
&& (b != cons_block && (b != cons_block
|| offset / sizeof b->conses[0] < cons_block_index) || offset / sizeof b->conses[0] < cons_block_index)
&& !EQ (((struct Lisp_Cons *) p)->car, Vdead)); && !EQ (((struct Lisp_Cons *) p)->car, Vdead));
@ -3481,6 +3492,7 @@ live_symbol_p (m, p)
and not be on the free-list. */ and not be on the free-list. */
return (offset >= 0 return (offset >= 0
&& offset % sizeof b->symbols[0] == 0 && offset % sizeof b->symbols[0] == 0
&& offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& (b != symbol_block && (b != symbol_block
|| offset / sizeof b->symbols[0] < symbol_block_index) || offset / sizeof b->symbols[0] < symbol_block_index)
&& !EQ (((struct Lisp_Symbol *) p)->function, Vdead)); && !EQ (((struct Lisp_Symbol *) p)->function, Vdead));
@ -3506,8 +3518,8 @@ live_float_p (m, p)
/* P must point to the start of a Lisp_Float and not be /* P must point to the start of a Lisp_Float and not be
one of the unused cells in the current float block. */ one of the unused cells in the current float block. */
return (offset >= 0 return (offset >= 0
&& offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
&& offset % sizeof b->floats[0] == 0 && offset % sizeof b->floats[0] == 0
&& offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
&& (b != float_block && (b != float_block
|| offset / sizeof b->floats[0] < float_block_index)); || offset / sizeof b->floats[0] < float_block_index));
} }
@ -3534,6 +3546,7 @@ live_misc_p (m, p)
and not be on the free-list. */ and not be on the free-list. */
return (offset >= 0 return (offset >= 0
&& offset % sizeof b->markers[0] == 0 && offset % sizeof b->markers[0] == 0
&& offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
&& (b != marker_block && (b != marker_block
|| offset / sizeof b->markers[0] < marker_block_index) || offset / sizeof b->markers[0] < marker_block_index)
&& ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free); && ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free);
@ -4068,6 +4081,9 @@ pure_alloc (size, type)
int type; int type;
{ {
POINTER_TYPE *result; POINTER_TYPE *result;
#ifdef USE_LSB_TAG
size_t alignment = (1 << GCTYPEBITS);
#else
size_t alignment = sizeof (EMACS_INT); size_t alignment = sizeof (EMACS_INT);
/* Give Lisp_Floats an extra alignment. */ /* Give Lisp_Floats an extra alignment. */
@ -4079,6 +4095,7 @@ pure_alloc (size, type)
alignment = sizeof (struct Lisp_Float); alignment = sizeof (struct Lisp_Float);
#endif #endif
} }
#endif
again: again:
result = ALIGN (purebeg + pure_bytes_used, alignment); result = ALIGN (purebeg + pure_bytes_used, alignment);

22
src/buffer.c
View File

@ -1,5 +1,5 @@
/* Buffer manipulation primitives for GNU Emacs. /* Buffer manipulation primitives for GNU Emacs.
Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999, 2000, 2001, 02, 2003 Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999, 2000, 2001, 02, 03, 2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -67,7 +67,7 @@ struct buffer *all_buffers;
Setting the default value also goes through the alist of buffers Setting the default value also goes through the alist of buffers
and stores into each buffer that does not say it has a local value. */ and stores into each buffer that does not say it has a local value. */
struct buffer buffer_defaults; DECL_ALIGN (struct buffer, buffer_defaults);
/* A Lisp_Object pointer to the above, used for staticpro */ /* A Lisp_Object pointer to the above, used for staticpro */
@ -97,7 +97,8 @@ struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be /* This structure holds the names of symbols whose values may be
buffer-local. It is indexed and accessed in the same way as the above. */ buffer-local. It is indexed and accessed in the same way as the above. */
struct buffer buffer_local_symbols; DECL_ALIGN (struct buffer, buffer_local_symbols);
/* A Lisp_Object pointer to the above, used for staticpro */ /* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols; static Lisp_Object Vbuffer_local_symbols;
@ -4959,6 +4960,7 @@ init_buffer_once ()
buffer_defaults.scroll_bar_width = Qnil; buffer_defaults.scroll_bar_width = Qnil;
buffer_defaults.vertical_scroll_bar_type = Qt; buffer_defaults.vertical_scroll_bar_type = Qt;
buffer_defaults.indicate_empty_lines = Qnil; buffer_defaults.indicate_empty_lines = Qnil;
buffer_defaults.indicate_buffer_boundaries = Qnil;
buffer_defaults.scroll_up_aggressively = Qnil; buffer_defaults.scroll_up_aggressively = Qnil;
buffer_defaults.scroll_down_aggressively = Qnil; buffer_defaults.scroll_down_aggressively = Qnil;
buffer_defaults.display_time = Qnil; buffer_defaults.display_time = Qnil;
@ -5028,6 +5030,7 @@ init_buffer_once ()
XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx; XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx;
XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx; XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx;
XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx; XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx;
XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx; XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx; XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx; XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
@ -5316,6 +5319,11 @@ This is the same as (default-value 'vertical-scroll-bar). */);
doc: /* Default value of `indicate-empty-lines' for buffers that don't override it. doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
This is the same as (default-value 'indicate-empty-lines). */); This is the same as (default-value 'indicate-empty-lines). */);
DEFVAR_LISP_NOPRO ("default-indicate-buffer-boundaries",
&buffer_defaults.indicate_buffer_boundaries,
doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
This is the same as (default-value 'indicate-buffer-boundaries). */);
DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively", DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
&buffer_defaults.scroll_up_aggressively, &buffer_defaults.scroll_up_aggressively,
doc: /* Default value of `scroll-up-aggressively'. doc: /* Default value of `scroll-up-aggressively'.
@ -5626,6 +5634,14 @@ A value of t means to use the vertical scroll bar type from the window's frame.
If non-nil, a bitmap is displayed in the left fringe of a window on If non-nil, a bitmap is displayed in the left fringe of a window on
window-systems. */); window-systems. */);
DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
&current_buffer->indicate_buffer_boundaries, Qnil,
doc: /* *Visually indicate buffer boundaries and scrolling.
If non-nil, the first and last line of the buffer are marked in the left and
right fringe of a window on window-systems.
In addition, if value is t, the top and bottom line of the window are marked
with up and down arrow bitmaps in the right fringe if window can be scrolled. */);
DEFVAR_PER_BUFFER ("scroll-up-aggressively", DEFVAR_PER_BUFFER ("scroll-up-aggressively",
&current_buffer->scroll_up_aggressively, Qnil, &current_buffer->scroll_up_aggressively, Qnil,
doc: /* How far to scroll windows upward. doc: /* How far to scroll windows upward.

3
src/buffer.h
View File

@ -733,6 +733,9 @@ struct buffer
like vi). */ like vi). */
Lisp_Object indicate_empty_lines; Lisp_Object indicate_empty_lines;
/* Non-nil means indicate buffer boundaries and scrolling. */
Lisp_Object indicate_buffer_boundaries;
/* Time stamp updated each time this buffer is displayed in a window. */ /* Time stamp updated each time this buffer is displayed in a window. */
Lisp_Object display_time; Lisp_Object display_time;

6
src/dired.c
View File

@ -1,5 +1,5 @@
/* Lisp functions for making directory listings. /* Lisp functions for making directory listings.
Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -941,9 +941,9 @@ Elements of the attribute list are:
else else
{ {
pw = (struct passwd *) getpwuid (s.st_uid); pw = (struct passwd *) getpwuid (s.st_uid);
values[2] = (pw ? build_string (pw->pw_name) : s.st_uid); values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
gr = (struct group *) getgrgid (s.st_gid); gr = (struct group *) getgrgid (s.st_gid);
values[3] = (gr ? build_string (gr->gr_name) : s.st_gid); values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
} }
values[4] = make_time (s.st_atime); values[4] = make_time (s.st_atime);
values[5] = make_time (s.st_mtime); values[5] = make_time (s.st_mtime);

44
src/dispextern.h
View File

@ -709,6 +709,15 @@ struct glyph_row
position of the next row. */ position of the next row. */
struct display_pos end; struct display_pos end;
/* Left fringe bitmap number (enum fringe_bitmap_type). */
unsigned left_fringe_bitmap : 4;
/* Right fringe bitmap number (enum fringe_bitmap_type). */
unsigned right_fringe_bitmap : 4;
/* 1 means that we must draw the bitmaps of this row. */
unsigned redraw_fringe_bitmaps_p : 1;
/* In a desired matrix, 1 means that this row must be updated. In a /* In a desired matrix, 1 means that this row must be updated. In a
current matrix, 0 means that the row has been invalidated, i.e. current matrix, 0 means that the row has been invalidated, i.e.
the row's contents do not agree with what is visible on the the row's contents do not agree with what is visible on the
@ -777,6 +786,29 @@ struct glyph_row
/* 1 means this row was ended by a newline from a string. */ /* 1 means this row was ended by a newline from a string. */
unsigned ends_in_newline_from_string_p : 1; unsigned ends_in_newline_from_string_p : 1;
/* 1 means this row width is exactly the width of the window, and the
final newline character is hidden in the right fringe. */
unsigned exact_window_width_line_p : 1;
/* 1 means this row currently shows the cursor in the right fringe. */
unsigned cursor_in_fringe_p : 1;
/* Non-zero means display a bitmap on X frames indicating that this
the first line of the buffer. */
unsigned indicate_bob_p : 1;
/* Non-zero means display a bitmap on X frames indicating that this
the top line of the window, but not start of the buffer. */
unsigned indicate_top_line_p : 1;
/* Non-zero means display a bitmap on X frames indicating that this
the last line of the buffer. */
unsigned indicate_eob_p : 1;
/* Non-zero means display a bitmap on X frames indicating that this
the bottom line of the window, but not end of the buffer. */
unsigned indicate_bottom_line_p : 1;
/* Continuation lines width at the start of the row. */ /* Continuation lines width at the start of the row. */
int continuation_lines_width; int continuation_lines_width;
}; };
@ -1582,10 +1614,19 @@ enum fringe_bitmap_type
NO_FRINGE_BITMAP = 0, NO_FRINGE_BITMAP = 0,
LEFT_TRUNCATION_BITMAP, LEFT_TRUNCATION_BITMAP,
RIGHT_TRUNCATION_BITMAP, RIGHT_TRUNCATION_BITMAP,
UP_ARROW_BITMAP,
DOWN_ARROW_BITMAP,
CONTINUED_LINE_BITMAP, CONTINUED_LINE_BITMAP,
CONTINUATION_LINE_BITMAP, CONTINUATION_LINE_BITMAP,
OVERLAY_ARROW_BITMAP, OVERLAY_ARROW_BITMAP,
FIRST_LINE_BITMAP,
LAST_LINE_BITMAP,
FILLED_BOX_CURSOR_BITMAP,
HOLLOW_BOX_CURSOR_BITMAP,
BAR_CURSOR_BITMAP,
HBAR_CURSOR_BITMAP,
ZV_LINE_BITMAP, ZV_LINE_BITMAP,
HOLLOW_SQUARE_BITMAP,
MAX_FRINGE_BITMAPS MAX_FRINGE_BITMAPS
}; };
@ -2485,7 +2526,10 @@ void move_it_past_eol P_ ((struct it *));
int in_display_vector_p P_ ((struct it *)); int in_display_vector_p P_ ((struct it *));
int frame_mode_line_height P_ ((struct frame *)); int frame_mode_line_height P_ ((struct frame *));
void highlight_trailing_whitespace P_ ((struct frame *, struct glyph_row *)); void highlight_trailing_whitespace P_ ((struct frame *, struct glyph_row *));
void draw_fringe_bitmap P_ ((struct window *, struct glyph_row *, int));
void draw_row_fringe_bitmaps P_ ((struct window *, struct glyph_row *)); void draw_row_fringe_bitmaps P_ ((struct window *, struct glyph_row *));
void draw_window_fringes P_ ((struct window *));
int update_window_fringes P_ ((struct window *, int));
void compute_fringe_widths P_ ((struct frame *, int)); void compute_fringe_widths P_ ((struct frame *, int));
extern Lisp_Object Qtool_bar; extern Lisp_Object Qtool_bar;
extern Lisp_Object Vshow_trailing_whitespace; extern Lisp_Object Vshow_trailing_whitespace;

37
src/dispnew.c
View File

@ -1,5 +1,5 @@
/* Updating of data structures for redisplay. /* Updating of data structures for redisplay.
Copyright (C) 1985,86,87,88,93,94,95,97,98,1999,2000,01,02,2003 Copyright (C) 1985,86,87,88,93,94,95,97,98,1999,2000,01,02,03,04
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -1500,12 +1500,11 @@ row_equal_p (w, a, b, mouse_face_p)
return 0; return 0;
} }
if (a->truncated_on_left_p != b->truncated_on_left_p if (a->fill_line_p != b->fill_line_p
|| a->fill_line_p != b->fill_line_p || a->cursor_in_fringe_p != b->cursor_in_fringe_p
|| a->truncated_on_right_p != b->truncated_on_right_p || a->left_fringe_bitmap != b->left_fringe_bitmap
|| a->overlay_arrow_p != b->overlay_arrow_p || a->right_fringe_bitmap != b->right_fringe_bitmap
|| a->continued_p != b->continued_p || a->exact_window_width_line_p != b->exact_window_width_line_p
|| a->indicate_empty_line_p != b->indicate_empty_line_p
|| a->overlapped_p != b->overlapped_p || a->overlapped_p != b->overlapped_p
|| (MATRIX_ROW_CONTINUATION_LINE_P (a) || (MATRIX_ROW_CONTINUATION_LINE_P (a)
!= MATRIX_ROW_CONTINUATION_LINE_P (b)) != MATRIX_ROW_CONTINUATION_LINE_P (b))
@ -3442,6 +3441,7 @@ direct_output_for_insert (g)
/* Can't do it in a continued line because continuation /* Can't do it in a continued line because continuation
lines would change. */ lines would change. */
(glyph_row->continued_p (glyph_row->continued_p
|| glyph_row->exact_window_width_line_p
/* Can't use this method if the line overlaps others or is /* Can't use this method if the line overlaps others or is
overlapped by others because these other lines would overlapped by others because these other lines would
have to be redisplayed. */ have to be redisplayed. */
@ -3647,6 +3647,10 @@ direct_output_for_insert (g)
cursor_to (y, x); cursor_to (y, x);
} }
#ifdef HAVE_WINDOW_SYSTEM
update_window_fringes (w, 0);
#endif
if (FRAME_RIF (f)) if (FRAME_RIF (f))
FRAME_RIF (f)->update_window_end_hook (w, 1, 0); FRAME_RIF (f)->update_window_end_hook (w, 1, 0);
update_end (f); update_end (f);
@ -4194,6 +4198,10 @@ update_window (w, force_p)
strcpy (w->current_matrix->method, w->desired_matrix->method); strcpy (w->current_matrix->method, w->desired_matrix->method);
#endif #endif
#ifdef HAVE_WINDOW_SYSTEM
update_window_fringes (w, 0);
#endif
/* End the update of window W. Don't set the cursor if we /* End the update of window W. Don't set the cursor if we
paused updating the display because in this case, paused updating the display because in this case,
set_window_cursor_after_update hasn't been called, and set_window_cursor_after_update hasn't been called, and
@ -4515,13 +4523,10 @@ update_window_line (w, vpos, mouse_face_overwritten_p)
if (!current_row->enabled_p if (!current_row->enabled_p
|| desired_row->y != current_row->y || desired_row->y != current_row->y
|| desired_row->visible_height != current_row->visible_height || desired_row->visible_height != current_row->visible_height
|| desired_row->overlay_arrow_p != current_row->overlay_arrow_p || desired_row->cursor_in_fringe_p != current_row->cursor_in_fringe_p
|| desired_row->truncated_on_left_p != current_row->truncated_on_left_p || current_row->redraw_fringe_bitmaps_p
|| desired_row->truncated_on_right_p != current_row->truncated_on_right_p
|| desired_row->continued_p != current_row->continued_p
|| desired_row->mode_line_p != current_row->mode_line_p || desired_row->mode_line_p != current_row->mode_line_p
|| (desired_row->indicate_empty_line_p || desired_row->exact_window_width_line_p != current_row->exact_window_width_line_p
!= current_row->indicate_empty_line_p)
|| (MATRIX_ROW_CONTINUATION_LINE_P (desired_row) || (MATRIX_ROW_CONTINUATION_LINE_P (desired_row)
!= MATRIX_ROW_CONTINUATION_LINE_P (current_row))) != MATRIX_ROW_CONTINUATION_LINE_P (current_row)))
rif->after_update_window_line_hook (desired_row); rif->after_update_window_line_hook (desired_row);
@ -4776,6 +4781,7 @@ scrolling_window (w, header_line_p)
if (c->enabled_p if (c->enabled_p
&& d->enabled_p && d->enabled_p
&& !d->redraw_fringe_bitmaps_p
&& c->y == d->y && c->y == d->y
&& MATRIX_ROW_BOTTOM_Y (c) <= yb && MATRIX_ROW_BOTTOM_Y (c) <= yb
&& MATRIX_ROW_BOTTOM_Y (d) <= yb && MATRIX_ROW_BOTTOM_Y (d) <= yb
@ -4831,6 +4837,7 @@ scrolling_window (w, header_line_p)
&& MATRIX_ROW (current_matrix, i - 1)->enabled_p && MATRIX_ROW (current_matrix, i - 1)->enabled_p
&& (MATRIX_ROW (current_matrix, i - 1)->y && (MATRIX_ROW (current_matrix, i - 1)->y
== MATRIX_ROW (desired_matrix, j - 1)->y) == MATRIX_ROW (desired_matrix, j - 1)->y)
&& !MATRIX_ROW (desired_matrix, j - 1)->redraw_fringe_bitmaps_p
&& row_equal_p (w, && row_equal_p (w,
MATRIX_ROW (desired_matrix, i - 1), MATRIX_ROW (desired_matrix, i - 1),
MATRIX_ROW (current_matrix, j - 1), 1)) MATRIX_ROW (current_matrix, j - 1), 1))
@ -5023,6 +5030,10 @@ scrolling_window (w, header_line_p)
to = MATRIX_ROW (current_matrix, r->desired_vpos + j); to = MATRIX_ROW (current_matrix, r->desired_vpos + j);
from = MATRIX_ROW (desired_matrix, r->desired_vpos + j); from = MATRIX_ROW (desired_matrix, r->desired_vpos + j);
to_overlapped_p = to->overlapped_p; to_overlapped_p = to->overlapped_p;
if (!from->mode_line_p && !w->pseudo_window_p
&& (to->left_fringe_bitmap != from->left_fringe_bitmap
|| to->right_fringe_bitmap != from->right_fringe_bitmap))
from->redraw_fringe_bitmaps_p = 1;
assign_row (to, from); assign_row (to, from);
to->enabled_p = 1, from->enabled_p = 0; to->enabled_p = 1, from->enabled_p = 0;
to->overlapped_p = to_overlapped_p; to->overlapped_p = to_overlapped_p;

3
src/fontset.c
View File

@ -599,7 +599,8 @@ fontset_font_pattern (f, id, c)
fontset = FONTSET_FROM_ID (id); fontset = FONTSET_FROM_ID (id);
xassert (!BASE_FONTSET_P (fontset)); xassert (!BASE_FONTSET_P (fontset));
fontset = FONTSET_BASE (fontset); fontset = FONTSET_BASE (fontset);
elt = FONTSET_REF (fontset, c); if (! EQ (fontset, Vdefault_fontset))
elt = FONTSET_REF (fontset, c);
} }
if (NILP (elt)) if (NILP (elt))
{ {

106
src/keyboard.c
View File

@ -1,5 +1,5 @@
/* Keyboard and mouse input; editor command loop. /* Keyboard and mouse input; editor command loop.
Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99,2000,01,02,03 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99,2000,01,02,03,04
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -470,36 +470,6 @@ extern char *pending_malloc_warning;
static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
/* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
The interrupt-level event handlers will never enqueue an event on a
frame which is not in Vframe_list, and once an event is dequeued,
internal_last_event_frame or the event itself points to the frame.
So that's all fine.
But while the event is sitting in the queue, it's completely
unprotected. Suppose the user types one command which will run for
a while and then delete a frame, and then types another event at
the frame that will be deleted, before the command gets around to
it. Suppose there are no references to this frame elsewhere in
Emacs, and a GC occurs before the second event is dequeued. Now we
have an event referring to a freed frame, which will crash Emacs
when it is dequeued.
Similar things happen when an event on a scroll bar is enqueued; the
window may be deleted while the event is in the queue.
So, we use this vector to protect the Lisp_Objects in the event
queue. That way, they'll be dequeued as dead frames or windows,
but still valid Lisp objects.
If kbd_buffer[i].kind != NO_EVENT, then
AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
static Lisp_Object kbd_buffer_gcpro;
/* Pointer to next available character in kbd_buffer. /* Pointer to next available character in kbd_buffer.
If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
@ -3630,7 +3600,6 @@ kbd_buffer_store_event (event)
Discard the event if it would fill the last slot. */ Discard the event if it would fill the last slot. */
if (kbd_fetch_ptr - 1 != kbd_store_ptr) if (kbd_fetch_ptr - 1 != kbd_store_ptr)
{ {
int idx;
#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error #if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error
prone to assign individual members for other events, in case prone to assign individual members for other events, in case
@ -3660,9 +3629,6 @@ kbd_buffer_store_event (event)
*kbd_store_ptr = *event; *kbd_store_ptr = *event;
#endif #endif
idx = 2 * (kbd_store_ptr - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
ASET (kbd_buffer_gcpro, idx + 1, event->arg);
++kbd_store_ptr; ++kbd_store_ptr;
} }
} }
@ -3778,9 +3744,6 @@ static INLINE void
clear_event (event) clear_event (event)
struct input_event *event; struct input_event *event;
{ {
int idx = 2 * (event - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
event->kind = NO_EVENT; event->kind = NO_EVENT;
} }
@ -6805,31 +6768,13 @@ tty_read_avail_input (struct display *display,
#endif /* not VMS */ #endif /* not VMS */
#ifdef SIGIO /* for entire page */ void
/* Note SIGIO has been undef'd if FIONREAD is missing. */ handle_async_input ()
static SIGTYPE
input_available_signal (signo)
int signo;
{ {
/* Must preserve main program's value of errno. */
int old_errno = errno;
#ifdef BSD4_1 #ifdef BSD4_1
extern int select_alarmed; extern int select_alarmed;
#endif #endif
interrupt_input_pending = 0;
#if defined (USG) && !defined (POSIX_SIGNALS)
/* USG systems forget handlers when they are used;
must reestablish each time */
signal (signo, input_available_signal);
#endif /* USG */
#ifdef BSD4_1
sigisheld (SIGIO);
#endif
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
while (1) while (1)
{ {
@ -6845,6 +6790,36 @@ input_available_signal (signo)
select_alarmed = 1; /* Force the select emulator back to life */ select_alarmed = 1; /* Force the select emulator back to life */
#endif #endif
} }
}
#ifdef SIGIO /* for entire page */
/* Note SIGIO has been undef'd if FIONREAD is missing. */
static SIGTYPE
input_available_signal (signo)
int signo;
{
/* Must preserve main program's value of errno. */
int old_errno = errno;
#if defined (USG) && !defined (POSIX_SIGNALS)
/* USG systems forget handlers when they are used;
must reestablish each time */
signal (signo, input_available_signal);
#endif /* USG */
#ifdef BSD4_1
sigisheld (SIGIO);
#endif
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
#ifdef SYNC_INPUT
interrupt_input_pending = 1;
#else
handle_async_input ();
#endif
#ifdef BSD4_1 #ifdef BSD4_1
sigfree (); sigfree ();
@ -6863,7 +6838,7 @@ void
reinvoke_input_signal () reinvoke_input_signal ()
{ {
#ifdef SIGIO #ifdef SIGIO
kill (getpid (), SIGIO); handle_async_input ();
#endif #endif
} }
@ -10123,7 +10098,6 @@ Also end any kbd macro being defined. */)
discard_tty_input (); discard_tty_input ();
kbd_fetch_ptr = kbd_store_ptr; kbd_fetch_ptr = kbd_store_ptr;
Ffillarray (kbd_buffer_gcpro, Qnil);
input_pending = 0; input_pending = 0;
return Qnil; return Qnil;
@ -10217,17 +10191,13 @@ stuff_buffered_input (stuffstring)
Should we ignore anything that was typed in at the "wrong" kboard? */ Should we ignore anything that was typed in at the "wrong" kboard? */
for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++) for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
{ {
int idx;
if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
kbd_fetch_ptr = kbd_buffer; kbd_fetch_ptr = kbd_buffer;
if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT) if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
stuff_char (kbd_fetch_ptr->code); stuff_char (kbd_fetch_ptr->code);
kbd_fetch_ptr->kind = NO_EVENT; clear_event (kbd_fetch_ptr);
idx = 2 * (kbd_fetch_ptr - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
} }
input_pending = 0; input_pending = 0;
@ -10679,7 +10649,6 @@ init_keyboard ()
recent_keys_index = 0; recent_keys_index = 0;
kbd_fetch_ptr = kbd_buffer; kbd_fetch_ptr = kbd_buffer;
kbd_store_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer;
kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
#ifdef HAVE_MOUSE #ifdef HAVE_MOUSE
do_mouse_tracking = Qnil; do_mouse_tracking = Qnil;
#endif #endif
@ -10976,9 +10945,6 @@ syms_of_keyboard ()
Fset (Qextended_command_history, Qnil); Fset (Qextended_command_history, Qnil);
staticpro (&Qextended_command_history); staticpro (&Qextended_command_history);
kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
staticpro (&kbd_buffer_gcpro);
accent_key_syms = Qnil; accent_key_syms = Qnil;
staticpro (&accent_key_syms); staticpro (&accent_key_syms);

81
src/lisp.h
View File

@ -1,5 +1,5 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter. /* Fundamental definitions for GNU Emacs Lisp interpreter.
Copyright (C) 1985,86,87,93,94,95,97,98,1999,2000, 2001, 2002, 2003 Copyright (C) 1985,86,87,93,94,95,97,98,1999,2000,01,02,03,2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -67,10 +67,6 @@ extern void die P_((const char *, const char *, int));
? (void) 0 \ ? (void) 0 \
: die ((msg), __FILE__, __LINE__)), \ : die ((msg), __FILE__, __LINE__)), \
0) 0)
/* Let's get some compile-time checking too. */
#undef NO_UNION_TYPE
#else #else
/* Produce same side effects and result, but don't complain. */ /* Produce same side effects and result, but don't complain. */
@ -292,6 +288,28 @@ enum pvec_type
/* For convenience, we also store the number of elements in these bits. */ /* For convenience, we also store the number of elements in these bits. */
#define PSEUDOVECTOR_SIZE_MASK 0x1ff #define PSEUDOVECTOR_SIZE_MASK 0x1ff
/***** Select the tagging scheme. *****/
/* First, try and define DECL_ALIGN(type,var) which declares a static
variable VAR of type TYPE with the added requirement that it be
TYPEBITS-aligned. */
#if defined USE_LSB_TAG && !defined DECL_ALIGN
/* What compiler directive should we use for non-gcc compilers? -stef */
# if defined (__GNUC__)
# define DECL_ALIGN(type, var) \
type __attribute__ ((__aligned__ (1 << GCTYPEBITS))) var
# else
# error "USE_LSB_TAG used without defining DECL_ALIGN"
# endif
#endif
#ifndef USE_LSB_TAG
/* Just remove the alignment annotation if we don't use it. */
#undef DECL_ALIGN
#define DECL_ALIGN(type, var) type var
#endif
/* These macros extract various sorts of values from a Lisp_Object. /* These macros extract various sorts of values from a Lisp_Object.
For example, if tem is a Lisp_Object whose type is Lisp_Cons, For example, if tem is a Lisp_Object whose type is Lisp_Cons,
@ -299,6 +317,27 @@ enum pvec_type
#ifdef NO_UNION_TYPE #ifdef NO_UNION_TYPE
#ifdef USE_LSB_TAG
#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) & TYPEMASK))
#define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS)
#define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
#define XSET(var, type, ptr) \
(eassert (XTYPE (ptr) == 0), /* Check alignment. */ \
(var) = ((EMACS_INT) (type)) | ((EMACS_INT) (ptr)))
#define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
/* XFASTINT and XSETFASTINT are for use when the integer is known to be
positive, in which case the implementation can sometimes be faster
depending on the tagging scheme. With USE_LSB_TAG, there's no benefit. */
#define XFASTINT(a) XINT (a)
#define XSETFASTINT(a, b) ((a) = make_number (b))
#define XPNTR(a) ((EMACS_INT) ((a) & ~TYPEMASK))
#else /* not USE_LSB_TAG */
#define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1) #define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1)
/* One need to override this if there must be high bits set in data space /* One need to override this if there must be high bits set in data space
@ -337,6 +376,8 @@ enum pvec_type
#define make_number(N) \ #define make_number(N) \
((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS) ((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS)
#endif /* not USE_LSB_TAG */
#define EQ(x, y) ((x) == (y)) #define EQ(x, y) ((x) == (y))
#else /* not NO_UNION_TYPE */ #else /* not NO_UNION_TYPE */
@ -1150,6 +1191,13 @@ struct Lisp_Free
unsigned gcmarkbit : 1; unsigned gcmarkbit : 1;
int spacer : 15; int spacer : 15;
union Lisp_Misc *chain; union Lisp_Misc *chain;
#ifdef USE_LSB_TAG
/* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
This assumes that Lisp_Marker is the largest of the alternatives and
that Lisp_Intfwd has the same size as "Lisp_Free w/o padding". */
char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
<< GCTYPEBITS) - sizeof (struct Lisp_Intfwd)];
#endif
}; };
/* To get the type field of a union Lisp_Misc, use XMISCTYPE. /* To get the type field of a union Lisp_Misc, use XMISCTYPE.
@ -1517,7 +1565,7 @@ typedef unsigned char UCHAR;
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname (); \ Lisp_Object fnname (); \
struct Lisp_Subr sname = \ DECL_ALIGN (struct Lisp_Subr, sname) = \
{ PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
fnname, minargs, maxargs, lname, prompt, 0}; \ fnname, minargs, maxargs, lname, prompt, 0}; \
Lisp_Object fnname Lisp_Object fnname
@ -1528,7 +1576,7 @@ typedef unsigned char UCHAR;
arguments, so we can catch errors with maxargs at compile-time. */ arguments, so we can catch errors with maxargs at compile-time. */
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
struct Lisp_Subr sname = \ DECL_ALIGN (struct Lisp_Subr, sname) = \
{ PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \ { PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
fnname, minargs, maxargs, lname, prompt, 0}; \ fnname, minargs, maxargs, lname, prompt, 0}; \
Lisp_Object fnname Lisp_Object fnname
@ -1675,6 +1723,22 @@ extern char *stack_bottom;
This is a good thing to do around a loop that has no side effects This is a good thing to do around a loop that has no side effects
and (in particular) cannot call arbitrary Lisp code. */ and (in particular) cannot call arbitrary Lisp code. */
#ifdef SYNC_INPUT
extern void handle_async_input P_ ((void));
extern int interrupt_input_pending;
#define QUIT \
do { \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
{ \
Vquit_flag = Qnil; \
Fsignal (Qquit, Qnil); \
} \
else if (interrupt_input_pending) \
handle_async_input (); \
} while (0)
#else /* not SYNC_INPUT */
#define QUIT \ #define QUIT \
do { \ do { \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
@ -1684,6 +1748,9 @@ extern char *stack_bottom;
} \ } \
} while (0) } while (0)
#endif /* not SYNC_INPUT */
/* Nonzero if ought to quit now. */ /* Nonzero if ought to quit now. */
#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))

3
src/lread.c
View File

@ -1,5 +1,5 @@
/* Lisp parsing and input streams. /* Lisp parsing and input streams.
Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 01, 2003 Copyright (C) 1985,86,87,88,89,93,94,95,97,98,99,2000,01,03,2004
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -3496,7 +3496,6 @@ defvar_per_buffer (namestring, address, type, doc)
{ {
Lisp_Object sym, val; Lisp_Object sym, val;
int offset; int offset;
extern struct buffer buffer_local_symbols;
sym = intern (namestring); sym = intern (namestring);
val = allocate_misc (); val = allocate_misc ();

40
src/macterm.c
View File

@ -1143,6 +1143,9 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p)
output_cursor.x, output_cursor.y); output_cursor.x, output_cursor.y);
x_draw_vertical_border (w); x_draw_vertical_border (w);
draw_window_fringes (w);
UNBLOCK_INPUT; UNBLOCK_INPUT;
} }
@ -1239,11 +1242,7 @@ x_after_update_window_line (desired_row)
xassert (w); xassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p) if (!desired_row->mode_line_p && !w->pseudo_window_p)
{ desired_row->redraw_fringe_bitmaps_p = 1;
BLOCK_INPUT;
draw_row_fringe_bitmaps (w, desired_row);
UNBLOCK_INPUT;
}
/* When a window has disappeared, make sure that no rest of /* When a window has disappeared, make sure that no rest of
full-width rows stays visible in the internal border. Could full-width rows stays visible in the internal border. Could
@ -1295,9 +1294,24 @@ x_draw_fringe_bitmap (w, row, p)
XGCValues gcv; XGCValues gcv;
GC gc = f->output_data.mac->normal_gc; GC gc = f->output_data.mac->normal_gc;
struct face *face = p->face; struct face *face = p->face;
int rowY;
/* Must clip because of partially visible lines. */ /* Must clip because of partially visible lines. */
x_clip_to_row (w, row, gc); rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
if (p->y < rowY)
{
/* Adjust position of "bottom aligned" bitmap on partially
visible last row. */
int oldY = row->y;
int oldVH = row->visible_height;
row->visible_height = p->h;
row->y -= rowY - p->y;
x_clip_to_row (w, row, gc);
row->y = oldY;
row->visible_height = oldVH;
}
else
x_clip_to_row (w, row, gc);
if (p->bx >= 0) if (p->bx >= 0)
{ {
@ -4546,6 +4560,14 @@ mac_draw_window_cursor (w, glyph_row, x, y, cursor_type, cursor_width, on_p, act
w->phys_cursor_width = cursor_width; w->phys_cursor_width = cursor_width;
w->phys_cursor_on_p = 1; w->phys_cursor_on_p = 1;
if (glyph_row->exact_window_width_line_p
&& w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA])
{
glyph_row->cursor_in_fringe_p = 1;
draw_fringe_bitmap (w, glyph_row, 0);
return;
}
switch (cursor_type) switch (cursor_type)
{ {
case HOLLOW_BOX_CURSOR: case HOLLOW_BOX_CURSOR:
@ -6643,8 +6665,8 @@ do_check_ram_size (void)
if (Gestalt (gestaltPhysicalRAMSize, &physical_ram_size) != noErr if (Gestalt (gestaltPhysicalRAMSize, &physical_ram_size) != noErr
|| Gestalt (gestaltLogicalRAMSize, &logical_ram_size) != noErr || Gestalt (gestaltLogicalRAMSize, &logical_ram_size) != noErr
|| physical_ram_size > 256 * 1024 * 1024 || physical_ram_size > (1 << VALBITS)
|| logical_ram_size > 256 * 1024 * 1024) || logical_ram_size > (1 << VALBITS))
{ {
StopAlert (RAM_TOO_LARGE_ALERT_ID, NULL); StopAlert (RAM_TOO_LARGE_ALERT_ID, NULL);
exit (1); exit (1);
@ -7443,7 +7465,9 @@ main (void)
do_get_menus (); do_get_menus ();
#ifndef USE_LSB_TAG
do_check_ram_size (); do_check_ram_size ();
#endif
init_emacs_passwd_dir (); init_emacs_passwd_dir ();

8
src/process.c
View File

@ -1,6 +1,6 @@
/* Asynchronous subprocess control for GNU Emacs. /* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
2001, 2002, 2003 Free Software Foundation, Inc. 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -4080,6 +4080,10 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
Otherwise, do pending quit if requested. */ Otherwise, do pending quit if requested. */
if (XINT (read_kbd) >= 0) if (XINT (read_kbd) >= 0)
QUIT; QUIT;
#ifdef SYNC_INPUT
else if (interrupt_input_pending)
handle_async_input ();
#endif
/* Exit now if the cell we're waiting for became non-nil. */ /* Exit now if the cell we're waiting for became non-nil. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
@ -4296,7 +4300,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
proc = chan_process[channel]; proc = chan_process[channel];
if (NILP (proc)) if (NILP (proc))
continue; continue;
if (XPROCESS (proc)->read_output_delay > 0) if (XINT (XPROCESS (proc)->read_output_delay) > 0)
{ {
check_delay--; check_delay--;
if (NILP (XPROCESS (proc)->read_output_skip)) if (NILP (XPROCESS (proc)->read_output_skip))

5
src/s/darwin.h
View File

@ -1,5 +1,5 @@
/* System description header file for Darwin (Mac OS X). /* System description header file for Darwin (Mac OS X).
Copyright (C) 2001, 2002 Free Software Foundation, Inc. Copyright (C) 2001, 02, 2004 Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -203,9 +203,6 @@ Boston, MA 02111-1307, USA. */
/* Fix compilation problem for regex.c. */ /* Fix compilation problem for regex.c. */
#define __restrict #define __restrict
/* Fix compilation problem for md5.c. */
#define __attribute__(x)
/* Used in dispnew.c. Copied from freebsd.h. */ /* Used in dispnew.c. Copied from freebsd.h. */
#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)

10
src/search.c
View File

@ -2553,8 +2553,16 @@ since only regular expressions have distinguished subexpressions. */)
} }
if (really_changed) if (really_changed)
newtext = make_string (substed, substed_len); {
if (buf_multibyte)
{
int nchars = multibyte_chars_in_text (substed, substed_len);
newtext = make_multibyte_string (substed, nchars, substed_len);
}
else
newtext = make_unibyte_string (substed, substed_len);
}
xfree (substed); xfree (substed);
} }

34
src/w32term.c
View File

@ -540,6 +540,9 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p)
output_cursor.x, output_cursor.y); output_cursor.x, output_cursor.y);
x_draw_vertical_border (w); x_draw_vertical_border (w);
draw_window_fringes (w);
UNBLOCK_INPUT; UNBLOCK_INPUT;
} }
@ -624,11 +627,7 @@ x_after_update_window_line (desired_row)
xassert (w); xassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p) if (!desired_row->mode_line_p && !w->pseudo_window_p)
{ desired_row->redraw_fringe_bitmaps_p = 1;
BLOCK_INPUT;
draw_row_fringe_bitmaps (w, desired_row);
UNBLOCK_INPUT;
}
/* When a window has disappeared, make sure that no rest of /* When a window has disappeared, make sure that no rest of
full-width rows stays visible in the internal border. Could full-width rows stays visible in the internal border. Could
@ -678,11 +677,26 @@ w32_draw_fringe_bitmap (w, row, p)
struct frame *f = XFRAME (WINDOW_FRAME (w)); struct frame *f = XFRAME (WINDOW_FRAME (w));
HDC hdc; HDC hdc;
struct face *face = p->face; struct face *face = p->face;
int rowY;
hdc = get_frame_dc (f); hdc = get_frame_dc (f);
/* Must clip because of partially visible lines. */ /* Must clip because of partially visible lines. */
w32_clip_to_row (w, row, hdc); rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
if (p->y < rowY)
{
/* Adjust position of "bottom aligned" bitmap on partially
visible last row. */
int oldY = row->y;
int oldVH = row->visible_height;
row->visible_height = p->h;
row->y -= rowY - p->y;
w32_clip_to_row (w, row, hdc);
row->y = oldY;
row->visible_height = oldVH;
}
else
w32_clip_to_row (w, row, hdc);
if (p->bx >= 0) if (p->bx >= 0)
{ {
@ -5120,6 +5134,14 @@ w32_draw_window_cursor (w, glyph_row, x, y, cursor_type, cursor_width, on_p, act
PostMessage (hwnd, WM_EMACS_TRACK_CARET, 0, 0); PostMessage (hwnd, WM_EMACS_TRACK_CARET, 0, 0);
} }
if (glyph_row->exact_window_width_line_p
&& w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA])
{
glyph_row->cursor_in_fringe_p = 1;
draw_fringe_bitmap (w, glyph_row, 0);
return;
}
switch (cursor_type) switch (cursor_type)
{ {
case HOLLOW_BOX_CURSOR: case HOLLOW_BOX_CURSOR:

648
src/xdisp.c
View File

@ -1,5 +1,5 @@
/* Display generation from window structure and buffer text. /* Display generation from window structure and buffer text.
Copyright (C) 1985,86,87,88,93,94,95,97,98,99,2000,01,02,03 Copyright (C) 1985,86,87,88,93,94,95,97,98,99,2000,01,02,03,04
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of GNU Emacs. This file is part of GNU Emacs.
@ -310,6 +310,21 @@ extern Lisp_Object Qscroll_bar;
Lisp_Object Vshow_trailing_whitespace; Lisp_Object Vshow_trailing_whitespace;
#ifdef HAVE_WINDOW_SYSTEM
/* Non-nil means that newline may flow into the right fringe. */
Lisp_Object Voverflow_newline_into_fringe;
#endif /* HAVE_WINDOW_SYSTEM */
/* Test if overflow newline into fringe. Called with iterator IT
at or past right window margin, and with IT->current_x set. */
#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) \
(!NILP (Voverflow_newline_into_fringe) \
&& FRAME_WINDOW_P (it->f) \
&& WINDOW_RIGHT_FRINGE_WIDTH (it->w) > 0 \
&& it->current_x == it->last_visible_x)
/* Non-nil means show the text cursor in void text areas /* Non-nil means show the text cursor in void text areas
i.e. in blank areas after eol and eob. This used to be i.e. in blank areas after eol and eob. This used to be
the default in 21.3. */ the default in 21.3. */
@ -5590,7 +5605,20 @@ move_it_in_display_line_to (it, to_charpos, to_x, op)
++it->hpos; ++it->hpos;
it->current_x = new_x; it->current_x = new_x;
if (i == it->nglyphs - 1) if (i == it->nglyphs - 1)
set_iterator_to_next (it, 1); {
set_iterator_to_next (it, 1);
#ifdef HAVE_WINDOW_SYSTEM
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
get_next_display_element (it);
if (ITERATOR_AT_END_OF_LINE_P (it))
{
result = MOVE_NEWLINE_OR_CR;
break;
}
}
#endif /* HAVE_WINDOW_SYSTEM */
}
} }
else else
{ {
@ -5647,6 +5675,17 @@ move_it_in_display_line_to (it, to_charpos, to_x, op)
if (it->truncate_lines_p if (it->truncate_lines_p
&& it->current_x >= it->last_visible_x) && it->current_x >= it->last_visible_x)
{ {
#ifdef HAVE_WINDOW_SYSTEM
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
get_next_display_element (it);
if (ITERATOR_AT_END_OF_LINE_P (it))
{
result = MOVE_NEWLINE_OR_CR;
break;
}
}
#endif /* HAVE_WINDOW_SYSTEM */
result = MOVE_LINE_TRUNCATED; result = MOVE_LINE_TRUNCATED;
break; break;
} }
@ -8895,26 +8934,205 @@ note_tool_bar_highlight (f, x, y)
#ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_WINDOW_SYSTEM
/* Notice that all bitmaps bits are "mirrored". */
/* An arrow like this: `<-'. */ /* An arrow like this: `<-'. */
/*
...xx...
....xx..
.....xx.
..xxxxxx
..xxxxxx
.....xx.
....xx..
...xx...
*/
static unsigned char left_bits[] = { static unsigned char left_bits[] = {
0x18, 0x0c, 0x06, 0x3f, 0x3f, 0x06, 0x0c, 0x18}; 0x18, 0x0c, 0x06, 0x3f, 0x3f, 0x06, 0x0c, 0x18};
/* Right truncation arrow bitmap `->'. */ /* Right truncation arrow bitmap `->'. */
/*
...xx...
..xx....
.xx.....
xxxxxx..
xxxxxx..
.xx.....
..xx....
...xx...
*/
static unsigned char right_bits[] = { static unsigned char right_bits[] = {
0x18, 0x30, 0x60, 0xfc, 0xfc, 0x60, 0x30, 0x18}; 0x18, 0x30, 0x60, 0xfc, 0xfc, 0x60, 0x30, 0x18};
/* Up arrow bitmap. */
/*
...xx...
..xxxx..
.xxxxxx.
xxxxxxxx
...xx...
...xx...
...xx...
...xx...
*/
static unsigned char up_arrow_bits[] = {
0x18, 0x3c, 0x7e, 0xff, 0x18, 0x18, 0x18, 0x18};
/* Down arrow bitmap. */
/*
...xx...
...xx...
...xx...
...xx...
xxxxxxxx
.xxxxxx.
..xxxx..
...xx...
*/
static unsigned char down_arrow_bits[] = {
0x18, 0x18, 0x18, 0x18, 0xff, 0x7e, 0x3c, 0x18};
/* Marker for continued lines. */ /* Marker for continued lines. */
/*
..xxxx..
.xxxxx..
xx......
xxx..x..
xxxxxx..
.xxxxx..
..xxxx..
.xxxxx..
*/
static unsigned char continued_bits[] = { static unsigned char continued_bits[] = {
0x3c, 0x7c, 0xc0, 0xe4, 0xfc, 0x7c, 0x3c, 0x7c}; 0x3c, 0x7c, 0xc0, 0xe4, 0xfc, 0x7c, 0x3c, 0x7c};
/* Marker for continuation lines. */ /* Marker for continuation lines. */
/*
..xxxx..
..xxxxx.
......xx
..x..xxx
..xxxxxx
..xxxxx.
..xxxx..
..xxxxx.
*/
static unsigned char continuation_bits[] = { static unsigned char continuation_bits[] = {
0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e}; 0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e};
/* Overlay arrow bitmap. A triangular arrow. */ /* Overlay arrow bitmap. A triangular arrow. */
/*
......xx
....xxxx
...xxxxx
..xxxxxx
..xxxxxx
...xxxxx
....xxxx
......xx
*/
static unsigned char ov_bits[] = { static unsigned char ov_bits[] = {
0x03, 0x0f, 0x1f, 0x3f, 0x3f, 0x1f, 0x0f, 0x03}; 0x03, 0x0f, 0x1f, 0x3f, 0x3f, 0x1f, 0x0f, 0x03};
/* First line bitmap. An left-up angle. */
/*
..xxxxxx
..xxxxxx
......xx
......xx
......xx
......xx
......xx
........
*/
static unsigned char first_line_bits[] = {
0x3f, 0x3f, 0x03, 0x03, 0x03, 0x03, 0x03, 0x00};
/* Last line bitmap. An left-down angle. */
/*
........
xx......
xx......
xx......
xx......
xx......
xxxxxx..
xxxxxx..
*/
static unsigned char last_line_bits[] = {
0x00, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xfc, 0xfc};
/* Filled box cursor bitmap. A filled box; max 13 pixels high. */
/*
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
.xxxxxxx
*/
static unsigned char filled_box_cursor_bits[] = {
0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f, 0x7f};
/* Hollow box cursor bitmap. A hollow box; max 13 pixels high. */
/*
.xxxxxxx
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.x.....x
.xxxxxxx
*/
static unsigned char hollow_box_cursor_bits[] = {
0x7f, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x41, 0x7f};
/* Bar cursor bitmap. A vertical bar; max 13 pixels high. */
/*
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
......xx
*/
static unsigned char bar_cursor_bits[] = {
0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03, 0x03};
/* HBar cursor bitmap. A horisontal bar; 2 pixels high. */
/*
.xxxxxxx
.xxxxxxx
*/
static unsigned char hbar_cursor_bits[] = {
0x7f, 0x7f};
/* Bitmap drawn to indicate lines not displaying text if /* Bitmap drawn to indicate lines not displaying text if
`indicate-empty-lines' is non-nil. */ `indicate-empty-lines' is non-nil. */
static unsigned char zv_bits[] = { static unsigned char zv_bits[] = {
@ -8927,32 +9145,89 @@ static unsigned char zv_bits[] = {
0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00}; 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00};
/* Hollow square bitmap. */
/*
.xxxxxx.
.x....x.
.x....x.
.x....x.
.x....x.
.xxxxxx.
*/
static unsigned char hollow_square_bits[] = {
0x7e, 0x42, 0x42, 0x42, 0x42, 0x7e};
struct fringe_bitmap fringe_bitmaps[MAX_FRINGE_BITMAPS] = struct fringe_bitmap fringe_bitmaps[MAX_FRINGE_BITMAPS] =
{ {
{ 0, 0, 0, NULL /* NO_FRINGE_BITMAP */ }, { 0, 0, 0, NULL /* NO_FRINGE_BITMAP */ },
{ 8, sizeof (left_bits), 0, left_bits }, { 8, sizeof (left_bits), 0, left_bits },
{ 8, sizeof (right_bits), 0, right_bits }, { 8, sizeof (right_bits), 0, right_bits },
{ 8, sizeof (up_arrow_bits), -1, up_arrow_bits },
{ 8, sizeof (down_arrow_bits), -2, down_arrow_bits },
{ 8, sizeof (continued_bits), 0, continued_bits }, { 8, sizeof (continued_bits), 0, continued_bits },
{ 8, sizeof (continuation_bits), 0, continuation_bits }, { 8, sizeof (continuation_bits), 0, continuation_bits },
{ 8, sizeof (ov_bits), 0, ov_bits }, { 8, sizeof (ov_bits), 0, ov_bits },
{ 8, sizeof (zv_bits), 3, zv_bits } { 8, sizeof (first_line_bits), -1, first_line_bits },
{ 8, sizeof (last_line_bits), -2, last_line_bits },
{ 8, sizeof (filled_box_cursor_bits), 0, filled_box_cursor_bits },
{ 8, sizeof (hollow_box_cursor_bits), 0, hollow_box_cursor_bits },
{ 8, sizeof (bar_cursor_bits), 0, bar_cursor_bits },
{ 8, sizeof (hbar_cursor_bits), -2, hbar_cursor_bits },
{ 8, sizeof (zv_bits), 3, zv_bits },
{ 8, sizeof (hollow_square_bits), 0, hollow_square_bits },
}; };
/* Draw the bitmap WHICH in one of the left or right fringes of /* Draw the bitmap WHICH in one of the left or right fringes of
window W. ROW is the glyph row for which to display the bitmap; it window W. ROW is the glyph row for which to display the bitmap; it
determines the vertical position at which the bitmap has to be determines the vertical position at which the bitmap has to be
drawn. */ drawn.
LEFT_P is 1 for left fringe, 0 for right fringe.
*/
static void void
draw_fringe_bitmap (w, row, which, left_p) draw_fringe_bitmap (w, row, left_p)
struct window *w; struct window *w;
struct glyph_row *row; struct glyph_row *row;
enum fringe_bitmap_type which;
int left_p; int left_p;
{ {
struct frame *f = XFRAME (WINDOW_FRAME (w)); struct frame *f = XFRAME (WINDOW_FRAME (w));
struct draw_fringe_bitmap_params p; struct draw_fringe_bitmap_params p;
enum fringe_bitmap_type which;
int period;
if (left_p)
which = row->left_fringe_bitmap;
else if (!row->cursor_in_fringe_p)
which = row->right_fringe_bitmap;
else
switch (w->phys_cursor_type)
{
case HOLLOW_BOX_CURSOR:
if (row->visible_height >= sizeof(hollow_box_cursor_bits))
which = HOLLOW_BOX_CURSOR_BITMAP;
else
which = HOLLOW_SQUARE_BITMAP;
break;
case FILLED_BOX_CURSOR:
which = FILLED_BOX_CURSOR_BITMAP;
break;
case BAR_CURSOR:
which = BAR_CURSOR_BITMAP;
break;
case HBAR_CURSOR:
which = HBAR_CURSOR_BITMAP;
break;
case NO_CURSOR:
default:
w->phys_cursor_on_p = 0;
row->cursor_in_fringe_p = 0;
which = row->right_fringe_bitmap;
break;
}
period = fringe_bitmaps[which].period;
/* Convert row to frame coordinates. */ /* Convert row to frame coordinates. */
p.y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y); p.y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
@ -8961,9 +9236,7 @@ draw_fringe_bitmap (w, row, which, left_p)
p.wd = fringe_bitmaps[which].width; p.wd = fringe_bitmaps[which].width;
p.h = fringe_bitmaps[which].height; p.h = fringe_bitmaps[which].height;
p.dh = (fringe_bitmaps[which].period p.dh = (period > 0 ? (p.y % period) : 0);
? (p.y % fringe_bitmaps[which].period)
: 0);
p.h -= p.dh; p.h -= p.dh;
/* Clip bitmap if too high. */ /* Clip bitmap if too high. */
if (p.h > row->height) if (p.h > row->height)
@ -9023,7 +9296,13 @@ draw_fringe_bitmap (w, row, which, left_p)
} }
/* Adjust y to the offset in the row to start drawing the bitmap. */ /* Adjust y to the offset in the row to start drawing the bitmap. */
p.y += (row->height - p.h) / 2; if (period == 0)
p.y += (row->height - p.h) / 2;
else if (period == -2)
{
p.h = fringe_bitmaps[which].height;
p.y += (row->visible_height - p.h);
}
FRAME_RIF (f)->draw_fringe_bitmap (w, row, &p); FRAME_RIF (f)->draw_fringe_bitmap (w, row, &p);
} }
@ -9036,8 +9315,6 @@ draw_row_fringe_bitmaps (w, row)
struct window *w; struct window *w;
struct glyph_row *row; struct glyph_row *row;
{ {
enum fringe_bitmap_type bitmap;
xassert (interrupt_input_blocked); xassert (interrupt_input_blocked);
/* If row is completely invisible, because of vscrolling, we /* If row is completely invisible, because of vscrolling, we
@ -9046,35 +9323,35 @@ draw_row_fringe_bitmaps (w, row)
return; return;
if (WINDOW_LEFT_FRINGE_WIDTH (w) != 0) if (WINDOW_LEFT_FRINGE_WIDTH (w) != 0)
{ draw_fringe_bitmap (w, row, 1);
/* Decide which bitmap to draw in the left fringe. */
if (row->overlay_arrow_p)
bitmap = OVERLAY_ARROW_BITMAP;
else if (row->truncated_on_left_p)
bitmap = LEFT_TRUNCATION_BITMAP;
else if (MATRIX_ROW_CONTINUATION_LINE_P (row))
bitmap = CONTINUATION_LINE_BITMAP;
else if (row->indicate_empty_line_p)
bitmap = ZV_LINE_BITMAP;
else
bitmap = NO_FRINGE_BITMAP;
draw_fringe_bitmap (w, row, bitmap, 1);
}
if (WINDOW_RIGHT_FRINGE_WIDTH (w) != 0) if (WINDOW_RIGHT_FRINGE_WIDTH (w) != 0)
{ draw_fringe_bitmap (w, row, 0);
/* Decide which bitmap to draw in the right fringe. */ }
if (row->truncated_on_right_p)
bitmap = RIGHT_TRUNCATION_BITMAP;
else if (row->continued_p)
bitmap = CONTINUED_LINE_BITMAP;
else if (row->indicate_empty_line_p && WINDOW_LEFT_FRINGE_WIDTH (w) == 0)
bitmap = ZV_LINE_BITMAP;
else
bitmap = NO_FRINGE_BITMAP;
draw_fringe_bitmap (w, row, bitmap, 0); /* Draw the fringes of window W. Only fringes for rows marked for
update in redraw_fringe_bitmaps_p are drawn. */
void
draw_window_fringes (w)
struct window *w;
{
struct glyph_row *row;
int yb = window_text_bottom_y (w);
int nrows = w->current_matrix->nrows;
int y = 0, rn;
if (w->pseudo_window_p)
return;
for (y = 0, rn = 0, row = w->current_matrix->rows;
y < yb && rn < nrows;
y += row->height, ++row, ++rn)
{
if (!row->redraw_fringe_bitmaps_p)
continue;
draw_row_fringe_bitmaps (w, row);
row->redraw_fringe_bitmaps_p = 0;
} }
} }
@ -9981,6 +10258,9 @@ redisplay_internal (preserve_echo_area)
#if GLYPH_DEBUG #if GLYPH_DEBUG
*w->desired_matrix->method = 0; *w->desired_matrix->method = 0;
debug_method_add (w, "optimization 1"); debug_method_add (w, "optimization 1");
#endif
#ifdef HAVE_WINDOW_SYSTEM
update_window_fringes (w, 0);
#endif #endif
goto update; goto update;
} }
@ -11394,6 +11674,137 @@ set_vertical_scroll_bar (w)
(w, end - start, whole, start); (w, end - start, whole, start);
} }
#ifdef HAVE_WINDOW_SYSTEM
/* Recalculate the bitmaps to show in the fringes of window W.
If FORCE_P is 0, only mark rows with modified bitmaps for update in
redraw_fringe_bitmaps_p; else mark all rows for update. */
int
update_window_fringes (w, force_p)
struct window *w;
int force_p;
{
struct glyph_row *row, *cur = 0;
int yb = window_text_bottom_y (w);
int rn, nrows = w->current_matrix->nrows;
int y;
int redraw_p = 0;
Lisp_Object ind;
if (w->pseudo_window_p)
return 0;
if (!MINI_WINDOW_P (w)
&& (ind = XBUFFER (w->buffer)->indicate_buffer_boundaries, !NILP (ind)))
{
int do_eob = 1, do_bob = 1;
for (y = 0, rn = 0;
y < yb && rn < nrows;
y += row->height, ++rn)
{
unsigned indicate_bob_p, indicate_top_line_p;
unsigned indicate_eob_p, indicate_bottom_line_p;
row = w->desired_matrix->rows + rn;
if (!row->enabled_p)
row = w->current_matrix->rows + rn;
indicate_bob_p = row->indicate_bob_p;
indicate_top_line_p = row->indicate_top_line_p;
indicate_eob_p = row->indicate_eob_p;
indicate_bottom_line_p = row->indicate_bottom_line_p;
row->indicate_bob_p = row->indicate_top_line_p = 0;
row->indicate_eob_p = row->indicate_bottom_line_p = 0;
if (MATRIX_ROW_START_CHARPOS (row) <= BUF_BEGV (XBUFFER (w->buffer)))
row->indicate_bob_p = do_bob, do_bob = 0;
else if (EQ (ind, Qt)
&& (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0) == rn)
row->indicate_top_line_p = 1;
if (MATRIX_ROW_END_CHARPOS (row) >= BUF_ZV (XBUFFER (w->buffer)))
row->indicate_eob_p = do_eob, do_eob = 0;
else if (EQ (ind, Qt)
&& y + row->height >= yb)
row->indicate_bottom_line_p = 1;
if (indicate_bob_p != row->indicate_bob_p
|| indicate_top_line_p != row->indicate_top_line_p
|| indicate_eob_p != row->indicate_eob_p
|| indicate_bottom_line_p != row->indicate_bottom_line_p)
row->redraw_fringe_bitmaps_p = 1;
}
}
for (y = 0, rn = 0;
y < yb && rn < nrows;
y += row->height, rn++)
{
enum fringe_bitmap_type left, right;
row = w->desired_matrix->rows + rn;
cur = w->current_matrix->rows + rn;
if (!row->enabled_p)
row = cur;
/* Decide which bitmap to draw in the left fringe. */
if (WINDOW_LEFT_FRINGE_WIDTH (w) == 0)
left = NO_FRINGE_BITMAP;
else if (row->overlay_arrow_p)
left = OVERLAY_ARROW_BITMAP;
else if (row->truncated_on_left_p)
left = LEFT_TRUNCATION_BITMAP;
else if (MATRIX_ROW_CONTINUATION_LINE_P (row))
left = CONTINUATION_LINE_BITMAP;
else if (row->indicate_empty_line_p)
left = ZV_LINE_BITMAP;
else if (row->indicate_bob_p)
left = FIRST_LINE_BITMAP;
else
left = NO_FRINGE_BITMAP;
/* Decide which bitmap to draw in the right fringe. */
if (WINDOW_RIGHT_FRINGE_WIDTH (w) == 0)
right = NO_FRINGE_BITMAP;
else if (row->truncated_on_right_p)
right = RIGHT_TRUNCATION_BITMAP;
else if (row->continued_p)
right = CONTINUED_LINE_BITMAP;
else if (row->indicate_eob_p)
right = LAST_LINE_BITMAP;
else if (row->indicate_top_line_p)
right = UP_ARROW_BITMAP;
else if (row->indicate_bottom_line_p)
right = DOWN_ARROW_BITMAP;
else if (row->indicate_empty_line_p && WINDOW_LEFT_FRINGE_WIDTH (w) == 0)
right = ZV_LINE_BITMAP;
else
right = NO_FRINGE_BITMAP;
if (force_p
|| row->y != cur->y
|| row->visible_height != cur->visible_height
|| left != cur->left_fringe_bitmap
|| right != cur->right_fringe_bitmap
|| cur->redraw_fringe_bitmaps_p)
{
redraw_p = row->redraw_fringe_bitmaps_p = cur->redraw_fringe_bitmaps_p = 1;
cur->left_fringe_bitmap = left;
cur->right_fringe_bitmap = right;
}
row->left_fringe_bitmap = left;
row->right_fringe_bitmap = right;
}
return redraw_p;
}
#endif /* HAVE_WINDOW_SYSTEM */
/* Redisplay leaf window WINDOW. JUST_THIS_ONE_P non-zero means only /* Redisplay leaf window WINDOW. JUST_THIS_ONE_P non-zero means only
selected_window is redisplayed. selected_window is redisplayed.
@ -11416,6 +11827,7 @@ redisplay_window (window, just_this_one_p)
struct it it; struct it it;
/* Record it now because it's overwritten. */ /* Record it now because it's overwritten. */
int current_matrix_up_to_date_p = 0; int current_matrix_up_to_date_p = 0;
int used_current_matrix_p = 0;
/* This is less strict than current_matrix_up_to_date_p. /* This is less strict than current_matrix_up_to_date_p.
It indictes that the buffer contents and narrowing are unchanged. */ It indictes that the buffer contents and narrowing are unchanged. */
int buffer_unchanged_p = 0; int buffer_unchanged_p = 0;
@ -11722,6 +12134,7 @@ redisplay_window (window, just_this_one_p)
switch (rc) switch (rc)
{ {
case CURSOR_MOVEMENT_SUCCESS: case CURSOR_MOVEMENT_SUCCESS:
used_current_matrix_p = 1;
goto done; goto done;
#if 0 /* try_cursor_movement never returns this value. */ #if 0 /* try_cursor_movement never returns this value. */
@ -11786,7 +12199,8 @@ redisplay_window (window, just_this_one_p)
buffer. */ buffer. */
|| !NILP (Vwindow_scroll_functions) || !NILP (Vwindow_scroll_functions)
|| MINI_WINDOW_P (w) || MINI_WINDOW_P (w)
|| !try_window_reusing_current_matrix (w)) || !(used_current_matrix_p =
try_window_reusing_current_matrix (w)))
{ {
IF_DEBUG (debug_method_add (w, "1")); IF_DEBUG (debug_method_add (w, "1"));
try_window (window, startp); try_window (window, startp);
@ -11915,7 +12329,8 @@ redisplay_window (window, just_this_one_p)
|| !NILP (Vwindow_scroll_functions) || !NILP (Vwindow_scroll_functions)
|| !just_this_one_p || !just_this_one_p
|| MINI_WINDOW_P (w) || MINI_WINDOW_P (w)
|| !try_window_reusing_current_matrix (w)) || !(used_current_matrix_p =
try_window_reusing_current_matrix (w)))
try_window (window, startp); try_window (window, startp);
/* If new fonts have been loaded (due to fontsets), give up. We /* If new fonts have been loaded (due to fontsets), give up. We
@ -12077,6 +12492,19 @@ redisplay_window (window, just_this_one_p)
#endif #endif
} }
#ifdef HAVE_WINDOW_SYSTEM
if (update_window_fringes (w, 0)
&& (used_current_matrix_p || overlay_arrow_seen)
&& !w->pseudo_window_p)
{
update_begin (f);
BLOCK_INPUT;
draw_window_fringes (w);
UNBLOCK_INPUT;
update_end (f);
}
#endif /* HAVE_WINDOW_SYSTEM */
/* We go to this label, with fonts_changed_p nonzero, /* We go to this label, with fonts_changed_p nonzero,
if it is necessary to try again using larger glyph matrices. if it is necessary to try again using larger glyph matrices.
We have to redeem the scroll bar even in this case, We have to redeem the scroll bar even in this case,
@ -12334,6 +12762,7 @@ try_window_reusing_current_matrix (w)
row->visible_height -= min_y - row->y; row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y) if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y; row->visible_height -= row->y + row->height - max_y;
row->redraw_fringe_bitmaps_p = 1;
it.current_y += row->height; it.current_y += row->height;
@ -12473,7 +12902,6 @@ try_window_reusing_current_matrix (w)
if (run.height) if (run.height)
{ {
struct frame *f = XFRAME (WINDOW_FRAME (w));
update_begin (f); update_begin (f);
FRAME_RIF (f)->update_window_begin_hook (w); FRAME_RIF (f)->update_window_begin_hook (w);
FRAME_RIF (f)->clear_window_mouse_face (w); FRAME_RIF (f)->clear_window_mouse_face (w);
@ -12494,6 +12922,7 @@ try_window_reusing_current_matrix (w)
row->visible_height -= min_y - row->y; row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y) if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y; row->visible_height -= row->y + row->height - max_y;
row->redraw_fringe_bitmaps_p = 1;
} }
/* Scroll the current matrix. */ /* Scroll the current matrix. */
@ -12616,7 +13045,8 @@ find_last_unchanged_at_beg_row (w)
row is not unchanged because it may be no longer row is not unchanged because it may be no longer
continued. */ continued. */
&& !(MATRIX_ROW_END_CHARPOS (row) == first_changed_pos && !(MATRIX_ROW_END_CHARPOS (row) == first_changed_pos
&& row->continued_p)) && (row->continued_p
|| row->exact_window_width_line_p)))
row_found = row; row_found = row;
/* Stop if last visible row. */ /* Stop if last visible row. */
@ -14512,7 +14942,20 @@ display_line (it)
it->continuation_lines_width += new_x; it->continuation_lines_width += new_x;
++it->hpos; ++it->hpos;
if (i == nglyphs - 1) if (i == nglyphs - 1)
set_iterator_to_next (it, 1); {
set_iterator_to_next (it, 1);
#ifdef HAVE_WINDOW_SYSTEM
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
get_next_display_element (it);
if (ITERATOR_AT_END_OF_LINE_P (it))
{
row->continued_p = 0;
row->exact_window_width_line_p = 1;
}
}
#endif /* HAVE_WINDOW_SYSTEM */
}
} }
else if (CHAR_GLYPH_PADDING_P (*glyph) else if (CHAR_GLYPH_PADDING_P (*glyph)
&& !FRAME_WINDOW_P (it->f)) && !FRAME_WINDOW_P (it->f))
@ -14614,6 +15057,7 @@ display_line (it)
break; break;
} }
at_end_of_line:
/* Is this a line end? If yes, we're also done, after making /* Is this a line end? If yes, we're also done, after making
sure that a non-default face is extended up to the right sure that a non-default face is extended up to the right
margin of the window. */ margin of the window. */
@ -14623,9 +15067,12 @@ display_line (it)
row->ends_in_newline_from_string_p = STRINGP (it->object); row->ends_in_newline_from_string_p = STRINGP (it->object);
#ifdef HAVE_WINDOW_SYSTEM
/* Add a space at the end of the line that is used to /* Add a space at the end of the line that is used to
display the cursor there. */ display the cursor there. */
append_space (it, 0); if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
append_space (it, 0);
#endif /* HAVE_WINDOW_SYSTEM */
/* Extend the face to the end of the line. */ /* Extend the face to the end of the line. */
extend_face_to_end_of_line (it); extend_face_to_end_of_line (it);
@ -14666,6 +15113,21 @@ display_line (it)
produce_special_glyphs (it, IT_TRUNCATION); produce_special_glyphs (it, IT_TRUNCATION);
} }
} }
#ifdef HAVE_WINDOW_SYSTEM
else
{
/* Don't truncate if we can overflow newline into fringe. */
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
get_next_display_element (it);
if (ITERATOR_AT_END_OF_LINE_P (it))
{
row->exact_window_width_line_p = 1;
goto at_end_of_line;
}
}
}
#endif /* HAVE_WINDOW_SYSTEM */
row->truncated_on_right_p = 1; row->truncated_on_right_p = 1;
it->continuation_lines_width = 0; it->continuation_lines_width = 0;
@ -19213,36 +19675,53 @@ notice_overwritten_cursor (w, area, x0, x1, y0, y1)
enum glyph_row_area area; enum glyph_row_area area;
int x0, y0, x1, y1; int x0, y0, x1, y1;
{ {
if (area == TEXT_AREA && w->phys_cursor_on_p) int cx0, cx1, cy0, cy1;
struct glyph_row *row;
if (!w->phys_cursor_on_p)
return;
if (area != TEXT_AREA)
return;
row = w->current_matrix->rows + w->phys_cursor.vpos;
if (!row->displays_text_p)
return;
if (row->cursor_in_fringe_p)
{ {
int cx0 = w->phys_cursor.x; row->cursor_in_fringe_p = 0;
int cx1 = cx0 + w->phys_cursor_width; draw_fringe_bitmap (w, row, 0);
int cy0 = w->phys_cursor.y; w->phys_cursor_on_p = 0;
int cy1 = cy0 + w->phys_cursor_height; return;
if (x0 <= cx0 && (x1 < 0 || x1 >= cx1))
{
/* The cursor image will be completely removed from the
screen if the output area intersects the cursor area in
y-direction. When we draw in [y0 y1[, and some part of
the cursor is at y < y0, that part must have been drawn
before. When scrolling, the cursor is erased before
actually scrolling, so we don't come here. When not
scrolling, the rows above the old cursor row must have
changed, and in this case these rows must have written
over the cursor image.
Likewise if part of the cursor is below y1, with the
exception of the cursor being in the first blank row at
the buffer and window end because update_text_area
doesn't draw that row. (Except when it does, but
that's handled in update_text_area.) */
if (((y0 >= cy0 && y0 < cy1) || (y1 > cy0 && y1 < cy1))
&& w->current_matrix->rows[w->phys_cursor.vpos].displays_text_p)
w->phys_cursor_on_p = 0;
}
} }
cx0 = w->phys_cursor.x;
cx1 = cx0 + w->phys_cursor_width;
if (x0 > cx0 || (x1 >= 0 && x1 < cx1))
return;
/* The cursor image will be completely removed from the
screen if the output area intersects the cursor area in
y-direction. When we draw in [y0 y1[, and some part of
the cursor is at y < y0, that part must have been drawn
before. When scrolling, the cursor is erased before
actually scrolling, so we don't come here. When not
scrolling, the rows above the old cursor row must have
changed, and in this case these rows must have written
over the cursor image.
Likewise if part of the cursor is below y1, with the
exception of the cursor being in the first blank row at
the buffer and window end because update_text_area
doesn't draw that row. (Except when it does, but
that's handled in update_text_area.) */
cy0 = w->phys_cursor.y;
cy1 = cy0 + w->phys_cursor_height;
if ((y0 < cy0 || y0 >= cy1) && (y1 <= cy0 || y1 >= cy1))
return;
w->phys_cursor_on_p = 0;
} }
#endif /* HAVE_WINDOW_SYSTEM */ #endif /* HAVE_WINDOW_SYSTEM */
@ -19377,6 +19856,14 @@ erase_phys_cursor (w)
if (cursor_row->visible_height <= 0) if (cursor_row->visible_height <= 0)
goto mark_cursor_off; goto mark_cursor_off;
/* If cursor is in the fringe, erase by drawing actual bitmap there. */
if (cursor_row->cursor_in_fringe_p)
{
cursor_row->cursor_in_fringe_p = 0;
draw_fringe_bitmap (w, cursor_row, 0);
goto mark_cursor_off;
}
/* This can happen when the new row is shorter than the old one. /* This can happen when the new row is shorter than the old one.
In this case, either draw_glyphs or clear_end_of_line In this case, either draw_glyphs or clear_end_of_line
should have cleared the cursor. Note that we wouldn't be should have cleared the cursor. Note that we wouldn't be
@ -21533,12 +22020,23 @@ wide as that tab on the display. */);
#endif #endif
DEFVAR_LISP ("show-trailing-whitespace", &Vshow_trailing_whitespace, DEFVAR_LISP ("show-trailing-whitespace", &Vshow_trailing_whitespace,
doc: /* Non-nil means highlight trailing whitespace. doc: /* *Non-nil means highlight trailing whitespace.
The face used for trailing whitespace is `trailing-whitespace'. */); The face used for trailing whitespace is `trailing-whitespace'. */);
Vshow_trailing_whitespace = Qnil; Vshow_trailing_whitespace = Qnil;
#ifdef HAVE_WINDOW_SYSTEM
DEFVAR_LISP ("overflow-newline-into-fringe", &Voverflow_newline_into_fringe,
doc: /* *Non-nil means that newline may flow into the right fringe.
This means that display lines which are exactly as wide as the window
(not counting the final newline) will only occupy one screen line, by
showing (or hiding) the final newline in the right fringe; when point
is at the final newline, the cursor is shown in the right fringe.
If nil, also continue lines which are exactly as wide as the window. */);
Voverflow_newline_into_fringe = Qt;
#endif
DEFVAR_LISP ("void-text-area-pointer", &Vvoid_text_area_pointer, DEFVAR_LISP ("void-text-area-pointer", &Vvoid_text_area_pointer,
doc: /* The pointer shape to show in void text areas. doc: /* *The pointer shape to show in void text areas.
Nil means to show the text pointer. Other options are `arrow', `text', Nil means to show the text pointer. Other options are `arrow', `text',
`hand', `vdrag', `hdrag', `modeline', and `hourglass'. */); `hand', `vdrag', `hdrag', `modeline', and `hourglass'. */);
Vvoid_text_area_pointer = Qarrow; Vvoid_text_area_pointer = Qarrow;

38
src/xterm.c
View File

@ -571,6 +571,9 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p)
output_cursor.x, output_cursor.y); output_cursor.x, output_cursor.y);
x_draw_vertical_border (w); x_draw_vertical_border (w);
draw_window_fringes (w);
UNBLOCK_INPUT; UNBLOCK_INPUT;
} }
@ -650,11 +653,7 @@ x_after_update_window_line (desired_row)
xassert (w); xassert (w);
if (!desired_row->mode_line_p && !w->pseudo_window_p) if (!desired_row->mode_line_p && !w->pseudo_window_p)
{ desired_row->redraw_fringe_bitmaps_p = 1;
BLOCK_INPUT;
draw_row_fringe_bitmaps (w, desired_row);
UNBLOCK_INPUT;
}
/* When a window has disappeared, make sure that no rest of /* When a window has disappeared, make sure that no rest of
full-width rows stays visible in the internal border. Could full-width rows stays visible in the internal border. Could
@ -698,9 +697,24 @@ x_draw_fringe_bitmap (w, row, p)
Window window = FRAME_X_WINDOW (f); Window window = FRAME_X_WINDOW (f);
GC gc = f->output_data.x->normal_gc; GC gc = f->output_data.x->normal_gc;
struct face *face = p->face; struct face *face = p->face;
int rowY;
/* Must clip because of partially visible lines. */ /* Must clip because of partially visible lines. */
x_clip_to_row (w, row, gc); rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
if (p->y < rowY)
{
/* Adjust position of "bottom aligned" bitmap on partially
visible last row. */
int oldY = row->y;
int oldVH = row->visible_height;
row->visible_height = p->h;
row->y -= rowY - p->y;
x_clip_to_row (w, row, gc);
row->y = oldY;
row->visible_height = oldVH;
}
else
x_clip_to_row (w, row, gc);
if (p->bx >= 0) if (p->bx >= 0)
{ {
@ -6314,6 +6328,11 @@ handle_one_xevent (dpyinfo, eventp, bufp_r, numcharsp, finish)
&compose_status); &compose_status);
#endif #endif
/* If not using XIM/XIC, and a compose sequence is in progress,
we break here. Otherwise, chars_matched is always 0. */
if (compose_status.chars_matched > 0 && nbytes == 0)
break;
orig_keysym = keysym; orig_keysym = keysym;
if (numchars > 1) if (numchars > 1)
@ -7452,6 +7471,13 @@ x_draw_window_cursor (w, glyph_row, x, y, cursor_type, cursor_width, on_p, activ
w->phys_cursor_type = cursor_type; w->phys_cursor_type = cursor_type;
w->phys_cursor_on_p = 1; w->phys_cursor_on_p = 1;
if (glyph_row->exact_window_width_line_p
&& w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA])
{
glyph_row->cursor_in_fringe_p = 1;
draw_fringe_bitmap (w, glyph_row, 0);
}
else
switch (cursor_type) switch (cursor_type)
{ {
case HOLLOW_BOX_CURSOR: case HOLLOW_BOX_CURSOR: