procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-79

Browse source 
Merge from emacs--cvs-trunk--0

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-735
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-747
   Update from CVS
This commit is contained in:
Miles Bader 2004-12-25 02:00:25 +00:00
commit 6a89b7e95a
76 changed files with 2287 additions and 1411 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
admin/FOR-RELEASE
View file

@ -57,7 +57,7 @@ Trying 192.87.102.36...
Connected to ftp.nluug.nl.
Ange-ftp chokes on the `No route to host' message and doesn't look any
further.
further.
I think in the near future we will see more of this problem, so it might be
time to make anfe-ftp more intelligent.
@ -112,6 +112,28 @@ we come to mark the http buffers as dead.
* REDISPLAY RELATED BUGS
** Strange text scrolling with Emacs + GTK
> I could reproduce the problem with the latest CVS.
>
> % emacs -Q
> M-x info RET
> M->
> C-l
> C-x ( C-u - 1 C-v C-x )
> C-x e e e e ...
>
> I see the problem around "CC mode" and "Forms".
It is not specific for the first line of a buffer.
Rather it happens for lines which are indented but the
indentation is controlled by a display property and
the newline is part of that display property -- in
that case, the indentation is not recognized for the
first display line.
** Avoid unbreakable loops in redisplay.
Redisplay may loop if there is an error in some display property, e.g.

543
configure vendored
View file

File diff suppressed because it is too large Load diff

8
etc/ChangeLog
View file

@ -1,3 +1,11 @@
2004-12-21 Richard M. Stallman <rms@gnu.org>
* DISTRIB: Don't say "freeware".
2004-12-15 Nick Roberts <nickrob@snap.net.nz>
* DEBUG: Change printing example to break on a procedure name.
2004-12-11 Dan Nicolaescu <dann@ics.uci.edu>
* e/eterm.ti: Add rs1.

24
etc/DEBUG
View file

@ -107,36 +107,32 @@ objects which you can examine in turn with the x... commands.
Even with a live process, these x... commands are useful for
examining the fields in a buffer, window, process, frame or marker.
Here's an example using concepts explained in the node "Value History"
of the GDB manual to print the variable frame from this line in
xmenu.c:
buf.frame_or_window = frame;
First, use these commands:
of the GDB manual to print values associated with the variable
called frame. First, use these commands:
cd src
gdb emacs
b xmenu.c:1296
b set_frame_buffer_list
r -q
Then type C-x 5 2 to create a new frame, and it hits the breakpoint:
Then when Emacs it hits the breakpoint:
(gdb) p frame
$1 = 1077872640
$1 = 139854428
(gdb) xtype
Lisp_Vectorlike
PVEC_FRAME
(gdb) xframe
$2 = (struct frame *) 0x3f0800
$2 = (struct frame *) 0x8560258
(gdb) p *$
$3 = {
size = 536871989,
next = 0x366240,
name = 809661752,
size = 1073742931,
next = 0x85dfe58,
name = 140615219,
[...]
}
(gdb) p $3->name
$4 = 809661752
$4 = 140615219
Now we can use `pr' to print the name of the frame:

2
etc/DISTRIB
View file

@ -83,7 +83,7 @@ product and divide it by five, that is a good amount.
If you like GNU Emacs, please express your satisfaction with a
donation: send me or the Foundation what you feel Emacs has been worth
to you. If you are glad that I developed GNU Emacs and distribute it
as freeware, rather than following the obstructive and antisocial
as free software, rather than following the obstructive and antisocial
practices typical of software developers, reward me. If you would
like the Foundation to develop more free software, contribute.

85
etc/NEWS
View file

@ -173,27 +173,45 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
** You can now follow links by clicking Mouse-1 on the link.
Traditionally, Emacs uses a Mouse-1 click to set point and a Mouse-2
click to follow a link, whereas most other applications use a Mouse-1
click for both purposes, depending on whether you click outside or
inside a link. With release 21.4, the behaviour of a Mouse-1 click
has been changed to match this context-sentitive dual behaviour.
Depending on the current mode, a Mouse-2 click in Emacs may do much
more than just follow a link, so the new Mouse-1 behaviour is only
activated for modes which explicitly mark a clickable text as a "link"
(see the new function `mouse-on-link-p' for details). The lisp
packages that are included in release 21.4 have been adapted to do
this, but external packages may not yet support this. However, there
is no risk in using such packages, as the worst thing that could
happen is that you get the original Mouse-1 behaviour when you click
on a link, which typically means that you set point where you click.
If you want to get the original Mouse-1 action also inside a link, you
just need to press the Mouse-1 button a little longer than a normal
click (i.e. press and hold the Mouse-1 button for half a second before
you release it).
Dragging the Mouse-1 inside a link still performs the original
drag-mouse-1 action, typically copy the text.
You can customize the new Mouse-1 behaviour via the new user option
`mouse-1-click-follows-link'.
+++
** When the undo information of the current command gets really large
(beyond the value of `undo-outer-limit'), Emacs asks you whether to
discard it or keep it.
** line-move-ignore-invisible now defaults to t.
** In Outline mode, hide-body no longer hides lines at the top
of the file that precede the first header line.
+++
** `set-auto-mode' now gives the interpreter magic line (if present)
precedence over the file name. Likewise an <?xml or <!DOCTYPE declaration
will give the buffer XML or SGML mode, based on the new var
`magic-mode-alist'.
+++
** New function `looking-back' checks whether a regular expression matches
the text before point. Specifying the LIMIT argument bounds how far
back the match can start; this is a way to keep it from taking too long.
+++
** New functions `make-progress-reporter', `progress-reporter-update',
`progress-reporter-force-update' and `progress-reporter-done' provide
a simple and efficient way of printing progress messages to the user.
+++
** In Enriched mode, `set-left-margin' and `set-right-margin' are now
by default bound to `C-c [' and `C-c ]' instead of the former `C-c C-l'
@ -1160,9 +1178,11 @@ All regular expression replacement commands now allow `\?' in the
replacement string to specify a position where the replacement string
can be edited for each replacement.
** query-replace uses isearch highlighting with lazy highlighting
when the user option `query-replace-highlight' is set to `isearch'.
If it is t, it uses old query-replace highlighting method.
** query-replace uses isearch lazy highlighting when the new user option
`query-replace-lazy-highlight' is non-nil.
** The current match in query-replace is highlighted in new face
`query-replace' which by default inherits from isearch face.
+++
** Emacs normally highlights mouse sensitive text whenever the mouse
@ -1497,9 +1517,8 @@ previous mark, i.e. C-u C-SPC C-SPC C-SPC ... cycles through the
mark ring. Use C-u C-u C-SPC to set the mark immediately after a jump.
** Movement commands `beginning-of-buffer', `end-of-buffer',
`beginning-of-defun', `end-of-defun' do not set the mark if the new
option `inhibit-mark-movement' is non-nil, or if the mark is already
active in Transient Mark mode.
`beginning-of-defun', `end-of-defun' do not set the mark if the mark
is already active in Transient Mark mode.
+++
** In the *Occur* buffer, `o' switches to it in another window, and
@ -2446,11 +2465,33 @@ configuration files.
* Lisp Changes in Emacs 21.4
** Lisp code can now test if a given buffer position is inside a
clickable link with the new function `mouse-on-link-p'. This is the
function used by the new `mouse-1-click-follows-link' functionality.
+++
** (while-no-input BODY...) runs BODY, but only so long as no input
arrives. If the user types or clicks anything, BODY stops as if a
quit had occurred. while-no-input returns the value of BODY, if BODY
finishes. It returns nil if BODY was aborted.
+++
** `set-auto-mode' now gives the interpreter magic line (if present)
precedence over the file name. Likewise an <?xml or <!DOCTYPE declaration
will give the buffer XML or SGML mode, based on the new var
`magic-mode-alist'.
+++
** New function `looking-back' checks whether a regular expression matches
the text before point. Specifying the LIMIT argument bounds how far
back the match can start; this is a way to keep it from taking too long.
+++
** New functions `make-progress-reporter', `progress-reporter-update',
`progress-reporter-force-update' and `progress-reporter-done' provide
a simple and efficient way for a command to present progress messages
for the user.
---
** To manipulate the File menu using easy-menu, you must specify the
proper name "file". In previous Emacs versions, you had to specify

5
lib-src/ChangeLog
View file

@ -1,3 +1,8 @@
2004-12-15 Andreas Schwab <schwab@suse.de>
* etags.c (main): Fix typo in conversion of LONG_OPTIONS from
preprocessing to compile time constant.
2004-11-17 Kim F. Storm <storm@cua.dk>
* etags.c: Undo last change.

4
lib-src/etags.c
View file

@ -1,5 +1,5 @@
/* Tags file maker to go with GNU Emacs -*- coding: latin-1 -*-
Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2001, 2002
Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2001, 2002, 2004
Free Software Foundation, Inc. and Ken Arnold
This file is not considered part of GNU Emacs.
@ -1183,7 +1183,7 @@ main (argc, argv)
#ifdef ETAGS_REGEXPS
optstring = "-r:Rc:";
#endif /* ETAGS_REGEXPS */
if (LONG_OPTIONS)
if (!LONG_OPTIONS)
optstring += 1;
optstring = concat (optstring,
"Cf:Il:o:SVhH",

277
lisp/ChangeLog
View file

@ -1,3 +1,280 @@
2004-12-24 Thien-Thi Nguyen <ttn@gnu.org>
* progmodes/hideshow.el: Require `cl' when compiling.
Remove XEmacs and Emacs 19 compatibility.
Use `dolist' and `add-to-list' for load-time actions.
(hs-discard-overlays): Use `dolist'.
(hs-show-block): Likewise.
2004-12-23 Dan Nicolaescu <dann@ics.uci.edu>
* faces.el (mode-line, mode-line-inactive): Use min-colors.
2004-12-23 Thien-Thi Nguyen <ttn@gnu.org>
* progmodes/hideshow.el (hs-inside-comment-p): Fix omission bug:
When extending backwards, move outside the current comment first.
2004-12-22 Kenichi Handa <handa@m17n.org>
* international/quail.el (quail-start-translation): Fix prompt
string for the case if input-method-use-echo-area being non-nil.
(quail-start-conversion): Likewise.
(quail-show-guidance): Don't show guidance if
input-method-use-echo-area is non-nil.
2004-12-21 Richard M. Stallman <rms@gnu.org>
* textmodes/ispell.el (ispell-help): Bind resize-mini-windows.
2004-12-21 Markus Rost <rost@ias.edu>
* calendar/diary-lib.el (mark-diary-entries): Set
mark-diary-entries-in-calendar only after checking for diary-file.
2004-12-21 Richard M. Stallman <rms@gnu.org>
* faces.el (escape-glyph): Use blue against light foreground.
* simple.el (undo-outer-limit-truncate): New function.
(undo-outer-limit-function): Use undo-outer-limit-truncate.
2004-12-21 Eli Barzilay <eli@barzilay.org>
* calculator.el: (calculator-radix-grouping-mode)
(calculator-radix-grouping-digits)
(calculator-radix-grouping-separator):
New defcustoms for the new radix grouping mode functionality.
(calculator-mode-hook): Now used in electric mode too.
(calculator-mode-map): Some new keys.
(calculator-message): New function. Some new calls.
(calculator-string-to-number): New function,
(calculator-curnum-value): Use it.
(calculator-rotate-displayer, calculator-rotate-displayer-back)
(calculator-displayer-prev, calculator-displayer-next):
Change digit group size when in radix mode.
(calculator-number-to-string): Renamed from calculator-num-to-string.
Now deals with digit grouping in radix mode.
2004-12-20 Glenn Morris <gmorris@ast.cam.ac.uk>
* calendar/calendar.el (view-other-diary-entries): Add autoload.
* calendar/diary-lib.el (view-other-diary-entries): Use
current-prefix-arg in interactive spec.
2004-12-19 Jay Belanger <belanger@truman.edu>
* calc/calc-aent.el (calcAlg-blank-matching-open):
Temporarily adjust the syntax of both delimiters of half-open
intervals.
2004-12-19 Kim F. Storm <storm@cua.dk>
* mouse.el (mouse-1-click-follows-link): Doc fix.
2004-12-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* term/mac-win.el (encoding-vector, mac-font-encoder-list)
(ccl-encode-mac-centraleurroman-font): Use centraleurroman
instead of centraleuropean as the name
2004-12-17 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.46.
* net/tramp.el (tramp-maybe-send-perl-script): Change order of
parameters wrt Tramp convention.
(tramp-handle-file-attributes-with-perl)
(tramp-handle-directory-files-and-attributes): Apply it.
(tramp-do-copy-or-rename-file-out-of-band): Check for existence of
`copy-program'. Reported by Zack Weinberg
<zack@codesourcery.com>.
(top): Set `edebug-form-spec' property directly rather than
calling `def-edebug-spec'.
* net/tramp-smb.el (tramp-smb-advice-PC-do-completion): Make the
advice less fragile. Surround temporary redefinition of
`substitute-in-file-name' with `unwind-protect'. Suggested by
Matt Hodges <MPHodges@member.fsf.org>.
2004-12-17 Juri Linkov <juri@jurta.org>
* replace.el (occur-accumulate-lines, occur-engine):
Make forcing deferred font-lock fontification jit-specific.
2004-12-17 Kim F. Storm <storm@cua.dk>
* mouse.el (mouse-1-click-follows-link): New defcustom.
(mouse-on-link-p): New function.
(mouse-drag-region-1): Implement mouse-1-click-follows-link
functionality. Map a mouse-1 click event into a mouse-2 (or
other) event when position is inside a link.
* tooltip.el (tooltip-show-help-function): Replace "mouse-2"
prefix in tooltip text with "mouse-1" when this is a link
recognized by mouse-1-click-follows-link functionality.
* help.el (describe-key): Report effective and original binding
for mouse-1 when clicked on a link.
(describe-mode): Add follow-link property to "minor-mode" button.
* help-fns.el (describe-variable): Add follow-link property to
"below" button.
* help-mode.el (help-xref): Add follow-link property.
* apropos.el (apropos-symbol, apropos-function, apropos-macro)
(apropos-command, apropos-variable, apropos-face, apropos-group)
(apropos-widget, apropos-plist): Add follow-link property.
* pcvs-defs.el (cvs-mode-map): Map follow-link to a function which
checks if position is in a filename, rather than some other
clickable item. Function looks for cvs-filename-face at position.
* wid-edit.el (widget-specify-field, widget-specify-button):
Map a :follow-link keyword into a follow-link property.
(link): Add :follow-link keyword, map to RET binding.
* dired.el (dired-mode-map): Map follow-link to mouse-face.
* progmodes/compile.el (compilation-minor-mode-map)
(compilation-button-map, compilation-mode-map): Likewise.
2004-12-17 Thien-Thi Nguyen <ttn@gnu.org>
* play/zone.el (zone): Init `line-spacing' from orig buffer.
(zone-replace-char): Take `count' and `del-count'
instead of `direction'. Update callers. When `del-count' is
non-nil, delete that many characters, otherwise `count' characters
backwards. Insert the newly-replaced string `count' times.
(zone-fret): Handle chars w/ width greater than one.
(zone-fall-through-ws): No longer take window width `ww'.
Update callers. Add handling for `char-width' greater than one.
(zone-pgm-drip): Update var holding window-end position every cycle.
2004-12-17 Andre Spiegel <spiegel@gnu.org>
* vc.el (vc-default-update-changelog): Use insert-file-contents,
rather than insert-file.
2004-12-16 Jay Belanger <belanger@truman.edu>
* calc/calc-comb.el (var-RandSeed): Don't initially bind it.
(math-init-random-base, math-random-digit): Check to see if
var-RandSeed is bound.
(math-random-last): Declare it.
(math-random-digit): Don't make math-random-last local.
2004-12-16 Thien-Thi Nguyen <ttn@gnu.org>
* play/zone.el (zone): Fix omission bug: Use a self-disabling
one-shot thunk for uniform (error, quit, normal) recovery.
Reported by John Paul Wallington.
(zone-pgm-random-life): Fix bug:
Recognize empty initial field by lack of "@" chars.
2004-12-16 Juri Linkov <juri@jurta.org>
* help.el (function-called-at-point):
* help-fns.el (variable-at-point): As a last resort try striping
non-word prefixes and suffixes.
* descr-text.el (describe-property-list): Don't treat syntax-table
specially. Use describe-text-sexp which inserts [show] button
for large objects and handles printing errors. Sort properties
by names in alphabetical order instead of by value sizes.
Add `mouse-face' to list of properties for `describe-face' widget.
(describe-char): Mask out face-id from 19 bits of character.
Print face-id separately.
* replace.el (occur-accumulate-lines, occur-engine):
Fontify unfontified matching lines in the source buffer
before copying them.
(occur-engine): Don't put mouse-face on context lines.
(occur-next-error): Set point to line beginning/end
before searching for prev/next property to skip multiple
matches on a line (not supported by occur engine).
Remove redundant prefix-numeric-value.
2004-12-15 Juri Linkov <juri@jurta.org>
* replace.el (match): New face.
(list-matching-lines-face): Change default from `bold' to `match'.
* progmodes/grep.el (grep-match-face): New defvar.
(grep-mode-font-lock-keywords): Use grep-match-face instead of
compilation-column-face to highlight grep matches.
* apropos.el (apropos-match-face): Change default from
`secondary-selection' to `match'.
* info-look.el (info-lookup-highlight-face): Change default from
`highlight' to `match'.
2004-12-15 Daniel Pfeiffer <occitan@esperanto.org>
* progmodes/executable.el (executable-interpret): Eliminate
obsolete compile-internal, and switch to comint for interaction.
2004-12-15 J.D. Smith <jdsmith@as.arizona.edu>
* progmodes/idlwave.el (idlwave-skip-multi-commands): Don't match
`&&' when skipping multiple statements on a line.
2004-12-15 Thien-Thi Nguyen <ttn@gnu.org>
* play/zone.el (zone): Set `truncate-lines'.
Also, init `tab-width' with value from original buffer.
(zone-shift-up): Rewrite for speed.
(zone-shift-down, zone-shift-left, zone-shift-right): Likewise.
(zone-pgm-jitter): Remove redundant entries from ops vector.
(zone-exploding-remove): Reduce iteration count.
(zone-cpos): Convert to defsubst.
(zone-replace-char): New defsubst.
(zone-park/sit-for): Likewise.
(zone-fret): Take window-start arg.
Update callers. Use `zone-park/sit-for'.
(zone-fill-out-screen): Rewrite.
(zone-fall-through-ws): Likewise. Update callers.
(zone-pgm-drip): Use `zone-replace-char'.
Move var inits before while-loop. Use `zone-park/sit-for'.
(zone-pgm-random-life): Handle empty initial field.
Use `zone-replace-char' and `zone-park/sit-for'.
2004-12-15 Juri Linkov <juri@jurta.org>
* isearch.el (isearch-update): Test isearch-lazy-highlight
before calling isearch-lazy-highlight-new-loop.
(isearch-lazy-highlight-new-loop):
Don't test isearch-lazy-highlight.
* replace.el (perform-replace): Add isearch-case-fold-search.
Use delimited-flag for isearch-regexp.
Reset isearch-lazy-highlight-last-string to force lazy
highlighting when called from isearch mode.
(query-replace-highlight): Revert defcustom type to boolean.
(query-replace-lazy-highlight): New defcustom.
(query-replace): New face.
(perform-replace, replace-highlight, replace-dehighlight):
Test query-replace-lazy-highlight instead of special value
`isearch' of query-replace-highlight.
(replace-dehighlight): Don't call isearch-dehighlight.
(replace-highlight): Don't call isearch-highlight.
Use face `query-replace' unconditionally.
2004-12-14 Kim F. Storm <storm@cua.dk>
* simple.el (inhibit-mark-movement): Remove defvar.
(beginning-of-buffer, end-of-buffer): Don't use it.
* emacs-lisp/lisp.el (beginning-of-defun, end-of-defun): Don't
use inhibit-mark-movement.
* emulation/cua-base.el (cua--preserve-mark-commands): Remove.
(cua--undo-push-mark): Remove.
(cua--pre-command-handler, cua--post-command-handler): Don't
fiddle with inhibit-mark-movement.
2004-12-14 Juri Linkov <juri@jurta.org>
* buff-menu.el (list-buffers-noselect): Collect internal info

25
lisp/apropos.el
View file

@ -96,7 +96,7 @@ turns off mouse highlighting."
:group 'apropos
:type 'face)
(defcustom apropos-match-face 'secondary-selection
(defcustom apropos-match-face 'match
"*Face for matching text in Apropos documentation/value, or nil for none.
This applies when you look for matches in the documentation or variable value
for the regexp; the part that matches gets displayed in this font."
@ -163,6 +163,7 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-symbol
'face apropos-symbol-face
'help-echo "mouse-2, RET: Display more help on this symbol"
'follow-link t
'action #'apropos-symbol-button-display-help
'skip t)
@ -174,19 +175,24 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-function
'apropos-label "Function"
'help-echo "mouse-2, RET: Display more help on this function"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol)))
'help-echo "mouse-2, RET: Display more help on this function")
(describe-function (button-get button 'apropos-symbol))))
(define-button-type 'apropos-macro
'apropos-label "Macro"
'help-echo "mouse-2, RET: Display more help on this macro"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol)))
'help-echo "mouse-2, RET: Display more help on this macro")
(describe-function (button-get button 'apropos-symbol))))
(define-button-type 'apropos-command
'apropos-label "Command"
'help-echo "mouse-2, RET: Display more help on this command"
'follow-link t
'action (lambda (button)
(describe-function (button-get button 'apropos-symbol)))
'help-echo "mouse-2, RET: Display more help on this command")
(describe-function (button-get button 'apropos-symbol))))
;; We used to use `customize-variable-other-window' instead for a
;; customizable variable, but that is slow. It is better to show an
@ -196,18 +202,21 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-variable
'apropos-label "Variable"
'help-echo "mouse-2, RET: Display more help on this variable"
'follow-link t
'action (lambda (button)
(describe-variable (button-get button 'apropos-symbol))))
(define-button-type 'apropos-face
'apropos-label "Face"
'help-echo "mouse-2, RET: Display more help on this face"
'follow-link t
'action (lambda (button)
(describe-face (button-get button 'apropos-symbol))))
(define-button-type 'apropos-group
'apropos-label "Group"
'help-echo "mouse-2, RET: Display more help on this group"
'follow-link t
'action (lambda (button)
(customize-group-other-window
(button-get button 'apropos-symbol))))
@ -215,12 +224,14 @@ term, and the rest of the words are alternative terms.")
(define-button-type 'apropos-widget
'apropos-label "Widget"
'help-echo "mouse-2, RET: Display more help on this widget"
'follow-link t
'action (lambda (button)
(widget-browse-other-window (button-get button 'apropos-symbol))))
(define-button-type 'apropos-plist
'apropos-label "Plist"
'help-echo "mouse-2, RET: Display more help on this plist"
'follow-link t
'action (lambda (button)
(apropos-describe-plist (button-get button 'apropos-symbol))))

52
lisp/calc/calc-aent.el
View file

@ -410,32 +410,40 @@ T means abort and give an error message.")
(exit-minibuffer))))
(defun calcAlg-blink-matching-open ()
(let ((oldpos (point))
(blinkpos nil))
(let ((rightpt (point))
(leftpt nil)
(rightchar (preceding-char))
leftchar
rightsyntax
leftsyntax)
(save-excursion
(condition-case ()
(setq blinkpos (scan-sexps oldpos -1))
(error nil)))
(if (and blinkpos
(> oldpos (1+ (point-min)))
(or (and (= (char-after (1- oldpos)) ?\))
(= (char-after blinkpos) ?\[))
(and (= (char-after (1- oldpos)) ?\])
(= (char-after blinkpos) ?\()))
(save-excursion
(goto-char blinkpos)
(looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
(let ((saved (aref (syntax-table) (char-after blinkpos))))
(unwind-protect
(progn
(aset (syntax-table) (char-after blinkpos)
(+ (logand saved 255)
(lsh (char-after (1- oldpos)) 8)))
(blink-matching-open))
(aset (syntax-table) (char-after blinkpos) saved)))
(setq leftpt (scan-sexps rightpt -1)
leftchar (char-after leftpt))
(error nil)))
(if (and leftpt
(or (and (= rightchar ?\))
(= leftchar ?\[))
(and (= rightchar ?\])
(= leftchar ?\()))
(save-excursion
(goto-char leftpt)
(looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
(let ((leftsaved (aref (syntax-table) leftchar))
(rightsaved (aref (syntax-table) rightchar)))
(unwind-protect
(progn
(cond ((= leftchar ?\[)
(aset (syntax-table) leftchar (cons 4 ?\)))
(aset (syntax-table) rightchar (cons 5 ?\[)))
(t
(aset (syntax-table) leftchar (cons 4 ?\]))
(aset (syntax-table) rightchar (cons 5 ?\())))
(blink-matching-open))
(aset (syntax-table) leftchar leftsaved)
(aset (syntax-table) rightchar rightsaved)))
(blink-matching-open))))
(defun calc-alg-digit-entry ()
(calc-alg-entry
(cond ((eq last-command-char ?e)

9
lisp/calc/calc-comb.el
View file

@ -540,12 +540,12 @@
;;; Produce a random 10-bit integer, with (random) if no seed provided,
;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A.
(defvar var-RandSeed nil)
(defvar var-RandSeed)
(defvar math-random-cache nil)
(defvar math-gaussian-cache nil)
(defun math-init-random-base ()
(if var-RandSeed
(if (and (boundp 'var-RandSeed) var-RandSeed)
(if (eq (car-safe var-RandSeed) 'vec)
nil
(if (Math-integerp var-RandSeed)
@ -599,9 +599,10 @@
;;; Produce a random digit in the range 0..999.
;;; Avoid various pitfalls that may lurk in the built-in (random) function!
;;; Shuffling algorithm from Numerical Recipes, section 7.1.
(defvar math-random-last)
(defun math-random-digit ()
(let (i math-random-last)
(or (eq var-RandSeed math-last-RandSeed)
(let (i)
(or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed))
(math-init-random-base))
(or math-random-cache
(progn

220
lisp/calculator.el
View file

@ -4,6 +4,7 @@
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
;; Time-stamp: <2002-07-13 01:14:35 eli>
;; This file is part of GNU Emacs.
@ -100,6 +101,20 @@ at runtime."
:type 'integer
:group 'calculator)
(defcustom calculator-radix-grouping-mode t
"*Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix').")
(defcustom calculator-radix-grouping-digits 4
"*The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'.")
(defcustom calculator-radix-grouping-separator "'"
"*The separator used in radix grouping display.
See `calculator-radix-grouping-mode'.")
(defcustom calculator-remove-zeros t
"*Non-nil value means delete all redundant zero decimal digits.
If this value is not t, and not nil, redundant zeros are removed except
@ -163,7 +178,11 @@ Otherwise show as a negative number."
:group 'calculator)
(defcustom calculator-mode-hook nil
"*List of hook functions for `calculator-mode' to run."
"*List of hook functions for `calculator-mode' to run.
Note: if `calculator-electric-mode' is on, then this hook will get
activated in the minibuffer - in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
:type 'hook
:group 'calculator)
@ -387,7 +406,7 @@ Used for repeating operations in calculator-repR/L.")
"oD" "oH" "oX" "oO" "oB")
(calculator-rotate-displayer "'")
(calculator-rotate-displayer-back "\"")
(calculator-displayer-pref "{")
(calculator-displayer-prev "{")
(calculator-displayer-next "}")
(calculator-saved-up [up] [?\C-p])
(calculator-saved-down [down] [?\C-n])
@ -399,10 +418,10 @@ Used for repeating operations in calculator-repR/L.")
(calculator-save-and-quit [(control return)]
[(control kp-enter)])
(calculator-paste [insert] [(shift insert)]
[mouse-2])
[paste] [mouse-2] [?\C-y])
(calculator-clear [delete] [?\C-?] [?\C-d])
(calculator-help [?h] [??] [f1] [help])
(calculator-copy [(control insert)])
(calculator-copy [(control insert)] [copy])
(calculator-backspace [backspace])
)))
(while p
@ -536,7 +555,7 @@ Used for repeating operations in calculator-repR/L.")
,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
"---"
,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
("Decimal Dislpay"
("Decimal Display"
,@(mapcar (lambda (d)
(vector (cadr d)
;; Note: inserts actual object here
@ -611,10 +630,11 @@ The prompt indicates the current modes:
* \"=?\": (? is B/O/H) the display radix (when input is decimal);
* \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display.
Also, the quote character can be used to switch display modes for
decimal numbers (double-quote rotates back), and the two brace
characters (\"{\" and \"}\" change display parameters that these
displayers use (if they handle such).
Also, the quote key can be used to switch display modes for decimal
numbers (double-quote rotates back), and the two brace characters
\(\"{\" and \"}\" change display parameters that these displayers use (if
they handle such). If output is using any radix mode, then these keys
toggle digit grouping mode and the chunk size.
Values can be saved for future reference in either a list of saved
values, or in registers.
@ -683,6 +703,7 @@ See the documentation for `calculator-mode' for more information."
(setq calculator-saved-global-map (current-global-map))
(use-local-map nil)
(use-global-map calculator-mode-map)
(run-hooks 'calculator-mode-hook)
(unwind-protect
(catch 'calculator-done
(Electric-command-loop
@ -717,6 +738,12 @@ See the documentation for `calculator-mode' for more information."
(if (and calculator-restart-other-mode calculator-electric-mode)
(calculator)))
(defun calculator-message (string &rest arguments)
"Same as `message', but special handle of electric mode."
(apply 'message string arguments)
(if calculator-electric-mode
(progn (sit-for 1) (message nil))))
;;;---------------------------------------------------------------------
;;; Operators
@ -818,82 +845,116 @@ The string is set not to exceed the screen width."
(concat calculator-prompt
(substring prompt (+ trim (length calculator-prompt)))))))
(defun calculator-curnum-value ()
"Get the numeric value of the displayed number string as a float."
(defun calculator-string-to-number (str)
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
(let ((radix
(cdr (assq calculator-input-radix
'((bin . 2) (oct . 8) (hex . 16)))))
(i -1) (value 0))
;; assume valid input (upcased & characters in range)
(while (< (setq i (1+ i)) (length calculator-curnum))
(setq value
(+ (let ((ch (aref calculator-curnum i)))
(- ch (if (<= ch ?9) ?0 (- ?A 10))))
(* radix value))))
(i -1) (value 0) (new-value 0))
;; assume mostly valid input (e.g., characters in range)
(while (< (setq i (1+ i)) (length str))
(setq new-value
(let* ((ch (upcase (aref str i)))
(n (cond ((< ch ?0) nil)
((<= ch ?9) (- ch ?0))
((< ch ?A) nil)
((<= ch ?Z) (- ch (- ?A 10)))
(t nil))))
(if (and n (<= 0 n) (< n radix))
(+ n (* radix value))
(progn
(calculator-message
"Warning: Ignoring bad input character `%c'." ch)
(sit-for 1)
value))))
(if (if (< new-value 0) (> value 0) (< value 0))
(calculator-message "Warning: Overflow in input."))
(setq value new-value))
value)
(car
(read-from-string
(cond
((equal "." calculator-curnum)
"0.0")
((string-match "[eE][+-]?$" calculator-curnum)
(concat calculator-curnum "0"))
((string-match "\\.[0-9]\\|[eE]" calculator-curnum)
calculator-curnum)
((string-match "\\." calculator-curnum)
;; do this because Emacs reads "23." as an integer
(concat calculator-curnum "0"))
((stringp calculator-curnum)
(concat calculator-curnum ".0"))
(t "0.0"))))))
(car (read-from-string
(cond ((equal "." str) "0.0")
((string-match "[eE][+-]?$" str) (concat str "0"))
((string-match "\\.[0-9]\\|[eE]" str) str)
((string-match "\\." str)
;; do this because Emacs reads "23." as an integer
(concat str "0"))
((stringp str) (concat str ".0"))
(t "0.0"))))))
(defun calculator-curnum-value ()
"Get the numeric value of the displayed number string as a float."
(calculator-string-to-number calculator-curnum))
(defun calculator-rotate-displayer (&optional new-disp)
"Switch to the next displayer on the `calculator-displayers' list.
Can be called with an optional argument NEW-DISP to force rotation to
that argument."
that argument.
If radix output mode is active, toggle digit grouping."
(interactive)
(setq calculator-displayers
(if (and new-disp (memq new-disp calculator-displayers))
(let ((tmp nil))
(while (not (eq (car calculator-displayers) new-disp))
(setq tmp (cons (car calculator-displayers) tmp))
(setq calculator-displayers (cdr calculator-displayers)))
(setq calculator-displayers
(nconc calculator-displayers (nreverse tmp))))
(nconc (cdr calculator-displayers)
(list (car calculator-displayers)))))
(message "Using %s." (cadr (car calculator-displayers)))
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(cond
(calculator-output-radix
(setq calculator-radix-grouping-mode
(not calculator-radix-grouping-mode))
(calculator-message
"Digit grouping mode %s."
(if calculator-radix-grouping-mode "ON" "OFF")))
(t
(setq calculator-displayers
(if (and new-disp (memq new-disp calculator-displayers))
(let ((tmp nil))
(while (not (eq (car calculator-displayers) new-disp))
(setq tmp (cons (car calculator-displayers) tmp))
(setq calculator-displayers
(cdr calculator-displayers)))
(setq calculator-displayers
(nconc calculator-displayers (nreverse tmp))))
(nconc (cdr calculator-displayers)
(list (car calculator-displayers)))))
(calculator-message
"Using %s." (cadr (car calculator-displayers)))))
(calculator-enter))
(defun calculator-rotate-displayer-back ()
"Like `calculator-rotate-displayer', but rotates modes back."
"Like `calculator-rotate-displayer', but rotates modes back.
If radix output mode is active, toggle digit grouping."
(interactive)
(calculator-rotate-displayer (car (last calculator-displayers))))
(defun calculator-displayer-prev ()
"Send the current displayer function a 'left argument.
This is used to modify display arguments (if the current displayer
function supports this)."
function supports this).
If radix output mode is active, increase the grouping size."
(interactive)
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond ((symbolp disp) (funcall disp 'left))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'left (cadr disp)))))))
(if calculator-output-radix
(progn (setq calculator-radix-grouping-digits
(1+ calculator-radix-grouping-digits))
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond
((symbolp disp) (funcall disp 'left))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'left (cadr disp))))))))
(defun calculator-displayer-next ()
"Send the current displayer function a 'right argument.
This is used to modify display arguments (if the current displayer
function supports this)."
function supports this).
If radix output mode is active, decrease the grouping size."
(interactive)
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond ((symbolp disp) (funcall disp 'right))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'right (cadr disp)))))))
(if calculator-output-radix
(progn (setq calculator-radix-grouping-digits
(max 2 (1- calculator-radix-grouping-digits)))
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond
((symbolp disp) (funcall disp 'right))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'right (cadr disp))))))))
(defun calculator-remove-zeros (numstr)
"Get a number string NUMSTR and remove unnecessary zeroes.
@ -995,7 +1056,7 @@ the 'left or 'right when one of the standard modes is used."
(calculator-remove-zeros str))
"e" (number-to-string exp))))))
(defun calculator-num-to-string (num)
(defun calculator-number-to-string (num)
"Convert NUM to a displayable string."
(cond
((and (numberp num) calculator-output-radix)
@ -1015,6 +1076,14 @@ the 'left or 'right when one of the standard modes is used."
(?6 . "110") (?7 . "111")))))))
(string-match "^0*\\(.+\\)" s)
(setq str (match-string 1 s))))
(if calculator-radix-grouping-mode
(let ((d (/ (length str) calculator-radix-grouping-digits))
(r (% (length str) calculator-radix-grouping-digits)))
(while (>= (setq d (1- d)) (if (zerop r) 1 0))
(let ((i (+ r (* d calculator-radix-grouping-digits))))
(setq str (concat (substring str 0 i)
calculator-radix-grouping-separator
(substring str i)))))))
(upcase
(if (and (not calculator-2s-complement) (< num 0))
(concat "-" str)
@ -1051,7 +1120,7 @@ If optional argument FORCE is non-nil, don't use the cached string."
;; customizable display for a single value
(caar calculator-displayers)
calculator-displayer)))
(mapconcat 'calculator-num-to-string
(mapconcat 'calculator-number-to-string
(reverse calculator-stack)
" "))
" "
@ -1319,9 +1388,8 @@ Optional string argument KEYS will force using it as the keys entered."
(if (not (and op (= -1 (calculator-op-arity op))))
;;(error "Binary operator without a first operand")
(progn
(message "Binary operator without a first operand")
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(calculator-message
"Binary operator without a first operand")
(throw 'op-error nil)))))
(calculator-reduce-stack
(cond ((eq (nth 1 op) '\() 10)
@ -1334,9 +1402,7 @@ Optional string argument KEYS will force using it as the keys entered."
(not (numberp (car calculator-stack)))))
;;(error "Unterminated expression")
(progn
(message "Unterminated expression")
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(calculator-message "Unterminated expression")
(throw 'op-error nil)))
(setq calculator-stack (cons op calculator-stack))
(calculator-reduce-stack (calculator-op-prec op))
@ -1540,7 +1606,7 @@ Optional string argument KEYS will force using it as the keys entered."
(setcdr as val)
(setq calculator-registers
(cons (cons reg val) calculator-registers)))
(message (format "[%c] := %S" reg val))))
(calculator-message "[%c] := %S" reg val)))
(defun calculator-put-value (val)
"Paste VAL as if entered.
@ -1552,24 +1618,26 @@ Used by `calculator-paste' and `get-register'."
(progn
(calculator-clear-fragile)
(setq calculator-curnum (let ((calculator-displayer "%S"))
(calculator-num-to-string val)))
(calculator-number-to-string val)))
(calculator-update-display))))
(defun calculator-paste ()
"Paste a value from the `kill-ring'."
(interactive)
(calculator-put-value
(let ((str (current-kill 0)))
(and calculator-paste-decimals
(let ((str (replace-regexp-in-string
"^ *\\(.+[^ ]\\) *$" "\\1" (current-kill 0))))
(and (not calculator-input-radix)
calculator-paste-decimals
(string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?"
str)
(or (match-string 1 str)
(match-string 2 str)
(match-string 3 str))
(setq str (concat (match-string 1 str)
(setq str (concat (or (match-string 1 str) "0")
(or (match-string 2 str) ".0")
(match-string 3 str))))
(condition-case nil (car (read-from-string str))
(or (match-string 3 str) ""))))
(condition-case nil (calculator-string-to-number str)
(error nil)))))
(defun calculator-get-register (reg)
@ -1678,7 +1746,7 @@ To use this, apply a binary operator (evaluate it), then call this."
(while (> x 0)
(setq r (* r (truncate x)))
(setq x (1- x)))
r))
(+ 0.0 r)))
(defun calculator-truncate (n)
"Truncate N, return 0 in case of overflow."

7
lisp/calendar/calendar.el
View file

@ -1660,6 +1660,13 @@ the date indicated by the cursor position in the displayed three-month
calendar."
t)
(autoload 'view-other-diary-entries "diary-lib"
"Prepare and display buffer of diary entries from an alternative diary file.
Searches for entries that match ARG days, starting with the date indicated
by the cursor position in the displayed three-month calendar.
D-FILE specifies the file to use as the diary file."
t)
(autoload 'calendar-sunrise-sunset "solar"
"Local time of sunrise and sunset for date under cursor."
t)

4
lisp/calendar/diary-lib.el
View file

@ -80,7 +80,7 @@ Searches for entries that match ARG days, starting with the date indicated
by the cursor position in the displayed three-month calendar.
D-FILE specifies the file to use as the diary file."
(interactive
(list (if arg (prefix-numeric-value arg) 1)
(list (prefix-numeric-value current-prefix-arg)
(read-file-name "Enter diary file name: " default-directory nil t)))
(let ((diary-file d-file))
(view-diary-entries arg)))
@ -841,11 +841,11 @@ Each entry in the diary file visible in the calendar window is marked.
After the entries are marked, the hooks `nongregorian-diary-marking-hook' and
`mark-diary-entries-hook' are run."
(interactive)
(setq mark-diary-entries-in-calendar t)
(let ((marking-diary-entries t)
file-glob-attrs marks)
(save-excursion
(set-buffer (find-file-noselect (diary-check-diary-file) t))
(setq mark-diary-entries-in-calendar t)
(message "Marking diary entries...")
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(let ((d diary-date-forms)

46
lisp/descr-text.el
View file

@ -104,24 +104,11 @@ The `category', `face' and `font-lock-face' properties are made
into widget buttons that call `describe-text-category' or
`describe-face' when pushed."
;; Sort the properties by the size of their value.
(dolist (elt (sort (let ((ret nil)
(key nil)
(val nil)
(len nil))
(dolist (elt (sort (let (ret)
(while properties
(setq key (pop properties)
val (pop properties)
len 0)
(unless (or (memq key '(category face font-lock-face
syntax-table))
(widgetp val))
(setq val (pp-to-string val)
len (length val)))
(push (list key val len) ret))
(push (list (pop properties) (pop properties)) ret))
ret)
(lambda (a b)
(< (nth 2 a)
(nth 2 b)))))
(lambda (a b) (string< (nth 0 a) (nth 0 b)))))
(let ((key (nth 0 elt))
(value (nth 1 elt)))
(widget-insert (propertize (format " %-20s " key)
@ -131,23 +118,15 @@ into widget buttons that call `describe-text-category' or
:notify `(lambda (&rest ignore)
(describe-text-category ',value))
(format "%S" value)))
((memq key '(face font-lock-face))
((memq key '(face font-lock-face mouse-face))
(widget-create 'link
:notify `(lambda (&rest ignore)
(describe-face ',value))
(format "%S" value)))
((eq key 'syntax-table)
(widget-create 'push-button
:tag "show"
:action (lambda (widget &optional event)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(pp (widget-get widget :value))))
value))
((widgetp value)
(describe-text-widget value))
(t
(widget-insert value))))
(describe-text-sexp value))))
(widget-insert "\n")))
;;; Describe-Text Commands.
@ -544,10 +523,17 @@ as well as widgets, buttons, overlays, and text properties."
(dotimes (i (length disp-vector))
(setq char (aref disp-vector i))
(aset disp-vector i
(cons char (describe-char-display pos char))))
(cons char (describe-char-display
pos (logand char #x7ffff)))))
(format "by display table entry [%s] (see below)"
(mapconcat #'(lambda (x) (format "?%c" (car x)))
disp-vector " ")))
(mapconcat
#'(lambda (x)
(if (> (car x) #x7ffff)
(format "?%c<face-id=%s>"
(logand (car x) #x7ffff)
(lsh (car x) -19))
(format "?%c" (car x))))
disp-vector " ")))
(composition
(let ((from (car composition))
(to (nth 1 composition))
@ -618,7 +604,7 @@ as well as widgets, buttons, overlays, and text properties."
(progn
(insert "these fonts (glyph codes):\n")
(dotimes (i (length disp-vector))
(insert (car (aref disp-vector i)) ?:
(insert (logand (car (aref disp-vector i)) #x7ffff) ?:
(propertize " " 'display '(space :align-to 5))
(if (cdr (aref disp-vector i))
(format "%s (0x%02X)" (cadr (aref disp-vector i))

1
lisp/dired.el
View file

@ -1104,6 +1104,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map [mouse-2] 'dired-mouse-find-file-other-window)
(define-key map [follow-link] 'mouse-face)
;; Commands to mark or flag certain categories of files
(define-key map "#" 'dired-flag-auto-save-files)
(define-key map "." 'dired-clean-directory)

2
lisp/emacs-lisp/bytecomp.el
View file

@ -2178,7 +2178,7 @@ list that represents a doc string reference.
(let ((old-load-list current-load-list)
(args (mapcar 'eval (cdr form))))
(apply 'require args)
;; Detech (require 'cl) in a way that works even if cl is already loaded.
;; Detect (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))
(setq byte-compile-warnings
(remq 'cl-functions byte-compile-warnings))))

6
lisp/emacs-lisp/lisp.el
View file

@ -192,8 +192,7 @@ open-parenthesis, and point ends up at the beginning of the line.
If variable `beginning-of-defun-function' is non-nil, its value
is called as a function to find the defun's beginning."
(interactive "p")
(or inhibit-mark-movement
(not (eq this-command 'beginning-of-defun))
(or (not (eq this-command 'beginning-of-defun))
(eq last-command 'beginning-of-defun)
(and transient-mark-mode mark-active)
(push-mark))
@ -245,8 +244,7 @@ matches the open-parenthesis that starts a defun; see function
If variable `end-of-defun-function' is non-nil, its value
is called as a function to find the defun's end."
(interactive "p")
(or inhibit-mark-movement
(not (eq this-command 'end-of-defun))
(or (not (eq this-command 'end-of-defun))
(eq last-command 'end-of-defun)
(and transient-mark-mode mark-active)
(push-mark))

17
lisp/emulation/cua-base.el
View file

@ -1003,14 +1003,6 @@ Extra commands should be added to `cua-movement-commands'")
(defvar cua-movement-commands nil
"User may add additional movement commands to this list.")
(defvar cua--preserve-mark-commands
'(end-of-buffer beginning-of-buffer)
"List of movement commands that move the mark.
CUA will preserve the previous mark position if a mark is already
active before one of these commands is executed.")
(defvar cua--undo-push-mark nil)
;;; Scrolling commands which does not signal errors at top/bottom
;;; of buffer at first key-press (instead moves to top/bottom
;;; of buffer).
@ -1100,11 +1092,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(aref (if window-system
(this-single-command-raw-keys)
(this-single-command-keys)) 0)))
(if mark-active
(if (and (memq this-command cua--preserve-mark-commands)
(not inhibit-mark-movement))
(setq cua--undo-push-mark t
inhibit-mark-movement t))
(unless mark-active
(push-mark-command nil t))
(setq cua--last-region-shifted t)
(setq cua--explicit-region-start nil))
@ -1151,9 +1139,6 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(defun cua--post-command-handler ()
(condition-case nil
(progn
(when cua--undo-push-mark
(setq cua--undo-push-mark nil
inhibit-mark-movement nil))
(when cua--global-mark-active
(cua--global-mark-post-command))
(when (fboundp 'cua--rectangle-post-command)

10
lisp/faces.el
View file

@ -1784,7 +1784,7 @@ created."
(defface mode-line
'((((type x w32 mac) (class color))
'((((class color) (min-colors 88))
:box (:line-width -1 :style released-button)
:background "grey75" :foreground "black")
(t
@ -1797,11 +1797,11 @@ created."
(defface mode-line-inactive
'((default
:inherit mode-line)
(((type x w32 mac) (background light) (class color))
(((class color) (min-colors 88) (background light))
:weight light
:box (:line-width -1 :color "grey75" :style nil)
:foreground "grey20" :background "grey90")
(((type x w32 mac) (background dark) (class color))
(((class color) (min-colors 88) (background dark) )
:weight light
:box (:line-width -1 :color "grey40" :style nil)
:foreground "grey80" :background "grey30"))
@ -2032,8 +2032,8 @@ Note: Other faces cannot inherit from the cursor face."
(defface escape-glyph '((((background dark)) :foreground "cyan")
(((type pc)) :foreground "magenta")
(t :foreground "dark blue"))
"Face for displaying \\ and ^ in multichar glyphs."
(t :foreground "blue"))
"Face for characters displayed as ^-sequences or \-sequences."
:group 'basic-faces)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

8
lisp/gnus/ChangeLog
View file

@ -1,3 +1,9 @@
2004-12-17 Kim F. Storm <storm@cua.dk>
* gnus-group.el (gnus-group-mode-map): Map follow-link to mouse-face.
* gnus-sum.el (gnus-summary-mode-map): Likewise.
2004-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
@ -905,7 +911,7 @@
* gnus-delay.el (gnus-delay-default-hour): Add :version.
* gnus-cite.el (gnus-cite-blank-line-after-header)
(gnus-article-boring-faces):
(gnus-article-boring-faces):
* gnus-art.el (gnus-buttonized-mime-types)
(gnus-inhibit-mime-unbuttonizing)

1
lisp/gnus/gnus-group.el
View file

@ -591,6 +591,7 @@ simple manner.")
"\M-e" gnus-group-edit-group-method
"^" gnus-group-enter-server-mode
gnus-mouse-2 gnus-mouse-pick-group
[follow-link] mouse-face
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-b" gnus-bug

7
lisp/gnus/gnus-sum.el
View file

@ -1703,6 +1703,7 @@ increase the score of each group you read."
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
gnus-mouse-2 gnus-mouse-pick-article
[follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
"i" gnus-summary-news-other-window
@ -5096,7 +5097,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(setq gnus-summary-use-undownloaded-faces
(gnus-agent-find-parameter
group
@ -7044,7 +7045,7 @@ If optional argument UNREAD is non-nil, only unread article is selected."
(gnus-summary-goto-subject article t)))
(gnus-summary-limit (append articles gnus-newsgroup-limit))
(gnus-summary-position-point))
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
@ -9140,7 +9141,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))

10
lisp/help-fns.el
View file

@ -478,8 +478,13 @@ Return 0 if there is no such symbol."
(and (symbolp obj) (boundp obj) obj))))
(error nil))
(let* ((str (find-tag-default))
(obj (if str (intern str))))
(and (symbolp obj) (boundp obj) obj))
(sym (if str (intern-soft str))))
(if (and sym (boundp sym))
sym
(save-match-data
(when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
(setq sym (intern-soft (match-string 1 str)))
(and (boundp sym) sym)))))
0))
;;;###autoload
@ -564,6 +569,7 @@ it is displayed along with the global value."
(insert " value is shown ")
(insert-button "below"
'action help-button-cache
'follow-link t
'help-echo "mouse-2, RET: show value")
(insert ".\n\n")))
;; Add a note for variables that have been make-var-buffer-local.

1
lisp/help-mode.el
View file

@ -68,6 +68,7 @@ The format is (FUNCTION ARGS...).")
;; Button types used by help
(define-button-type 'help-xref
'follow-link t
'action #'help-button-action)
(defun help-button-action (button)

61
lisp/help.el
View file

@ -267,8 +267,13 @@ If that doesn't give a function, return nil."
(and (symbolp obj) (fboundp obj) obj))))
(error nil))))
(let* ((str (find-tag-default))
(obj (if str (intern str))))
(and (symbolp obj) (fboundp obj) obj))))
(sym (if str (intern-soft str))))
(if (and sym (fboundp sym))
sym
(save-match-data
(when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
(setq sym (intern-soft (match-string 1 str)))
(and (fboundp sym) sym)))))))
;;; `User' help functions
@ -609,17 +614,58 @@ the last key hit are used."
(princ "\n which is ")
(describe-function-1 defn)
(when up-event
(let ((defn (or (string-key-binding up-event) (key-binding up-event))))
(let ((ev (aref up-event 0))
(descr (key-description up-event))
(hdr "\n\n-------------- up event ---------------\n\n")
defn
mouse-1-tricky mouse-1-remapped)
(when (and (consp ev)
(eq (car ev) 'mouse-1)
(windowp window)
mouse-1-click-follows-link
(not (eq mouse-1-click-follows-link 'double))
(with-current-buffer (window-buffer window)
(mouse-on-link-p (posn-point (event-start ev)))))
(setq mouse-1-tricky (integerp mouse-1-click-follows-link)
mouse-1-remapped (or (not mouse-1-tricky)
(> mouse-1-click-follows-link 0)))
(if mouse-1-remapped
(setcar ev 'mouse-2)))
(setq defn (or (string-key-binding up-event) (key-binding up-event)))
(unless (or (null defn) (integerp defn) (equal defn 'undefined))
(princ "\n\n-------------- up event ---------------\n\n")
(princ (key-description up-event))
(princ (if mouse-1-tricky
"\n\n----------------- up-event (short click) ----------------\n\n"
hdr))
(setq hdr nil)
(princ descr)
(if (windowp window)
(princ " at that spot"))
(if mouse-1-remapped
(princ " is remapped to <mouse-2>\n which" ))
(princ " runs the command ")
(prin1 defn)
(princ "\n which is ")
(describe-function-1 defn))))
(print-help-return-message)))))))
(describe-function-1 defn))
(when mouse-1-tricky
(setcar ev
(if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2))
(setq defn (or (string-key-binding up-event) (key-binding up-event)))
(unless (or (null defn) (integerp defn) (equal defn 'undefined))
(princ (or hdr
"\n\n----------------- up-event (long click) ----------------\n\n"))
(princ "Pressing ")
(princ descr)
(if (windowp window)
(princ " at that spot"))
(princ (format " for longer than %d milli-seconds\n"
(abs mouse-1-click-follows-link)))
(if (not mouse-1-remapped)
(princ " remaps it to <mouse-2> which" ))
(princ " runs the command ")
(prin1 defn)
(princ "\n which is ")
(describe-function-1 defn))))
(print-help-return-message))))))))
(defun describe-mode (&optional buffer)
@ -692,6 +738,7 @@ whose documentation describes the minor mode."
(princ " ")
(insert-button pretty-minor-mode
'action (car help-button-cache)
'follow-link t
'help-echo "mouse-2, RET: show full information")
(princ (format " minor mode (%s):\n"
(if indicator

2
lisp/info-look.el
View file

@ -47,7 +47,7 @@ Automatically becomes buffer local when set in any fashion.")
"Non-nil means pop up the Info buffer in another window."
:group 'info-lookup :type 'boolean)
(defcustom info-lookup-highlight-face 'highlight
(defcustom info-lookup-highlight-face 'match
"Face for highlighting looked up help items.
Setting this variable to nil disables highlighting."
:group 'info-lookup :type 'face)

28
lisp/international/quail.el
View file

@ -1359,11 +1359,12 @@ Return the input string."
(while quail-translating
(set-buffer-modified-p modified-p)
(quail-show-guidance)
(let* ((keyseq (read-key-sequence
(and input-method-use-echo-area
(concat input-method-previous-message
quail-current-str))
nil nil t))
(let* ((prompt (if input-method-use-echo-area
(format "%s%s %s"
(or input-method-previous-message "")
quail-current-str
quail-guidance-str)))
(keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-translation-keymap) keyseq)))
(if (if key
(and (commandp cmd) (not (eq cmd 'quail-other-command)))
@ -1424,12 +1425,13 @@ Return the input string."
quail-translating t)
(quail-setup-overlays nil)))
(quail-show-guidance)
(let* ((keyseq (read-key-sequence
(and input-method-use-echo-area
(concat input-method-previous-message
quail-conversion-str
quail-current-str))
nil nil t))
(let* ((prompt (if input-method-use-echo-area
(format "%s%s%s %s"
(or input-method-previous-message "")
quail-conversion-str
quail-current-str
quail-guidance-str)))
(keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-conversion-keymap) keyseq)))
(if (if key (commandp cmd) (eq cmd 'quail-self-insert-command))
(progn
@ -1938,10 +1940,10 @@ minibuffer and the selected frame has no other windows)."
;; Then, show the guidance.
(when (and (quail-require-guidance-buf)
(not input-method-use-echo-area)
(null unread-command-events)
(null unread-post-input-method-events))
(if (or (eq (selected-window) (minibuffer-window))
input-method-use-echo-area)
(if (eq (selected-window) (minibuffer-window))
(if (eq (minibuffer-window) (frame-root-window))
;; Use another frame. It is sure that we are using some
;; window system.

5
lisp/isearch.el
View file

@ -649,7 +649,7 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(setq ;; quit-flag nil not for isearch-mode
isearch-adjusted nil
isearch-yank-flag nil)
(isearch-lazy-highlight-new-loop)
(if isearch-lazy-highlight (isearch-lazy-highlight-new-loop))
;; We must prevent the point moving to the end of composition when a
;; part of the composition has just been searched.
(setq disable-point-adjustment t))
@ -2329,8 +2329,7 @@ is nil. This function is called when exiting an incremental search if
"Cleanup any previous `isearch-lazy-highlight' loop and begin a new one.
This happens when `isearch-update' is invoked (which can cause the
search string to change or the window to scroll)."
(when (and isearch-lazy-highlight
(null executing-kbd-macro)
(when (and (null executing-kbd-macro)
(sit-for 0) ;make sure (window-start) is credible
(or (not (equal isearch-string
isearch-lazy-highlight-last-string))

108
lisp/mouse.el
View file

@ -49,6 +49,39 @@
:version "21.4"
:group 'mouse)
(defcustom mouse-1-click-follows-link 350
"Non-nil means that clicking Mouse-1 on a link follows the link.
With the default setting, an ordinary Mouse-1 click on a link
performs the same action as Mouse-2 on that link, while a longer
Mouse-1 click \(hold down the Mouse-1 button for more than 350
milliseconds) performs the original Mouse-1 binding \(which
typically sets point where you click the mouse).
If value is an integer, the time elapsed between pressing and
releasing the mouse button determines whether to follow the link
or perform the normal Mouse-1 action (typically set point).
The absolute numeric value specifices the maximum duration of a
\"short click\" in milliseconds. A positive value means that a
short click follows the link, and a longer click performs the
normal action. A negative value gives the opposite behaviour.
If value is `double', a double click follows the link.
Otherwise, a single Mouse-1 click unconditionally follows the link.
Note that dragging the mouse never follows the link.
This feature only works in modes that specifically identify
clickable text as links, so it may not work with some external
packages. See `mouse-on-link-p' for details."
:version "21.4"
:type '(choice (const :tag "Disabled" nil)
(const :tag "Double click" double)
(number :tag "Single click time limit" :value 350)
(other :tag "Single click" t))
:group 'mouse)
;; Provide a mode-specific menu on a mouse button.
@ -733,6 +766,51 @@ If the click is in the echo area, display the `*Messages*' buffer."
(run-hooks 'mouse-leave-buffer-hook)
(mouse-drag-region-1 start-event))))
(defun mouse-on-link-p (pos)
"Return non-nil if POS is on a link in the current buffer.
A clickable link is identified by one of the following methods:
1) If the character at POS has a non-nil `follow-link' text or
overlay property, the value of that property is returned.
2) If there is a local key-binding or a keybinding at position
POS for the `follow-link' event, the binding of that event
determines whether POS is inside a link:
- If the binding is `mouse-face', POS is inside a link if there
is a non-nil `mouse-face' property at POS. Return t in this case.
- If the binding is a function, FUNC, POS is inside a link if
the call \(FUNC POS) returns non-nil. Return the return value
from that call.
- Otherwise, return the binding of the `follow-link' binding.
The return value is interpreted as follows:
- If it is a string, the mouse-1 event is translated into the
first character of the string, i.e. the action of the mouse-1
click is the local or global binding of that character.
- If it is a vector, the mouse-1 event is translated into the
first element of that vector, i.e. the action of the mouse-1
click is the local or global binding of that event.
- Otherwise, the mouse-1 event is translated into a mouse-2 event
at the same position."
(or (get-char-property pos 'follow-link)
(save-excursion
(goto-char pos)
(let ((b (key-binding [follow-link] nil t)))
(cond
((eq b 'mouse-face)
(and (get-char-property pos 'mouse-face) t))
((functionp b)
(funcall b pos))
(t b))))))
(defun mouse-drag-region-1 (start-event)
(mouse-minibuffer-check start-event)
(let* ((echo-keystrokes 0)
@ -749,6 +827,7 @@ If the click is in the echo area, display the `*Messages*' buffer."
(nth 3 bounds)
;; Don't count the mode line.
(1- (nth 3 bounds))))
on-link remap-double-click
(click-count (1- (event-click-count start-event))))
(setq mouse-selection-click-count click-count)
(setq mouse-selection-click-count-buffer (current-buffer))
@ -758,6 +837,13 @@ If the click is in the echo area, display the `*Messages*' buffer."
(if (< (point) start-point)
(goto-char start-point))
(setq start-point (point))
(setq on-link (and mouse-1-click-follows-link
(mouse-on-link-p start-point)))
(setq remap-double-click (and on-link
(eq mouse-1-click-follows-link 'double)
(= click-count 1)))
(if remap-double-click ;; Don't expand mouse overlay in links
(setq click-count 0))
(let ((range (mouse-start-end start-point start-point click-count)))
(move-overlay mouse-drag-overlay (car range) (nth 1 range)
(window-buffer start-window))
@ -880,6 +966,28 @@ If the click is in the echo area, display the `*Messages*' buffer."
(or end-point
(= (window-start start-window)
start-window-start)))
(if (and on-link
(not end-point)
(consp event)
(or remap-double-click
(and
(not (eq mouse-1-click-follows-link 'double))
(= click-count 0)
(= (event-click-count event) 1)
(not (input-pending-p))
(or (not (integerp mouse-1-click-follows-link))
(let ((t0 (posn-timestamp (event-start start-event)))
(t1 (posn-timestamp (event-end event))))
(and (integerp t0) (integerp t1)
(if (> mouse-1-click-follows-link 0)
(<= (- t1 t0) mouse-1-click-follows-link)
(< (- t0 t1) mouse-1-click-follows-link)))))
(or (not double-click-time)
(sit-for 0 (if (integerp double-click-time)
double-click-time 500) t)))))
(if (or (vectorp on-link) (stringp on-link))
(setq event (aref on-link 0))
(setcar event 'mouse-2)))
(setq unread-command-events
(cons event unread-command-events)))))
(delete-overlay mouse-drag-overlay)))))

8
lisp/net/tramp-smb.el
View file

@ -1105,9 +1105,11 @@ Return the difference in the format of a time value."
;; Do `PC-do-completion' without substitution
(let* (save)
(fset 'save (symbol-function 'substitute-in-file-name))
(fset 'substitute-in-file-name (symbol-function 'identity))
ad-do-it
(fset 'substitute-in-file-name (symbol-function 'save)))
(unwind-protect
(progn
(fset 'substitute-in-file-name (symbol-function 'identity))
ad-do-it)
(fset 'substitute-in-file-name (symbol-function 'save))))
;; Expand "$"
(let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21

128
lisp/net/tramp.el
View file

@ -34,7 +34,7 @@
;;
;; Notes:
;; -----
;;
;;
;; This package only works for Emacs 20 and higher, and for XEmacs 21
;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs
;; 19 is reported to have other problems. For XEmacs 21, you need the
@ -205,7 +205,7 @@ file name, the backup directory is prepended with Tramp file name prefix
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
:type '(repeat
:type '(repeat
(list (regexp :tag "File regexp")
(string :tag "Backup Dir")
(set :inline t
@ -506,7 +506,7 @@ This variable defaults to the value of `tramp-encoding-shell'."
(tramp-copy-args nil)
(tramp-copy-keep-date-arg "-p")
(tramp-password-end-of-line "xy")) ;see docstring for "xy"
("fcp"
("fcp"
(tramp-connection-function tramp-open-connection-rsh)
(tramp-login-program "fsh")
(tramp-copy-program "fcp")
@ -633,7 +633,7 @@ variable `tramp-methods'."
("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n")
("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
("su" tramp-multi-connect-su "su - %u%n")
("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n"))
"*List of connection functions for multi-hop methods.
@ -777,7 +777,7 @@ the info pages.")
"sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function
"multi" nil)
(tramp-set-completion-function
(tramp-set-completion-function
"scpx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"sshx" tramp-completion-function-alist-ssh)
@ -1536,9 +1536,9 @@ cat /tmp/tramp.$$
rm -f /tmp/tramp.$$
}"
"Shell function to implement `uudecode' to standard output.
Many systems support `uudecode -o /dev/stdout' for this or
`uudecode -o -' or `uudecode -p', but some systems don't, and for
them we have this shell function.")
Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
for this or `uudecode -p', but some systems don't, and for them
we have this shell function.")
;; Perl script to implement `file-attributes' in a Lisp `read'able
;; output. If you are hacking on this, note that you get *no* output
@ -1960,10 +1960,9 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
;; To be activated for debugging containing this macro
;; It works only when VAR is nil. Otherwise, it can be deactivated by
;; (def-edebug-spec with-parsed-tramp-file-name 0)
;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0)
;; I'm too stupid to write a precise SPEC for it.
(if (functionp 'def-edebug-spec)
(def-edebug-spec with-parsed-tramp-file-name t))
(put 'with-parsed-tramp-file-name 'edebug-form-spec t)
(defmacro tramp-let-maybe (variable value &rest body)
"Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
@ -2056,7 +2055,7 @@ target of the symlink differ."
(setq filename (tramp-file-name-localname
(tramp-dissect-file-name
(expand-file-name filename)))))
;; Right, they are on the same host, regardless of user, method, etc.
;; We now make the link on the remote machine. This will occur as the user
;; that FILENAME belongs to.
@ -2065,7 +2064,7 @@ target of the symlink differ."
l-multi-method l-method l-user l-host
(format "cd %s && %s -sf %s %s"
cwd ln
filename
filename
l-localname)
t)))))
@ -2347,9 +2346,9 @@ target of the symlink differ."
"file attributes with perl: %s"
(tramp-make-tramp-file-name
multi-method method user host localname))
(tramp-maybe-send-perl-script tramp-perl-file-attributes
"tramp_file_attributes"
multi-method method user host)
(tramp-maybe-send-perl-script multi-method method user host
tramp-perl-file-attributes
"tramp_file_attributes")
(tramp-send-command multi-method method user host
(format "tramp_file_attributes %s %s"
(tramp-shell-quote-argument localname) id-format))
@ -2394,7 +2393,12 @@ target of the symlink differ."
;; This function makes the same assumption as
;; `tramp-handle-set-visited-file-modtime'.
(defun tramp-handle-verify-visited-file-modtime (buf)
"Like `verify-visited-file-modtime' for tramp files."
"Like `verify-visited-file-modtime' for tramp files.
At the time `verify-visited-file-modtime' calls this function, we
already know that the buffer is visiting a file and that
`visited-file-modtime' does not return 0. Do not call this
function directly, unless those two cases are already taken care
of."
(with-current-buffer buf
;; There is no file visiting the buffer, or the buffer has no
;; recorded last modification time.
@ -2406,7 +2410,7 @@ target of the symlink differ."
(let* ((attr (file-attributes f))
(modtime (nth 5 attr))
(mt (visited-file-modtime)))
(cond
;; file exists, and has a known modtime.
((and attr (not (equal modtime '(0 0))))
@ -2689,9 +2693,9 @@ if the remote host can't provide the modtime."
(save-excursion
(setq directory (tramp-handle-expand-file-name directory))
(with-parsed-tramp-file-name directory nil
(tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes
"tramp_directory_files_and_attributes"
multi-method method user host)
(tramp-maybe-send-perl-script multi-method method user host
tramp-perl-directory-files-and-attributes
"tramp_directory_files_and_attributes")
(tramp-send-command multi-method method user host
(format "tramp_directory_files_and_attributes %s %s"
(tramp-shell-quote-argument localname)
@ -2753,7 +2757,7 @@ if the remote host can't provide the modtime."
(push (buffer-substring (point)
(tramp-line-end-position))
result))
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)
@ -3096,6 +3100,12 @@ be a local filename. The method used must be an out-of-band method."
;; Use an asynchronous process. By this, password can be handled.
(save-excursion
;; Check for program.
(when (and (fboundp 'executable-find)
(not (executable-find copy-program)))
(error "Cannot find copy program: %s" copy-program))
(set-buffer trampbuf)
(setq tramp-current-multi-method multi-method
tramp-current-method method
@ -3170,15 +3180,15 @@ This is like `dired-recursive-delete-directory' for tramp files."
'file-error
(list "Removing old file name" "no such directory" filename)))
;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
(tramp-send-command multi-method method user host
(tramp-send-command multi-method method user host
(format "rm -r %s" (tramp-shell-quote-argument localname)))
;; Wait for the remote system to return to us...
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output 120)
;; Make sure that it worked...
(and (file-exists-p filename)
(error "Failed to recusively delete %s" filename))))
(error "Failed to recursively delete %s" filename))))
(defun tramp-handle-dired-call-process (program discard &rest arguments)
"Like `dired-call-process' for tramp files."
(with-parsed-tramp-file-name default-directory nil
@ -3200,7 +3210,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
(tramp-send-command-and-check multi-method method user host nil)
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)))))
(defun tramp-handle-dired-compress-file (file &rest ok-flag)
"Like `dired-compress-file' for tramp files."
;; OK-FLAG is valid for XEmacs only, but not implemented.
@ -3568,7 +3578,7 @@ This will break if COMMAND prints a newline, followed by the value of
(when (and (numberp buffer) (zerop buffer))
(error "Implementation does not handle immediate return"))
(when (consp buffer) (error "Implementation does not handle error files"))
(shell-command
(shell-command
(mapconcat 'tramp-shell-quote-argument
(cons program args)
" ")
@ -4250,7 +4260,7 @@ necessary anymore."
;; `tramp-completion-file-name-regexp-unified' aren't different.
;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
;; Using `last-input-event' is a little bit risky, because completing a file
;; Using `last-input-event' is a little bit risky, because completing a file
;; might require loading other files, like "~/.netrc", and for them it
;; shouldn't be decided based on that variable. On the other hand, those files
;; shouldn't have partial tramp file name syntax. Maybe another variable should
@ -4354,7 +4364,7 @@ necessary anymore."
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
(setq result (append result
(setq result (append result
(mapcar
(lambda (x)
(tramp-get-completion-user-host
@ -4395,7 +4405,7 @@ necessary anymore."
;; [nil nil "x" nil nil]
;; [nil "x" nil nil nil]
;; "/x:" "/x:y" "/x:y:"
;; "/x:" "/x:y" "/x:y:"
;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""]
;; "/[x/" "/[x/y"
;; [nil "x" nil "" nil] [nil "x" nil "y" nil]
@ -4769,7 +4779,7 @@ User may be nil."
;;; Internal Functions:
(defun tramp-maybe-send-perl-script (script name multi-method method user host)
(defun tramp-maybe-send-perl-script (multi-method method user host script name)
"Define in remote shell function NAME implemented as perl SCRIPT.
Only send the definition if it has not already been done.
Function may have 0-3 parameters."
@ -4864,7 +4874,7 @@ TIME is an Emacs internal time value as returned by `current-time'."
"touch" nil (current-buffer) nil "-t" touch-time file))
(pop-to-buffer (current-buffer))
(error "tramp-touch: touch failed"))))))
(defun tramp-buffer-name (multi-method method user host)
"A name for the connection buffer for USER at HOST using METHOD."
(if multi-method
@ -5022,7 +5032,7 @@ file exists and nonzero exit status otherwise."
(file-exists-p existing)
(not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
;; CCC test ksh or bash found for tilde expansion?
(defun tramp-find-shell (multi-method method user host)
@ -5121,9 +5131,9 @@ Returns nil if none was found, else the command is returned."
(tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path)
(tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path)))
;; ------------------------------------------------------------
;; -- Functions for establishing connection --
;; ------------------------------------------------------------
;; ------------------------------------------------------------
;; -- Functions for establishing connection --
;; ------------------------------------------------------------
;; The following functions are actions to be taken when seeing certain
;; prompts from the remote host. See the variable
@ -5364,7 +5374,7 @@ Maybe the different regular expressions need to be tuned.
(when multi-method
(error "Cannot multi-connect using telnet connection method"))
(tramp-pre-connection multi-method method user host)
(tramp-message 7 "Opening connection for %s@%s using %s..."
(tramp-message 7 "Opening connection for %s@%s using %s..."
(or user (user-login-name)) host method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
@ -5398,7 +5408,7 @@ Maybe the different regular expressions need to be tuned.
p multi-method method user host)
(tramp-post-connection multi-method method user host)))))
(defun tramp-open-connection-rsh (multi-method method user host)
"Open a connection using an rsh METHOD.
This starts the command `rsh HOST -l USER'[*], then waits for a remote
@ -5423,7 +5433,7 @@ arguments, and xx will be used as the host name to connect to.
(error "Cannot multi-connect using rsh connection method"))
(tramp-pre-connection multi-method method user host)
(if (and user (not (string= user "")))
(tramp-message 7 "Opening connection for %s@%s using %s..."
(tramp-message 7 "Opening connection for %s@%s using %s..."
user host method)
(tramp-message 7 "Opening connection at %s using %s..." host method))
(let ((process-environment (copy-sequence process-environment))
@ -5452,9 +5462,9 @@ arguments, and xx will be used as the host name to connect to.
(> emacs-major-version 20))
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
(apply #'start-process bufnam buf login-program
(apply #'start-process bufnam buf login-program
real-host "-l" user login-args)
(apply #'start-process bufnam buf login-program
(apply #'start-process bufnam buf login-program
real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
@ -5524,10 +5534,10 @@ prompt than you do, so it is not at all unlikely that the variable
tramp-actions-before-shell)
(tramp-open-connection-setup-interactive-shell
p multi-method method user host)
(tramp-post-connection multi-method method
(tramp-post-connection multi-method method
user host)))))
;; HHH: Not Changed. Multi method. It is not clear to me how this can
;; HHH: Not Changed. Multi method. It is not clear to me how this can
;; handle not giving a user name in the "file name".
;;
;; This is more difficult than for the single-hop method. In the
@ -5597,7 +5607,7 @@ log in as u2 to h2."
(tramp-post-connection multi-method method user host)))))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
;; of no user name provided. Hack to make it work as it did before:
;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-telnet (p method user host command)
@ -5619,8 +5629,8 @@ If USER is nil, uses the return value of (user-login-name) instead."
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
;; of no user name provided. Hack to make it work as it did before:
;; HHH: Changed. Multi method. Don't know how to handle this in the case
;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-rlogin (p method user host command)
@ -5645,8 +5655,8 @@ If USER is nil, uses the return value of (user-login-name) instead."
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
;; of no user name provided. Hack to make it work as it did before:
;; HHH: Changed. Multi method. Don't know how to handle this in the case
;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-su (p method user host command)
@ -6276,7 +6286,7 @@ Sends COMMAND, then waits 30 seconds for shell prompt."
(tramp-barf-if-no-shell-prompt
nil 30
"Couldn't `%s', see buffer `%s'" command (buffer-name)))
(defun tramp-wait-for-output (&optional timeout)
"Wait for output from remote rsh command."
(let ((proc (get-buffer-process (current-buffer)))
@ -6609,9 +6619,9 @@ Not actually used. Use `(format \"%o\" i)' instead?"
""))
;; ------------------------------------------------------------
;; -- TRAMP file names --
;; ------------------------------------------------------------
;; ------------------------------------------------------------
;; -- TRAMP file names --
;; ------------------------------------------------------------
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
@ -6622,7 +6632,7 @@ Not actually used. Use `(format \"%o\" i)' instead?"
"Return t iff NAME is a tramp file."
(save-match-data
(string-match tramp-file-name-regexp name)))
;; HHH: Changed. Used to assign the return value of (user-login-name)
;; to the `user' part of the structure if a user name was not
;; provided, now it assigns nil.
@ -6675,7 +6685,7 @@ This is MULTI-METHOD, if non-nil. Otherwise, it is METHOD, if non-nil.
If both MULTI-METHOD and METHOD are nil, do a lookup in
`tramp-default-method-alist'."
(or multi-method method (tramp-find-default-method user host)))
;; HHH: Not Changed. Multi method. Will probably not handle the case where
;; a user name is not provided in the "file name" very well.
(defun tramp-dissect-multi-file-name (name)
@ -6847,7 +6857,7 @@ as default."
(if entry
(second entry)
(symbol-value param))))
;; Auto saving to a special directory.
@ -7039,9 +7049,9 @@ exiting if process is running."
process flag)))
;; ------------------------------------------------------------
;; -- Kludges section --
;; ------------------------------------------------------------
;; ------------------------------------------------------------
;; -- Kludges section --
;; ------------------------------------------------------------
;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
;; does not deal well with newline characters. Newline is replaced by
@ -7304,7 +7314,7 @@ report.
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;; * Add caching for filename completion. (Greg Stark)
;; Of course, this has issues with usability (stale cache bites)
;; Of course, this has issues with usability (stale cache bites)
;; -- <daniel@danann.net>
;; * Provide a local cache of old versions of remote files for the rsync
;; transfer method to use. (Greg Stark)

2
lisp/net/trampver.el
View file

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

2
lisp/pcvs-defs.el
View file

@ -380,6 +380,8 @@ This variable is buffer local and only used in the *cvs* buffer.")
("+" . cvs-mode-tree)
;; mouse bindings
([mouse-2] . cvs-mode-find-file)
([follow-link] . (lambda (pos)
(if (eq (get-char-property pos 'face) 'cvs-filename-face) t)))
([(down-mouse-3)] . cvs-menu)
;; dired-like bindings
("\C-o" . cvs-mode-display-file)

285
lisp/play/zone.el
View file

@ -33,10 +33,11 @@
;; `zone-programs'. See `zone-call' for higher-ordered zoning.
;; WARNING: Not appropriate for Emacs sessions over modems or
;; computers as slow as mine.
;; computers as slow as mine.
;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar,
;; Max Froumentin.
;; THANKS: Christopher Mayer, Scott Flinchbaugh,
;; Rachel Kalmar, Max Froumentin, Juri Linkov,
;; Luigi Panzeri, John Paul Wallington.
;;; Code:
@ -140,19 +141,28 @@ If the element is a function or a list of a function and a number,
(window-start)))))
(put 'zone 'orig-buffer (current-buffer))
(put 'zone 'modeline-hidden-level 0)
(set-buffer outbuf)
(switch-to-buffer outbuf)
(setq mode-name "Zone")
(erase-buffer)
(setq buffer-undo-list t
truncate-lines t
tab-width (zone-orig tab-width)
line-spacing (zone-orig line-spacing))
(insert text)
(switch-to-buffer outbuf)
(setq buffer-undo-list t)
(untabify (point-min) (point-max))
(set-window-start (selected-window) (point-min))
(set-window-point (selected-window) wp)
(sit-for 0 500)
(let ((pgm (elt zone-programs (random (length zone-programs))))
(ct (and f (frame-parameter f 'cursor-type))))
(when ct (modify-frame-parameters f '((cursor-type . (bar . 0)))))
(ct (and f (frame-parameter f 'cursor-type)))
(restore (list '(kill-buffer outbuf))))
(when ct
(modify-frame-parameters f '((cursor-type . (bar . 0))))
(setq restore (cons '(modify-frame-parameters
f (list (cons 'cursor-type ct)))
restore)))
;; Make `restore' a self-disabling one-shot thunk.
(setq restore `(lambda () ,@restore (setq restore nil)))
(condition-case nil
(progn
(message "Zoning... (%s)" pgm)
@ -166,14 +176,17 @@ If the element is a function or a list of a function and a number,
(zone-call pgm)
(message "Zoning...sorry"))
(error
(funcall restore)
(while (not (input-pending-p))
(message (format "We were zoning when we wrote %s..." pgm))
(sit-for 3)
(message "...here's hoping we didn't hose your buffer!")
(sit-for 3)))
(quit (ding) (message "Zoning...sorry")))
(when ct (modify-frame-parameters f (list (cons 'cursor-type ct)))))
(kill-buffer outbuf)))
(quit
(funcall restore)
(ding)
(message "Zoning...sorry")))
(when restore (funcall restore)))))
;;;; Zone when idle, or not.
@ -195,13 +208,11 @@ If the element is a function or a list of a function and a number,
(message "I won't zone out any more"))
;;;; zone-pgm-jitter
;;;; jittering
(defun zone-shift-up ()
(let* ((b (point))
(e (progn
(end-of-line)
(if (looking-at "\n") (1+ (point)) (point))))
(e (progn (forward-line 1) (point)))
(s (buffer-substring b e)))
(delete-region b e)
(goto-char (point-max))
@ -209,48 +220,40 @@ If the element is a function or a list of a function and a number,
(defun zone-shift-down ()
(goto-char (point-max))
(forward-line -1)
(beginning-of-line)
(let* ((b (point))
(e (progn
(end-of-line)
(if (looking-at "\n") (1+ (point)) (point))))
(e (progn (forward-line -1) (point)))
(s (buffer-substring b e)))
(delete-region b e)
(goto-char (point-min))
(insert s)))
(defun zone-shift-left ()
(while (not (eobp))
(or (eolp)
(let ((c (following-char)))
(delete-char 1)
(end-of-line)
(insert c)))
(forward-line 1)))
(let (s)
(while (not (eobp))
(unless (eolp)
(setq s (buffer-substring (point) (1+ (point))))
(delete-char 1)
(end-of-line)
(insert s))
(forward-char 1))))
(defun zone-shift-right ()
(while (not (eobp))
(end-of-line)
(or (bolp)
(let ((c (preceding-char)))
(delete-backward-char 1)
(beginning-of-line)
(insert c)))
(forward-line 1)))
(goto-char (point-max))
(end-of-line)
(let (s)
(while (not (bobp))
(unless (bolp)
(setq s (buffer-substring (1- (point)) (point)))
(delete-char -1)
(beginning-of-line)
(insert s))
(end-of-line 0))))
(defun zone-pgm-jitter ()
(let ((ops [
zone-shift-left
zone-shift-left
zone-shift-left
zone-shift-left
zone-shift-right
zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-up
]))
(goto-char (point-min))
@ -260,7 +263,7 @@ If the element is a function or a list of a function and a number,
(sit-for 0 10))))
;;;; zone-pgm-whack-chars
;;;; whacking chars
(defun zone-pgm-whack-chars ()
(let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
@ -280,7 +283,7 @@ If the element is a function or a list of a function and a number,
(setq i (1+ i)))
tbl))
;;;; zone-pgm-dissolve
;;;; dissolving
(defun zone-remove-text ()
(let ((working t))
@ -305,11 +308,11 @@ If the element is a function or a list of a function and a number,
(zone-pgm-jitter))
;;;; zone-pgm-explode
;;;; exploding
(defun zone-exploding-remove ()
(let ((i 0))
(while (< i 20)
(while (< i 5)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
@ -328,7 +331,7 @@ If the element is a function or a list of a function and a number,
(zone-pgm-jitter))
;;;; zone-pgm-putz-with-case
;;;; putzing w/ case
;; Faster than `zone-pgm-putz-with-case', but not as good: all
;; instances of the same letter have the same case, which produces a
@ -377,7 +380,7 @@ If the element is a function or a list of a function and a number,
(sit-for 0 2)))
;;;; zone-pgm-rotate
;;;; rotating
(defun zone-line-specs ()
(let (ret)
@ -439,66 +442,84 @@ If the element is a function or a list of a function and a number,
(zone-pgm-rotate (lambda () (1- (- (random 3))))))
;;;; zone-pgm-drip
;;;; dripping
(defun zone-cpos (pos)
(defsubst zone-cpos (pos)
(buffer-substring pos (1+ pos)))
(defun zone-fret (pos)
(defsubst zone-replace-char (count del-count char-as-string new-value)
(delete-char (or del-count (- count)))
(aset char-as-string 0 new-value)
(dotimes (i count) (insert char-as-string)))
(defsubst zone-park/sit-for (pos seconds)
(let ((p (point)))
(goto-char pos)
(prog1 (sit-for seconds)
(goto-char p))))
(defun zone-fret (wbeg pos)
(let* ((case-fold-search nil)
(c-string (zone-cpos pos))
(cw-ceil (ceiling (char-width (aref c-string 0))))
(hmm (cond
((string-match "[a-z]" c-string) (upcase c-string))
((string-match "[A-Z]" c-string) (downcase c-string))
(t " "))))
(t (propertize " " 'display `(space :width ,cw-ceil))))))
(do ((i 0 (1+ i))
(wait 0.5 (* wait 0.8)))
((= i 20))
(goto-char pos)
(delete-char 1)
(insert (if (= 0 (% i 2)) hmm c-string))
(sit-for wait))
(zone-park/sit-for wbeg wait))
(delete-char -1) (insert c-string)))
(defun zone-fill-out-screen (width height)
(save-excursion
(goto-char (point-min))
(let ((start (window-start))
(line (make-string width 32)))
(goto-char start)
;; fill out rectangular ws block
(while (not (eobp))
(end-of-line)
(let ((cc (current-column)))
(if (< cc width)
(insert (make-string (- width cc) 32))
(delete-char (- width cc))))
(unless (eobp)
(forward-char 1)))
(while (progn (end-of-line)
(let ((cc (current-column)))
(if (< cc width)
(insert (substring line cc))
(delete-char (- width cc)))
(cond ((eobp) (insert "\n") nil)
(t (forward-char 1) t)))))
;; pad ws past bottom of screen
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(let ((line (concat (make-string (1- width) ? ) "\n")))
(do ((i 0 (1+ i)))
((= i nl))
(insert line)))))))
(setq line (concat line "\n"))
(do ((i 0 (1+ i)))
((= i nl))
(insert line))))
(goto-char start)
(recenter 0)
(sit-for 0)))
(defun zone-fall-through-ws (c col wend)
(let ((fall-p nil) ; todo: move outward
(wait 0.15)
(o (point)) ; for terminals w/o cursor hiding
(p (point)))
(while (progn
(forward-line 1)
(move-to-column col)
(looking-at " "))
(setq fall-p t)
(delete-char 1)
(insert (if (< (point) wend) c " "))
(save-excursion
(goto-char p)
(delete-char 1)
(insert " ")
(goto-char o)
(sit-for (setq wait (* wait 0.8))))
(setq p (1- (point))))
(defun zone-fall-through-ws (c wbeg wend)
(let* ((cw-ceil (ceiling (char-width (aref c 0))))
(spaces (make-string cw-ceil 32))
(col (current-column))
(wait 0.15)
newpos fall-p)
(while (when (save-excursion
(next-line 1)
(and (= col (current-column))
(setq newpos (point))
(string= spaces (buffer-substring-no-properties
newpos (+ newpos cw-ceil)))
(setq newpos (+ newpos (1- cw-ceil)))))
(setq fall-p t)
(delete-char 1)
(insert spaces)
(goto-char newpos)
(when (< (point) wend)
(delete-char cw-ceil)
(insert c)
(forward-char -1)
(zone-park/sit-for wbeg (setq wait (* wait 0.8))))))
fall-p))
(defun zone-pgm-drip (&optional fret-p pancake-p)
@ -506,41 +527,35 @@ If the element is a function or a list of a function and a number,
(wh (window-height))
(mc 0) ; miss count
(total (* ww wh))
(fall-p nil))
(fall-p nil)
wbeg wend c)
(zone-fill-out-screen ww wh)
(setq wbeg (window-start)
wend (window-end))
(catch 'done
(while (not (input-pending-p))
(let ((wbeg (window-start))
(wend (window-end)))
(setq mc 0)
;; select non-ws character, but don't miss too much
(goto-char (+ wbeg (random (- wend wbeg))))
(while (looking-at "[ \n\f]")
(if (= total (setq mc (1+ mc)))
(throw 'done 'sel)
(goto-char (+ wbeg (random (- wend wbeg))))))
;; character animation sequence
(let ((p (point)))
(when fret-p (zone-fret p))
(goto-char p)
(setq fall-p (zone-fall-through-ws
(zone-cpos p) (current-column) wend))))
(setq mc 0 wend (window-end))
;; select non-ws character, but don't miss too much
(goto-char (+ wbeg (random (- wend wbeg))))
(while (looking-at "[ \n\f]")
(if (= total (setq mc (1+ mc)))
(throw 'done 'sel)
(goto-char (+ wbeg (random (- wend wbeg))))))
;; character animation sequence
(let ((p (point)))
(when fret-p (zone-fret wbeg p))
(goto-char p)
(setq c (zone-cpos p)
fall-p (zone-fall-through-ws c wbeg wend)))
;; assuming current-column has not changed...
(when (and pancake-p
fall-p
(< (count-lines (point-min) (point))
wh))
(previous-line 1)
(forward-char 1)
(sit-for 0.137)
(delete-char -1)
(insert "@")
(sit-for 0.137)
(delete-char -1)
(insert "*")
(sit-for 0.137)
(delete-char -1)
(insert "_"))))))
(let ((cw (ceiling (char-width (aref c 0)))))
(zone-replace-char cw 1 c ?@) (zone-park/sit-for wbeg 0.137)
(zone-replace-char cw nil c ?*) (zone-park/sit-for wbeg 0.137)
(zone-replace-char cw nil c ?_)))))))
(defun zone-pgm-drip-fretfully ()
(zone-pgm-drip t))
@ -552,7 +567,7 @@ If the element is a function or a list of a function and a number,
(zone-pgm-drip t t))
;;;; zone-pgm-paragraph-spaz
;;;; paragraph spazzing (for textish modes)
(defun zone-pgm-paragraph-spaz ()
(if (memq (zone-orig major-mode)
@ -633,30 +648,29 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(rtc (- (frame-width) 11))
(min (window-start))
(max (1- (window-end)))
c col)
s c col)
(delete-region max (point-max))
(while (progn (goto-char (+ min (random max)))
(and (sit-for 0.005)
(while (and (progn (goto-char min) (sit-for 0.05))
(progn (goto-char (+ min (random max)))
(or (progn (skip-chars-forward " @\n" max)
(not (= max (point))))
(unless (or (= 0 (skip-chars-backward " @\n" min))
(= min (point)))
(forward-char -1)
t))))
(setq c (char-after))
(unless (or (not c) (= ?\n c))
(forward-char 1)
(insert-and-inherit ; keep colors
(cond ((or (> top (point))
(< bot (point))
(or (> 11 (setq col (current-column)))
(< rtc col)))
32)
((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
((and (<= ?A c) (>= ?Z c)) ?*)
(t ?@)))
(forward-char -1)
(delete-char -1)))
(unless (or (eolp) (eobp))
(setq s (zone-cpos (point))
c (aref s 0))
(zone-replace-char
(char-width c)
1 s (cond ((or (> top (point))
(< bot (point))
(or (> 11 (setq col (current-column)))
(< rtc col)))
32)
((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
((and (<= ?A c) (>= ?Z c)) ?*)
(t ?@)))))
(sit-for 3)
(setq col nil)
(goto-char bot)
@ -666,8 +680,13 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(setq col (cons (buffer-substring (point) c) col))
(end-of-line 0)
(forward-char -10))
(let ((life-patterns (vector (cons (make-string (length (car col)) 32)
col))))
(let ((life-patterns (vector
(if (and col (search-forward "@" max t))
(cons (make-string (length (car col)) 32) col)
(list (mapconcat 'identity
(make-list (/ (- rtc 11) 15)
(make-string 5 ?@))
(make-string 10 32)))))))
(life (or zone-pgm-random-life-wait (random 4)))
(kill-buffer nil))))

3
lisp/progmodes/compile.el
View file

@ -1044,6 +1044,7 @@ exited abnormally with code %d\n"
(defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
(define-key map [follow-link] 'mouse-face)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\C-m" 'compile-goto-error)
(define-key map "\C-c\C-k" 'kill-compilation)
@ -1073,6 +1074,7 @@ exited abnormally with code %d\n"
(defvar compilation-button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-goto-error)
(define-key map [follow-link] 'mouse-face)
(define-key map "\C-m" 'compile-goto-error)
map)
"Keymap for compilation-message buttons.")
@ -1084,6 +1086,7 @@ exited abnormally with code %d\n"
;; because that introduces a menu bar item we don't want.
;; That confuses C-down-mouse-3.
(define-key map [mouse-2] 'compile-goto-error)
(define-key map [follow-link] 'mouse-face)
(define-key map "\C-c\C-c" 'compile-goto-error)
(define-key map "\C-m" 'compile-goto-error)
(define-key map "\C-c\C-k" 'kill-compilation)

14
lisp/progmodes/executable.el
View file

@ -199,20 +199,20 @@ non-executable files."
(file-modes buffer-file-name)))))))
;;;###autoload
(defun executable-interpret (command)
"Run script with user-specified args, and collect output in a buffer.
While script runs asynchronously, you can use the \\[next-error] command
to find the next error."
While script runs asynchronously, you can use the \\[next-error]
command to find the next error. The buffer is also in `comint-mode' and
`compilation-shell-minor-mode', so that you can answer any prompts."
(interactive (list (read-string "Run script: "
(or executable-command
buffer-file-name))))
(require 'compile)
(save-some-buffers (not compilation-ask-about-save))
(make-local-variable 'executable-command)
(compile-internal (setq executable-command command)
"No more errors." "Interpretation"
;; Give it a simpler regexp to match.
nil executable-error-regexp-alist))
(set (make-local-variable 'executable-command) command)
(let ((compilation-error-regexp-alist executable-error-regexp-alist))
(compilation-start command t (lambda (x) "*interpretation*"))))

5
lisp/progmodes/grep.el
View file

@ -275,6 +275,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(defvar grep-error-face compilation-error-face
"Face name to use for grep error messages.")
(defvar grep-match-face 'match
"Face name to use for grep matches.")
(defvar grep-mode-font-lock-keywords
'(;; Command output lines.
("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face)
@ -291,7 +294,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(2 compilation-line-face))
;; Highlight grep matches and delete markers
("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
(2 compilation-column-face)
(2 grep-match-face)
((lambda (p))
(progn
;; Delete markers with `replace-match' because it updates

164
lisp/progmodes/hideshow.el
View file

@ -5,7 +5,7 @@
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
;; Maintainer-Version: 5.31
;; Maintainer-Version: 5.39.2.8
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
;; This file is part of GNU Emacs.
@ -58,7 +58,7 @@
;;
;; (load-library "hideshow")
;; (add-hook 'X-mode-hook ; other modes similarly
;; '(lambda () (hs-minor-mode 1)))
;; (lambda () (hs-minor-mode 1)))
;;
;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
@ -133,10 +133,7 @@
;; variable `hs-special-modes-alist'. Packages that use hideshow should
;; do something like:
;;
;; (let ((my-mode-hs-info '(my-mode "{{" "}}" ...)))
;; (if (not (member my-mode-hs-info hs-special-modes-alist))
;; (setq hs-special-modes-alist
;; (cons my-mode-hs-info hs-special-modes-alist))))
;; (add-to-list 'hs-special-modes-alist '(my-mode "{{" "}}" ...))
;;
;; If you have an entry that works particularly well, consider
;; submitting it for inclusion in hideshow.el. See docstring for
@ -180,9 +177,9 @@
;; In the case of `vc-diff', here is a less invasive workaround:
;;
;; (add-hook 'vc-before-checkin-hook
;; '(lambda ()
;; (goto-char (point-min))
;; (hs-show-block)))
;; (lambda ()
;; (goto-char (point-min))
;; (hs-show-block)))
;;
;; Unfortunately, these workarounds do not restore hideshow state.
;; If someone figures out a better way, please let me know.
@ -223,6 +220,7 @@
;;; Code:
(require 'easymenu)
(eval-when-compile (require 'cl))
;;---------------------------------------------------------------------------
;; user-configurable variables
@ -265,8 +263,7 @@ This has effect iff `search-invisible' is set to `open'."
'((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
(c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
(bibtex-mode ("^@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)
)
(java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning))
"*Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
@ -378,28 +375,6 @@ Note that `mode-line-format' is buffer-local.")
;;---------------------------------------------------------------------------
;; system dependency
; ;; xemacs compatibility
; (when (string-match "xemacs\\|lucid" emacs-version)
; ;; use pre-packaged compatiblity layer
; (require 'overlay))
;
; ;; xemacs and emacs-19 compatibility
; (when (or (not (fboundp 'add-to-invisibility-spec))
; (not (fboundp 'remove-from-invisibility-spec)))
; ;; `buffer-invisibility-spec' mutators snarfed from Emacs 20.3 lisp/subr.el
; (defun add-to-invisibility-spec (arg)
; (cond
; ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
; (setq buffer-invisibility-spec (list arg)))
; (t
; (setq buffer-invisibility-spec
; (cons arg buffer-invisibility-spec)))))
; (defun remove-from-invisibility-spec (arg)
; (when buffer-invisibility-spec
; (setq buffer-invisibility-spec
; (delete arg buffer-invisibility-spec)))))
;; hs-match-data
(defalias 'hs-match-data 'match-data)
;;---------------------------------------------------------------------------
@ -409,12 +384,9 @@ Note that `mode-line-format' is buffer-local.")
"Delete hideshow overlays in region defined by FROM and TO."
(when (< to from)
(setq from (prog1 to (setq to from))))
(let ((ovs (overlays-in from to)))
(while ovs
(let ((ov (car ovs)))
(when (overlay-get ov 'hs)
(delete-overlay ov)))
(setq ovs (cdr ovs)))))
(dolist (ov (overlays-in from to))
(when (overlay-get ov 'hs)
(delete-overlay ov))))
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.
@ -433,16 +405,16 @@ OV is shown.
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(setq hs-headline
(if hide-p
nil
(or hs-headline
(let ((start (overlay-start ov)))
(buffer-substring
(save-excursion (goto-char start)
(beginning-of-line)
(skip-chars-forward " \t")
(point))
start)))))
(if hide-p
nil
(or hs-headline
(let ((start (overlay-start ov)))
(buffer-substring
(save-excursion (goto-char start)
(beginning-of-line)
(skip-chars-forward " \t")
(point))
start)))))
(force-mode-line-update)
(overlay-put ov 'invisible (and hide-p 'hs)))
@ -464,10 +436,10 @@ on what kind of block is to be hidden."
;; deprecated backward compatibility -- `block'<=>`code'
(and (eq 'block hs-isearch-open)
(eq 'code flag)))
(overlay-put overlay 'isearch-open-invisible 'hs-isearch-show)
(overlay-put overlay
'isearch-open-invisible-temporary
'hs-isearch-show-temporary))
(overlay-put overlay 'isearch-open-invisible 'hs-isearch-show)
(overlay-put overlay
'isearch-open-invisible-temporary
'hs-isearch-show-temporary))
overlay))))
(defun hs-forward-sexp (match-data arg)
@ -523,10 +495,10 @@ and then further adjusted to be at the end of the line."
(defun hs-safety-is-job-n ()
"Warn if `buffer-invisibility-spec' does not contain symbol `hs'."
(unless (and (listp buffer-invisibility-spec)
(assq 'hs buffer-invisibility-spec))
(message "Warning: `buffer-invisibility-spec' does not contain hs!!")
(sit-for 2)))
(unless (and (listp buffer-invisibility-spec)
(assq 'hs buffer-invisibility-spec))
(message "Warning: `buffer-invisibility-spec' does not contain hs!!")
(sit-for 2)))
(defun hs-inside-comment-p ()
"Return non-nil if point is inside a comment, otherwise nil.
@ -543,10 +515,15 @@ as cdr."
(let ((q (point)))
(when (or (looking-at hs-c-start-regexp)
(re-search-backward hs-c-start-regexp (point-min) t))
;; first get to the beginning of this comment...
(while (and (not (bobp))
(= (point) (progn (forward-comment -1) (point))))
(forward-char -1))
;; ...then extend backwards
(forward-comment (- (buffer-size)))
(skip-chars-forward " \t\n\f")
(let ((p (point))
(not-hidable nil))
(hidable t))
(beginning-of-line)
(unless (looking-at (concat "[ \t]*" hs-c-start-regexp))
;; we are in this situation: (example)
@ -565,19 +542,19 @@ as cdr."
(while (and (< (point) q)
(> (point) p)
(not (looking-at hs-c-start-regexp)))
(setq p (point));; use this to avoid an infinite cycle
(setq p (point)) ;; use this to avoid an infinite cycle
(forward-comment 1)
(skip-chars-forward " \t\n\f"))
(when (or (not (looking-at hs-c-start-regexp))
(> (point) q))
;; we cannot hide this comment block
(setq not-hidable t)))
(setq hidable nil)))
;; goto the end of the comment
(forward-comment (buffer-size))
(skip-chars-backward " \t\n\f")
(end-of-line)
(when (>= (point) q)
(list (if not-hidable nil p) (point))))))))
(list (and hidable p) (point))))))))
(defun hs-grok-mode-type ()
"Set up hideshow variables for new buffers.
@ -645,7 +622,7 @@ Return point, or nil if original point was not in a block."
(hs-hide-level-recursive (1- arg) minp maxp)
(goto-char (match-beginning hs-block-start-mdata-select))
(hs-hide-block-at-point t)))
(hs-safety-is-job-n)
(hs-safety-is-job-n)
(goto-char maxp))
(defmacro hs-life-goes-on (&rest body)
@ -675,8 +652,8 @@ and `case-fold-search' are both t."
(let ((overlays (overlays-at (point)))
(found nil))
(while (and (not found) (overlayp (car overlays)))
(setq found (overlay-get (car overlays) 'hs)
overlays (cdr overlays)))
(setq found (overlay-get (car overlays) 'hs)
overlays (cdr overlays)))
found)))
(defun hs-c-like-adjust-block-beginning (initial)
@ -724,7 +701,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(funcall hs-hide-all-non-comment-function)
(hs-hide-block-at-point t)))
;; found a comment, probably
(let ((c-reg (hs-inside-comment-p))) ; blech!
(let ((c-reg (hs-inside-comment-p))) ; blech!
(when (and c-reg (car c-reg))
(if (> (count-lines (car c-reg) (nth 1 c-reg)) 1)
(hs-hide-block-at-point t c-reg)
@ -772,18 +749,15 @@ See documentation for functions `hs-hide-block' and `run-hooks'."
(or
;; first see if we have something at the end of the line
(catch 'eol-begins-hidden-region-p
(let ((here (point))
(ovs (save-excursion (end-of-line) (overlays-at (point)))))
(while ovs
(let ((ov (car ovs)))
(when (overlay-get ov 'hs)
(goto-char
(cond (end (overlay-end ov))
((eq 'comment (overlay-get ov 'hs)) here)
(t (+ (overlay-start ov) (overlay-get ov 'hs-ofs)))))
(delete-overlay ov)
(throw 'eol-begins-hidden-region-p t)))
(setq ovs (cdr ovs)))
(let ((here (point)))
(dolist (ov (save-excursion (end-of-line) (overlays-at (point))))
(when (overlay-get ov 'hs)
(goto-char
(cond (end (overlay-end ov))
((eq 'comment (overlay-get ov 'hs)) here)
(t (+ (overlay-start ov) (overlay-get ov 'hs-ofs)))))
(delete-overlay ov)
(throw 'eol-begins-hidden-region-p t)))
nil))
;; not immediately obvious, look for a suitable block
(let ((c-reg (hs-inside-comment-p))
@ -870,9 +844,9 @@ Key bindings:
(interactive "P")
(setq hs-headline nil
hs-minor-mode (if (null arg)
(not hs-minor-mode)
(> (prefix-numeric-value arg) 0)))
hs-minor-mode (if (null arg)
(not hs-minor-mode)
(> (prefix-numeric-value arg) 0)))
(if hs-minor-mode
(progn
(hs-grok-mode-type)
@ -912,27 +886,19 @@ Key bindings:
)))))
;; some housekeeping
(or (assq 'hs-minor-mode minor-mode-map-alist)
(setq minor-mode-map-alist
(cons (cons 'hs-minor-mode hs-minor-mode-map)
minor-mode-map-alist)))
(or (assq 'hs-minor-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist
(list '(hs-minor-mode " hs")))))
(add-to-list 'minor-mode-map-alist (cons 'hs-minor-mode hs-minor-mode-map))
(add-to-list 'minor-mode-alist '(hs-minor-mode " hs") t)
;; make some variables permanently buffer-local
(let ((vars '(hs-minor-mode
hs-c-start-regexp
hs-block-start-regexp
hs-block-start-mdata-select
hs-block-end-regexp
hs-forward-sexp-func
hs-adjust-block-beginning)))
(while vars
(let ((var (car vars)))
(make-variable-buffer-local var)
(put var 'permanent-local t))
(setq vars (cdr vars))))
(dolist (var '(hs-minor-mode
hs-c-start-regexp
hs-block-start-regexp
hs-block-start-mdata-select
hs-block-end-regexp
hs-forward-sexp-func
hs-adjust-block-beginning))
(make-variable-buffer-local var)
(put var 'permanent-local t))
;;---------------------------------------------------------------------------
;; that's it

4
lisp/progmodes/idlwave.el
View file

@ -2571,7 +2571,9 @@ If not in a statement just moves to end of line. Returns position."
(let ((save-point (point)))
(when (re-search-forward ".*&" lim t)
(goto-char (match-end 0))
(if (idlwave-quoted) (goto-char save-point)))
(if (idlwave-quoted)
(goto-char save-point)
(if (eq (char-after (- (point) 2)) ?&) (goto-char save-point))))
(point)))
(defun idlwave-skip-label-or-case ()

166
lisp/replace.el
View file

@ -735,16 +735,17 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
Compatibility function for \\[next-error] invocations."
(interactive "p")
;; we need to run occur-find-match from within the Occur buffer
(with-current-buffer
(with-current-buffer
(if (next-error-buffer-p (current-buffer))
(current-buffer)
(next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))
(when reset
(goto-char (point-min)))
(goto-char (cond (reset (point-min))
((< argp 0) (line-beginning-position))
((line-end-position))))
(occur-find-match
(abs (prefix-numeric-value argp))
(if (> 0 (prefix-numeric-value argp))
(abs argp)
(if (> 0 argp)
#'previous-single-property-change
#'next-single-property-change)
"No more matches")
@ -752,6 +753,20 @@ Compatibility function for \\[next-error] invocations."
(set-window-point (get-buffer-window (current-buffer)) (point))
(occur-mode-goto-occurrence)))
(defface match
'((((class color) (min-colors 88) (background light))
:background "Tan")
(((class color) (min-colors 88) (background dark))
:background "RoyalBlue4")
(((class color) (min-colors 8))
:background "blue" :foreground "white")
(((type tty) (class mono))
:inverse-video t)
(t :background "gray"))
"Face used to highlight matches permanently."
:group 'matching
:version "21.4")
(defcustom list-matching-lines-default-context-lines 0
"*Default number of context lines included around `list-matching-lines' matches.
A negative number means to include that many lines before the match.
@ -761,7 +776,7 @@ A positive number means to include that many lines both before and after."
(defalias 'list-matching-lines 'occur)
(defcustom list-matching-lines-face 'bold
(defcustom list-matching-lines-face 'match
"*Face used by \\[list-matching-lines] to show the text that matches.
If the value is nil, don't highlight the matching portions specially."
:type 'face
@ -776,18 +791,22 @@ If the value is nil, don't highlight the buffer names specially."
(defun occur-accumulate-lines (count &optional keep-props)
(save-excursion
(let ((forwardp (> count 0))
(result nil))
result beg end)
(while (not (or (zerop count)
(if forwardp
(eobp)
(bobp))))
(setq count (+ count (if forwardp -1 1)))
(setq beg (line-beginning-position)
end (line-end-position))
(if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode
(text-property-not-all beg end 'fontified t))
(jit-lock-fontify-now beg end))
(push
(funcall (if keep-props
#'buffer-substring
#'buffer-substring-no-properties)
(line-beginning-position)
(line-end-position))
beg end)
result)
(forward-line (if forwardp 1 -1)))
(nreverse result))))
@ -982,14 +1001,17 @@ See also `multi-occur'."
(when (setq endpt (re-search-forward regexp nil t))
(setq matches (1+ matches)) ;; increment match count
(setq matchbeg (match-beginning 0))
(setq begpt (save-excursion
(goto-char matchbeg)
(line-beginning-position)))
(setq lines (+ lines (1- (count-lines origpt endpt))))
(save-excursion
(goto-char matchbeg)
(setq begpt (line-beginning-position)
endpt (line-end-position)))
(setq marker (make-marker))
(set-marker marker matchbeg)
(setq curstring (buffer-substring begpt
(line-end-position)))
(if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode
(text-property-not-all begpt endpt 'fontified t))
(jit-lock-fontify-now begpt endpt))
(setq curstring (buffer-substring begpt endpt))
;; Depropertize the string, and maybe
;; highlight the matches
(let ((len (length curstring))
@ -998,17 +1020,15 @@ See also `multi-occur'."
(set-text-properties 0 len nil curstring))
(while (and (< start len)
(string-match regexp curstring start))
(add-text-properties (match-beginning 0)
(match-end 0)
(append
`(occur-match t)
(when match-face
;; Use `face' rather than
;; `font-lock-face' here
;; so as to override faces
;; copied from the buffer.
`(face ,match-face)))
curstring)
(add-text-properties
(match-beginning 0) (match-end 0)
(append
`(occur-match t)
(when match-face
;; Use `face' rather than `font-lock-face' here
;; so as to override faces copied from the buffer.
`(face ,match-face)))
curstring)
(setq start (match-end 0))))
;; Generate the string to insert for this match
(let* ((out-line
@ -1019,7 +1039,10 @@ See also `multi-occur'."
(when prefix-face
`(font-lock-face prefix-face))
'(occur-prefix t)))
curstring
;; We don't put `mouse-face' on the newline,
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring 'mouse-face 'highlight)
"\n"))
(data
(if (= nlines 0)
@ -1043,10 +1066,7 @@ See also `multi-occur'."
(insert "-------\n"))
(add-text-properties
beg end
`(occur-target ,marker help-echo "mouse-2: go to this occurrence"))
;; We don't put `mouse-face' on the newline,
;; because that loses.
(add-text-properties beg (1- end) '(mouse-face highlight)))))
`(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
(goto-char endpt))
(if endpt
(progn
@ -1283,6 +1303,7 @@ make, or the user didn't cancel the call."
(isearch-string isearch-string)
(isearch-regexp isearch-regexp)
(isearch-case-fold-search isearch-case-fold-search)
(message
(if query-flag
(substitute-command-keys
@ -1315,9 +1336,11 @@ make, or the user didn't cancel the call."
(if regexp-flag from-string
(regexp-quote from-string))
"\\b")))
(if (eq query-replace-highlight 'isearch)
(setq isearch-string search-string
isearch-regexp regexp-flag))
(when query-replace-lazy-highlight
(setq isearch-string search-string
isearch-regexp (or delimited-flag regexp-flag)
isearch-case-fold-search case-fold-search
isearch-lazy-highlight-last-string nil))
(push-mark)
(undo-boundary)
@ -1535,13 +1558,15 @@ make, or the user didn't cancel the call."
(append (listify-key-sequence key)
unread-command-events))
(setq done t)))
(when (eq query-replace-highlight 'isearch)
;; Force isearch rehighlighting
(if (not (memq def '(skip backup)))
(setq isearch-lazy-highlight-last-string nil))
;; Restore isearch data in case of isearching during edit
(when query-replace-lazy-highlight
;; Restore isearch data for lazy highlighting
;; in case of isearching during recursive edit
(setq isearch-string search-string
isearch-regexp regexp-flag)))
isearch-regexp (or delimited-flag regexp-flag)
isearch-case-fold-search case-fold-search)
;; Force lazy rehighlighting only after replacements
(if (not (memq def '(skip backup)))
(setq isearch-lazy-highlight-last-string nil))))
;; Record previous position for ^ when we move on.
;; Change markers to numbers in the match data
;; since lots of markers slow down editing.
@ -1576,38 +1601,45 @@ make, or the user didn't cancel the call."
(if (= replace-count 1) "" "s")))
(and keep-going stack)))
(defcustom query-replace-highlight
(if (and search-highlight isearch-lazy-highlight) 'isearch t)
"*Non-nil means to highlight words during query replacement.
If `isearch', use isearch highlighting for query replacement."
:type '(choice (const :tag "Highlight" t)
(const :tag "No highlighting" nil)
(const :tag "Isearch highlighting" 'isearch))
(defcustom query-replace-highlight t
"*Non-nil means to highlight matches during query replacement."
:type 'boolean
:group 'matching)
(defcustom query-replace-lazy-highlight t
"*Controls the lazy-highlighting during query replacements.
When non-nil, all text in the buffer matching the current match
is highlighted lazily using isearch lazy highlighting (see
`isearch-lazy-highlight-initial-delay' and
`isearch-lazy-highlight-interval')."
:type 'boolean
:group 'matching
:version "21.4")
(defface query-replace
'((t (:inherit isearch)))
"Face for highlighting query replacement matches."
:group 'matching
:version "21.4")
(defvar replace-overlay nil)
(defun replace-dehighlight ()
(cond ((eq query-replace-highlight 'isearch)
(isearch-dehighlight t)
(isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil))
(query-replace-highlight
(when replace-overlay
(delete-overlay replace-overlay)
(setq replace-overlay nil)))))
(defun replace-highlight (beg end)
(if query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay beg end (current-buffer))
(setq replace-overlay (make-overlay beg end))
(overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
(isearch-lazy-highlight-new-loop)))
(defun replace-highlight (start end)
(cond ((eq query-replace-highlight 'isearch)
(isearch-highlight start end)
(isearch-lazy-highlight-new-loop))
(query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay start end (current-buffer))
(setq replace-overlay (make-overlay start end))
(overlay-put replace-overlay 'face
(if (facep 'query-replace)
'query-replace 'region))))))
(defun replace-dehighlight ()
(when replace-overlay
(delete-overlay replace-overlay))
(when query-replace-lazy-highlight
(isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil)))
;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
;;; replace.el ends here

21
lisp/simple.el
View file

@ -645,10 +645,6 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point."
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
(defvar inhibit-mark-movement nil
"If non-nil, movement commands, such as \\[beginning-of-buffer], \
do not set the mark.")
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With \\[universal-argument] prefix, do not set mark at previous position.
@ -660,8 +656,7 @@ of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-min)) is faster and avoids clobbering the mark."
(interactive "P")
(or inhibit-mark-movement
(consp arg)
(or (consp arg)
(and transient-mark-mode mark-active)
(push-mark))
(let ((size (- (point-max) (point-min))))
@ -686,8 +681,7 @@ of the accessible part of the buffer.
Don't use this command in Lisp programs!
\(goto-char (point-max)) is faster and avoids clobbering the mark."
(interactive "P")
(or inhibit-mark-movement
(consp arg)
(or (consp arg)
(and transient-mark-mode mark-active)
(push-mark))
(let ((size (- (point-max) (point-min))))
@ -1490,6 +1484,17 @@ is not *inside* the region START...END."
(t
'(0 . 0)))
'(0 . 0)))
;; When the first undo batch in an undo list is longer than undo-outer-limit,
;; this function gets called to ask the user what to do.
;; Garbage collection is inhibited around the call,
;; so it had better not do a lot of consing.
(setq undo-outer-limit-function 'undo-outer-limit-truncate)
(defun undo-outer-limit-truncate (size)
(if (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? "
(buffer-name) size))
(progn (setq buffer-undo-list nil) t)
nil))
(defvar shell-command-history nil
"History list for some commands that read shell commands.")

2
lisp/textmodes/ispell.el
View file

@ -1975,7 +1975,7 @@ SPC: Accept word this time.
(sit-for 5)
(kill-buffer "*Ispell Help*"))
(unwind-protect
(progn
(let ((resize-mini-windows 'grow-only))
(select-window (minibuffer-window))
(erase-buffer)
(message nil)

23
lisp/tooltip.el
View file

@ -1,6 +1,7 @@
;;; tooltip.el --- show tooltip windows
;; Copyright (C) 1997, 1999, 2000, 2001, 2004 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
@ -476,7 +477,25 @@ This function must return nil if it doesn't handle EVENT."
(defun tooltip-show-help-function (msg)
"Function installed as `show-help-function'.
MSG is either a help string to display, or nil to cancel the display."
(let ((previous-help tooltip-help-message))
(let ((previous-help tooltip-help-message)
mp pos)
(if (and mouse-1-click-follows-link
(stringp msg)
(save-match-data
(string-match "^mouse-2" msg))
(setq mp (mouse-pixel-position))
(consp (setq pos (cdr mp)))
(setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
(windowp (posn-window pos)))
(with-current-buffer (window-buffer (posn-window pos))
(if (mouse-on-link-p (posn-point pos))
(setq msg (concat
(cond
((eq mouse-1-click-follows-link 'double) "double-")
((and (integerp mouse-1-click-follows-link)
(< mouse-1-click-follows-link 0)) "Long ")
(t ""))
"mouse-1" (substring msg 7))))))
(setq tooltip-help-message msg)
(cond ((null msg)
;; Cancel display. This also cancels a delayed tip, if

2
lisp/vc.el
View file

@ -2836,7 +2836,7 @@ Uses `rcs2log' which only works for RCS and CVS."
(pop-to-buffer
(set-buffer (get-buffer-create "*vc*")))
(erase-buffer)
(insert-file tempfile)
(insert-file-contents tempfile)
"failed"))
(setq default-directory (file-name-directory changelog))
(delete-file tempfile)))))

6
lisp/wid-edit.el
View file

@ -327,6 +327,7 @@ new value.")
(let ((keymap (widget-get widget :keymap))
(face (or (widget-get widget :value-face) 'widget-field-face))
(help-echo (widget-get widget :help-echo))
(follow-link (widget-get widget :follow-link))
(rear-sticky
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
@ -345,6 +346,7 @@ new value.")
;; works in the field when, say, Custom uses `suppress-keymap'.
(overlay-put overlay 'local-map keymap)
(overlay-put overlay 'face face)
(overlay-put overlay 'follow-link follow-link)
(overlay-put overlay 'help-echo help-echo))
(setq to (1- to))
(setq rear-sticky t))
@ -354,6 +356,7 @@ new value.")
(overlay-put overlay 'field widget)
(overlay-put overlay 'local-map keymap)
(overlay-put overlay 'face face)
(overlay-put overlay 'follow-link follow-link)
(overlay-put overlay 'help-echo help-echo)))
(widget-specify-secret widget))
@ -378,6 +381,7 @@ new value.")
(defun widget-specify-button (widget from to)
"Specify button for WIDGET between FROM and TO."
(let ((overlay (make-overlay from to nil t nil))
(follow-link (widget-get widget :follow-link))
(help-echo (widget-get widget :help-echo)))
(widget-put widget :button-overlay overlay)
(if (functionp help-echo)
@ -389,6 +393,7 @@ new value.")
(unless (widget-get widget :suppress-face)
(overlay-put overlay 'face (widget-apply widget :button-face-get)))
(overlay-put overlay 'pointer 'hand)
(overlay-put overlay 'follow-link follow-link)
(overlay-put overlay 'help-echo help-echo)))
(defun widget-mouse-help (window overlay point)
@ -1705,6 +1710,7 @@ If END is omitted, it defaults to the length of LIST."
"An embedded link."
:button-prefix 'widget-link-prefix
:button-suffix 'widget-link-suffix
:follow-link "\C-m"
:help-echo "Follow the link."
:format "%[%t%]")

4
lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2004-12-21 Richard M. Stallman <rms@gnu.org>
* commands.texi (Event Input Misc): Add while-no-input.
2004-12-11 Richard M. Stallman <rms@gnu.org>
* display.texi (Line Height): Rewrite text for clarity.

12
lispref/commands.texi
View file

@ -2388,6 +2388,18 @@ The alias @code{last-input-char} exists for compatibility with
Emacs version 18.
@end defvar
@defmac while-no-input body...
This construct runs the @var{body} forms and returns the value
of the last one---but only if no input arrives. If any input
arrives during the execution of the @var{body} forms, it aborts
them (working much like a quit), and the @code{while-no-input}
form returns @code{nil}.
If a part of @var{body} binds @code{inhibit-quit} to non-@code{nil},
arrival of input during those parts won't cause an abort until
the end of that part.
@end defmac
@defun discard-input
@cindex flush input
@cindex discard input

37
man/ChangeLog
View file

@ -1,3 +1,40 @@
2004-12-20 Jay Belanger <belanger@truman.edu>
* calc.texi (Types Tutorial): Emphasized that you can't divide by
zero.
2004-12-17 Luc Teirlinck <teirllm@auburn.edu>
* cc-mode.texi (Text Filling and Line Breaking): Put period after
@xref.
(Font Locking): Avoid @strong{Note:}.
2004-12-17 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.46.
* tramp.texi (bottom): Add arch-tag. It was lost, somehow.
2004-12-16 Luc Teirlinck <teirllm@auburn.edu>
* url.texi: Correct typos.
(Retrieving URLs): @var{nil}->@code{nil}.
(HTTP language/coding, mailto): Replace "GNU Emacs Manual" with
the standard "The GNU Emacs Manual" in fifth argument of @xref's.
(Dealing with HTTP documents): @inforef->@xref.
2004-12-15 Juri Linkov <juri@jurta.org>
* mark.texi (Transient Mark, Mark Ring): M-< and other
movement commands don't set mark in Transient Mark mode
if mark is active.
2004-12-15 Jay Belanger <belanger@truman.edu>
* calc.texi: Consistently capitalized all mode names.
(Answers to Exercises): Mention that an answer can be a fraction
when in Fraction mode.
2004-12-13 Jay Belanger <belanger@truman.edu>
* calc.texi: Fix some TeX definitions.

449
man/calc.texi
View file

File diff suppressed because it is too large Load diff

4
man/cc-mode.texi
View file

@ -1420,7 +1420,7 @@ then as the comment prefix. It defaults to @samp{*
@code{c-block-comment-prefix} typically gets overriden by the default
style @code{gnu}, which sets it to blank. You can see the line
splitting effect described here by setting a different style,
e.g. @code{k&r} @xref{Choosing a Style}}, which makes a comment
e.g. @code{k&r} @xref{Choosing a Style}.}, which makes a comment
@example
/* Got O(n^2) here, which is a Bad Thing. */
@ -1643,7 +1643,7 @@ trailing backslashes.
@cindex font locking
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@strong{Note:} The font locking in AWK mode is currently not integrated
@strong{Please note:} The font locking in AWK mode is currently not integrated
with the rest of @ccmode{}, so this section does not apply there.
@xref{AWK Mode Font Locking}, instead.

11
man/mark.texi
View file

@ -191,7 +191,9 @@ You can activate the new region by executing @kbd{C-x C-x}
(@code{exchange-point-and-mark}).
@item
@kbd{C-s} when the mark is active does not alter the mark.
Commands that normally set the mark before moving long distances (like
@kbd{M-<} and @kbd{C-s}) do not alter the mark in Transient Mark mode
when the mark is active.
@item
Some commands operate on the region if a region is active. For
@ -384,9 +386,10 @@ the same buffer.
Many commands that can move long distances, such as @kbd{M-<}
(@code{beginning-of-buffer}), start by setting the mark and saving the
old mark on the mark ring. This is to make it easier for you to move
back later. Searches set the mark if they move point. You can tell
when a command sets the mark because it displays @samp{Mark set} in the
echo area.
back later. Searches set the mark if they move point. However, in
Transient Mark mode, these commands do not set the mark when the mark
is already active. You can tell when a command sets the mark because
it displays @samp{Mark set} in the echo area.
If you want to move back to the same place over and over, the mark
ring may not be convenient enough. If so, you can record the position

2
man/trampver.texi
View file

@ -4,7 +4,7 @@
@c In the Tramp CVS, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
@set trampver 2.0.45
@set trampver 2.0.46
@c Other flags from configuration
@set prefix /usr/local

94
man/url.texi
View file

@ -27,7 +27,7 @@ Copyright (C) 1993, 1994, 1995, 1996 William M. Perry
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation; with the
Invariant Sections being
Invariant Sections being
``GNU GENERAL PUBLIC LICENSE''. A copy of the
license is included in the section entitled ``GNU Free Documentation
License.''
@ -74,9 +74,9 @@ License.''
* General Facilities:: URLs can be cached, accessed via a gateway
and tracked in a history list.
* Customization:: Variables you can alter.
* Function Index::
* Variable Index::
* Concept Index::
* Function Index::
* Variable Index::
* Concept Index::
@end menu
@node Getting Started
@ -115,7 +115,7 @@ The meaning of
the @var{path} component depends on the service.
@menu
* Configuration::
* Configuration::
* Parsed URLs:: URLs are parsed into vector structures.
@end menu
@ -204,7 +204,7 @@ Recreates a URL string from the parsed @var{url}.
@defun url-retrieve-synchronously url
Retrieve @var{url} synchronously and return a buffer containing the
data. @var{url} is either a string or a parsed URL structure. Return
@var{nil} if there are no data associated with it (the case for dired,
@code{nil} if there are no data associated with it (the case for dired,
info, or mailto URLs that need no further processing).
@end defun
@ -214,7 +214,7 @@ Retrieve @var{url} asynchronously and call @var{callback} with args
has been completely retrieved, with the current buffer containing the
object and any MIME headers associated with it. @var{url} is either a
string or a parsed URL structure. Returns the buffer @var{url} will
load into, or @var{nil} if the process has already completed.
load into, or @code{nil} if the process has already completed.
@end defun
@node Supported URL Types
@ -222,7 +222,7 @@ load into, or @var{nil} if the process has already completed.
@menu
* http/https:: Hypertext Transfer Protocol.
* file/ftp:: Local files and FTP archives.
* file/ftp:: Local files and FTP archives.
* info:: Emacs `Info' pages.
* mailto:: Sending email.
* news/nntp/snews:: Usenet news.
@ -235,7 +235,7 @@ load into, or @var{nil} if the process has already completed.
@c * netrek::
@c * prospero::
* cid:: Content-ID.
* about::
* about::
* ldap:: Lightweight Directory Access Protocol
* imap:: IMAP mailboxes.
* man:: Unix man pages.
@ -273,10 +273,10 @@ otherwise the user will be asked on each request.
@menu
* Cookies::
* HTTP language/coding::
* HTTP URL Options::
* Dealing with HTTP documents::
* Cookies::
* HTTP language/coding::
* HTTP URL Options::
* Dealing with HTTP documents::
@end menu
@node Cookies
@ -330,7 +330,7 @@ preferred character set encodings, e.g.@: Latin-9 or Big5, and these
can be weighted. In Emacs 21 this list is generated automatically
from the list of defined coding systems which have associated MIME
types. These are sorted by coding priority. @xref{Recognize Coding,
, Recognizing Coding Systems, emacs, GNU Emacs Manual}.
, Recognizing Coding Systems, emacs, The GNU Emacs Manual}.
@end defopt
@defopt url-mime-language-string
@ -384,9 +384,9 @@ Currently this is just the raw header contents.
HTTP URLs are retrieved into a buffer containing the HTTP headers
followed by the body. Since the headers are quasi-MIME, they may be
processed using the MIME library. @inforef{Top, The MIME library,
emacs-mime}. The URL package provides a function to do this in
general:
processed using the MIME library. @xref{Top,, Emacs MIME,
emacs-mime, The Emacs MIME Manual}. The URL package provides a
function to do this in general:
@defun url-decode-text-part handle &optional coding
This function decodes charset-encoded text in the current buffer. In
@ -414,8 +414,8 @@ file://@var{user}:@var{password}@@@var{host}:@var{port}/@var{file}
@end example
These schemes are defined in RFC 1808.
@samp{ftp:} and @samp{file:} are synonomous in this library. They
allow reading arbitary files from hosts. Either @samp{ange-ftp}
@samp{ftp:} and @samp{file:} are synonymous in this library. They
allow reading arbitrary files from hosts. Either @samp{ange-ftp}
(Emacs) or @samp{efs} (XEmacs) is used to retrieve them from remote
hosts. Local files are accessed directly.
@ -451,13 +451,13 @@ Info URLs are not officially defined. They invoke
@cindex email
A mailto URL will send an email message to the address in the
URL, for example @samp{mailto:foo@@bar.com} would compose a
message to @samp{foo@@bar.com}.
message to @samp{foo@@bar.com}.
@defopt url-mail-command
@vindex mail-user-agent
The function called whenever url needs to send mail. This should
normally be left to default from @var{mail-user-agent}. @xref{Mail
Methods, , Mail-Composition Methods, emacs, GNU Emacs Manual}.
Methods, , Mail-Composition Methods, emacs, The GNU Emacs Manual}.
@end defopt
An @samp{X-Url-From} header field containing the URL of the document
@ -468,7 +468,7 @@ The form of a mailto URL is
@example
@samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]}
@end example
@noindent where an arbitary number of @var{header}s can be added. If the
@noindent where an arbitrary number of @var{header}s can be added. If the
@var{header} is @samp{body}, then @var{contents} is put in the body
otherwise a @var{header} header field is created with @var{contents}
as its contents. Note that the URL library does not consider any
@ -493,11 +493,11 @@ fields may be included in news URLs though they are properly only
allowed for nntp an snews.
@table @samp
@item news:@var{newsgroup}
@item news:@var{newsgroup}
Retrieves a list of messages in @var{newsgroup};
@item news:@var{message-id}
Retrieves the message with the given @var{message-id};
@item news:*
@item news:*
Retrieves a list of all available newsgroups;
@item nntp://@var{host}:@var{port}/@var{newsgroup}
@itemx nntp://@var{host}:@var{port}/@var{message-id}
@ -510,7 +510,7 @@ Similar to the @samp{news} versions.
@samp{snews} is the same as @samp{nntp} except that the default port
is :563.
@cindex SSL
(It is tunnelled through SSL.)
(It is tunneled through SSL.)
An @samp{nntp} URL is the same as a news URL, except that the URL may
specify an article by its number.
@ -550,9 +550,9 @@ Well-known ports are used if the URL does not specify a port.
@cindex IRC
@cindex Internet Relay Chat
@cindex ZEN IRC
@c Fixme: reference (was http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt)
@c Fixme: reference (was http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt)
@dfn{Internet Relay Chat} (IRC) is handled by handing off the @sc{irc}
session to a function named in @code{url-irc-function}.
session to a function named in @code{url-irc-function}.
@defopt url-irc-function
A function to actually open an IRC connection.
@ -582,7 +582,7 @@ including parameters. It defaults to
@samp{text/plain;charset=US-ASCII}. The @samp{text/plain} can be
omitted but the charset parameter supplied. If @samp{;base64} is
present, the @var{data} are base64-encoded.
@node nfs
@section nfs
@cindex NFS
@ -658,11 +658,11 @@ the Lisp @code{man} function.
@chapter Defining New URLs
@menu
* Naming conventions::
* Required functions::
* Optional functions::
* Asynchronous fetching::
* Supporting file-name-handlers::
* Naming conventions::
* Required functions::
* Optional functions::
* Asynchronous fetching::
* Supporting file-name-handlers::
@end menu
@node Naming conventions
@ -684,10 +684,10 @@ the Lisp @code{man} function.
@chapter General Facilities
@menu
* Disk Caching::
* Proxies::
* Gateways in general::
* History::
* Disk Caching::
* Proxies::
* Gateways in general::
* History::
@end menu
@node Disk Caching
@ -761,7 +761,7 @@ more likely to conflict with other files.
@end smallexample
@end defun
@c Fixme: never actually used currently?
@c Fixme: never actually used currently?
@c @defopt url-standalone-mode
@c @cindex Relying on cache
@c @cindex Cache only mode
@ -783,7 +783,7 @@ more likely to conflict with other files.
@node Proxies
@section Proxies and Gatewaying
@c fixme: check/document url-ns stuff
@c fixme: check/document url-ns stuff
@cindex proxy servers
@cindex proxies
@cindex environment variables
@ -815,7 +815,7 @@ NO_PROXY="*.aventail.com,home.com,.seanet.com"
@noindent says to contact all machines in the @samp{aventail.com} and
@samp{seanet.com} domains directly, as well as the machine named
@samp{home.com}. If @code{NO_PROXY} isn't defined, @code{no_PROXY}
and @code{no_proxy} are also tried, in that order.
and @code{no_proxy} are also tried, in that order.
Proxies may also be specified directly in Lisp.
@ -940,7 +940,7 @@ This specifies the default server, it takes the form
where @var{version} can be either 4 or 5.
@end defopt
@defvar socks-password
If this is @code{nil} then you will be asked for the passward,
If this is @code{nil} then you will be asked for the password,
otherwise it will be used as the password for authenticating you to
the @sc{socks} server.
@end defvar
@ -980,9 +980,9 @@ This the @samp{nslookup} program. It is @code{"nslookup"} by default.
@end defopt
@menu
* Suppressing network connexions::
* Suppressing network connexions::
@end menu
@c * Broken hostname resolution::
@c * Broken hostname resolution::
@node Suppressing network connexions
@subsection Suppressing Network Connexions
@ -1010,7 +1010,7 @@ opened by the URL library.
@c @cindex resolver, hostname
@c Some C libraries do not include the hostname resolver routines in
@c their static libraries. If Emacs was linked statically, and was not
@c linked with the resolver libraries, it wil not be able to get to any
@c linked with the resolver libraries, it will not be able to get to any
@c machines off the local network. This is characterized by being able
@c to reach someplace with a raw ip number, but not its hostname
@c (@url{http://129.79.254.191/} works, but
@ -1052,8 +1052,8 @@ The history `list' is actually a hash table,
strings. The times are in the format returned by @code{current-time}.
@defun url-history-update-url url time
This function updates the hsitory table with an entry for @var{url}
accessed at the gievn @var{time}.
This function updates the history table with an entry for @var{url}
accessed at the given @var{time}.
@end defun
@defopt url-history-track
@ -1144,7 +1144,7 @@ function taking a single argument (the prompt) and returning @code{t}
only if an affirmative answer is given.
@end defopt
@defopt url-gateway-method
@c fixme: describe gatewaying
@c fixme: describe gatewaying
A symbol specifying the type of gateway support to use fro connexions
from the local machine. The supported methods are:

116
src/ChangeLog
View file

@ -1,3 +1,118 @@
2004-12-23 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* keyboard.c (input_available_signal): Call SIGNAL_THREAD_CHECK
before touching input_available_clear_time, to avoid accessing it
from multiple threads.
2004-12-23 Jason Rumney <jasonr@gnu.org>
* image.c (__WIN32__) [HAVE_NTGUI]: Define for correct behaviour
of JPEG library.
2004-12-22 Richard M. Stallman <rms@gnu.org>
* emacs.c (main): If batch mode, set Vundo_outer_limit to nil.
* lisp.h (Vundo_outer_limit): Fix decl.
* undo.c (Vundo_outer_limit): Replaces undo_outer_limit.
Uses changed.
(syms_of_undo): Initialize appropriately.
(truncate_undo_list): If it's nil, there's no limit.
2004-12-22 Kenichi Handa <handa@m17n.org>
* xselect.c (Fx_get_cut_buffer_internal): Return a unibyte string.
2004-12-21 Richard M. Stallman <rms@gnu.org>
* eval.c (unwind_to_catch): Clear immediate_quit.
* xdisp.c (get_next_display_element): Display codes 8a0 and 8ad
specially as `\ ' and `\-'.
* keyboard.c (kbd_buffer_store_event_hold):
In the code for while-no-input, handle immediate_quit.
* alloc.c (Fgarbage_collect): Update call to truncate_undo_list.
Call that at the very start.
(undo_limit, undo_strong_limit, undo_outer_limit): Moved to undo.c.
(syms_of_alloc): Don't define undo-limit,
undo-strong-limit and undo-outer-limit here.
* undo.c (truncate_undo_list): Return void.
Take just one argument, the buffer.
Make it current, and inhibit recursive GC.
Access and update the undo list directly; return void.
Refer to the undo...limit variables directly.
Test undo_outer_limit only after counting the whole current command.
When it's exceeded, call the function in undo-outer-limit-function.
(undo_limit, undo_strong_limit, undo_outer_limit): From alloc.c.
(Vundo_outer_limit_function): New variable.
(syms_of_undo): Define undo-limit, undo-strong-limit
and undo-outer-limit here, and undo-outer-limit-function.
Doc fixes.
* lisp.h (truncate_undo_list): Update decl.
2004-12-21 Piet van Oostrum <piet@cs.uu.nl>
* fileio.c (Fread_file_name): Delete duplicates in
file-name-history when history_delete_duplicates is true.
2004-12-20 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* macterm.c (mac_do_list_fonts): Fix memory leak
2004-12-20 Richard M. Stallman <rms@gnu.org>
* regex.c (re_match_2_internal) <symend, wordend>:
Fix calls to UPDATE_SYNTAX_TABLE_FORWARD.
2004-12-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* macterm.c (endif, x_font_name_to_mac_font_name): Use
maccentraleurroman instead of maccentraleuropean
(mac_c_string_match, mac_do_list_fonts): Speed up font search by
quickly finding a specific font without needing regexps.
2004-12-15 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* syssignal.h: Declare main_thread.
(SIGNAL_THREAD_CHECK): New macro.
* keyboard.c (input_available_signal): Move thread checking code
to macro SIGNAL_THREAD_CHECK and call that macro.
(interrupt_signal): Call SIGNAL_THREAD_CHECK.
* alloc.c (uninterrupt_malloc): Move main_thread to emacs.c.
* emacs.c: Define main_thread.
(main): Initialize main_thread.
(handle_USR1_signal, handle_USR2_signal, fatal_error_signal)
(memory_warning_signal): Call SIGNAL_THREAD_CHECK.
* floatfns.c (float_error): Call SIGNAL_THREAD_CHECK.
* dispnew.c (window_change_signal): Call SIGNAL_THREAD_CHECK.
* sysdep.c (select_alarm): Call SIGNAL_THREAD_CHECK.
* process.c (send_process_trap, sigchld_handler): Call
SIGNAL_THREAD_CHECK.
* data.c (arith_error): Call SIGNAL_THREAD_CHECK.
* atimer.c (alarm_signal_handler): Call SIGNAL_THREAD_CHECK.
* xterm.c (xg_scroll_callback): Update XG_LAST_SB_DATA before
returning when xg_ignore_gtk_scrollbar is true.
2004-12-14 Kim F. Storm <storm@cua.dk>
* keyboard.c (read_char): Save and restore echo_string when
handling input method.
2004-12-13 Richard M. Stallman <rms@gnu.org>
* eval.c (syms_of_eval) <quit-flag>: Doc fix.
@ -143,6 +258,7 @@
* eval.c (Fcalled_interactively_p): Don't check INTERACTIVE.
(interactive_p): Skip Scalled_interactively_p frames
like Sinteractive_p frames.
(unwind_to_catch): Clear handling_signal.
* data.c (Fmake_variable_buffer_local): Doc fix.
(Fmake_local_variable): Doc fix.

109
src/alloc.c
View file

@ -99,7 +99,7 @@ extern __malloc_size_t __malloc_extra_blocks;
If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
functions below are called from malloc, there is a chance that one
of these threads preempts the Emacs main thread and the hook variables
end up in a inconsistent state. So we have a mutex to prevent that (note
end up in an inconsistent state. So we have a mutex to prevent that (note
that the backend handles concurrent access to malloc within its own threads
but Emacs code running in the main thread is not included in that control).
@ -109,7 +109,6 @@ extern __malloc_size_t __malloc_extra_blocks;
To prevent that, we only call BLOCK/UNBLOCK from the main thread. */
static pthread_mutex_t alloc_mutex;
pthread_t main_thread;
#define BLOCK_INPUT_ALLOC \
do \
@ -201,12 +200,6 @@ extern
#endif /* VIRT_ADDR_VARIES */
int malloc_sbrk_unused;
/* Two limits controlling how much undo information to keep. */
EMACS_INT undo_limit;
EMACS_INT undo_strong_limit;
EMACS_INT undo_outer_limit;
/* Number of live and free conses etc. */
static int total_conses, total_markers, total_symbols, total_vector_size;
@ -1310,8 +1303,6 @@ uninterrupt_malloc ()
pthread_mutexattr_init (&attr);
pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
pthread_mutex_init (&alloc_mutex, &attr);
main_thread = pthread_self ();
#endif /* HAVE_GTK_AND_PTHREAD */
if (__free_hook != emacs_blocked_free)
@ -4604,13 +4595,48 @@ returns nil, because real GC can't be done. */)
if (abort_on_gc)
abort ();
EMACS_GET_TIME (t1);
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return Qnil;
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
{
register struct buffer *nextb = all_buffers;
while (nextb)
{
/* If a buffer's undo list is Qt, that means that undo is
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
if (nextb->base_buffer == 0 && !NILP (nextb->name))
{
/* If a buffer's gap size is more than 10% of the buffer
size, or larger than 2000 bytes, then shrink it
accordingly. Keep a minimum size of 20 bytes. */
int size = min (2000, max (20, (nextb->text->z_byte / 10)));
if (nextb->text->gap_size > size)
{
struct buffer *save_current = current_buffer;
current_buffer = nextb;
make_gap (-(nextb->text->gap_size - size));
current_buffer = save_current;
}
}
nextb = nextb->next;
}
}
EMACS_GET_TIME (t1);
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
consing_since_gc = 0;
@ -4649,42 +4675,6 @@ returns nil, because real GC can't be done. */)
shrink_regexp_cache ();
/* Don't keep undo information around forever. */
{
register struct buffer *nextb = all_buffers;
while (nextb)
{
/* If a buffer's undo list is Qt, that means that undo is
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
nextb->undo_list
= truncate_undo_list (nextb->undo_list, undo_limit,
undo_strong_limit, undo_outer_limit);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
if (nextb->base_buffer == 0 && !NILP (nextb->name))
{
/* If a buffer's gap size is more than 10% of the buffer
size, or larger than 2000 bytes, then shrink it
accordingly. Keep a minimum size of 20 bytes. */
int size = min (2000, max (20, (nextb->text->z_byte / 10)));
if (nextb->text->gap_size > size)
{
struct buffer *save_current = current_buffer;
current_buffer = nextb;
make_gap (-(nextb->text->gap_size - size));
current_buffer = save_current;
}
}
nextb = nextb->next;
}
}
gc_in_progress = 1;
/* clear_marks (); */
@ -5959,29 +5949,6 @@ prevent garbage collection during a part of the program. */);
doc: /* Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in shared (pure) space. */);
DEFVAR_INT ("undo-limit", &undo_limit,
doc: /* Keep no more undo information once it exceeds this size.
This limit is applied when garbage collection happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data. */);
undo_limit = 20000;
DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
doc: /* Don't keep more than this much size of undo information.
A previous command which pushes the undo list past this size
is entirely forgotten when GC happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data. */);
undo_strong_limit = 30000;
DEFVAR_INT ("undo-outer-limit", &undo_outer_limit,
doc: /* Don't keep more than this much size of undo information.
If the current command has produced more than this much undo information,
GC discards it. This is a last-ditch limit to prevent memory overflow.
The size is counted as the number of bytes occupied,
which includes both saved text and other data. */);
undo_outer_limit = 300000;
DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
doc: /* Non-nil means display messages at start and end of garbage collection. */);
garbage_collection_messages = 0;

2
src/atimer.c
View file

@ -364,6 +364,8 @@ alarm_signal_handler (signo)
{
EMACS_TIME now;
SIGNAL_THREAD_CHECK (signo);
EMACS_GET_TIME (now);
pending_atimers = 0;

1
src/data.c
View file

@ -3262,6 +3262,7 @@ arith_error (signo)
sigsetmask (SIGEMPTYMASK);
#endif /* not BSD4_1 */
SIGNAL_THREAD_CHECK (signo);
Fsignal (Qarith_error, Qnil);
}

4
src/dispnew.c
View file

@ -5980,6 +5980,9 @@ window_change_signal (signalnum) /* If we don't have an argument, */
#endif
int old_errno = errno;
signal (SIGWINCH, window_change_signal);
SIGNAL_THREAD_CHECK (signalnum);
get_frame_size (&width, &height);
/* The frame size change obviously applies to a termcap-controlled
@ -6002,7 +6005,6 @@ window_change_signal (signalnum) /* If we don't have an argument, */
}
}
signal (SIGWINCH, window_change_signal);
errno = old_errno;
}
#endif /* SIGWINCH */

21
src/emacs.c
View file

@ -342,6 +342,14 @@ int fatal_error_in_progress;
void (*fatal_error_signal_hook) P_ ((void));
#ifdef HAVE_GTK_AND_PTHREAD
/* When compiled with GTK and running under Gnome, multiple threads meay be
created. Keep track of our main thread to make sure signals are delivered
to it (see syssignal.h). */
pthread_t main_thread;
#endif
#ifdef SIGUSR1
SIGTYPE
@ -350,6 +358,7 @@ handle_USR1_signal (sig)
{
struct input_event buf;
SIGNAL_THREAD_CHECK (sig);
bzero (&buf, sizeof buf);
buf.kind = USER_SIGNAL_EVENT;
buf.frame_or_window = selected_frame;
@ -365,6 +374,7 @@ handle_USR2_signal (sig)
{
struct input_event buf;
SIGNAL_THREAD_CHECK (sig);
bzero (&buf, sizeof buf);
buf.kind = USER_SIGNAL_EVENT;
buf.code = 1;
@ -379,6 +389,7 @@ SIGTYPE
fatal_error_signal (sig)
int sig;
{
SIGNAL_THREAD_CHECK (sig);
fatal_error_code = sig;
signal (sig, SIG_DFL);
@ -418,6 +429,7 @@ memory_warning_signal (sig)
int sig;
{
signal (sig, memory_warning_signal);
SIGNAL_THREAD_CHECK (sig);
malloc_warning ("Operating system warns that virtual memory is running low.\n");
@ -1029,6 +1041,10 @@ main (argc, argv
# endif /* not SYNC_INPUT */
#endif /* not SYSTEM_MALLOC */
#ifdef HAVE_GTK_AND_PTHREAD
main_thread = pthread_self ();
#endif /* HAVE_GTK_AND_PTHREAD */
#if defined (MSDOS) || defined (WINDOWSNT)
/* We do all file input/output as binary files. When we need to translate
newlines, we do that manually. */
@ -1117,7 +1133,10 @@ main (argc, argv
/* Handle the -batch switch, which means don't do interactive display. */
noninteractive = 0;
if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args))
noninteractive = 1;
{
noninteractive = 1;
Vundo_outer_limit = Qnil;
}
if (argmatch (argv, argc, "-script", "--script", 3, &junk, &skip_args))
{
noninteractive = 1; /* Set batch mode. */

1
src/eval.c
View file

@ -1178,6 +1178,7 @@ unwind_to_catch (catch, value)
set_poll_suppress_count (catch->poll_suppress_count);
interrupt_input_blocked = catch->interrupt_input_blocked;
handling_signal = 0;
immediate_quit = 0;
do
{

16
src/fileio.c
View file

@ -228,6 +228,8 @@ extern int minibuf_level;
extern int minibuffer_auto_raise;
extern int history_delete_duplicates;
/* These variables describe handlers that have "already" had a chance
to handle the current operation.
@ -6299,7 +6301,13 @@ and `read-file-name-function'. */)
if (replace_in_history)
/* Replace what Fcompleting_read added to the history
with what we will actually return. */
XSETCAR (Fsymbol_value (Qfile_name_history), double_dollars (val));
{
Lisp_Object val1 = double_dollars (val);
tem = Fsymbol_value (Qfile_name_history);
if (history_delete_duplicates)
XSETCDR (tem, Fdelete (val1, XCDR(tem)));
XSETCAR (tem, val1);
}
else if (add_to_history)
{
/* Add the value to the history--but not if it matches
@ -6307,8 +6315,10 @@ and `read-file-name-function'. */)
Lisp_Object val1 = double_dollars (val);
tem = Fsymbol_value (Qfile_name_history);
if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
Fset (Qfile_name_history,
Fcons (val1, tem));
{
if (history_delete_duplicates) tem = Fdelete (val1, tem);
Fset (Qfile_name_history, Fcons (val1, tem));
}
}
return val;

1
src/floatfns.c
View file

@ -981,6 +981,7 @@ float_error (signo)
signal (SIGILL, float_error);
#endif /* BSD_SYSTEM */
SIGNAL_THREAD_CHECK (signo);
in_float = 0;
Fsignal (Qarith_error, Fcons (float_error_arg, Qnil));

6
src/image.c
View file

@ -6269,6 +6269,12 @@ jpeg_image_p (object)
#undef HAVE_STDLIB_H
#endif /* HAVE_STLIB_H */
#if defined (HAVE_NTGUI) && !defined (__WIN32__)
/* jpeglib.h will define boolean differently depending on __WIN32__,
so make sure it is defined. */
#define __WIN32__ 1
#endif
#include <jpeglib.h>
#include <jerror.h>
#include <setjmp.h>

56
src/keyboard.c
View file

@ -3043,6 +3043,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
/* Save the echo status. */
int saved_immediate_echo = current_kboard->immediate_echo;
struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
Lisp_Object saved_echo_string = current_kboard->echo_string;
int saved_echo_after_prompt = current_kboard->echo_after_prompt;
#if 0
@ -3097,6 +3098,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
current_kboard->echo_string = saved_echo_string;
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
@ -3579,6 +3581,9 @@ event_to_kboard (event)
}
#endif
Lisp_Object Vthrow_on_input;
/* Store an event obtained at interrupt level into kbd_buffer, fifo */
void
@ -3704,6 +3709,24 @@ kbd_buffer_store_event_hold (event, hold_quit)
*kbd_store_ptr = *event;
++kbd_store_ptr;
}
/* If we're inside while-no-input, and this event qualifies
as input, set quit-flag to cause an interrupt. */
if (!NILP (Vthrow_on_input)
&& event->kind != FOCUS_IN_EVENT
&& event->kind != HELP_EVENT
&& event->kind != DEICONIFY_EVENT)
{
Vquit_flag = Vthrow_on_input;
/* If we're inside a function that wants immediate quits,
do it now. */
if (immediate_quit && NILP (Vinhibit_quit))
{
immediate_quit = 0;
sigfree ();
QUIT;
}
}
}
@ -6817,30 +6840,16 @@ input_available_signal (signo)
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
SIGNAL_THREAD_CHECK (signo);
#endif
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
# if !defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD)
extern pthread_t main_thread;
if (pthread_self () != main_thread)
{
/* POSIX says any thread can receive the signal. On GNU/Linux that is
not true, but for other systems (FreeBSD at least) it is. So direct
the signal to the correct thread and block it from this thread. */
sigset_t new_mask;
sigemptyset (&new_mask);
sigaddset (&new_mask, SIGIO);
pthread_sigmask (SIG_BLOCK, &new_mask, 0);
pthread_kill (main_thread, SIGIO);
return;
}
# endif /* HAVE_GTK_AND_PTHREAD */
#ifndef SYNC_INPUT
handle_async_input ();
#endif
@ -10255,6 +10264,7 @@ interrupt_signal (signalnum) /* If we don't have an argument, */
}
#endif /* USG */
SIGNAL_THREAD_CHECK (signalnum);
cancel_echoing ();
if (!NILP (Vquit_flag)
@ -11375,6 +11385,12 @@ Used during Emacs' startup. */);
doc: /* *How long to display an echo-area message when the minibuffer is active.
If the value is not a number, such messages don't time out. */);
Vminibuffer_message_timeout = make_number (2);
DEFVAR_LISP ("throw-on-input", &Vthrow_on_input,
doc: /* If non-nil, any keyboard input throws to this symbol.
The value of that variable is passed to `quit-flag' and later causes a
peculiar kind of quitting. */);
Vthrow_on_input = Qnil;
}
void

3
src/lisp.h
View file

@ -3090,7 +3090,7 @@ extern void syms_of_macros P_ ((void));
/* defined in undo.c */
extern Lisp_Object Qinhibit_read_only;
EXFUN (Fundo_boundary, 0);
extern Lisp_Object truncate_undo_list P_ ((Lisp_Object, int, int, int));
extern void truncate_undo_list P_ ((struct buffer *));
extern void record_marker_adjustment P_ ((Lisp_Object, int));
extern void record_insert P_ ((int, int));
extern void record_delete P_ ((int, Lisp_Object));
@ -3099,6 +3099,7 @@ extern void record_change P_ ((int, int));
extern void record_property_change P_ ((int, int, Lisp_Object, Lisp_Object,
Lisp_Object));
extern void syms_of_undo P_ ((void));
extern Lisp_Object Vundo_outer_limit;
/* defined in textprop.c */
extern Lisp_Object Qfont, Qmouse_face;

102
src/macterm.c
View file

@ -5997,7 +5997,7 @@ mac_to_x_fontname (name, size, style, scriptcode, encoding_base)
strcpy(cs, "mac-cyrillic");
break;
case kTextEncodingMacCentralEurRoman:
strcpy(cs, "mac-centraleuropean");
strcpy(cs, "mac-centraleurroman");
break;
case kTextEncodingMacSymbol:
case kTextEncodingMacDingbats:
@ -6055,7 +6055,7 @@ x_font_name_to_mac_font_name (char *xf, char *mf)
coding_system = Qeuc_kr;
else if (strcmp (cs, "mac-roman") == 0
|| strcmp (cs, "mac-cyrillic") == 0
|| strcmp (cs, "mac-centraleuropean") == 0
|| strcmp (cs, "mac-centraleurroman") == 0
|| strcmp (cs, "adobe-fontspecific") == 0)
strcpy (mf, family);
else
@ -6299,6 +6299,28 @@ static int xlfd_scalable_fields[] =
-1
};
static Lisp_Object
mac_c_string_match (regexp, string, nonspecial, exact)
Lisp_Object regexp;
const char *string, *nonspecial;
int exact;
{
if (exact)
{
if (strcmp (string, nonspecial) == 0)
return build_string (string);
}
else if (strstr (string, nonspecial))
{
Lisp_Object str = build_string (string);
if (fast_string_match (regexp, str) >= 0)
return str;
}
return Qnil;
}
static Lisp_Object
mac_do_list_fonts (pattern, maxnames)
char *pattern;
@ -6310,6 +6332,8 @@ mac_do_list_fonts (pattern, maxnames)
char scaled[256];
char *ptr;
int scl_val[XLFD_SCL_LAST], *field, *val;
char *longest_start, *cur_start, *nonspecial;
int longest_len, cur_len, exact;
for (i = 0; i < XLFD_SCL_LAST; i++)
scl_val[i] = -1;
@ -6367,34 +6391,66 @@ mac_do_list_fonts (pattern, maxnames)
ptr = regex;
*ptr++ = '^';
/* Turn pattern into a regexp and do a regexp match. */
longest_start = cur_start = ptr;
longest_len = cur_len = 0;
exact = 1;
/* Turn pattern into a regexp and do a regexp match. Also find the
longest substring containing no special characters. */
for (; *pattern; pattern++)
{
if (*pattern == '?')
*ptr++ = '.';
else if (*pattern == '*')
{
*ptr++ = '.';
*ptr++ = '*';
}
if (*pattern == '?' || *pattern == '*')
{
if (cur_len > longest_len)
{
longest_start = cur_start;
longest_len = cur_len;
}
cur_len = 0;
exact = 0;
if (*pattern == '?')
*ptr++ = '.';
else /* if (*pattern == '*') */
{
*ptr++ = '.';
*ptr++ = '*';
}
}
else
*ptr++ = tolower (*pattern);
{
if (cur_len == 0)
cur_start = ptr;
cur_len++;
*ptr++ = tolower (*pattern);
}
}
if (cur_len > longest_len)
{
longest_start = cur_start;
longest_len = cur_len;
}
*ptr = '$';
*(ptr + 1) = '\0';
nonspecial = xmalloc (longest_len + 1);
strncpy (nonspecial, longest_start, longest_len);
nonspecial[longest_len] = '\0';
pattern_regex = build_string (regex);
for (i = 0; i < font_name_count; i++)
{
fontname = build_string (font_name_table[i]);
if (fast_string_match (pattern_regex, fontname) >= 0)
fontname = mac_c_string_match (pattern_regex, font_name_table[i],
nonspecial, exact);
if (!NILP (fontname))
{
font_list = Fcons (fontname, font_list);
n_fonts++;
if (maxnames > 0 && n_fonts >= maxnames)
break;
if (exact || maxnames > 0 && ++n_fonts >= maxnames)
break;
}
else if (scl_val[XLFD_SCL_PIXEL_SIZE] > 0
&& (ptr = strstr (font_name_table[i], "-0-0-75-75-m-0-")))
@ -6408,17 +6464,19 @@ mac_do_list_fonts (pattern, maxnames)
scl_val[XLFD_SCL_POINT_SIZE],
scl_val[XLFD_SCL_AVGWIDTH],
ptr + sizeof ("-0-0-75-75-m-0-") - 1);
fontname = build_string (scaled);
if (fast_string_match (pattern_regex, fontname) >= 0)
fontname = mac_c_string_match (pattern_regex, scaled,
nonspecial, exact);
if (!NILP (fontname))
{
font_list = Fcons (fontname, font_list);
n_fonts++;
if (maxnames > 0 && n_fonts >= maxnames)
if (exact || maxnames > 0 && ++n_fonts >= maxnames)
break;
}
}
}
xfree (nonspecial);
return font_list;
}

3
src/process.c
View file

@ -5109,6 +5109,7 @@ Lisp_Object process_sent_to;
SIGTYPE
send_process_trap ()
{
SIGNAL_THREAD_CHECK (SIGPIPE);
#ifdef BSD4_1
sigrelse (SIGPIPE);
sigrelse (SIGALRM);
@ -6144,6 +6145,8 @@ sigchld_handler (signo)
register struct Lisp_Process *p;
extern EMACS_TIME *input_available_clear_time;
SIGNAL_THREAD_CHECK (signo);
#ifdef BSD4_1
extern int sigheld;
sigheld |= sigbit (SIGCHLD);

2
src/regex.c
View file

@ -6096,7 +6096,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop)
PREFETCH_NOLIMIT ();
c2 = RE_STRING_CHAR (d, dend - d);
#ifdef emacs
UPDATE_SYNTAX_TABLE_FORWARD (charpos);
UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1);
#endif
s2 = SYNTAX (c2);

1
src/sysdep.c
View file

@ -2472,6 +2472,7 @@ select_alarm ()
#else /* not BSD4_1 */
signal (SIGALRM, SIG_IGN);
#endif /* not BSD4_1 */
SIGNAL_THREAD_CHECK (SIGALRM);
if (read_alarm_should_throw)
longjmp (read_alarm_throw, 1);
}

27
src/syssignal.h
View file

@ -20,6 +20,11 @@ Boston, MA 02111-1307, USA. */
extern void init_signals P_ ((void));
#ifdef HAVE_GTK_AND_PTHREAD
#include <pthread.h>
extern pthread_t main_thread;
#endif
#ifdef POSIX_SIGNALS
/* Don't #include <signal.h>. That header should always be #included
@ -198,5 +203,27 @@ extern SIGMASKTYPE sigprocmask_set;
char *strsignal ();
#endif
#ifdef HAVE_GTK_AND_PTHREAD
#define SIGNAL_THREAD_CHECK(signo) \
do { \
if (pthread_self () != main_thread) \
{ \
/* POSIX says any thread can receive the signal. On GNU/Linux \
that is not true, but for other systems (FreeBSD at least) \
it is. So direct the signal to the correct thread and block \
it from this thread. */ \
sigset_t new_mask; \
\
sigemptyset (&new_mask); \
sigaddset (&new_mask, signo); \
pthread_sigmask (SIG_BLOCK, &new_mask, 0); \
pthread_kill (main_thread, signo); \
return; \
} \
} while (0)
#else /* not HAVE_GTK_AND_PTHREAD */
#define SIGNAL_THREAD_CHECK(signo)
#endif /* not HAVE_GTK_AND_PTHREAD */
/* arch-tag: 4580e86a-340d-4574-9e11-a742b6e1a152
(do not change this comment) */

154
src/undo.c
View file

@ -24,6 +24,17 @@ Boston, MA 02111-1307, USA. */
#include "buffer.h"
#include "commands.h"
/* Limits controlling how much undo information to keep. */
EMACS_INT undo_limit;
EMACS_INT undo_strong_limit;
Lisp_Object Vundo_outer_limit;
/* Function to call when undo_outer_limit is exceeded. */
Lisp_Object Vundo_outer_limit_function;
/* Last buffer for which undo information was recorded. */
Lisp_Object last_undo_buffer;
@ -291,31 +302,35 @@ but another undo command will undo to the previous boundary. */)
}
/* At garbage collection time, make an undo list shorter at the end,
returning the truncated list.
MINSIZE, MAXSIZE and LIMITSIZE are the limits on size allowed,
as described below.
In practice, these are the values of undo-limit,
undo-strong-limit, and undo-outer-limit. */
returning the truncated list. How this is done depends on the
variables undo-limit, undo-strong-limit and undo-outer-limit.
In some cases this works by calling undo-outer-limit-function. */
Lisp_Object
truncate_undo_list (list, minsize, maxsize, limitsize)
Lisp_Object list;
int minsize, maxsize, limitsize;
void
truncate_undo_list (b)
struct buffer *b;
{
Lisp_Object list;
Lisp_Object prev, next, last_boundary;
int size_so_far = 0;
/* Make sure that calling undo-outer-limit-function
won't cause another GC. */
int count = inhibit_garbage_collection ();
/* Make the buffer current to get its local values of variables such
as undo_limit. Also so that Vundo_outer_limit_function can
tell which buffer to operate on. */
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
set_buffer_internal (b);
list = b->undo_list;
prev = Qnil;
next = list;
last_boundary = Qnil;
/* Always preserve at least the most recent undo record
unless it is really horribly big.
If the first element is an undo boundary, skip past it.
Skip, skip, skip the undo, skip, skip, skip the undo,
Skip, skip, skip the undo, skip to the undo bound'ry.
(Get it? "Skip to my Loo?") */
/* If the first element is an undo boundary, skip past it. */
if (CONSP (next) && NILP (XCAR (next)))
{
/* Add in the space occupied by this element and its chain link. */
@ -326,6 +341,12 @@ truncate_undo_list (list, minsize, maxsize, limitsize)
next = XCDR (next);
}
/* Always preserve at least the most recent undo record
unless it is really horribly big.
Skip, skip, skip the undo, skip, skip, skip the undo,
Skip, skip, skip the undo, skip to the undo bound'ry. */
while (CONSP (next) && ! NILP (XCAR (next)))
{
Lisp_Object elt;
@ -341,35 +362,53 @@ truncate_undo_list (list, minsize, maxsize, limitsize)
+ SCHARS (XCAR (elt)));
}
/* If we reach LIMITSIZE before the first boundary,
we're heading for memory full, so truncate the list to nothing. */
if (size_so_far > limitsize)
return Qnil;
/* Advance to next element. */
prev = next;
next = XCDR (next);
}
/* If by the first boundary we have already passed undo_outer_limit,
we're heading for memory full, so offer to clear out the list. */
if (INTEGERP (Vundo_outer_limit)
&& size_so_far > XINT (Vundo_outer_limit)
&& !NILP (Vundo_outer_limit_function))
{
Lisp_Object temp = last_undo_buffer;
/* Normally the function this calls is undo-outer-limit-truncate. */
if (! NILP (call1 (Vundo_outer_limit_function,
make_number (size_so_far))))
{
/* The function is responsible for making
any desired changes in buffer-undo-list. */
unbind_to (count, Qnil);
return;
}
/* That function probably used the minibuffer, and if so, that
changed last_undo_buffer. Change it back so that we don't
force next change to make an undo boundary here. */
last_undo_buffer = temp;
}
if (CONSP (next))
last_boundary = prev;
/* Keep more if it fits. */
/* Keep additional undo data, if it fits in the limits. */
while (CONSP (next))
{
Lisp_Object elt;
elt = XCAR (next);
/* When we get to a boundary, decide whether to truncate
either before or after it. The lower threshold, MINSIZE,
either before or after it. The lower threshold, undo_limit,
tells us to truncate after it. If its size pushes past
the higher threshold MAXSIZE as well, we truncate before it. */
the higher threshold undo_strong_limit, we truncate before it. */
if (NILP (elt))
{
if (size_so_far > maxsize)
if (size_so_far > undo_strong_limit)
break;
last_boundary = prev;
if (size_so_far > minsize)
if (size_so_far > undo_limit)
break;
}
@ -390,16 +429,15 @@ truncate_undo_list (list, minsize, maxsize, limitsize)
/* If we scanned the whole list, it is short enough; don't change it. */
if (NILP (next))
return list;
;
/* Truncate at the boundary where we decided to truncate. */
if (!NILP (last_boundary))
{
XSETCDR (last_boundary, Qnil);
return list;
}
else if (!NILP (last_boundary))
XSETCDR (last_boundary, Qnil);
/* There's nothing we decided to keep, so clear it out. */
else
return Qnil;
b->undo_list = Qnil;
unbind_to (count, Qnil);
}
DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
@ -563,6 +601,54 @@ syms_of_undo ()
defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
DEFVAR_INT ("undo-limit", &undo_limit,
doc: /* Keep no more undo information once it exceeds this size.
This limit is applied when garbage collection happens.
When a previous command increases the total undo list size past this
value, the earlier commands that came before it are forgotten.
The size is counted as the number of bytes occupied,
which includes both saved text and other data. */);
undo_limit = 20000;
DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
doc: /* Don't keep more than this much size of undo information.
This limit is applied when garbage collection happens.
When a previous command increases the total undo list size past this
value, that command and the earlier commands that came before it are forgotten.
However, the most recent buffer-modifying command's undo info
is never discarded for this reason.
The size is counted as the number of bytes occupied,
which includes both saved text and other data. */);
undo_strong_limit = 30000;
DEFVAR_LISP ("undo-outer-limit", &Vundo_outer_limit,
doc: /* Outer limit on size of undo information for one command.
At garbage collection time, if the current command has produced
more than this much undo information, it asks you whether to delete
the information. This is a last-ditch limit to prevent memory overflow.
The size is counted as the number of bytes occupied,
which includes both saved text and other data.
In fact, this calls the function which is the value of
`undo-outer-limit-function' with one argument, the size.
The text above describes the behavior of the function
that variable usually specifies. */);
Vundo_outer_limit = make_number (300000);
DEFVAR_LISP ("undo-outer-limit-function", &Vundo_outer_limit_function,
doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
This function is called with one argument, the current undo list size
for the most recent command (since the last undo boundary).
If the function returns t, that means truncation has been fully handled.
If it returns nil, the other forms of truncation are done.
Garbage collection is inhibited around the call to this function,
so it must make sure not to do a lot of consing. */);
Vundo_outer_limit_function = Qnil;
}
/* arch-tag: d546ee01-4aed-4ffb-bb8b-eefaae50d38a

15
src/xdisp.c
View file

@ -5050,6 +5050,21 @@ get_next_display_element (it)
XSETINT (it->ctl_chars[1], g);
ctl_len = 2;
}
else if (it->c == 0x8a0 || it->c == 0x8ad)
{
/* Set IT->ctl_chars[0] to the glyph for `\\'. */
if (it->dp
&& INTEGERP (DISP_ESCAPE_GLYPH (it->dp))
&& GLYPH_CHAR_VALID_P (XINT (DISP_ESCAPE_GLYPH (it->dp))))
g = XINT (DISP_ESCAPE_GLYPH (it->dp));
else
g = FAST_MAKE_GLYPH ('\\', face_id);
XSETINT (it->ctl_chars[0], g);
g = FAST_MAKE_GLYPH (it->c == 0x8ad ? '-' : ' ', face_id);
XSETINT (it->ctl_chars[1], g);
ctl_len = 2;
}
else
{
unsigned char str[MAX_MULTIBYTE_LENGTH];

2
src/xselect.c
View file

@ -2324,7 +2324,7 @@ DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
Fcons (x_atom_to_symbol (display, type),
Fcons (make_number (format), Qnil))));
ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
/* Use xfree, not XFree, because x_get_window_property
calls xmalloc itself. */
xfree (data);

6
src/xterm.c
View file

@ -4289,8 +4289,6 @@ xg_scroll_callback (widget, data)
int part = -1, whole = 0, portion = 0;
GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_range_get_adjustment (widget));
if (xg_ignore_gtk_scrollbar) return;
position = gtk_adjustment_get_value (adj);
p = g_object_get_data (G_OBJECT (widget), XG_LAST_SB_DATA);
@ -4304,6 +4302,8 @@ xg_scroll_callback (widget, data)
previous = *p;
*p = position;
if (xg_ignore_gtk_scrollbar) return;
diff = (int) (position - previous);
if (diff == (int) adj->step_increment)
@ -4335,7 +4335,7 @@ xg_scroll_callback (widget, data)
}
if (part >= 0)
{
{
window_being_scrolled = bar->window;
last_scroll_bar_part = part;
x_send_scroll_bar_event (bar->window, part, portion, whole);