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

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-55

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

Patches applied:

 * emacs--cvs-trunk--0  (patch 320-323)

   - Update from CVS
This commit is contained in:
Miles Bader 2005-05-26 05:42:19 +00:00
commit d2eeec7fb9
95 changed files with 2243 additions and 961 deletions
Download patch file Download diff file Expand all files Collapse all files

19
admin/FOR-RELEASE
View file

@ -88,23 +88,26 @@ is encountered.
** Add missing years in copyright notices of all files. ** Add missing years in copyright notices of all files.
Policy document admin/notes/years must be updated before
making further progress on this task!!!
Please record your name here and say which part of the distribution Please record your name here and say which part of the distribution
you're going to handle. you're going to handle.
DIRECTORY STATUS IN CHARGE DIRECTORY STATUS IN CHARGE
--------- ------ --------- --------- ------ ---------
leim working Kenichi Handa leim working Kenichi Handa
lisp/calc done Thien-Thi Nguyen lisp/calc working Thien-Thi Nguyen
lisp/calendar working Glenn Morris lisp/calendar working Glenn Morris
lisp/emulation done Thien-Thi Nguyen lisp/emulation working Thien-Thi Nguyen
lisp/eshell working Thien-Thi Nguyen lisp/eshell working Thien-Thi Nguyen
lisp/international done Kenichi Handa lisp/international done Kenichi Handa
lisp/languages done Kenichi Handa lisp/languages done Kenichi Handa
lisp/mh-e done Thien-Thi Nguyen lisp/mh-e working Thien-Thi Nguyen
lisp/net done Thien-Thi Nguyen lisp/net working Thien-Thi Nguyen
lisp/play done Thien-Thi Nguyen lisp/play working Thien-Thi Nguyen
lisp/term done Thien-Thi Nguyen lisp/term working Thien-Thi Nguyen
lisp/toolbar done Thien-Thi Nguyen lisp/toolbar working Thien-Thi Nguyen
lisp/url working Thien-Thi Nguyen lisp/url working Thien-Thi Nguyen
** Update AUTHORS. ** Update AUTHORS.
@ -132,7 +135,7 @@ man/commands.texi "Luc Teirlinck" Chong Yidong
man/custom.texi Chong Yidong man/custom.texi Chong Yidong
man/dired.texi Chong Yidong joakim@verona.se man/dired.texi Chong Yidong joakim@verona.se
man/display.texi "Luc Teirlinck" Chong Yidong man/display.texi "Luc Teirlinck" Chong Yidong
man/emacs.texi "Luc Teirlinck" man/emacs.texi "Luc Teirlinck" Lute Kamstra
man/entering.texi "Luc Teirlinck" Chong Yidong man/entering.texi "Luc Teirlinck" Chong Yidong
man/files.texi "Luc Teirlinck" Chong Yidong man/files.texi "Luc Teirlinck" Chong Yidong
man/fixit.texi "Luc Teirlinck" Chong Yidong man/fixit.texi "Luc Teirlinck" Chong Yidong

7
admin/notes/years
View file

@ -1,3 +1,10 @@
THIS DOCUMENT IS UNDER REVIEW.
DO NOT FOLLOW THESE INSTRUCTIONS -- THEY ARE NOT CORRECT.
How to Maintain Copyright Years for GNU Emacs How to Maintain Copyright Years for GNU Emacs

18
etc/NEWS
View file

@ -807,7 +807,7 @@ this variable is found in `default-indicate-buffer-boundaries'.
If value is `left' or `right', both angle and arrow bitmaps are If value is `left' or `right', both angle and arrow bitmaps are
displayed in the left or right fringe, resp. displayed in the left or right fringe, resp.
The value can also be an alist which specifies the presense and The value can also be an alist which specifies the presence and
position of each bitmap individually. position of each bitmap individually.
For example, ((top . left) (t . right)) places the top angle bitmap For example, ((top . left) (t . right)) places the top angle bitmap
@ -3069,6 +3069,10 @@ any customizations.
* Incompatible Lisp Changes in Emacs 22.1 * Incompatible Lisp Changes in Emacs 22.1
---
** The variables post-command-idle-hook and post-command-idle-delay have
been removed. Use run-with-idle-timer instead.
+++ +++
** `suppress-keymap' now works by remapping `self-insert-command' to ** `suppress-keymap' now works by remapping `self-insert-command' to
the command `undefined'. (In earlier Emacs versions, it used the command `undefined'. (In earlier Emacs versions, it used
@ -3087,10 +3091,6 @@ the command `undefined'. (In earlier Emacs versions, it used
** General Lisp changes: ** General Lisp changes:
---
*** The variables post-command-idle-hook and post-command-idle-delay have
been removed. Use run-with-idle-timer instead.
+++ +++
*** The function `eql' is now available without requiring the CL package. *** The function `eql' is now available without requiring the CL package.
@ -3705,6 +3705,7 @@ sure saved files have the current year in any copyright headers.
`save-some-buffers' will always save that buffer without asking (if `save-some-buffers' will always save that buffer without asking (if
it's modified). it's modified).
+++
*** New function `locate-file' searches for a file in a list of directories. *** New function `locate-file' searches for a file in a list of directories.
`locate-file' accepts a name of a file to search (a string), and two `locate-file' accepts a name of a file to search (a string), and two
lists: a list of directories to search in and a list of suffixes to lists: a list of directories to search in and a list of suffixes to
@ -4845,6 +4846,11 @@ used to add text properties to mode-line elements.
to display the size of the accessible part of the buffer on the mode to display the size of the accessible part of the buffer on the mode
line. line.
*** Mouse-face on mode-line (and header-line) is now supported.
`mode-line-highlight' is the standard face indicating mouse sensitive
elements on mode-line (and header-line) like `highlight' face on text
areas.
** Menu manipulation changes: ** Menu manipulation changes:
--- ---
@ -14322,7 +14328,7 @@ select one of those items.
---------------------------------------------------------------------- ----------------------------------------------------------------------
Copyright information: Copyright information:
Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the of this document as received, in any medium, provided that the

5
lib-src/ChangeLog
View file

@ -1,3 +1,8 @@
2005-05-25 Thien-Thi Nguyen <ttn@gnu.org>
* yow.c (setup_yow): Use EXIT_FAILURE in case no separators found.
(yow): Use EXIT_FAILURE in case of memory error.
2005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 2005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* make-docfile.c (DIRECTORY_SEP): New macro. * make-docfile.c (DIRECTORY_SEP): New macro.

6
lib-src/yow.c
View file

@ -104,7 +104,7 @@ setup_yow(fp)
while ((c = getc(fp)) != SEP) { while ((c = getc(fp)) != SEP) {
if (c == EOF) { if (c == EOF) {
fprintf(stderr, "yow: file contains no separators\n"); fprintf(stderr, "yow: file contains no separators\n");
exit(2); exit(EXIT_FAILURE);
} }
} }
header_len = ftell(fp); header_len = ftell(fp);
@ -157,7 +157,7 @@ yow (fp)
buf = (char *) malloc(bufsize); buf = (char *) malloc(bufsize);
if (buf == (char *)0) { if (buf == (char *)0) {
fprintf(stderr, "yow: virtual memory exhausted\n"); fprintf(stderr, "yow: virtual memory exhausted\n");
exit (3); exit (EXIT_FAILURE);
} }
buf[i++] = c; buf[i++] = c;
@ -170,7 +170,7 @@ yow (fp)
buf = (char *) realloc(buf, bufsize); buf = (char *) realloc(buf, bufsize);
if (buf == (char *)0) { if (buf == (char *)0) {
fprintf(stderr, "yow: virtual memory exhausted\n"); fprintf(stderr, "yow: virtual memory exhausted\n");
exit (3); exit (EXIT_FAILURE);
} }
} }
} }

391
lisp/ChangeLog
View file

@ -1,5 +1,333 @@
2005-05-26 Nick Roberts <nickrob@snap.net.nz>
* log-edit.el (log-edit-changelog-entries): Distinguish between
filenames like xfns.c and fns.c.
Coded by Stefan Monnier <monnier@iro.umontreal.ca>.
2005-05-25 Luc Teirlinck <teirllm@auburn.edu>
* buff-menu.el (Buffer-menu-revert-function): Improve handling of
point after reverting.
(Buffer-menu-make-sort-button): Handle the case where
`Buffer-menu-use-header-line' is nil.
2005-05-25 Thien-Thi Nguyen <ttn@gnu.org>
* vms-patch.el (vms-magic-right-square-brace, vms-magic-colon):
New funcs. In minibuffer-local-completion-map bind `]', `/'
and `:' to them.
2005-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
* startup.el (normal-top-level): Allow modification of load-path while
we're iterating over it.
2005-05-25 Juanma Barranquero <lekktu@gmail.com>
* thumbs.el (thumbs-thumbsdir-max-size, thumbs-temp-file)
(thumbs-cleanup-thumbsdir, thumbs-call-convert)
(thumbs-resize-interactive, thumbs-insert-image)
(thumbs-insert-thumb, thumbs-dired-show-marked)
(thumbs-find-image-at-point, thumbs-delete-images)
(thumbs-rename-images, thumbs-next-image, thumbs-dired-setroot)
(thumbs-increment-image-size, thumbs-decrement-image-size):
Fix typos in docstrings.
2005-05-24 Andre Spiegel <spiegel@gnu.org>
* progmodes/cperl-mode.el (cperl-vc-header-alist): Obsoleted.
(cperl-vc-rcs-header, cperl-vc-sccs-header): New user options.
(cperl-mode): Use them.
2005-05-24 Juanma Barranquero <lekktu@gmail.com>
* window.el (quit-window, shrink-window-if-larger-than-buffer):
Doc fixes.
2005-05-24 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-inferior-io-mode-map):
Bind C-d to gdb-inferior-io-eof.
* dired.el (dired-dnd-popup-notice): Use message-box.
2005-05-23 Masatake YAMATO <jet@gyve.org>
* bindings.el (mode-line-major-mode-keymap):
Bind [mode-line down-mouse-1] to `mouse-major-mode-menu'.
* faces.el (mode-line-highlight): New face.
* ruler-mode.el (ruler-mode-ruler): Use mode-line-highlight
as mouse-face.
* bindings.el (top-level, help-echo, mode-line-modified)
(mode-line-mule-info, mode-line-eol-desc): Use mode-line-highlight
as mouse-face.
2005-05-23 Juanma Barranquero <lekktu@gmail.com>
* progmodes/cc-engine.el (c-guess-basic-syntax):
Remove spurious call to `zerop'.
* emacs-lisp/cl.el (acons, pairlis): Add docstring.
2005-05-23 Martin Stjernholm <bug-cc-mode@gnu.org>
CC Mode update to 5.30.10:
* cc-fonts.el (c-font-lock-declarators): Fixed bug where the point
could go past the limit in decoration level 2, thereby causing
errors during interactive fontification.
* cc-mode.el (c-make-inherited-keymap): Fixed cc-bytecomp bug when
the file is evaluated interactively.
* cc-engine.el (c-guess-basic-syntax): Handle operator
declarations somewhat better in C++.
* cc-styles.el, cc-mode.el (c-run-mode-hooks): New helper macro to
make use of `run-mode-hooks' which has been added in Emacs 21.1.
(c-mode, c++-mode, objc-mode, java-mode, idl-mode, pike-mode)
(awk-mode): Use it.
(make-local-hook): Suppress warning about obsoleteness.
* cc-engine.el, cc-align.el, cc-cmds.el
(c-append-backslashes-forward, c-delete-backslashes-forward)
(c-find-decl-spots, c-semi&comma-no-newlines-before-nonblanks):
Compensate for return value from `forward-line' when it has moved
but not to a different line due to eob.
* cc-engine.el (c-guess-basic-syntax): Fixed anchoring in
`objc-method-intro' and `objc-method-args-cont'.
2005-05-23 Alan Mackenzie <bug-cc-mode@gnu.org>
CC Mode update to 5.30.10:
* cc-mode.el, cc-engine.el, cc-align.el: Change the FSF's address
in the copyright statement. Incidentally, change "along with GNU
Emacs" to "along with this program" where it occurs.
* cc-mode.el: Add a fourth parameter `t' to the awk-mode autoload,
so that it is interactive, hence can be found by M-x awk-mode
whilst cc-mode is yet to be loaded. Reported by Glenn Morris
<gmorris+emacs@ast.cam.ac.uk>.
* cc-awk.el: Add character classes (e.g. "[:alpha:]") into AWK
Mode's regexps.
2005-05-23 Kevin Ryde <user42@zip.com.au>
* cc-align.el (c-lineup-argcont): Ignore conses for {} pairs from
c-parse-state, to avoid a lisp error (on bad code).
2005-05-23 Lute Kamstra <lute@gnu.org>
* subr.el (font-lock-defaults): Remove defvar as it's already
defined in font-core.el.
* font-lock.el (font-lock-beginning-of-syntax-function): Fix
docstring.
2005-05-23 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-info-locals-handler): Make regexps
more general and work when GDB variable "print pretty" is on,
as with Emacs, for example.
2005-05-22 Luc Teirlinck <teirllm@auburn.edu>
* font-core.el: Update comment.
* emacs-lisp/easy-mmode.el (define-global-minor-mode): Use
`after-change-major-mode-hook' instead of `find-file-hook'.
* buff-menu.el (Buffer-menu-mode): Use `run-mode-hooks'.
2005-05-22 Eli Zaretskii <eliz@gnu.org>
* simple.el (yank, yank-pop): Mention `yank-excluded-properties'
and `yank-handler' in the doc strings.
2005-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl.el (eql): Remove. It's a builtin already.
2005-05-22 Richard M. Stallman <rms@gnu.org>
* help.el (describe-key): Move print-help-return-message call
out of conditional.
* progmodes/etags.el (list-tags): Use with-no-warnings.
* mail/smtpmail.el (smtpmail-open-stream): Use with-no-warnings.
(smtpmail-send-queued-mail): Avoid beginning-of-buffer.
(starttls-extra-args, starttls-extra-arguments): Add defvars.
* mail/mailalias.el (mail-get-names): Avoid beginning-of-buffer.
* language/viet-util.el (viet-viscii-nonascii-translation-table):
Add defvar.
* emulation/viper-ex.el (viper-ex-work-buf, viper-ex-print-buf):
Use defvar, not defconst.
* hexl.el (hexl-follow-line): Use with-no-warnings.
* emulation/tpu-extras.el: Use write-file-functions instead of
write-file-hooks.
* dired.el (dired-font-lock-keywords): Fontify files with junk
extensions even if marked by -F.
2005-05-22 Juanma Barranquero <lekktu@gmail.com>
* emacs-lisp/cl.el (pushnew, cl-macroexpand, floatp-safe, plusp)
(minusp, oddp, evenp, mapcar*, list*, copy-list, adjoin, subst):
* emacs-lisp/cl-extra.el (coerce, map, maplist, cl-mapc, mapl)
(mapcan, mapcon, some, every, notany, notevery, signum, isqrt)
(concatenate, list-length, get*, getf, cl-remprop):
* emacs-lisp/cl-macs.el (function*, case, ecase, typecase)
(etypecase, progv, lexical-let, lexical-let*)
(multiple-value-bind, multiple-value-setq, shiftf):
Improve argument/docstring consistency.
* subr.el (focus-frame, unfocus-frame):
Revert deletion on 2005-05-01.
2005-05-22 Andre Spiegel <spiegel@gnu.org>
* vc-cvs.el (vc-cvs-checkout-model): Handle the case where FILE
doesn't exist.
* vc.el (vc-trunk-p): Add autoload cookie. The function is used
in vc-rcs.el when vc-mistrust-permissions is t, which is not the
default.
2005-05-22 Nick Roberts <nickrob@snap.net.nz>
* emacs-lisp/bytecomp.el: Remove make-obsolete-variable for
already deleted variables: auto-fill-hook, blink-paren-hook,
lisp-indent-hook, inhibit-local-variables, unread-command-event
suspend-hooks, comment-indent-hook, meta-flag,
before-change-function, after-change-function,
font-lock-doc-string-face.
2005-05-21 Luc Teirlinck <teirllm@auburn.edu>
* emacs-lisp/derived.el (define-derived-mode): Doc fix.
2005-05-21 Eli Zaretskii <eliz@gnu.org>
* mail/rmail.el (rmail-reply): Filter the list in reply-to through
rmail-dont-reply-to.
2005-05-21 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
* mail/sendmail.el (mail-send): Use [[:space:]] instead of a
literal blank when splitting new-header-values.
2005-05-21 Matt Hodges <MPHodges@member.fsf.org>
* calendar/cal-menu.el (cal-menu-update): Add separator as a
string so that tmm doesn't create a completion entry for it.
* textmodes/table.el (table-disable-menu): Ditto.
2005-05-21 Richard M. Stallman <rms@gnu.org>
* progmodes/idlwave.el (idlwave-doc-header): Use insert-file-contents.
* progmodes/flymake.el (flymake-makehash): Use with-no-warnings.
* net/rcompile.el (remote-compile): Use compilation-start.
* tmm.el (tmm-shortcut): Avoid using beginning-of-buffer.
2005-05-21 Daniel Pfeiffer <occitan@esperanto.org>
* files.el (auto-mode-alist): Check GNUmakefile before makefile.
Default to makefile-bsdmake-mode on BSD systems.
* imenu.el (imenu-generic-expression, imenu--generic-function'):
REGEXP may also be a search function now. The part of doc-string
for describing the structure was 95% identical to that of
`imenu--generic-function'. Unify it there.
* progmodes/make-mode.el (makefile-imenu-generic-expression):
Use function to find dependencies, because regexp alone is so complex,
it easily goes into an endless loop.
(makefile-makepp-mode): Also add submenu for Perl functions
defined in the makefile.
(makefile-bsdmake-mode): Special imenu-generic-expression no
longer needed, due to function call.
(makefile-match-dependency): Take BOUND into account when checking
if we're through.
2005-05-20 Jay Belanger <belanger@truman.edu>
* calc/calc-units.el (calc-invalidate-units-table):
Use inhibit-read-only.
(math-build-units-table-buffer): Use view-mode.
2005-05-20 David Kastrup <dak@gnu.org>
* emacs-lisp/easymenu.el (easy-menu-add): Correct docstring since
easy-menu-add is not a nop on Emacs; and clarify when to call it.
2005-05-20 Lute Kamstra <lute@gnu.org>
* diff-mode.el (diff-header-face, diff-file-header-face)
(diff-index-face, diff-hunk-header-face, diff-removed-face)
(diff-added-face, diff-changed-face, diff-function-face)
(diff-context-face, diff-nonexistent-face): Put them in the
diff-mode customization group.
2005-05-20 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/vhdl-mode.el (vhdl-font-lock-match-item): Simplify regexp.
* progmodes/sh-script.el (sh-mode, sh-get-word): Minor regexp fixes.
* font-lock.el (lisp-font-lock-keywords-2): Don't error.
Minor regexp-optimization.
2005-05-20 Carsten Dominik <dominik@science.uva.nl>
* textmodes/org.el (org-agenda-toggle-time-grid): New command.
(org-agenda-use-time-grid, org-agenda-time-grid): New options.
(org-agenda-add-time-grid-maybe): New function.
(org-agenda): Call `org-agenda-add-time-grid-maybe'.
(org-table-create): `dotimes' instead of `mapcar'.
(org-xor): Simplify implementation.
(org-agenda): `inhibit-redisplay' turned on.
(org-agenda-change-all-lines): Use `org-format-agenda-item' to get
a consistent line after a state change.
(org-agenda-remove-times-when-in-prefix): New option.
(org-prefix-has-time): New variable.
(org-parse-time-string): Optional argument NODEFAULT.
(org-format-agenda-item): Parse items for time-of-day
specifications and move these into the prefix if possible.
(org-agenda-priority): Get current heading, not previous heading
during agenda remote editing.
2005-05-20 Juanma Barranquero <lekktu@gmail.com> 2005-05-20 Juanma Barranquero <lekktu@gmail.com>
* emacs-lisp/cl-seq.el (reduce, fill, replace, remove*)
(remove-if, remove-if-not, delete*, delete-if, delete-if-not)
(remove-duplicates, delete-duplicates, substitute)
(substitute-if, substitute-if-not, nsubstitute, nsubstitute-if)
(nsubstitute-if-not, find, find-if, find-if-not, position)
(position-if, position-if-not, count, count-if, count-if-not)
(mismatch, search, sort*, stable-sort, merge, member*)
(member-if, member-if-not, assoc*, assoc-if, assoc-if-not)
(rassoc*, rassoc-if, rassoc-if-not, union, nunion)
(intersection, nintersection, set-difference, nset-difference)
(set-exclusive-or, nset-exclusive-or, subsetp, subst-if)
(subst-if-not, nsubst, nsubst-if, nsubst-if-not, sublis)
(nsublis, tree-equal): Improve argument/docstring consistency.
* subr.el (send-string, send-region): * subr.el (send-string, send-region):
Remove obsolescence declaration. Remove obsolescence declaration.
(window-dot, set-window-dot, read-input, show-buffer) (window-dot, set-window-dot, read-input, show-buffer)
@ -68,6 +396,7 @@
(left-fringe-p): Function deleted. (left-fringe-p): Function deleted.
* buff-menu.el (Buffer-menu-buffer-face): In group Buffer-menu. * buff-menu.el (Buffer-menu-buffer-face): In group Buffer-menu.
(list-buffers-noselect): Set `font-lock-face' property, not `face'.
* dired-aux.el (dired-copy-file-recursive): Handle symlinks * dired-aux.el (dired-copy-file-recursive): Handle symlinks
in recursive copy. in recursive copy.
@ -89,7 +418,7 @@
2005-05-19 Carsten Dominik <dominik@science.uva.nl> 2005-05-19 Carsten Dominik <dominik@science.uva.nl>
* textmodes/reftex.el (reftex-isearch-minor-mode): Moved the * textmodes/reftex.el (reftex-isearch-minor-mode): Move the
definition of this variable from reftex-global.el to reftex.el, definition of this variable from reftex-global.el to reftex.el,
because it is needed in the menu. because it is needed in the menu.
@ -112,8 +441,8 @@
(makefile-add-this-line-macro): Simplify and integrate into (makefile-add-this-line-macro): Simplify and integrate into
`makefile-pickup-macros. `makefile-pickup-macros.
(makefile-pickup-filenames-as-targets): Simplify. (makefile-pickup-filenames-as-targets): Simplify.
(makefile-previous-dependency, makefile-match-dependency): Don't (makefile-previous-dependency, makefile-match-dependency):
stumble over `::'. Don't stumble over `::'.
2005-05-19 Nick Roberts <nickrob@snap.net.nz> 2005-05-19 Nick Roberts <nickrob@snap.net.nz>
@ -127,8 +456,8 @@
* help-fns.el (describe-variable): Remove hyperlinks in a * help-fns.el (describe-variable): Remove hyperlinks in a
variable's value as these are quite frequently inappropriate. variable's value as these are quite frequently inappropriate.
* follow.el (follow-submit-feedback, follow-mode): Remove * follow.el (follow-submit-feedback, follow-mode):
references to post-command-idle-hook. Remove references to post-command-idle-hook.
2005-05-18 Daniel Pfeiffer <occitan@esperanto.org> 2005-05-18 Daniel Pfeiffer <occitan@esperanto.org>
@ -138,8 +467,8 @@
2005-05-18 Jay Belanger <belanger@truman.edu> 2005-05-18 Jay Belanger <belanger@truman.edu>
* calc/calc-help.el (calc-s-prefix-help): Add * calc/calc-help.el (calc-s-prefix-help):
`calc-copy-special-constant' to help string. Add `calc-copy-special-constant' to help string.
2005-05-18 Luc Teirlinck <teirllm@auburn.edu> 2005-05-18 Luc Teirlinck <teirllm@auburn.edu>
@ -152,8 +481,8 @@
2005-05-18 Carsten Dominik <dominik@science.uva.nl> 2005-05-18 Carsten Dominik <dominik@science.uva.nl>
* textmodes/reftex-vars.el (reftex-cite-format-builtin): Support * textmodes/reftex-vars.el (reftex-cite-format-builtin):
for jurabib. Support for jurabib.
* textmodes/reftex.el (featurep): Define aliases for overlay * textmodes/reftex.el (featurep): Define aliases for overlay
commands, for XEmacs compatibility, and use these aliases in commands, for XEmacs compatibility, and use these aliases in
@ -164,8 +493,8 @@
(reftex-access-search-path): Use `reftex-uniquify' instead of (reftex-access-search-path): Use `reftex-uniquify' instead of
`reftex-uniq' `reftex-uniq'
* textmodes/reftex-sel.el (reftex-select-unmark): Overlay * textmodes/reftex-sel.el (reftex-select-unmark):
`before-string' property modification enables for Emacs as well. Overlay `before-string' property modification enables for Emacs as well.
(reftex-select-item): Use `reftex-delete-overlay'. (reftex-select-item): Use `reftex-delete-overlay'.
(reftex-select-mark): Use `reftex-make-overlay' and (reftex-select-mark): Use `reftex-make-overlay' and
`reftex-overlay-put'. `reftex-overlay-put'.
@ -200,8 +529,7 @@
* progmodes/prolog.el (inferior-prolog-mode): Doc fix. * progmodes/prolog.el (inferior-prolog-mode): Doc fix.
(prolog-consult-region): Replace `send-string' by (prolog-consult-region): Replace `send-string' by
`process-send-string'; replace `send-region' by `process-send-string'; replace `send-region' by `process-send-region'.
`process-send-region'.
* progmodes/delphi.el (delphi-log-msg): * progmodes/delphi.el (delphi-log-msg):
Replace `set-window-dot' by `set-window-point'. Replace `set-window-dot' by `set-window-point'.
@ -232,8 +560,8 @@
loop. It should also be more efficient, because first it only loop. It should also be more efficient, because first it only
searches for `:', instead of applying the very complex regexp. searches for `:', instead of applying the very complex regexp.
(makefile-mode): Cancel `font-lock-support-mode', because blocks (makefile-mode): Cancel `font-lock-support-mode', because blocks
to be fontified in one piece can be too long for JIT. Makefiles to be fontified in one piece can be too long for JIT.
are never *that* big. Makefiles are never *that* big.
2005-05-17 Reiner Steib <Reiner.Steib@gmx.de> 2005-05-17 Reiner Steib <Reiner.Steib@gmx.de>
@ -259,8 +587,8 @@
2005-05-16 Daniel Pfeiffer <occitan@esperanto.org> 2005-05-16 Daniel Pfeiffer <occitan@esperanto.org>
* font-lock.el (lisp-font-lock-keywords-1): Set * font-lock.el (lisp-font-lock-keywords-1):
`font-lock-negation-char-face' for [^...] char group. Set `font-lock-negation-char-face' for [^...] char group.
(lisp-font-lock-keywords-2): Highlight regexp's \\( \\| \\). (lisp-font-lock-keywords-2): Highlight regexp's \\( \\| \\).
* progmodes/make-mode.el (makefile-dependency-regex): Turn it into * progmodes/make-mode.el (makefile-dependency-regex): Turn it into
@ -274,11 +602,10 @@
might be the same one to be skipped by the initial [^$], leading might be the same one to be skipped by the initial [^$], leading
to an overlooked variable use. to an overlooked variable use.
(makefile-make-font-lock-keywords): Remove two parameters, which (makefile-make-font-lock-keywords): Remove two parameters, which
are now variables that some of the modes set locally. Handle are now variables that some of the modes set locally.
dependency and rule action matching through functions, because Handle dependency and rule action matching through functions, because
regexps alone match too often. Dependency matching now comes regexps alone match too often. Dependency matching now comes
last, so it can check, whether a colon already matched something last, so it can check, whether a colon already matched something else.
else.
(makefile-mode): Inform that font-lock improves makefile parsing (makefile-mode): Inform that font-lock improves makefile parsing
capabilities. capabilities.
(makefile-match-dependency, makefile-match-action): New functions. (makefile-match-dependency, makefile-match-action): New functions.
@ -363,8 +690,8 @@
(reftex-bib-sort-year-reverse, reftex-format-citation): (reftex-bib-sort-year-reverse, reftex-format-citation):
* textmodes/reftex-parse.el (reftex-init-section-numbers) * textmodes/reftex-parse.el (reftex-init-section-numbers)
(reftex-section-number): (reftex-section-number):
* textmodes/texinfmt.el (texinfo-paragraphindent): Replace * textmodes/texinfmt.el (texinfo-paragraphindent):
`string-to-int' by `string-to-number'. Replace `string-to-int' by `string-to-number'.
* international/latexenc.el: Add page marker to force the "Local * international/latexenc.el: Add page marker to force the "Local
Variables:" string out of the last page. Variables:" string out of the last page.
@ -472,23 +799,22 @@
(tramp-pre-connection): Add parameter CHUNKSIZE. Make local (tramp-pre-connection): Add parameter CHUNKSIZE. Make local
variable `tramp-chunksize'. Change callees. variable `tramp-chunksize'. Change callees.
(tramp-open-connection-setup-interactive-shell): Check remote host (tramp-open-connection-setup-interactive-shell): Check remote host
for buggy `send-process-string' implementation. Set for buggy `send-process-string' implementation.
`tramp-chunksize' if found. Reported by Michael Kifer Set `tramp-chunksize' if found. Reported by Michael Kifer
<kifer@cs.sunysb.edu> (and a lot of other people all the years). <kifer@cs.sunysb.edu> (and a lot of other people all the years).
(tramp-handle-shell-command): `insert-buffer' cannot be used (tramp-handle-shell-command): `insert-buffer' cannot be used
because the contents of the Tramp buffer is changed before because the contents of the Tramp buffer is changed before
insertion (`expand-file' and alike). Reported by Fr,Ai(Bd,Ai(Bric Bothamy insertion (`expand-file' and alike). Reported by Fr,Ai(Bd,Ai(Bric Bothamy
<frederic.bothamy@free.fr>. <frederic.bothamy@free.fr>.
(tramp-set-auto-save): Actions should be done for Tramp file name (tramp-set-auto-save): Actions should be done for Tramp file name
handler only. Ange-FTP has its own auto-save mechanism. Reported handler only. Ange-FTP has its own auto-save mechanism.
by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>. Reported by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>.
(tramp-set-auto-save-file-modes): Set file modes of (tramp-set-auto-save-file-modes): Set file modes of
`buffer-auto-save-file-name' to ?\600 as fallback solution. `buffer-auto-save-file-name' to ?\600 as fallback solution.
Reported by Ferenc Wagner <wferi@tba.elte.hu>. Reported by Ferenc Wagner <wferi@tba.elte.hu>.
(tramp-bug): Remove obsolete variable. (tramp-bug): Remove obsolete variable.
(tramp-append-tramp-buffers): Rewrite partly. More suitable check (tramp-append-tramp-buffers): Rewrite partly. More suitable check
for presence of `mml-mode'. Make it running for older Emacsen as for presence of `mml-mode'. Make it running for older Emacsen as well.
well.
2005-05-14 John Paul Wallington <jpw@pobox.com> 2005-05-14 John Paul Wallington <jpw@pobox.com>
@ -540,15 +866,14 @@
2005-05-13 Matt Hodges <MPHodges@member.fsf.org> 2005-05-13 Matt Hodges <MPHodges@member.fsf.org>
* tmm.el (tmm-get-keymap): Include only active menus and menu * tmm.el (tmm-get-keymap): Include only active menus and menu items.
items.
* emacs-lisp/easymenu.el (easy-menu-define): Doc fixes. * emacs-lisp/easymenu.el (easy-menu-define): Doc fixes.
2005-05-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 2005-05-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* dired.el (dired-mode): make-variable-buffer-local => * dired.el (dired-mode): make-variable-buffer-local =>
make-local-variable make-local-variable.
2005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 2005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
@ -9592,7 +9917,7 @@
(Info-build-toc): Don't check for special Info file names. (Info-build-toc): Don't check for special Info file names.
Set main-file to nil if Info-find-file returns a symbol. Set main-file to nil if Info-find-file returns a symbol.
2004-10-05 Emilio C. Lopes <eclig@gmx.net>: 2004-10-05 Emilio C. Lopes <eclig@gmx.net>
* calendar/calendar.el (calendar-goto-iso-week): Add autoload. * calendar/calendar.el (calendar-goto-iso-week): Add autoload.
(calendar-mode-map): Add binding for `calendar-goto-iso-week'. (calendar-mode-map): Add binding for `calendar-goto-iso-week'.

20
lisp/bindings.el
View file

@ -165,7 +165,8 @@ corresponding to the mode line clicked."
(eval-when-compile (eval-when-compile
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-3] 'mode-line-change-eol) (define-key map [mode-line mouse-3] 'mode-line-change-eol)
map)))) map))
'mouse-face 'mode-line-highlight))
(push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache) (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
desc))) desc)))
@ -177,7 +178,8 @@ corresponding to the mode line clicked."
"Input method: " "Input method: "
current-input-method current-input-method
". mouse-2: disable, mouse-3: describe") ". mouse-2: disable, mouse-3: describe")
local-map ,mode-line-input-method-map)) local-map ,mode-line-input-method-map
mouse-face mode-line-highlight))
,(propertize ,(propertize
"%z" "%z"
'help-echo 'help-echo
@ -191,6 +193,7 @@ corresponding to the mode line clicked."
" buffer; mouse-3: describe coding system") " buffer; mouse-3: describe coding system")
(concat "Unibyte " (symbol-name buffer-file-coding-system) (concat "Unibyte " (symbol-name buffer-file-coding-system)
" buffer"))))) " buffer")))))
'mouse-face 'mode-line-highlight
'local-map mode-line-coding-system-map) 'local-map mode-line-coding-system-map)
(:eval (mode-line-eol-desc))) (:eval (mode-line-eol-desc)))
"Mode-line control for displaying information of multilingual environment. "Mode-line control for displaying information of multilingual environment.
@ -235,7 +238,8 @@ Normally nil in most modes, since there is no process to display.")
"Not r"))))) "Not r")))))
'local-map (purecopy (make-mode-line-mouse-map 'local-map (purecopy (make-mode-line-mouse-map
'mouse-3 'mouse-3
#'mode-line-toggle-read-only))) #'mode-line-toggle-read-only))
'mouse-face 'mode-line-highlight)
(propertize (propertize
"%1+" "%1+"
'help-echo (purecopy (lambda (window object point) 'help-echo (purecopy (lambda (window object point)
@ -246,7 +250,8 @@ Normally nil in most modes, since there is no process to display.")
"M" "M"
"Not m"))))) "Not m")))))
'local-map (purecopy (make-mode-line-mouse-map 'local-map (purecopy (make-mode-line-mouse-map
'mouse-3 #'mode-line-toggle-modified)))) 'mouse-3 #'mode-line-toggle-modified))
'mouse-face 'mode-line-highlight))
"Mode-line control for displaying whether current buffer is modified.") "Mode-line control for displaying whether current buffer is modified.")
(make-variable-buffer-local 'mode-line-modified) (make-variable-buffer-local 'mode-line-modified)
@ -262,6 +267,7 @@ buffer size, the line number and the column number.")
(defvar mode-line-major-mode-keymap (defvar mode-line-major-mode-keymap
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1] 'mouse-major-mode-menu)
(define-key map [mode-line mouse-2] 'describe-mode) (define-key map [mode-line mouse-2] 'describe-mode)
(define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1) (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1)
map) "\ map) "\
@ -303,13 +309,16 @@ Keymap to display on minor modes.")
(list (list
(propertize "%[(" 'help-echo help-echo) (propertize "%[(" 'help-echo help-echo)
`(:propertize ("" mode-name) `(:propertize ("" mode-name)
help-echo "mouse-2: help for current major mode" help-echo "mouse-1: major-mode-menu mouse-2: help for current major mode"
mouse-face mode-line-highlight
local-map ,mode-line-major-mode-keymap) local-map ,mode-line-major-mode-keymap)
'("" mode-line-process) '("" mode-line-process)
`(:propertize ("" minor-mode-alist) `(:propertize ("" minor-mode-alist)
mouse-face mode-line-highlight
help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu" help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu"
local-map ,mode-line-minor-mode-keymap) local-map ,mode-line-minor-mode-keymap)
(propertize "%n" 'help-echo "mouse-2: widen" (propertize "%n" 'help-echo "mouse-2: widen"
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map 'local-map (make-mode-line-mouse-map
'mouse-2 #'mode-line-widen)) 'mouse-2 #'mode-line-widen))
(propertize ")%]--" 'help-echo help-echo))) (propertize ")%]--" 'help-echo help-echo)))
@ -465,6 +474,7 @@ text properties for face, help-echo, and local-map to it."
'face 'Buffer-menu-buffer-face 'face 'Buffer-menu-buffer-face
'help-echo 'help-echo
(purecopy "mouse-1: previous buffer, mouse-3: next buffer") (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
'mouse-face 'mode-line-highlight
'local-map mode-line-buffer-identification-keymap))) 'local-map mode-line-buffer-identification-keymap)))
(setq-default mode-line-buffer-identification (setq-default mode-line-buffer-identification

44
lisp/buff-menu.el
View file

@ -1,7 +1,7 @@
;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*- ;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003, ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
;; 2004 Free Software Foundation, Inc. ;; 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF ;; Maintainer: FSF
;; Keywords: convenience ;; Keywords: convenience
@ -190,7 +190,7 @@ Letters do not insert themselves; instead, they are commands.
#'(lambda (&optional noconfirm) 'fast)) #'(lambda (&optional noconfirm) 'fast))
(setq truncate-lines t) (setq truncate-lines t)
(setq buffer-read-only t) (setq buffer-read-only t)
(run-hooks 'buffer-menu-mode-hook)) (run-mode-hooks 'buffer-menu-mode-hook))
;; This function exists so we can make the doc string of Buffer-menu-mode ;; This function exists so we can make the doc string of Buffer-menu-mode
;; look nice. ;; look nice.
@ -203,17 +203,21 @@ Letters do not insert themselves; instead, they are commands.
(or (eq buffer-undo-list t) (or (eq buffer-undo-list t)
(setq buffer-undo-list nil)) (setq buffer-undo-list nil))
;; We can not use save-excursion here. The buffer gets erased. ;; We can not use save-excursion here. The buffer gets erased.
(let ((ocol (current-column)) (let ((opoint (point))
(eobp (eobp))
(ocol (current-column))
(oline (progn (move-to-column 4) (oline (progn (move-to-column 4)
(get-text-property (point) 'buffer))) (get-text-property (point) 'buffer)))
(prop (point-min)) (prop (point-min))
;; do not make undo records for the reversion. ;; do not make undo records for the reversion.
(buffer-undo-list t)) (buffer-undo-list t))
(list-buffers-noselect Buffer-menu-files-only) (list-buffers-noselect Buffer-menu-files-only)
(while (setq prop (next-single-property-change prop 'buffer)) (if oline
(when (eq (get-text-property prop 'buffer) oline) (while (setq prop (next-single-property-change prop 'buffer))
(goto-char prop) (when (eq (get-text-property prop 'buffer) oline)
(move-to-column ocol))))) (goto-char prop)
(move-to-column ocol)))
(goto-char (if eobp (point-max) opoint)))))
(defun Buffer-menu-toggle-files-only (arg) (defun Buffer-menu-toggle-files-only (arg)
"Toggle whether the current buffer-menu displays only file buffers. "Toggle whether the current buffer-menu displays only file buffers.
@ -633,15 +637,29 @@ For more information, see the function `buffer-menu'."
(if (equal column Buffer-menu-sort-column) (setq column nil)) (if (equal column Buffer-menu-sort-column) (setq column nil))
(propertize name (propertize name
'help-echo (if column 'help-echo (if column
(concat "mouse-2: sort by " (downcase name)) (if Buffer-menu-use-header-line
"mouse-2: sort by visited order") (concat "mouse-2: sort by " (downcase name))
(concat "mouse-2, RET: sort by "
(downcase name)))
(if Buffer-menu-use-header-line
"mouse-2: sort by visited order"
"mouse-2, RET: sort by visited order"))
'mouse-face 'highlight 'mouse-face 'highlight
'keymap (let ((map (make-sparse-keymap))) 'keymap (let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-2] (if Buffer-menu-use-header-line
`(lambda (e) (define-key map [header-line mouse-2]
(interactive "e") `(lambda (e)
(save-window-excursion (interactive "e")
(save-window-excursion
(if e (mouse-select-window e))
(Buffer-menu-sort ,column))))
(define-key map [mouse-2]
`(lambda (e)
(interactive "e")
(if e (mouse-select-window e)) (if e (mouse-select-window e))
(Buffer-menu-sort ,column)))
(define-key map "\C-m"
`(lambda () (interactive)
(Buffer-menu-sort ,column)))) (Buffer-menu-sort ,column))))
map))) map)))

120
lisp/calc/calc-units.el
View file

@ -555,7 +555,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at "Calculator Units Table") (if (looking-at "Calculator Units Table")
(let ((buffer-read-only nil)) (let ((inhibit-read-only t))
(insert "(Obsolete) ")))))))) (insert "(Obsolete) "))))))))
(defun calc-get-unit-definition (uname) (defun calc-get-unit-definition (uname)
@ -1310,65 +1310,65 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(save-excursion (save-excursion
(message "Formatting units table...") (message "Formatting units table...")
(set-buffer buf) (set-buffer buf)
(setq buffer-read-only nil) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(insert "Calculator Units Table:\n\n") (insert "Calculator Units Table:\n\n")
(insert "Unit Type Definition Description\n\n") (insert "Unit Type Definition Description\n\n")
(while uptr (while uptr
(setq u (car uptr) (setq u (car uptr)
name (nth 2 u)) name (nth 2 u))
(when (eq (car u) 'm) (when (eq (car u) 'm)
(setq std t)) (setq std t))
(setq shadowed (and std (assq (car u) math-additional-units))) (setq shadowed (and std (assq (car u) math-additional-units)))
(when (and name (when (and name
(> (length name) 1) (> (length name) 1)
(eq (aref name 0) ?\*)) (eq (aref name 0) ?\*))
(unless (eq uptr math-units-table) (unless (eq uptr math-units-table)
(insert "\n")) (insert "\n"))
(setq name (substring name 1))) (setq name (substring name 1)))
(insert " ") (insert " ")
(and shadowed (insert "(")) (and shadowed (insert "("))
(insert (symbol-name (car u))) (insert (symbol-name (car u)))
(and shadowed (insert ")")) (and shadowed (insert ")"))
(if (nth 3 u) (if (nth 3 u)
(progn (progn
(indent-to 10) (indent-to 10)
(insert (symbol-name (nth 3 u)))) (insert (symbol-name (nth 3 u))))
(or std (or std
(progn (progn
(indent-to 10) (indent-to 10)
(insert "U")))) (insert "U"))))
(indent-to 14) (indent-to 14)
(and shadowed (insert "(")) (and shadowed (insert "("))
(if (nth 1 u) (if (nth 1 u)
(insert (math-format-value (nth 1 u) 80)) (insert (math-format-value (nth 1 u) 80))
(insert (symbol-name (car u)))) (insert (symbol-name (car u))))
(and shadowed (insert ")")) (and shadowed (insert ")"))
(indent-to 41) (indent-to 41)
(insert " ") (insert " ")
(when name (when name
(insert name)) (insert name))
(if shadowed (if shadowed
(insert " (redefined above)") (insert " (redefined above)")
(unless (nth 1 u) (unless (nth 1 u)
(insert " (base unit)"))) (insert " (base unit)")))
(insert "\n") (insert "\n")
(setq uptr (cdr uptr))) (setq uptr (cdr uptr)))
(insert "\n\nUnit Prefix Table:\n\n") (insert "\n\nUnit Prefix Table:\n\n")
(setq uptr math-unit-prefixes) (setq uptr math-unit-prefixes)
(while uptr (while uptr
(setq u (car uptr)) (setq u (car uptr))
(insert " " (char-to-string (car u))) (insert " " (char-to-string (car u)))
(if (equal (nth 1 u) (nth 1 (nth 1 uptr))) (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))
(insert " " (char-to-string (car (car (setq uptr (cdr uptr))))) (insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))
" ") " ")
(insert " ")) (insert " "))
(insert "10^" (int-to-string (nth 2 (nth 1 u)))) (insert "10^" (int-to-string (nth 2 (nth 1 u))))
(indent-to 15) (indent-to 15)
(insert " " (nth 2 u) "\n") (insert " " (nth 2 u) "\n")
(while (eq (car (car (setq uptr (cdr uptr)))) 0))) (while (eq (car (car (setq uptr (cdr uptr)))) 0)))
(insert "\n") (insert "\n"))
(setq buffer-read-only t) (view-mode)
(message "Formatting units table...done")) (message "Formatting units table...done"))
(setq math-units-table-buffer-valid t) (setq math-units-table-buffer-valid t)
(let ((oldbuf (current-buffer))) (let ((oldbuf (current-buffer)))

2
lisp/calendar/cal-menu.el
View file

@ -221,7 +221,7 @@ not available."
l))) l)))
(setq l (cons ["Mark Holidays" mark-calendar-holidays t] (setq l (cons ["Mark Holidays" mark-calendar-holidays t]
(cons ["Unmark Calendar" calendar-unmark t] (cons ["Unmark Calendar" calendar-unmark t]
(cons ["--" '("--") t] l)))) (cons "--" l))))
(define-key calendar-mode-map [menu-bar Holidays] (define-key calendar-mode-map [menu-bar Holidays]
(cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l)))) (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l))))
(define-key calendar-mode-map [menu-bar Holidays separator] (define-key calendar-mode-map [menu-bar Holidays separator]

30
lisp/diff-mode.el
View file

@ -185,7 +185,8 @@ when editing big diffs)."
(((class color) (background dark)) (((class color) (background dark))
:foreground "green" :weight bold) :foreground "green" :weight bold)
(t :weight bold)) (t :weight bold))
"`diff-mode' face inherited by hunk and index header faces.") "`diff-mode' face inherited by hunk and index header faces."
:group 'diff-mode)
(defvar diff-header-face 'diff-header-face) (defvar diff-header-face 'diff-header-face)
(defface diff-file-header-face (defface diff-file-header-face
@ -198,27 +199,32 @@ when editing big diffs)."
(((class color) (background dark)) (((class color) (background dark))
:foreground "cyan" :weight bold) :foreground "cyan" :weight bold)
(t :weight bold)) ; :height 1.3 (t :weight bold)) ; :height 1.3
"`diff-mode' face used to highlight file header lines.") "`diff-mode' face used to highlight file header lines."
:group 'diff-mode)
(defvar diff-file-header-face 'diff-file-header-face) (defvar diff-file-header-face 'diff-file-header-face)
(defface diff-index-face (defface diff-index-face
'((t :inherit diff-file-header-face)) '((t :inherit diff-file-header-face))
"`diff-mode' face used to highlight index header lines.") "`diff-mode' face used to highlight index header lines."
:group 'diff-mode)
(defvar diff-index-face 'diff-index-face) (defvar diff-index-face 'diff-index-face)
(defface diff-hunk-header-face (defface diff-hunk-header-face
'((t :inherit diff-header-face)) '((t :inherit diff-header-face))
"`diff-mode' face used to highlight hunk header lines.") "`diff-mode' face used to highlight hunk header lines."
:group 'diff-mode)
(defvar diff-hunk-header-face 'diff-hunk-header-face) (defvar diff-hunk-header-face 'diff-hunk-header-face)
(defface diff-removed-face (defface diff-removed-face
'((t :inherit diff-changed-face)) '((t :inherit diff-changed-face))
"`diff-mode' face used to highlight removed lines.") "`diff-mode' face used to highlight removed lines."
:group 'diff-mode)
(defvar diff-removed-face 'diff-removed-face) (defvar diff-removed-face 'diff-removed-face)
(defface diff-added-face (defface diff-added-face
'((t :inherit diff-changed-face)) '((t :inherit diff-changed-face))
"`diff-mode' face used to highlight added lines.") "`diff-mode' face used to highlight added lines."
:group 'diff-mode)
(defvar diff-added-face 'diff-added-face) (defvar diff-added-face 'diff-added-face)
(defface diff-changed-face (defface diff-changed-face
@ -226,12 +232,14 @@ when editing big diffs)."
:foreground "magenta" :weight bold :slant italic) :foreground "magenta" :weight bold :slant italic)
(((type tty pc) (class color) (background dark)) (((type tty pc) (class color) (background dark))
:foreground "yellow" :weight bold :slant italic)) :foreground "yellow" :weight bold :slant italic))
"`diff-mode' face used to highlight changed lines.") "`diff-mode' face used to highlight changed lines."
:group 'diff-mode)
(defvar diff-changed-face 'diff-changed-face) (defvar diff-changed-face 'diff-changed-face)
(defface diff-function-face (defface diff-function-face
'((t :inherit diff-context-face)) '((t :inherit diff-context-face))
"`diff-mode' face used to highlight function names produced by \"diff -p\".") "`diff-mode' face used to highlight function names produced by \"diff -p\"."
:group 'diff-mode)
(defvar diff-function-face 'diff-function-face) (defvar diff-function-face 'diff-function-face)
(defface diff-context-face (defface diff-context-face
@ -239,12 +247,14 @@ when editing big diffs)."
:foreground "grey50") :foreground "grey50")
(((class color) (background dark)) (((class color) (background dark))
:foreground "grey70")) :foreground "grey70"))
"`diff-mode' face used to highlight context and other side-information.") "`diff-mode' face used to highlight context and other side-information."
:group 'diff-mode)
(defvar diff-context-face 'diff-context-face) (defvar diff-context-face 'diff-context-face)
(defface diff-nonexistent-face (defface diff-nonexistent-face
'((t :inherit diff-file-header-face)) '((t :inherit diff-file-header-face))
"`diff-mode' face used to highlight nonexistent files in recursive diffs.") "`diff-mode' face used to highlight nonexistent files in recursive diffs."
:group 'diff-mode)
(defvar diff-nonexistent-face 'diff-nonexistent-face) (defvar diff-nonexistent-face 'diff-nonexistent-face)
(defconst diff-yank-handler '(diff-yank-function)) (defconst diff-yank-handler '(diff-yank-function))

25
lisp/dired.el
View file

@ -418,7 +418,24 @@ Subexpression 2 must end right before the \\n or \\r.")
;; It is quicker to first find just an extension, then go back to the ;; It is quicker to first find just an extension, then go back to the
;; start of that file name. So we do this complex MATCH-ANCHORED form. ;; start of that file name. So we do this complex MATCH-ANCHORED form.
(list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$") (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
'(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))) '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
;;
;; Files suffixed with `completion-ignored-extensions'
;; plus a character put in by -F.
'(eval .
(list (concat "\\(" (regexp-opt completion-ignored-extensions)
"\\|#\\)[*=|]$")
'(".+" (progn
(end-of-line)
;; If the last character is not part of the filename,
;; move back to the start of the filename
;; so it can be fontified.
;; Otherwise, leave point at the end of the line;
;; that way, nothing is fontified.
(unless (get-text-property (1- (point)) 'mouse-face)
(dired-move-to-filename)))
nil (0 dired-ignored-face))))
)
"Additional expressions to highlight in Dired mode.") "Additional expressions to highlight in Dired mode.")
;;; Macros must be defined before they are used, for the byte compiler. ;;; Macros must be defined before they are used, for the byte compiler.
@ -3163,10 +3180,8 @@ Anything else means ask for each directory."
:group 'dired) :group 'dired)
(defun dired-dnd-popup-notice () (defun dired-dnd-popup-notice ()
(x-popup-dialog (message-box
t "Recursive copies not enabled.\nSee variable dired-recursive-copies."))
'("Recursive copies not enabled.\nSee variable dired-recursive-copies."
("Ok" . nil))))
(defun dired-dnd-do-ask-action (uri) (defun dired-dnd-do-ask-action (uri)

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

@ -4057,27 +4057,6 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
(setq command-line-args-left (cdr command-line-args-left))) (setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0)) (kill-emacs 0))
(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
(make-obsolete-variable 'inhibit-local-variables
"use enable-local-variables (with the reversed sense)."
"before 19.15")
(make-obsolete-variable 'unread-command-event
"use unread-command-events; which is a list of events rather than a single event."
"before 19.15")
(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
(make-obsolete-variable 'meta-flag "use the set-input-mode function instead." "before 19.34")
(make-obsolete-variable 'before-change-function
"use before-change-functions; which is a list of functions rather than a single function."
"before 19.34")
(make-obsolete-variable 'after-change-function
"use after-change-functions; which is a list of functions rather than a single function."
"before 19.34")
(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
(provide 'byte-compile) (provide 'byte-compile)
(provide 'bytecomp) (provide 'bytecomp)

70
lisp/emacs-lisp/cl-extra.el
View file

@ -46,7 +46,8 @@
(defun coerce (x type) (defun coerce (x type)
"Coerce OBJECT to type TYPE. "Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier." TYPE is a Common Lisp type specifier.
\n(fn OBJECT TYPE)"
(cond ((eq type 'list) (if (listp x) x (append x nil))) (cond ((eq type 'list) (if (listp x) x (append x nil)))
((eq type 'vector) (if (vectorp x) x (vconcat x))) ((eq type 'vector) (if (vectorp x) x (vconcat x)))
((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'string) (if (stringp x) x (concat x)))
@ -120,16 +121,17 @@ strings case-insensitively."
(nreverse cl-res)))) (nreverse cl-res))))
(defun map (cl-type cl-func cl-seq &rest cl-rest) (defun map (cl-type cl-func cl-seq &rest cl-rest)
"Map a function across one or more sequences, returning a sequence. "Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return, FUNC is the function, and SEQS TYPE is the sequence type to return.
are the argument sequences." \n(fn TYPE FUNCTION SEQUENCE...)"
(let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
(and cl-type (coerce cl-res cl-type)))) (and cl-type (coerce cl-res cl-type))))
(defun maplist (cl-func cl-list &rest cl-rest) (defun maplist (cl-func cl-list &rest cl-rest)
"Map FUNC to each sublist of LIST or LISTS. "Map FUNCTION to each sublist of LIST or LISTs.
Like `mapcar', except applies to lists and their cdr's rather than to Like `mapcar', except applies to lists and their cdr's rather than to
the elements themselves." the elements themselves.
\n(fn FUNCTION LIST...)"
(if cl-rest (if cl-rest
(let ((cl-res nil) (let ((cl-res nil)
(cl-args (cons cl-list (copy-sequence cl-rest))) (cl-args (cons cl-list (copy-sequence cl-rest)))
@ -146,14 +148,16 @@ the elements themselves."
(nreverse cl-res)))) (nreverse cl-res))))
(defun cl-mapc (cl-func cl-seq &rest cl-rest) (defun cl-mapc (cl-func cl-seq &rest cl-rest)
"Like `mapcar', but does not accumulate values returned by the function." "Like `mapcar', but does not accumulate values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest (if cl-rest
(progn (apply 'map nil cl-func cl-seq cl-rest) (progn (apply 'map nil cl-func cl-seq cl-rest)
cl-seq) cl-seq)
(mapc cl-func cl-seq))) (mapc cl-func cl-seq)))
(defun mapl (cl-func cl-list &rest cl-rest) (defun mapl (cl-func cl-list &rest cl-rest)
"Like `maplist', but does not accumulate values returned by the function." "Like `maplist', but does not accumulate values returned by the function.
\n(fn FUNCTION LIST...)"
(if cl-rest (if cl-rest
(apply 'maplist cl-func cl-list cl-rest) (apply 'maplist cl-func cl-list cl-rest)
(let ((cl-p cl-list)) (let ((cl-p cl-list))
@ -161,16 +165,19 @@ the elements themselves."
cl-list) cl-list)
(defun mapcan (cl-func cl-seq &rest cl-rest) (defun mapcan (cl-func cl-seq &rest cl-rest)
"Like `mapcar', but nconc's together the values returned by the function." "Like `mapcar', but nconc's together the values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
(defun mapcon (cl-func cl-list &rest cl-rest) (defun mapcon (cl-func cl-list &rest cl-rest)
"Like `maplist', but nconc's together the values returned by the function." "Like `maplist', but nconc's together the values returned by the function.
\n(fn FUNCTION LIST...)"
(apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
(defun some (cl-pred cl-seq &rest cl-rest) (defun some (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of any element of SEQ or SEQs. "Return true if PREDICATE is true of any element of SEQ or SEQs.
If so, return the true (non-nil) value returned by PREDICATE." If so, return the true (non-nil) value returned by PREDICATE.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq)) (if (or cl-rest (nlistp cl-seq))
(catch 'cl-some (catch 'cl-some
(apply 'map nil (apply 'map nil
@ -183,7 +190,8 @@ If so, return the true (non-nil) value returned by PREDICATE."
cl-x))) cl-x)))
(defun every (cl-pred cl-seq &rest cl-rest) (defun every (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is true of every element of SEQ or SEQs." "Return true if PREDICATE is true of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq)) (if (or cl-rest (nlistp cl-seq))
(catch 'cl-every (catch 'cl-every
(apply 'map nil (apply 'map nil
@ -195,11 +203,13 @@ If so, return the true (non-nil) value returned by PREDICATE."
(null cl-seq))) (null cl-seq)))
(defun notany (cl-pred cl-seq &rest cl-rest) (defun notany (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of every element of SEQ or SEQs." "Return true if PREDICATE is false of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(not (apply 'some cl-pred cl-seq cl-rest))) (not (apply 'some cl-pred cl-seq cl-rest)))
(defun notevery (cl-pred cl-seq &rest cl-rest) (defun notevery (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of some element of SEQ or SEQs." "Return true if PREDICATE is false of some element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
(not (apply 'every cl-pred cl-seq cl-rest))) (not (apply 'every cl-pred cl-seq cl-rest)))
;;; Support for `loop'. ;;; Support for `loop'.
@ -332,16 +342,16 @@ If so, return the true (non-nil) value returned by PREDICATE."
(setq a (* (/ a (gcd a b)) b)))) (setq a (* (/ a (gcd a b)) b))))
a))) a)))
(defun isqrt (a) (defun isqrt (x)
"Return the integer square root of the argument." "Return the integer square root of the argument."
(if (and (integerp a) (> a 0)) (if (and (integerp x) (> x 0))
(let ((g (cond ((<= a 100) 10) ((<= a 10000) 100) (let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
((<= a 1000000) 1000) (t a))) ((<= x 1000000) 1000) (t x)))
g2) g2)
(while (< (setq g2 (/ (+ g (/ a g)) 2)) g) (while (< (setq g2 (/ (+ g (/ x g)) 2)) g)
(setq g g2)) (setq g g2))
g) g)
(if (eq a 0) 0 (signal 'arith-error nil)))) (if (eq x 0) 0 (signal 'arith-error nil))))
(defun floor* (x &optional y) (defun floor* (x &optional y)
"Return a list of the floor of X and the fractional part of X. "Return a list of the floor of X and the fractional part of X.
@ -388,9 +398,9 @@ With two arguments, return rounding and remainder of their quotient."
"The remainder of X divided by Y, with the same sign as X." "The remainder of X divided by Y, with the same sign as X."
(nth 1 (truncate* x y))) (nth 1 (truncate* x y)))
(defun signum (a) (defun signum (x)
"Return 1 if A is positive, -1 if negative, 0 if zero." "Return 1 if X is positive, -1 if negative, 0 if zero."
(cond ((> a 0) 1) ((< a 0) -1) (t 0))) (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
;; Random numbers. ;; Random numbers.
@ -514,7 +524,8 @@ If START or END is negative, it counts from the end."
res)))))) res))))))
(defun concatenate (type &rest seqs) (defun concatenate (type &rest seqs)
"Concatenate, into a sequence of type TYPE, the argument SEQUENCES." "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\n(fn TYPE SEQUENCE...)"
(cond ((eq type 'vector) (apply 'vconcat seqs)) (cond ((eq type 'vector) (apply 'vconcat seqs))
((eq type 'string) (apply 'concat seqs)) ((eq type 'string) (apply 'concat seqs))
((eq type 'list) (apply 'append (append seqs '(nil)))) ((eq type 'list) (apply 'append (append seqs '(nil))))
@ -532,7 +543,7 @@ If START or END is negative, it counts from the end."
(nconc (nreverse x) y)) (nconc (nreverse x) y))
(defun list-length (x) (defun list-length (x)
"Return the length of a list. Return nil if list is circular." "Return the length of list X. Return nil if list is circular."
(let ((n 0) (fast x) (slow x)) (let ((n 0) (fast x) (slow x))
(while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
(setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
@ -550,7 +561,8 @@ If START or END is negative, it counts from the end."
;;; Property lists. ;;; Property lists.
(defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none." "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
(or (get sym tag) (or (get sym tag)
(and def (and def
(let ((plist (symbol-plist sym))) (let ((plist (symbol-plist sym)))
@ -560,7 +572,8 @@ If START or END is negative, it counts from the end."
(defun getf (plist tag &optional def) (defun getf (plist tag &optional def)
"Search PROPLIST for property PROPNAME; return its value or DEFAULT. "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'." PROPLIST is a list of the sort returned by `symbol-plist'.
\n(fn PROPLIST PROPNAME &optional DEFAULT)"
(setplist '--cl-getf-symbol-- plist) (setplist '--cl-getf-symbol-- plist)
(or (get '--cl-getf-symbol-- tag) (or (get '--cl-getf-symbol-- tag)
;; Originally we called get* here, ;; Originally we called get* here,
@ -582,7 +595,8 @@ PROPLIST is a list of the sort returned by `symbol-plist'."
(and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
(defun cl-remprop (sym tag) (defun cl-remprop (sym tag)
"Remove from SYMBOL's plist the property PROP and its value." "Remove from SYMBOL's plist the property PROPNAME and its value.
\n(fn SYMBOL PROPNAME)"
(let ((plist (symbol-plist sym))) (let ((plist (symbol-plist sym)))
(if (and plist (eq tag (car plist))) (if (and plist (eq tag (car plist)))
(progn (setplist sym (cdr (cdr plist))) t) (progn (setplist sym (cdr (cdr plist))) t)

38
lisp/emacs-lisp/cl-macs.el
View file

@ -207,8 +207,8 @@ and BODY is implicitly surrounded by (block NAME ...).
(defmacro function* (func) (defmacro function* (func)
"Introduce a function. "Introduce a function.
Like normal `function', except that if argument is a lambda form, its Like normal `function', except that if argument is a lambda form,
ARGLIST allows full Common Lisp conventions." its argument list allows full Common Lisp conventions."
(if (eq (car-safe func) 'lambda) (if (eq (car-safe func) 'lambda)
(let* ((res (cl-transform-lambda (cdr func) 'cl-none)) (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
(form (list 'function (cons 'lambda (cdr res))))) (form (list 'function (cons 'lambda (cdr res)))))
@ -488,13 +488,14 @@ The result of the body appears to the compiler as a quoted constant."
;;; Conditional control structures. ;;; Conditional control structures.
(defmacro case (expr &rest clauses) (defmacro case (expr &rest clauses)
"Eval EXPR and choose from CLAUSES on that value. "Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated. against each key in each KEYLIST; the corresponding BODY is evaluated.
If no clause succeeds, case returns nil. A single atom may be used in If no clause succeeds, case returns nil. A single atom may be used in
place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match. allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'." Key values are compared by `eql'.
\n(fn EXPR (KEYLIST BODY...)...)"
(let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(head-list nil) (head-list nil)
(body (cons (body (cons
@ -522,15 +523,17 @@ Key values are compared by `eql'."
(defmacro ecase (expr &rest clauses) (defmacro ecase (expr &rest clauses)
"Like `case', but error if no case fits. "Like `case', but error if no case fits.
`otherwise'-clauses are not allowed." `otherwise'-clauses are not allowed.
\n(fn EXPR (KEYLIST BODY...)...)"
(list* 'case expr (append clauses '((ecase-error-flag))))) (list* 'case expr (append clauses '((ecase-error-flag)))))
(defmacro typecase (expr &rest clauses) (defmacro typecase (expr &rest clauses)
"Evals EXPR, chooses from CLAUSES on that value. "Evals EXPR, chooses among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
typecase returns nil. A TYPE of t or `otherwise' is allowed only in the typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match." final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
(let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(type-list nil) (type-list nil)
(body (cons (body (cons
@ -552,7 +555,8 @@ final clause, and matches if no other keys match."
(defmacro etypecase (expr &rest clauses) (defmacro etypecase (expr &rest clauses)
"Like `typecase', but error if no case fits. "Like `typecase', but error if no case fits.
`otherwise'-clauses are not allowed." `otherwise'-clauses are not allowed.
\n(fn EXPR (TYPE BODY...)...)"
(list* 'typecase expr (append clauses '((ecase-error-flag))))) (list* 'typecase expr (append clauses '((ecase-error-flag)))))
@ -1273,7 +1277,7 @@ before assigning any symbols SYM to the corresponding values.
(defmacro progv (symbols values &rest body) (defmacro progv (symbols values &rest body)
"Bind SYMBOLS to VALUES dynamically in BODY. "Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each SYMBOL in the first list is bound to the corresponding VALUE in the Each symbol in the first list is bound to the corresponding value in the
second list (or made unbound if VALUES is shorter than SYMBOLS); then the second list (or made unbound if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time." a `let' form, except that the list of symbols can be computed at run-time."
@ -1284,7 +1288,7 @@ a `let' form, except that the list of symbols can be computed at run-time."
;;; This should really have some way to shadow 'byte-compile properties, etc. ;;; This should really have some way to shadow 'byte-compile properties, etc.
(defmacro flet (bindings &rest body) (defmacro flet (bindings &rest body)
"Make temporary function defns. "Make temporary function definitions.
This is an analogue of `let' that operates on the function cell of FUNC This is an analogue of `let' that operates on the function cell of FUNC
rather than its value cell. The FORMs are evaluated with the specified rather than its value cell. The FORMs are evaluated with the specified
function definitions in place, then the definitions are undone (the FUNCs function definitions in place, then the definitions are undone (the FUNCs
@ -1311,7 +1315,7 @@ go back to their previous definitions, or lack thereof).
body)) body))
(defmacro labels (bindings &rest body) (defmacro labels (bindings &rest body)
"Make temporary func bindings. "Make temporary function bindings.
This is like `flet', except the bindings are lexical instead of dynamic. This is like `flet', except the bindings are lexical instead of dynamic.
Unlike `flet', this macro is fully compliant with the Common Lisp standard. Unlike `flet', this macro is fully compliant with the Common Lisp standard.
@ -1369,7 +1373,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(defmacro lexical-let (bindings &rest body) (defmacro lexical-let (bindings &rest body)
"Like `let', but lexically scoped. "Like `let', but lexically scoped.
The main visible difference is that lambdas inside BODY will create The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp." lexical closures as in Common Lisp.
\n(fn VARLIST BODY)"
(let* ((cl-closure-vars cl-closure-vars) (let* ((cl-closure-vars cl-closure-vars)
(vars (mapcar (function (vars (mapcar (function
(lambda (x) (lambda (x)
@ -1411,7 +1416,8 @@ lexical closures as in Common Lisp."
(defmacro lexical-let* (bindings &rest body) (defmacro lexical-let* (bindings &rest body)
"Like `let*', but lexically scoped. "Like `let*', but lexically scoped.
The main visible difference is that lambdas inside BODY will create The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp." lexical closures as in Common Lisp.
\n(fn VARLIST BODY)"
(if (null bindings) (cons 'progn body) (if (null bindings) (cons 'progn body)
(setq bindings (reverse bindings)) (setq bindings (reverse bindings))
(while bindings (while bindings
@ -1435,7 +1441,7 @@ is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
simulate true multiple return values. For compatibility, (values A B C) is simulate true multiple return values. For compatibility, (values A B C) is
a synonym for (list A B C). a synonym for (list A B C).
\(fn (SYM SYM...) FORM BODY)" \(fn (SYM...) FORM BODY)"
(let ((temp (make-symbol "--cl-var--")) (n -1)) (let ((temp (make-symbol "--cl-var--")) (n -1))
(list* 'let* (cons (list temp form) (list* 'let* (cons (list temp form)
(mapcar (function (mapcar (function
@ -1451,7 +1457,7 @@ each of the symbols SYM in turn. This is analogous to the Common Lisp
`multiple-value-setq' macro, using lists to simulate true multiple return `multiple-value-setq' macro, using lists to simulate true multiple return
values. For compatibility, (values A B C) is a synonym for (list A B C). values. For compatibility, (values A B C) is a synonym for (list A B C).
\(fn (SYM SYM...) FORM)" \(fn (SYM...) FORM)"
(cond ((null vars) (list 'progn form nil)) (cond ((null vars) (list 'progn form nil))
((null (cdr vars)) (list 'setq (car vars) (list 'car form))) ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
(t (t
@ -1967,7 +1973,7 @@ The form returns true if TAG was found and removed, nil otherwise."
Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'. Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE PLACE... VAL)" \(fn PLACE... VAL)"
(cond (cond
((null args) place) ((null args) place)
((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args)))) ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))

209
lisp/emacs-lisp/cl-seq.el
View file

@ -125,8 +125,9 @@
(defun reduce (cl-func cl-seq &rest cl-keys) (defun reduce (cl-func cl-seq &rest cl-keys)
"Reduce two-argument FUNCTION across SEQUENCE. "Reduce two-argument FUNCTION across SEQ.
Keywords supported: :start :end :from-end :initial-value :key" \nKeywords supported: :start :end :from-end :initial-value :key
\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
(or (listp cl-seq) (setq cl-seq (append cl-seq nil))) (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
(setq cl-seq (subseq cl-seq cl-start cl-end)) (setq cl-seq (subseq cl-seq cl-start cl-end))
@ -145,7 +146,8 @@ Keywords supported: :start :end :from-end :initial-value :key"
(defun fill (seq item &rest cl-keys) (defun fill (seq item &rest cl-keys)
"Fill the elements of SEQ with ITEM. "Fill the elements of SEQ with ITEM.
Keywords supported: :start :end" \nKeywords supported: :start :end
\n(fn SEQ ITEM [KEYWORD VALUE]...)"
(cl-parsing-keywords ((:start 0) :end) () (cl-parsing-keywords ((:start 0) :end) ()
(if (listp seq) (if (listp seq)
(let ((p (nthcdr cl-start seq)) (let ((p (nthcdr cl-start seq))
@ -164,7 +166,8 @@ Keywords supported: :start :end"
(defun replace (cl-seq1 cl-seq2 &rest cl-keys) (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
"Replace the elements of SEQ1 with the elements of SEQ2. "Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned. SEQ1 is destructively modified, then returned.
Keywords supported: :start1 :end1 :start2 :end2" \nKeywords supported: :start1 :end1 :start2 :end2
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
(if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
(or (= cl-start1 cl-start2) (or (= cl-start1 cl-start2)
@ -206,7 +209,8 @@ Keywords supported: :start1 :end1 :start2 :end2"
"Remove all occurrences of ITEM in SEQ. "Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :test :test-not :key :count :start :end :from-end" \nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) () (:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0) (if (<= (or cl-count (setq cl-count 8000000)) 0)
@ -250,20 +254,23 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
"Remove all items satisfying PREDICATE in SEQ. "Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'remove* nil cl-list :if cl-pred cl-keys)) (apply 'remove* nil cl-list :if cl-pred cl-keys))
(defun remove-if-not (cl-pred cl-list &rest cl-keys) (defun remove-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ. "Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'remove* nil cl-list :if-not cl-pred cl-keys)) (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
(defun delete* (cl-item cl-seq &rest cl-keys) (defun delete* (cl-item cl-seq &rest cl-keys)
"Remove all occurrences of ITEM in SEQ. "Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :test :test-not :key :count :start :end :from-end" \nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) () (:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0) (if (<= (or cl-count (setq cl-count 8000000)) 0)
@ -305,23 +312,27 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
(defun delete-if (cl-pred cl-list &rest cl-keys) (defun delete-if (cl-pred cl-list &rest cl-keys)
"Remove all items satisfying PREDICATE in SEQ. "Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'delete* nil cl-list :if cl-pred cl-keys)) (apply 'delete* nil cl-list :if cl-pred cl-keys))
(defun delete-if-not (cl-pred cl-list &rest cl-keys) (defun delete-if-not (cl-pred cl-list &rest cl-keys)
"Remove all items not satisfying PREDICATE in SEQ. "Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'delete* nil cl-list :if-not cl-pred cl-keys)) (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
(defun remove-duplicates (cl-seq &rest cl-keys) (defun remove-duplicates (cl-seq &rest cl-keys)
"Return a copy of SEQ with all duplicate elements removed. "Return a copy of SEQ with all duplicate elements removed.
Keywords supported: :test :test-not :key :start :end :from-end" \nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
(cl-delete-duplicates cl-seq cl-keys t)) (cl-delete-duplicates cl-seq cl-keys t))
(defun delete-duplicates (cl-seq &rest cl-keys) (defun delete-duplicates (cl-seq &rest cl-keys)
"Remove all duplicate elements from SEQ (destructively). "Remove all duplicate elements from SEQ (destructively).
Keywords supported: :test :test-not :key :start :end :from-end" \nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn SEQ [KEYWORD VALUE]...)"
(cl-delete-duplicates cl-seq cl-keys nil)) (cl-delete-duplicates cl-seq cl-keys nil))
(defun cl-delete-duplicates (cl-seq cl-keys cl-copy) (defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
@ -368,7 +379,8 @@ Keywords supported: :test :test-not :key :start :end :from-end"
"Substitute NEW for OLD in SEQ. "Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :test :test-not :key :count :start :end :from-end" \nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not :count (cl-parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) () (:start 0) :end :from-end) ()
(if (or (eq cl-old cl-new) (if (or (eq cl-old cl-new)
@ -388,20 +400,23 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
"Substitute NEW for all items satisfying PREDICATE in SEQ. "Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ. "Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ. to avoid corrupting the original SEQ.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
"Substitute NEW for OLD in SEQ. "Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :test :test-not :key :count :start :end :from-end" \nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not :count (cl-parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) () (:start 0) :end :from-end) ()
(or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
@ -433,38 +448,44 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items satisfying PREDICATE in SEQ. "Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
"Substitute NEW for all items not satisfying PREDICATE in SEQ. "Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible. This is a destructive function; it reuses the storage of SEQ whenever possible.
Keywords supported: :key :count :start :end :from-end" \nKeywords supported: :key :count :start :end :from-end
\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
(defun find (cl-item cl-seq &rest cl-keys) (defun find (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in LIST. "Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found. Return the matching ITEM, or nil if not found.
Keywords supported: :test :test-not :key :start :end :from-end" \nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
(and cl-pos (elt cl-seq cl-pos)))) (and cl-pos (elt cl-seq cl-pos))))
(defun find-if (cl-pred cl-list &rest cl-keys) (defun find-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST. "Find the first item satisfying PREDICATE in SEQ.
Return the matching ITEM, or nil if not found. Return the matching item, or nil if not found.
Keywords supported: :key :start :end :from-end" \nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'find nil cl-list :if cl-pred cl-keys)) (apply 'find nil cl-list :if cl-pred cl-keys))
(defun find-if-not (cl-pred cl-list &rest cl-keys) (defun find-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST. "Find the first item not satisfying PREDICATE in SEQ.
Return the matching ITEM, or nil if not found. Return the matching item, or nil if not found.
Keywords supported: :key :start :end :from-end" \nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'find nil cl-list :if-not cl-pred cl-keys)) (apply 'find nil cl-list :if-not cl-pred cl-keys))
(defun position (cl-item cl-seq &rest cl-keys) (defun position (cl-item cl-seq &rest cl-keys)
"Find the first occurrence of ITEM in LIST. "Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found. Return the index of the matching item, or nil if not found.
Keywords supported: :test :test-not :key :start :end :from-end" \nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not (cl-parsing-keywords (:test :test-not :key :if :if-not
(:start 0) :end :from-end) () (:start 0) :end :from-end) ()
(cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
@ -491,20 +512,23 @@ Keywords supported: :test :test-not :key :start :end :from-end"
(and (< cl-start cl-end) cl-start)))) (and (< cl-start cl-end) cl-start))))
(defun position-if (cl-pred cl-list &rest cl-keys) (defun position-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST. "Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found. Return the index of the matching item, or nil if not found.
Keywords supported: :key :start :end :from-end" \nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'position nil cl-list :if cl-pred cl-keys)) (apply 'position nil cl-list :if cl-pred cl-keys))
(defun position-if-not (cl-pred cl-list &rest cl-keys) (defun position-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST. "Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found. Return the index of the matching item, or nil if not found.
Keywords supported: :key :start :end :from-end" \nKeywords supported: :key :start :end :from-end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'position nil cl-list :if-not cl-pred cl-keys)) (apply 'position nil cl-list :if-not cl-pred cl-keys))
(defun count (cl-item cl-seq &rest cl-keys) (defun count (cl-item cl-seq &rest cl-keys)
"Count the number of occurrences of ITEM in LIST. "Count the number of occurrences of ITEM in SEQ.
Keywords supported: :test :test-not :key :start :end" \nKeywords supported: :test :test-not :key :start :end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
(let ((cl-count 0) cl-x) (let ((cl-count 0) cl-x)
(or cl-end (setq cl-end (length cl-seq))) (or cl-end (setq cl-end (length cl-seq)))
@ -516,20 +540,23 @@ Keywords supported: :test :test-not :key :start :end"
cl-count))) cl-count)))
(defun count-if (cl-pred cl-list &rest cl-keys) (defun count-if (cl-pred cl-list &rest cl-keys)
"Count the number of items satisfying PREDICATE in LIST. "Count the number of items satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end" \nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'count nil cl-list :if cl-pred cl-keys)) (apply 'count nil cl-list :if cl-pred cl-keys))
(defun count-if-not (cl-pred cl-list &rest cl-keys) (defun count-if-not (cl-pred cl-list &rest cl-keys)
"Count the number of items not satisfying PREDICATE in LIST. "Count the number of items not satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end" \nKeywords supported: :key :start :end
\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
(apply 'count nil cl-list :if-not cl-pred cl-keys)) (apply 'count nil cl-list :if-not cl-pred cl-keys))
(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
"Compare SEQ1 with SEQ2, return index of first mismatching element. "Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence. other, the return value indicates the end of the shorter sequence.
Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :from-end (cl-parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) () (:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end1 (setq cl-end1 (length cl-seq1)))
@ -558,7 +585,8 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
"Search for SEQ1 as a subsequence of SEQ2. "Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found; Return the index of the leftmost element of the first match found;
return nil if there are no matches. return nil if there are no matches.
Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :from-end (cl-parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) () (:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end1 (setq cl-end1 (length cl-seq1)))
@ -580,9 +608,10 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
(and (< cl-start2 cl-end2) cl-pos))))) (and (< cl-start2 cl-end2) cl-pos)))))
(defun sort* (cl-seq cl-pred &rest cl-keys) (defun sort* (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQUENCE according to PREDICATE. "Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQUENCE if possible. This is a destructive function; it reuses the storage of SEQ if possible.
Keywords supported: :key" \nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(if (nlistp cl-seq) (if (nlistp cl-seq)
(replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
(cl-parsing-keywords (:key) () (cl-parsing-keywords (:key) ()
@ -593,16 +622,18 @@ Keywords supported: :key"
(funcall cl-key cl-y))))))))) (funcall cl-key cl-y)))))))))
(defun stable-sort (cl-seq cl-pred &rest cl-keys) (defun stable-sort (cl-seq cl-pred &rest cl-keys)
"Sort the argument SEQUENCE stably according to PREDICATE. "Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQUENCE if possible. This is a destructive function; it reuses the storage of SEQ if possible.
Keywords supported: :key" \nKeywords supported: :key
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(apply 'sort* cl-seq cl-pred cl-keys)) (apply 'sort* cl-seq cl-pred cl-keys))
(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
"Destructively merge the two sequences to produce a new sequence. "Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
argument sequences, and PRED is a `less-than' predicate on the elements. sequences, and PREDICATE is a `less-than' predicate on the elements.
Keywords supported: :key" \nKeywords supported: :key
\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
(or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
(or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
(cl-parsing-keywords (:key) () (cl-parsing-keywords (:key) ()
@ -618,7 +649,8 @@ Keywords supported: :key"
(defun member* (cl-item cl-list &rest cl-keys) (defun member* (cl-item cl-list &rest cl-keys)
"Find the first occurrence of ITEM in LIST. "Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM. Return the sublist of LIST whose car is ITEM.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if cl-keys (if cl-keys
(cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-list (not (cl-check-test cl-item (car cl-list)))) (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
@ -631,13 +663,15 @@ Keywords supported: :test :test-not :key"
(defun member-if (cl-pred cl-list &rest cl-keys) (defun member-if (cl-pred cl-list &rest cl-keys)
"Find the first item satisfying PREDICATE in LIST. "Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches. Return the sublist of LIST whose car matches.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'member* nil cl-list :if cl-pred cl-keys)) (apply 'member* nil cl-list :if cl-pred cl-keys))
(defun member-if-not (cl-pred cl-list &rest cl-keys) (defun member-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item not satisfying PREDICATE in LIST. "Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches. Return the sublist of LIST whose car matches.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'member* nil cl-list :if-not cl-pred cl-keys)) (apply 'member* nil cl-list :if-not cl-pred cl-keys))
(defun cl-adjoin (cl-item cl-list &rest cl-keys) (defun cl-adjoin (cl-item cl-list &rest cl-keys)
@ -649,7 +683,8 @@ Keywords supported: :key"
;;; See compiler macro in cl-macs.el ;;; See compiler macro in cl-macs.el
(defun assoc* (cl-item cl-alist &rest cl-keys) (defun assoc* (cl-item cl-alist &rest cl-keys)
"Find the first item whose car matches ITEM in LIST. "Find the first item whose car matches ITEM in LIST.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if cl-keys (if cl-keys
(cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist (while (and cl-alist
@ -663,17 +698,20 @@ Keywords supported: :test :test-not :key"
(defun assoc-if (cl-pred cl-list &rest cl-keys) (defun assoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose car satisfies PREDICATE in LIST. "Find the first item whose car satisfies PREDICATE in LIST.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'assoc* nil cl-list :if cl-pred cl-keys)) (apply 'assoc* nil cl-list :if cl-pred cl-keys))
(defun assoc-if-not (cl-pred cl-list &rest cl-keys) (defun assoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose car does not satisfy PREDICATE in LIST. "Find the first item whose car does not satisfy PREDICATE in LIST.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
(defun rassoc* (cl-item cl-alist &rest cl-keys) (defun rassoc* (cl-item cl-alist &rest cl-keys)
"Find the first item whose cdr matches ITEM in LIST. "Find the first item whose cdr matches ITEM in LIST.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if (or cl-keys (numberp cl-item)) (if (or cl-keys (numberp cl-item))
(cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist (while (and cl-alist
@ -685,12 +723,14 @@ Keywords supported: :test :test-not :key"
(defun rassoc-if (cl-pred cl-list &rest cl-keys) (defun rassoc-if (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr satisfies PREDICATE in LIST. "Find the first item whose cdr satisfies PREDICATE in LIST.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'rassoc* nil cl-list :if cl-pred cl-keys)) (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
(defun rassoc-if-not (cl-pred cl-list &rest cl-keys) (defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
"Find the first item whose cdr does not satisfy PREDICATE in LIST. "Find the first item whose cdr does not satisfy PREDICATE in LIST.
Keywords supported: :key" \nKeywords supported: :key
\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
(apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
(defun union (cl-list1 cl-list2 &rest cl-keys) (defun union (cl-list1 cl-list2 &rest cl-keys)
@ -698,7 +738,8 @@ Keywords supported: :key"
The result list contains all items that appear in either LIST1 or LIST2. The result list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2. to avoid corrupting the original LIST1 and LIST2.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) cl-list1) ((equal cl-list1 cl-list2) cl-list1)
(t (t
@ -717,7 +758,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in either LIST1 or LIST2. The result list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2 This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible. whenever possible.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
(t (apply 'union cl-list1 cl-list2 cl-keys)))) (t (apply 'union cl-list1 cl-list2 cl-keys))))
@ -726,7 +768,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in both LIST1 and LIST2. The result list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2. to avoid corrupting the original LIST1 and LIST2.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(and cl-list1 cl-list2 (and cl-list1 cl-list2
(if (equal cl-list1 cl-list2) cl-list1 (if (equal cl-list1 cl-list2) cl-list1
(cl-parsing-keywords (:key) (:test :test-not) (cl-parsing-keywords (:key) (:test :test-not)
@ -747,7 +790,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in both LIST1 and LIST2. The result list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2 This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible. whenever possible.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
(defun set-difference (cl-list1 cl-list2 &rest cl-keys) (defun set-difference (cl-list1 cl-list2 &rest cl-keys)
@ -755,7 +799,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in LIST1 but not LIST2. The result list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2. to avoid corrupting the original LIST1 and LIST2.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1 (if (or (null cl-list1) (null cl-list2)) cl-list1
(cl-parsing-keywords (:key) (:test :test-not) (cl-parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil)) (let ((cl-res nil))
@ -773,7 +818,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in LIST1 but not LIST2. The result list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2 This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible. whenever possible.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1 (if (or (null cl-list1) (null cl-list2)) cl-list1
(apply 'set-difference cl-list1 cl-list2 cl-keys))) (apply 'set-difference cl-list1 cl-list2 cl-keys)))
@ -782,7 +828,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in exactly one of LIST1, LIST2. The result list contains all items that appear in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary This is a non-destructive function; it makes a copy of the data if necessary
to avoid corrupting the original LIST1 and LIST2. to avoid corrupting the original LIST1 and LIST2.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil) ((equal cl-list1 cl-list2) nil)
(t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
@ -793,7 +840,8 @@ Keywords supported: :test :test-not :key"
The result list contains all items that appear in exactly one of LIST1, LIST2. The result list contains all items that appear in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2 This is a destructive function; it reuses the storage of LIST1 and LIST2
whenever possible. whenever possible.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
((equal cl-list1 cl-list2) nil) ((equal cl-list1 cl-list2) nil)
(t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
@ -802,7 +850,8 @@ Keywords supported: :test :test-not :key"
(defun subsetp (cl-list1 cl-list2 &rest cl-keys) (defun subsetp (cl-list1 cl-list2 &rest cl-keys)
"Return true if LIST1 is a subset of LIST2. "Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2. I.e., if every element of LIST1 also appears in LIST2.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) t) ((null cl-list2) nil) (cond ((null cl-list1) t) ((null cl-list2) nil)
((equal cl-list1 cl-list2) t) ((equal cl-list1 cl-list2) t)
(t (cl-parsing-keywords (:key) (:test :test-not) (t (cl-parsing-keywords (:key) (:test :test-not)
@ -815,38 +864,44 @@ Keywords supported: :test :test-not :key"
(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (non-destructively). "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW. Return a copy of TREE with all matching elements replaced by NEW.
Keywords supported: :key" \nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW. Return a copy of TREE with all non-matching elements replaced by NEW.
Keywords supported: :key" \nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
(defun nsubst (cl-new cl-old cl-tree &rest cl-keys) (defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (destructively). "Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar'). to `setcar').
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
(apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements matching PREDICATE in TREE (destructively). "Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar'). Any element of TREE which matches is changed to NEW (via a call to `setcar').
Keywords supported: :key" \nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
"Substitute NEW for elements not matching PREDICATE in TREE (destructively). "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar'). Any element of TREE which matches is changed to NEW (via a call to `setcar').
Keywords supported: :key" \nKeywords supported: :key
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
(defun sublis (cl-alist cl-tree &rest cl-keys) (defun sublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (non-destructively). "Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced. Return a copy of TREE with all matching elements replaced.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
(cl-sublis-rec cl-tree))) (cl-sublis-rec cl-tree)))
@ -867,7 +922,8 @@ Keywords supported: :test :test-not :key"
(defun nsublis (cl-alist cl-tree &rest cl-keys) (defun nsublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (destructively). "Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'. Any matching element of TREE is changed via a call to `setcar'.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
(let ((cl-hold (list cl-tree))) (let ((cl-hold (list cl-tree)))
(cl-nsublis-rec cl-hold) (cl-nsublis-rec cl-hold)
@ -888,9 +944,10 @@ Keywords supported: :test :test-not :key"
(setq cl-tree (cdr cl-tree)))))) (setq cl-tree (cdr cl-tree))))))
(defun tree-equal (cl-x cl-y &rest cl-keys) (defun tree-equal (cl-x cl-y &rest cl-keys)
"Return t if trees X and Y have `eql' leaves. "Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively. Atoms are compared by `eql'; cons cells are compared recursively.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
(cl-parsing-keywords (:test :test-not :key) () (cl-parsing-keywords (:test :test-not :key) ()
(cl-tree-equal-rec cl-x cl-y))) (cl-tree-equal-rec cl-x cl-y)))

69
lisp/emacs-lisp/cl.el
View file

@ -112,16 +112,6 @@ a future Emacs interpreter will be able to use it.")
(defun cl-cannot-unload () (defun cl-cannot-unload ()
(error "Cannot unload the feature `cl'")) (error "Cannot unload the feature `cl'"))
;;; Predicates.
(defun eql (a b) ; See compiler macro in cl-macs.el
"Return t if the two args are the same Lisp object.
Floating-point numbers of equal value are `eql', but they may not be `eq'."
(if (numberp a)
(equal a b)
(eq a b)))
;;; Generalized variables. These macros are defined here so that they ;;; Generalized variables. These macros are defined here so that they
;;; can safely be used in .emacs files. ;;; can safely be used in .emacs files.
@ -162,7 +152,8 @@ be a symbol, or any generalized variable allowed by `setf'."
"(pushnew X PLACE): insert X at the head of the list if not already there. "(pushnew X PLACE): insert X at the head of the list if not already there.
Like (push X PLACE), except that the list is unmodified if X is `eql' to Like (push X PLACE), except that the list is unmodified if X is `eql' to
an element already on the list. an element already on the list.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn X PLACE [KEYWORD VALUE]...)"
(if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
(list* 'callf2 'adjoin x place keys))) (list* 'callf2 'adjoin x place keys)))
@ -256,7 +247,8 @@ Otherwise, the macro is expanded and the expansion is considered
in place of FORM. When a non-macro-call results, it is returned. in place of FORM. When a non-macro-call results, it is returned.
The second optional arg ENVIRONMENT specifies an environment of macro The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation." definitions to shadow the loaded ones for use in file byte-compilation.
\n(fn FORM &optional ENVIRONMENT)"
(let ((cl-macro-environment cl-env)) (let ((cl-macro-environment cl-env))
(while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
(and (symbolp cl-macro) (and (symbolp cl-macro)
@ -300,27 +292,27 @@ definitions to shadow the loaded ones for use in file byte-compilation."
;;; Numbers. ;;; Numbers.
(defun floatp-safe (x) (defun floatp-safe (object)
"Return t if OBJECT is a floating point number. "Return t if OBJECT is a floating point number.
On Emacs versions that lack floating-point support, this function On Emacs versions that lack floating-point support, this function
always returns nil." always returns nil."
(and (numberp x) (not (integerp x)))) (and (numberp object) (not (integerp object))))
(defun plusp (x) (defun plusp (number)
"Return t if NUMBER is positive." "Return t if NUMBER is positive."
(> x 0)) (> number 0))
(defun minusp (x) (defun minusp (number)
"Return t if NUMBER is negative." "Return t if NUMBER is negative."
(< x 0)) (< number 0))
(defun oddp (x) (defun oddp (integer)
"Return t if INTEGER is odd." "Return t if INTEGER is odd."
(eq (logand x 1) 1)) (eq (logand integer 1) 1))
(defun evenp (x) (defun evenp (integer)
"Return t if INTEGER is even." "Return t if INTEGER is even."
(eq (logand x 1) 0)) (eq (logand integer 1) 0))
(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
@ -344,7 +336,8 @@ always returns nil."
If there are several SEQs, FUNCTION is called with that many arguments, If there are several SEQs, FUNCTION is called with that many arguments,
and mapping stops as soon as the shortest list runs out. With just one and mapping stops as soon as the shortest list runs out. With just one
SEQ, this is like `mapcar'. With several, it is like the Common Lisp SEQ, this is like `mapcar'. With several, it is like the Common Lisp
`mapcar' function extended to arbitrary sequence types." `mapcar' function extended to arbitrary sequence types.
\n(fn FUNCTION SEQ...)"
(if cl-rest (if cl-rest
(if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
(cl-mapcar-many cl-func (cons cl-x cl-rest)) (cl-mapcar-many cl-func (cons cl-x cl-rest))
@ -503,9 +496,10 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
;; x)) ;; x))
(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
"Return a new list with specified args as elements, consed to last arg. "Return a new list with specified ARGs as elements, consed to last ARG.
Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
`(cons A (cons B (cons C D)))'." `(cons A (cons B (cons C D)))'.
\n(fn ARG...)"
(cond ((not rest) arg) (cond ((not rest) arg)
((not (cdr rest)) (cons arg (car rest))) ((not (cdr rest)) (cons arg (car rest)))
(t (let* ((n (length rest)) (t (let* ((n (length rest))
@ -522,8 +516,8 @@ Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
(nreverse res))) (nreverse res)))
(defun copy-list (list) (defun copy-list (list)
"Return a copy of a list, which may be a dotted list. "Return a copy of LIST, which may be a dotted list.
The elements of the list are not copied, just the list structure itself." The elements of LIST are not copied, just the list structure itself."
(if (consp list) (if (consp list)
(let ((res nil)) (let ((res nil))
(while (consp list) (push (pop list) res)) (while (consp list) (push (pop list) res))
@ -544,7 +538,8 @@ The elements of the list are not copied, just the list structure itself."
(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
"Return ITEM consed onto the front of LIST only if it's not already there. "Return ITEM consed onto the front of LIST only if it's not already there.
Otherwise, return LIST unmodified. Otherwise, return LIST unmodified.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(cond ((or (equal cl-keys '(:test eq)) (cond ((or (equal cl-keys '(:test eq))
(and (null cl-keys) (not (numberp cl-item)))) (and (null cl-keys) (not (numberp cl-item))))
(if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
@ -555,7 +550,8 @@ Keywords supported: :test :test-not :key"
(defun subst (cl-new cl-old cl-tree &rest cl-keys) (defun subst (cl-new cl-old cl-tree &rest cl-keys)
"Substitute NEW for OLD everywhere in TREE (non-destructively). "Substitute NEW for OLD everywhere in TREE (non-destructively).
Return a copy of TREE with all elements `eql' to OLD replaced by NEW. Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
Keywords supported: :test :test-not :key" \nKeywords supported: :test :test-not :key
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
(if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
(apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
(cl-do-subst cl-new cl-old cl-tree))) (cl-do-subst cl-new cl-old cl-tree)))
@ -569,8 +565,17 @@ Keywords supported: :test :test-not :key"
cl-tree (cons a d)))) cl-tree (cons a d))))
(t cl-tree))) (t cl-tree)))
(defun acons (a b c) (cons (cons a b) c)) (defun acons (key value alist)
(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) "Add KEY and VALUE to ALIST.
Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
(cons (cons key value) alist))
(defun pairlis (keys values &optional alist)
"Make an alist from KEYS and VALUES.
Return a new alist composed by associating KEYS to corresponding VALUES;
the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (mapcar* 'cons keys values) alist))
;;; Miscellaneous. ;;; Miscellaneous.
@ -699,5 +704,5 @@ Keywords supported: :test :test-not :key"
(run-hooks 'cl-load-hook) (run-hooks 'cl-load-hook)
;;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851 ;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
;;; cl.el ends here ;;; cl.el ends here

1
lisp/emacs-lisp/derived.el
View file

@ -132,6 +132,7 @@ BODY can start with a bunch of keyword arguments. The following keyword
arguments are currently understood: arguments are currently understood:
:group GROUP :group GROUP
Declare the customization group that corresponds to this mode. Declare the customization group that corresponds to this mode.
The command `customize-mode' uses this.
:syntax-table TABLE :syntax-table TABLE
Use TABLE instead of the default. Use TABLE instead of the default.
A nil value means to simply use the same syntax-table as the parent. A nil value means to simply use the same syntax-table as the parent.

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

@ -172,7 +172,7 @@ For example, you could write
(setq group (setq group
`(:group ',(intern (replace-regexp-in-string `(:group ',(intern (replace-regexp-in-string
"-mode\\'" "" mode-name))))) "-mode\\'" "" mode-name)))))
`(progn `(progn
;; Define the variable to enable or disable the mode. ;; Define the variable to enable or disable the mode.
,(if (not globalp) ,(if (not globalp)
@ -306,9 +306,9 @@ in which `%s' turns it on."
;; Setup hook to handle future mode changes and new buffers. ;; Setup hook to handle future mode changes and new buffers.
(if ,global-mode (if ,global-mode
(progn (progn
(add-hook 'find-file-hook ',buffers) (add-hook 'after-change-major-mode-hook ',buffers)
(add-hook 'change-major-mode-hook ',cmmh)) (add-hook 'change-major-mode-hook ',cmmh))
(remove-hook 'find-file-hook ',buffers) (remove-hook 'after-change-major-mode-hook ',buffers)
(remove-hook 'change-major-mode-hook ',cmmh)) (remove-hook 'change-major-mode-hook ',cmmh))
;; Go through existing buffers. ;; Go through existing buffers.

14
lisp/emacs-lisp/easymenu.el
View file

@ -471,11 +471,15 @@ Contrary to XEmacs, this is a nop on Emacs since menus are automatically
(defun easy-menu-add (menu &optional map) (defun easy-menu-add (menu &optional map)
"Add the menu to the menubar. "Add the menu to the menubar.
This is a nop on Emacs since menus are automatically activated when the On Emacs, menus are already automatically activated when the
corresponding keymap is activated. On XEmacs this is needed to actually corresponding keymap is activated. On XEmacs this is needed to
add the menu to the current menubar. actually add the menu to the current menubar.
Maybe precalculate equivalent key bindings.
Do it only if `easy-menu-precalculate-equivalent-keybindings' is on." This also precalculates equivalent key bindings when
`easy-menu-precalculate-equivalent-keybindings' is on.
You should call this once the menu and keybindings are set up
completely and menu filter functions can be expected to work."
(when easy-menu-precalculate-equivalent-keybindings (when easy-menu-precalculate-equivalent-keybindings
(if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
(setq menu (symbol-value menu))) (setq menu (symbol-value menu)))

6
lisp/emulation/tpu-extras.el
View file

@ -144,9 +144,9 @@ the previous line when starting from a line beginning."
"Eliminate whitespace at ends of lines, if the cursor is free." "Eliminate whitespace at ends of lines, if the cursor is free."
(if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends)))
(or (memq 'tpu-write-file-hook write-file-hooks) (or (memq 'tpu-write-file-hook write-file-functions)
(setq write-file-hooks (setq write-file-functions
(cons 'tpu-write-file-hook write-file-hooks))) (cons 'tpu-write-file-hook write-file-functions)))
;;; Utility routines for implementing scroll margins ;;; Utility routines for implementing scroll margins

4
lisp/emulation/viper-ex.el
View file

@ -67,10 +67,10 @@
;;; Variables ;;; Variables
(defconst viper-ex-work-buf-name " *ex-working-space*") (defconst viper-ex-work-buf-name " *ex-working-space*")
(defconst viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) (defvar viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
(defconst viper-ex-tmp-buf-name " *ex-tmp*") (defconst viper-ex-tmp-buf-name " *ex-tmp*")
(defconst viper-ex-print-buf-name " *ex-print*") (defconst viper-ex-print-buf-name " *ex-print*")
(defconst viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name)) (defvar viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name))
;;; ex-commands... ;;; ex-commands...

13
lisp/faces.el
View file

@ -1844,9 +1844,22 @@ created."
:group 'modeline :group 'modeline
:group 'basic-faces) :group 'basic-faces)
(defface mode-line-highlight
'((((class color) (min-colors 88) (background light))
:background "RoyalBlue4" :foreground "white")
(((class color) (min-colors 88) (background dark))
:background "light sky blue" :foreground "black")
(t
:inverse-video t))
"Basic mode line face for highlighting."
:version "22.1"
:group 'modeline
:group 'basic-faces)
;; Make `modeline' an alias for `mode-line', for compatibility. ;; Make `modeline' an alias for `mode-line', for compatibility.
(put 'modeline 'face-alias 'mode-line) (put 'modeline 'face-alias 'mode-line)
(put 'modeline-inactive 'face-alias 'mode-line-inactive) (put 'modeline-inactive 'face-alias 'mode-line-inactive)
(put 'modeline-higilight 'face-alias 'mode-line-highlight)
(defface header-line (defface header-line
'((default '((default

9
lisp/files.el
View file

@ -1744,7 +1744,7 @@ in that case, this function acts as if `enable-local-variables' were t."
(mapc (mapc
(lambda (elt) (lambda (elt)
(cons (purecopy (car elt)) (cdr elt))) (cons (purecopy (car elt)) (cdr elt)))
'(;; do this first, so that .html.pl is Polish html, not Perl `(;; do this first, so that .html.pl is Polish html, not Perl
("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
("\\.te?xt\\'" . text-mode) ("\\.te?xt\\'" . text-mode)
("\\.[tT]e[xX]\\'" . tex-mode) ("\\.[tT]e[xX]\\'" . tex-mode)
@ -1762,9 +1762,12 @@ in that case, this function acts as if `enable-local-variables' were t."
("\\.ad[abs]\\'" . ada-mode) ("\\.ad[abs]\\'" . ada-mode)
("\\.ad[bs].dg\\'" . ada-mode) ("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
("[Mm]akefile\\'" . makefile-mode)
("GNUmakefile\\'" . makefile-gmake-mode) ("GNUmakefile\\'" . makefile-gmake-mode)
,@(if (memq system-type '(berkeley-unix next-mach darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
'(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
("[Mm]akefile\\'" . makefile-mode)))
("Makeppfile\\'" . makefile-makepp-mode) ("Makeppfile\\'" . makefile-makepp-mode)
("\\.am\\'" . makefile-automake-mode) ("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here ;; Less common extensions come here

24
lisp/font-core.el
View file

@ -231,24 +231,20 @@ this function onto `change-major-mode-hook'."
;; hook is run, the major mode is in the process of being changed and we do not ;; hook is run, the major mode is in the process of being changed and we do not
;; know what the final major mode will be. So, `font-lock-change-major-mode' ;; know what the final major mode will be. So, `font-lock-change-major-mode'
;; only (a) notes the name of the current buffer, and (b) adds our function ;; only (a) notes the name of the current buffer, and (b) adds our function
;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hook' and ;; `turn-on-font-lock-if-enabled' to the hook variables
;; `post-command-hook' (for buffers that are not visiting files). By the time ;; `after-change-major-mode-hook' and `post-command-hook' (for modes
;; that do not yet run `after-change-major-mode-hook'). By the time
;; the functions on the first of these hooks to be run are run, the new major ;; the functions on the first of these hooks to be run are run, the new major
;; mode is assumed to be in place. This way we get a Font Lock function run ;; mode is assumed to be in place. This way we get a Font Lock function run
;; when a major mode is turned on, without knowing major modes or their hooks. ;; when a major mode is turned on, without knowing major modes or their hooks.
;; ;;
;; Naturally this requires that (a) major modes run `kill-all-local-variables', ;; Naturally this requires that major modes run `kill-all-local-variables'
;; as they are supposed to do, and (b) the major mode is in place after the ;; and `after-change-major-mode-hook', as they are supposed to. For modes
;; file is visited or the command that ran `kill-all-local-variables' has ;; that do not run `after-change-major-mode-hook' yet, `post-command-hook'
;; finished, whichever the sooner. Arguably, any major mode that does not ;; takes care of things if the mode is set directly or indirectly by
;; follow the convension (a) is broken, and I can't think of any reason why (b) ;; an interactive command; however, problems can occur if the mode is
;; would not be met (except `gnudoit' on non-files). However, it is not clean. ;; set by a timer or process: in that case, proper handling of Font Lock mode
;; ;; may be delayed until the next interactive command.
;; Probably the cleanest solution is to have each major mode function run some
;; hook, e.g., `major-mode-hook', but maybe implementing that change is
;; impractical. I am personally against making `setq' a macro or be advised,
;; or have a special function such as `set-major-mode', but maybe someone can
;; come up with another solution?
;; User interface. ;; User interface.
;; ;;

25
lisp/font-lock.el
View file

@ -563,11 +563,11 @@ is not in a string or comment and not within any bracket-pairs (or else,
a place such that any bracket-pairs outside it can be ignored for Emacs a place such that any bracket-pairs outside it can be ignored for Emacs
syntax analysis and fontification). syntax analysis and fontification).
If this is nil, the beginning of the buffer is used, which is If this is nil, Font Lock uses `syntax-begin-function' to move back
always correct but tends to be slow. outside of any comment, string, or sexp. This variable is semi-obsolete;
This is normally set via `font-lock-defaults'. we recommend setting `syntax-begin-function' instead.
This variable is semi-obsolete; we recommend setting
`syntax-begin-function' instead.") This is normally set via `font-lock-defaults'.")
(defvar font-lock-mark-block-function nil (defvar font-lock-mark-block-function nil
"*Non-nil means use this function to mark a block of text. "*Non-nil means use this function to mark a block of text.
@ -2054,19 +2054,22 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
("\\<:\\sw+\\>" 0 font-lock-builtin-face) ("\\<:\\sw+\\>" 0 font-lock-builtin-face)
;; ELisp and CLisp `&' keywords as types. ;; ELisp and CLisp `&' keywords as types.
("\\&\\sw+\\>" . font-lock-type-face) ("\\&\\sw+\\>" . font-lock-type-face)
;; Make regexp grouping constructs bold, so they stand out, but only in strings. ;; Make regexp grouping constructs bold, so they stand out, but only
;; in strings.
((lambda (bound) ((lambda (bound)
(if (re-search-forward "\\([\\][\\]\\)\\([(|)]\\)\\(\\?:\\)?" bound) (if (re-search-forward "\\(\\\\\\\\\\)\\([(|)]\\)\\(\\?:\\)?" bound t)
(let ((face (get-text-property (1- (point)) 'face))) (let ((face (get-text-property (1- (point)) 'face)))
(if (listp face) (if (listp face)
(memq 'font-lock-string-face face) (memq 'font-lock-string-face face)
(eq 'font-lock-string-face face))))) (eq 'font-lock-string-face face)))))
(1 font-lock-comment-face prepend) ; Should we introduce a lowlight face for this? ;; Should we introduce a lowlight face for this?
; Ideally that would retain the color, dimmed 50%. ;; Ideally that would retain the color, dimmed.
(1 font-lock-comment-face prepend)
(2 'bold prepend) (2 'bold prepend)
(3 font-lock-type-face prepend t)) (3 font-lock-type-face prepend t))
;; Underline innermost grouping, so that you can more easily see what belongs together. ;; Underline innermost grouping, so that you can more easily see what
;; 2005-05-12: Font-lock can go into an unbreakable endless loop on this -- something's broken. ;; belongs together. 2005-05-12: Font-lock can go into an
;; unbreakable endless loop on this -- something's broken.
;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]" ;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]"
;;1 'underline prepend) ;;1 'underline prepend)
;;; This is too general -- rms. ;;; This is too general -- rms.

4
lisp/help.el
View file

@ -698,8 +698,8 @@ the last key hit are used."
(princ " runs the command ") (princ " runs the command ")
(prin1 defn) (prin1 defn)
(princ "\n which is ") (princ "\n which is ")
(describe-function-1 defn)))) (describe-function-1 defn)))))
(print-help-return-message)))))))) (print-help-return-message)))))))
(defun describe-mode (&optional buffer) (defun describe-mode (&optional buffer)

9
lisp/hexl.el
View file

@ -926,10 +926,11 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
"Activate `hl-line-mode'" "Activate `hl-line-mode'"
(require 'frame) (require 'frame)
(require 'hl-line) (require 'hl-line)
(set (make-local-variable 'hl-line-range-function) (with-no-warnings
'hexl-highlight-line-range) (set (make-local-variable 'hl-line-range-function)
(set (make-local-variable 'hl-line-face) 'hexl-highlight-line-range)
'highlight) (set (make-local-variable 'hl-line-face)
'highlight))
(hl-line-mode 1)) (hl-line-mode 1))
(defun hexl-highlight-line-range () (defun hexl-highlight-line-range ()

65
lisp/imenu.el
View file

@ -192,32 +192,9 @@ with name concatenation."
(defvar imenu-generic-expression nil (defvar imenu-generic-expression nil
"The regex pattern to use for creating a buffer index. "The regex pattern to use for creating a buffer index.
If non-nil this pattern is passed to `imenu--generic-function' If non-nil this pattern is passed to `imenu--generic-function' to
to create a buffer index. create a buffer index. Look there for the documentation of this
pattern's structure.
The value should be an alist with elements that look like this:
(MENU-TITLE REGEXP INDEX)
or like this:
(MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
with zero or more ARGUMENTS. The former format creates a simple element in
the index alist when it matches; the latter creates a special element
of the form (NAME POSITION-MARKER FUNCTION ARGUMENTS...)
with FUNCTION and ARGUMENTS copied from `imenu-generic-expression'.
MENU-TITLE is a string used as the title for the submenu or nil if the
entries are not nested.
REGEXP is a regexp that should match a construct in the buffer that is
to be displayed in the menu; i.e., function or variable definitions,
etc. It contains a substring which is the name to appear in the
menu. See the info section on Regexps for more information.
INDEX points to the substring in REGEXP that contains the name (of the
function, variable or type) that is to appear in the menu.
The variable `imenu-case-fold-search' determines whether or not the
regexp matches are case sensitive, and `imenu-syntax-alist' can be
used to alter the syntax table for the search.
For example, see the value of `fortran-imenu-generic-expression' used by For example, see the value of `fortran-imenu-generic-expression' used by
`fortran-mode' with `imenu-syntax-alist' set locally to give the `fortran-mode' with `imenu-syntax-alist' set locally to give the
@ -750,21 +727,33 @@ for modes which use `imenu--generic-function'. If it is not set, but
"Return an index of the current buffer as an alist. "Return an index of the current buffer as an alist.
PATTERNS is an alist with elements that look like this: PATTERNS is an alist with elements that look like this:
(MENU-TITLE REGEXP INDEX). (MENU-TITLE REGEXP INDEX)
or like this: or like this:
(MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
with zero or more ARGUMENTS. with zero or more ARGUMENTS. The former format creates a simple
element in the index alist when it matches; the latter creates a
special element of the form (NAME POSITION-MARKER FUNCTION
ARGUMENTS...) with FUNCTION and ARGUMENTS copied from
`imenu-generic-expression'.
MENU-TITLE is a string used as the title for the submenu or nil if the MENU-TITLE is a string used as the title for the submenu or nil
entries are not nested. if the entries are not nested.
REGEXP is a regexp that should match a construct in the buffer that is REGEXP is a regexp that should match a construct in the buffer
to be displayed in the menu; i.e., function or variable definitions, that is to be displayed in the menu; i.e., function or variable
etc. It contains a substring which is the name to appear in the definitions, etc. It contains a substring which is the name to
menu. See the info section on Regexps for more information. appear in the menu. See the info section on Regexps for more
information. REGEXP may also be a function, called without
arguments. It is expected to search backwards. It shall return
true and set `match-data' iff it finds another element.
INDEX points to the substring in REGEXP that contains the name (of the INDEX points to the substring in REGEXP that contains the
function, variable or type) that is to appear in the menu. name (of the function, variable or type) that is to appear in the
menu.
The variable `imenu-case-fold-search' determines whether or not the
regexp matches are case sensitive, and `imenu-syntax-alist' can be
used to alter the syntax table for the search.
See `lisp-imenu-generic-expression' for an example of PATTERNS. See `lisp-imenu-generic-expression' for an example of PATTERNS.
@ -811,7 +800,9 @@ depending on PATTERNS."
start beg) start beg)
;; Go backwards for convenience of adding items in order. ;; Go backwards for convenience of adding items in order.
(goto-char (point-max)) (goto-char (point-max))
(while (and (re-search-backward regexp nil t) (while (and (if (functionp regexp)
(funcall regexp)
(re-search-backward regexp nil t))
;; Exit the loop if we get an empty match, ;; Exit the loop if we get an empty match,
;; because it means a bad regexp was specified. ;; because it means a bad regexp was specified.
(not (= (match-beginning 0) (match-end 0)))) (not (= (match-beginning 0) (match-end 0))))

2
lisp/language/viet-util.el
View file

@ -41,6 +41,8 @@
;;; Code: ;;; Code:
(defvar viet-viscii-nonascii-translation-table)
;;;###autoload ;;;###autoload
(defun viet-encode-viscii-char (char) (defun viet-encode-viscii-char (char)
"Return VISCII character code of CHAR if appropriate." "Return VISCII character code of CHAR if appropriate."

8
lisp/log-edit.el
View file

@ -607,8 +607,12 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
(search-forward pattern nil t)))) (search-forward pattern nil t))))
(setq pattern (file-name-nondirectory file))) (setq pattern (file-name-nondirectory file)))
(setq pattern (concat "\\(^\\|[^[:alnum:]]\\)"
pattern
"\\($\\|[^[:alnum:]]\\)"))
(let (texts) (let (texts)
(while (search-forward pattern nil t) (while (re-search-forward pattern nil t)
(let ((entry (log-edit-changelog-entry))) (let ((entry (log-edit-changelog-entry)))
(push entry texts) (push entry texts)
(goto-char (elt entry 1)))) (goto-char (elt entry 1))))
@ -646,5 +650,5 @@ Sort REGIONS front-to-back first."
(provide 'log-edit) (provide 'log-edit)
;;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc ;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc
;;; log-edit.el ends here ;;; log-edit.el ends here

2
lisp/mail/mailalias.el
View file

@ -435,7 +435,7 @@ PATTERN is the string we want to complete."
(if mail-passwd-command (if mail-passwd-command
(call-process shell-file-name nil t nil (call-process shell-file-name nil t nil
shell-command-switch mail-passwd-command)) shell-command-switch mail-passwd-command))
(beginning-of-buffer) (goto-char (point-min))
(setq mail-local-names nil) (setq mail-local-names nil)
(while (not (eobp)) (while (not (eobp))
;;Recognize lines like ;;Recognize lines like

6
lisp/mail/rmail.el
View file

@ -3444,7 +3444,11 @@ use \\[mail-yank-original] to yank the original message into it."
;; I don't know whether there are other mailers that still ;; I don't know whether there are other mailers that still
;; need the names to be stripped. ;; need the names to be stripped.
;;; (mail-strip-quoted-names reply-to) ;;; (mail-strip-quoted-names reply-to)
reply-to ;; Remove unwanted names from reply-to, since Mail-Followup-To
;; header causes all the names in it to wind up in reply-to, not
;; in cc. But if what's left is an empty list, use the original.
(let* ((reply-to-list (rmail-dont-reply-to reply-to)))
(if (string= reply-to-list "") reply-to reply-to-list))
subject subject
(rmail-make-in-reply-to-field from date message-id) (rmail-make-in-reply-to-field from date message-id)
(if just-sender (if just-sender

3
lisp/mail/sendmail.el
View file

@ -810,7 +810,8 @@ the user from the mailer."
'(lambda (e) '(lambda (e)
(unless (member e l) (unless (member e l)
(push e l))) (push e l)))
(split-string new-header-values ", +" t)) (split-string new-header-values
",[[:space:]]+" t))
(mapconcat 'identity l ", ")) (mapconcat 'identity l ", "))
"\n")) "\n"))
;; Add Mail-Reply-To if none yet ;; Add Mail-Reply-To if none yet

7
lisp/mail/smtpmail.el
View file

@ -396,7 +396,7 @@ This is relative to `smtpmail-queue-dir'.")
;;; mail, send it, etc... ;;; mail, send it, etc...
(let ((file-msg "")) (let ((file-msg ""))
(insert-file-contents smtpmail-queue-index) (insert-file-contents smtpmail-queue-index)
(beginning-of-buffer) (goto-char (point-min))
(while (not (eobp)) (while (not (eobp))
(setq file-msg (buffer-substring (point) (line-end-position))) (setq file-msg (buffer-substring (point) (line-end-position)))
(load file-msg) (load file-msg)
@ -465,11 +465,14 @@ This is relative to `smtpmail-queue-dir'.")
(push el2 result))) (push el2 result)))
(nreverse result))) (nreverse result)))
(defvar starttls-extra-args)
(defvar starttls-extra-arguments)
(defun smtpmail-open-stream (process-buffer host port) (defun smtpmail-open-stream (process-buffer host port)
(let ((cred (smtpmail-find-credentials (let ((cred (smtpmail-find-credentials
smtpmail-starttls-credentials host port))) smtpmail-starttls-credentials host port)))
(if (null (and cred (condition-case () (if (null (and cred (condition-case ()
(progn (with-no-warnings
(require 'starttls) (require 'starttls)
(call-process (if starttls-use-gnutls (call-process (if starttls-use-gnutls
starttls-gnutls-program starttls-gnutls-program

2
lisp/net/rcompile.el
View file

@ -168,7 +168,7 @@ See \\[compile]."
compile-command))) compile-command)))
(setq remote-compile-host host) (setq remote-compile-host host)
(save-some-buffers nil nil) (save-some-buffers nil nil)
(compile-internal compile-command "No more errors") (compilation-start compile-command)
;; Set comint-file-name-prefix in the compilation buffer so ;; Set comint-file-name-prefix in the compilation buffer so
;; compilation-parse-errors will find referenced files by ange-ftp. ;; compilation-parse-errors will find referenced files by ange-ftp.
(with-current-buffer compilation-last-buffer (with-current-buffer compilation-last-buffer

10
lisp/progmodes/cc-align.el
View file

@ -24,9 +24,9 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to ;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02111-1307, USA. ;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:
@ -175,7 +175,8 @@ Works with: arglist-cont, arglist-cont-nonempty."
(let ((open-paren (elt c-syntactic-element 2)) (let ((open-paren (elt c-syntactic-element 2))
(paren-state (c-parse-state))) (paren-state (c-parse-state)))
(while (not (eq (car paren-state) open-paren)) (while (not (eq (car paren-state) open-paren))
(goto-char (car paren-state)) (unless (consp (car paren-state)) ;; ignore matched braces
(goto-char (car paren-state)))
(setq paren-state (cdr paren-state))))) (setq paren-state (cdr paren-state)))))
(let ((start (point)) c) (let ((start (point)) c)
@ -1171,6 +1172,7 @@ Otherwise, no determination is made."
;;(/= (point-max) ;;(/= (point-max)
;; (save-excursion (skip-syntax-forward " ") (point)) ;; (save-excursion (skip-syntax-forward " ") (point))
(zerop (forward-line 1)) (zerop (forward-line 1))
(bolp) ; forward-line has funny behavior at eob.
(not (looking-at "^[ \t]*$"))) (not (looking-at "^[ \t]*$")))
'stop 'stop
nil))) nil)))

19
lisp/progmodes/cc-awk.el
View file

@ -2,7 +2,7 @@
;; Copyright (C) 1988,94,96,2000,01,02,03 Free Software Foundation, Inc. ;; Copyright (C) 1988,94,96,2000,01,02,03 Free Software Foundation, Inc.
;; Author: Alan Mackenzie (originally based on awk-mode.el) ;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el)
;; Maintainer: FSF ;; Maintainer: FSF
;; Keywords: AWK, cc-mode, unix, languages ;; Keywords: AWK, cc-mode, unix, languages
@ -526,13 +526,22 @@
;; Matches any AWK regexp character which doesn't require special analysis. ;; Matches any AWK regexp character which doesn't require special analysis.
(defconst c-awk-escaped-newlines*-re "\\(\\\\[\n\r]\\)*") (defconst c-awk-escaped-newlines*-re "\\(\\\\[\n\r]\\)*")
;; Matches a (possibly empty) sequence of escaped newlines. ;; Matches a (possibly empty) sequence of escaped newlines.
;; NOTE: In what follows, "[asdf]" in a regexp will be called a "character
;; list", and "[:alpha:]" inside a character list will be known as a
;; "character class". These terms for these things vary between regexp
;; descriptions .
(defconst c-awk-regexp-char-class-re (defconst c-awk-regexp-char-class-re
"\\[:[a-z]+:\\]")
;; Matches a character class spec (e.g. [:alpha:]).
(defconst c-awk-regexp-char-list-re
(concat "\\[" c-awk-escaped-newlines*-re "^?" c-awk-escaped-newlines*-re "]?" (concat "\\[" c-awk-escaped-newlines*-re "^?" c-awk-escaped-newlines*-re "]?"
"\\(" c-awk-esc-pair-re "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)")) "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-class-re
;; Matches a regexp char class, up to (but not including) EOL if the ] is "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)"))
;; Matches a regexp char list, up to (but not including) EOL if the ] is
;; missing. ;; missing.
(defconst c-awk-regexp-innards-re (defconst c-awk-regexp-innards-re
(concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-class-re (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-list-re
"\\|" c-awk-regexp-normal-re "\\)*")) "\\|" c-awk-regexp-normal-re "\\)*"))
;; Matches the inside of an AWK regexp (i.e. without the enclosing /s) ;; Matches the inside of an AWK regexp (i.e. without the enclosing /s)
(defconst c-awk-regexp-without-end-re (defconst c-awk-regexp-without-end-re
@ -549,7 +558,7 @@
;; A "neutral" char(pair). Doesn't change the "state" of a subsequent /. ;; A "neutral" char(pair). Doesn't change the "state" of a subsequent /.
;; This is space/tab, braces, an auto-increment/decrement operator or an ;; This is space/tab, braces, an auto-increment/decrement operator or an
;; escaped character. Or one of the (illegal) characters @ or `. But NOT an ;; escaped character. Or one of the (illegal) characters @ or `. But NOT an
;; end of line (even if escpaed). ;; end of line (even if escaped).
(defconst c-awk-neutrals*-re (defconst c-awk-neutrals*-re
(concat "\\(" c-awk-neutral-re "\\)*")) (concat "\\(" c-awk-neutral-re "\\)*"))
;; A (possibly empty) string of neutral characters (or character pairs). ;; A (possibly empty) string of neutral characters (or character pairs).

9
lisp/progmodes/cc-cmds.el
View file

@ -2441,7 +2441,8 @@ command to conveniently insert and align the necessary backslashes."
(delete-region (point) end) (delete-region (point) end)
(indent-to column 1))) (indent-to column 1)))
(= (forward-line 1) 0)))) (zerop (forward-line 1)))
(bolp))) ; forward-line has funny behavior at eob.
;; Make sure there are backslashes with at least one space in ;; Make sure there are backslashes with at least one space in
;; front of them. ;; front of them.
@ -2466,7 +2467,8 @@ command to conveniently insert and align the necessary backslashes."
(insert ?\\) (insert ?\\)
(insert ?\ ?\\))) (insert ?\ ?\\)))
(= (forward-line 1) 0))))))) (zerop (forward-line 1)))
(bolp)))))) ; forward-line has funny behavior at eob.
(defun c-delete-backslashes-forward (to-mark point-pos) (defun c-delete-backslashes-forward (to-mark point-pos)
;; This function does not do any hidden buffer changes. ;; This function does not do any hidden buffer changes.
@ -2481,7 +2483,8 @@ command to conveniently insert and align the necessary backslashes."
(skip-chars-backward " \t" (if (>= (point) point-pos) (skip-chars-backward " \t" (if (>= (point) point-pos)
point-pos)) point-pos))
(point)))) (point))))
(= (forward-line 1) 0))))) (zerop (forward-line 1)))
(bolp)))) ; forward-line has funny behavior at eob.

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

@ -104,7 +104,7 @@
;;; Variables also used at compile time. ;;; Variables also used at compile time.
(defconst c-version "5.30.9" (defconst c-version "5.30.10"
"CC Mode version number.") "CC Mode version number.")
(defconst c-version-sym (intern c-version)) (defconst c-version-sym (intern c-version))

34
lisp/progmodes/cc-engine.el
View file

@ -24,9 +24,9 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to ;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02111-1307, USA. ;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:
@ -3198,6 +3198,7 @@ This function does not do any hidden buffer changes."
;; when font-lock refontifies the current line only. ;; when font-lock refontifies the current line only.
(when (save-excursion (when (save-excursion
(and (= (forward-line 1) 0) (and (= (forward-line 1) 0)
(bolp) ; forward-line has funny behavior at eob.
(or (< (c-point 'eol) cfd-limit) (or (< (c-point 'eol) cfd-limit)
(progn (backward-char) (progn (backward-char)
(not (eq (char-before) ?\\)))))) (not (eq (char-before) ?\\))))))
@ -4551,7 +4552,7 @@ brace."
;; operator token preceded by "operator". ;; operator token preceded by "operator".
(save-excursion (save-excursion
(and (c-safe (c-backward-sexp) t) (and (c-safe (c-backward-sexp) t)
(looking-at "operator\\([^_]\\|$\\)"))) (looking-at "operator\\>\\([^_]\\|$\\)")))
(and (eq (char-before) ?<) (and (eq (char-before) ?<)
(c-with-syntax-table c++-template-syntax-table (c-with-syntax-table c++-template-syntax-table
(if (c-safe (goto-char (c-up-list-forward (point)))) (if (c-safe (goto-char (c-up-list-forward (point))))
@ -6104,7 +6105,12 @@ This function does not do any hidden buffer changes."
;; Note: We use the fact that lim is always after any ;; Note: We use the fact that lim is always after any
;; preceding brace sexp. ;; preceding brace sexp.
(while (and (zerop (c-backward-token-2 1 t lim)) (while (and (zerop (c-backward-token-2 1 t lim))
(not (looking-at "[;<,=]")))) (or (not (looking-at "[;<,=]"))
(and c-overloadable-operators-regexp
(looking-at c-overloadable-operators-regexp)
(save-excursion
(c-backward-token-2 1 nil lim)
(looking-at "operator\\>[^_]"))))))
(or (memq (char-after) '(?, ?=)) (or (memq (char-after) '(?, ?=))
(and (c-major-mode-is 'c++-mode) (and (c-major-mode-is 'c++-mode)
(zerop (c-backward-token-2 1 nil lim)) (zerop (c-backward-token-2 1 nil lim))
@ -6237,7 +6243,15 @@ This function does not do any hidden buffer changes."
;; CASE 5I: ObjC method definition. ;; CASE 5I: ObjC method definition.
((and c-opt-method-key ((and c-opt-method-key
(looking-at c-opt-method-key)) (looking-at c-opt-method-key))
(c-beginning-of-statement-1 lim) (c-beginning-of-statement-1 nil t)
(if (= (point) indent-point)
;; Handle the case when it's the first (non-comment)
;; thing in the buffer. Can't look for a 'same return
;; value from cbos1 since ObjC directives currently
;; aren't recognized fully, so that we get 'same
;; instead of 'previous if it moved over a preceding
;; directive.
(goto-char (point-min)))
(c-add-syntax 'objc-method-intro (c-point 'boi))) (c-add-syntax 'objc-method-intro (c-point 'boi)))
;; CASE 5P: AWK pattern or function or continuation ;; CASE 5P: AWK pattern or function or continuation
;; thereof. ;; thereof.
@ -6316,11 +6330,13 @@ This function does not do any hidden buffer changes."
;; CASE 5K: we are at an ObjC method definition ;; CASE 5K: we are at an ObjC method definition
;; continuation line. ;; continuation line.
((and c-opt-method-key ((and c-opt-method-key
(progn (save-excursion
(goto-char indent-point)
(c-beginning-of-statement-1 lim) (c-beginning-of-statement-1 lim)
(beginning-of-line) (beginning-of-line)
(looking-at c-opt-method-key))) (when (looking-at c-opt-method-key)
(c-add-syntax 'objc-method-args-cont (point))) (setq placeholder (point)))))
(c-add-syntax 'objc-method-args-cont placeholder))
;; CASE 5L: we are at the first argument of a template ;; CASE 5L: we are at the first argument of a template
;; arglist that begins on the previous line. ;; arglist that begins on the previous line.
((eq (char-before) ?<) ((eq (char-before) ?<)

2
lisp/progmodes/cc-fonts.el
View file

@ -875,7 +875,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; with array initializers. Otherwise stop at braces ;; with array initializers. Otherwise stop at braces
;; to avoid going past full function and class blocks. ;; to avoid going past full function and class blocks.
(and (if (and (eq got-init ?=) (and (if (and (eq got-init ?=)
(= (c-forward-token-2) 0) (= (c-forward-token-2 1 nil limit) 0)
(looking-at "{")) (looking-at "{"))
(c-safe (c-forward-sexp) t) (c-safe (c-forward-sexp) t)
t) t)

2
lisp/progmodes/cc-langs.el
View file

@ -1186,7 +1186,7 @@ will be handled."
(c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key)) (c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key))
(c-lang-defconst c-other-block-decl-kwds (c-lang-defconst c-other-block-decl-kwds
"Keywords where the following block (if any) contain another "Keywords where the following block (if any) contains another
declaration level that should not be considered a class. declaration level that should not be considered a class.
If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',

38
lisp/progmodes/cc-mode.el
View file

@ -24,9 +24,9 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to ;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02111-1307, USA. ;; Boston, MA 02110-1301, USA.
;;; Commentary: ;;; Commentary:
@ -91,10 +91,12 @@
(cc-require 'cc-align) (cc-require 'cc-align)
(cc-require 'cc-menus) (cc-require 'cc-menus)
;; SILENCE the compiler. ;; Silence the compiler.
(cc-bytecomp-defvar comment-line-break-function) ; (X)Emacs 20+ (cc-bytecomp-defvar comment-line-break-function) ; (X)Emacs 20+
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 20+ (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 20+
(cc-bytecomp-defun set-keymap-parents) ; XEmacs (cc-bytecomp-defun set-keymap-parents) ; XEmacs
(cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1+
(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
;; We set these variables during mode init, yet we don't require ;; We set these variables during mode init, yet we don't require
;; font-lock. ;; font-lock.
@ -201,12 +203,15 @@ control). See \"cc-mode.el\" for more info."
(defun c-make-inherited-keymap () (defun c-make-inherited-keymap ()
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
;; Necessary to use `cc-bytecomp-fboundp' below since this
;; function is called from top-level forms that are evaluated
;; while cc-bytecomp is active when one does M-x eval-buffer.
(cond (cond
;; XEmacs ;; XEmacs
((fboundp 'set-keymap-parents) ((cc-bytecomp-fboundp 'set-keymap-parents)
(set-keymap-parents map c-mode-base-map)) (set-keymap-parents map c-mode-base-map))
;; Emacs ;; Emacs
((fboundp 'set-keymap-parent) ((cc-bytecomp-fboundp 'set-keymap-parent)
(set-keymap-parent map c-mode-base-map)) (set-keymap-parent map c-mode-base-map))
;; incompatible ;; incompatible
(t (error "CC Mode is incompatible with this version of Emacs"))) (t (error "CC Mode is incompatible with this version of Emacs")))
@ -587,6 +592,13 @@ Note that the style variables are always made local to the buffer."
(add-hook 'hack-local-variables-hook 'c-postprocess-file-styles) (add-hook 'hack-local-variables-hook 'c-postprocess-file-styles)
(defmacro c-run-mode-hooks (&rest hooks)
;; Emacs 21.1 has introduced a system with delayed mode hooks that
;; require the use of the new function `run-mode-hooks'.
(if (cc-bytecomp-fboundp 'run-mode-hooks)
`(run-mode-hooks ,@hooks)
`(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks))))
;; Support for C ;; Support for C
@ -667,7 +679,7 @@ Key bindings:
(c-common-init 'c-mode) (c-common-init 'c-mode)
(easy-menu-add c-c-menu) (easy-menu-add c-c-menu)
(cc-imenu-init cc-imenu-c-generic-expression) (cc-imenu-init cc-imenu-c-generic-expression)
(run-mode-hooks 'c-mode-common-hook 'c-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'c-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -730,7 +742,7 @@ Key bindings:
(c-common-init 'c++-mode) (c-common-init 'c++-mode)
(easy-menu-add c-c++-menu) (easy-menu-add c-c++-menu)
(cc-imenu-init cc-imenu-c++-generic-expression) (cc-imenu-init cc-imenu-c++-generic-expression)
(run-mode-hooks 'c-mode-common-hook 'c++-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'c++-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -794,7 +806,7 @@ Key bindings:
(c-common-init 'objc-mode) (c-common-init 'objc-mode)
(easy-menu-add c-objc-menu) (easy-menu-add c-objc-menu)
(cc-imenu-init nil 'cc-imenu-objc-function) (cc-imenu-init nil 'cc-imenu-objc-function)
(run-mode-hooks 'c-mode-common-hook 'objc-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'objc-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -864,7 +876,7 @@ Key bindings:
(c-common-init 'java-mode) (c-common-init 'java-mode)
(easy-menu-add c-java-menu) (easy-menu-add c-java-menu)
(cc-imenu-init cc-imenu-java-generic-expression) (cc-imenu-init cc-imenu-java-generic-expression)
(run-mode-hooks 'c-mode-common-hook 'java-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'java-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -922,7 +934,7 @@ Key bindings:
(c-common-init 'idl-mode) (c-common-init 'idl-mode)
(easy-menu-add c-idl-menu) (easy-menu-add c-idl-menu)
;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO ;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO
(run-mode-hooks 'c-mode-common-hook 'idl-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'idl-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -984,7 +996,7 @@ Key bindings:
(c-common-init 'pike-mode) (c-common-init 'pike-mode)
(easy-menu-add c-pike-menu) (easy-menu-add c-pike-menu)
;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO ;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO
(run-mode-hooks 'c-mode-common-hook 'pike-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'pike-mode-hook)
(c-update-modeline)) (c-update-modeline))
@ -1076,7 +1088,7 @@ Key bindings:
;; in cc-engine.el, just before (defun c-fast-in-literal ... ;; in cc-engine.el, just before (defun c-fast-in-literal ...
(defalias 'c-in-literal 'c-slow-in-literal) (defalias 'c-in-literal 'c-slow-in-literal)
(run-mode-hooks 'c-mode-common-hook 'awk-mode-hook) (c-run-mode-hooks 'c-mode-common-hook 'awk-mode-hook)
(c-update-modeline)) (c-update-modeline))
) ;; closes the (if (not (memq 'syntax-properties c-emacs-features)) ) ;; closes the (if (not (memq 'syntax-properties c-emacs-features))

1
lisp/progmodes/cc-styles.el
View file

@ -48,6 +48,7 @@
;; Silence the compiler. ;; Silence the compiler.
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
(defvar c-style-alist (defvar c-style-alist

23
lisp/progmodes/cperl-mode.el
View file

@ -342,10 +342,19 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
:type 'integer :type 'integer
:group 'cperl-indentation-details) :group 'cperl-indentation-details)
(defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") (defvar cperl-vc-header-alist nil)
(RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")) (make-obsolete-variable
"*What to use as `vc-header-alist' in CPerl." 'cperl-vc-header-alist
:type '(repeat (list symbol string)) "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
"*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
:type '(repeat string)
:group 'cperl)
(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")
"*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
:type '(repeat string)
:group 'cperl) :group 'cperl)
(defcustom cperl-clobber-mode-lists (defcustom cperl-clobber-mode-lists
@ -1485,8 +1494,10 @@ or as help on variables `cperl-tips', `cperl-problems',
(function cperl-imenu--create-perl-index)) (function cperl-imenu--create-perl-index))
(make-local-variable 'imenu-sort-function) (make-local-variable 'imenu-sort-function)
(setq imenu-sort-function nil) (setq imenu-sort-function nil)
(make-local-variable 'vc-header-alist) (make-local-variable 'vc-rcs-header)
(set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning (set 'vc-rcs-header cperl-vc-rcs-header)
(make-local-variable 'vc-sccs-header)
(set 'vc-sccs-header cperl-vc-sccs-header)
(make-local-variable 'font-lock-defaults) (make-local-variable 'font-lock-defaults)
(setq font-lock-defaults (setq font-lock-defaults
(cond (cond

3
lisp/progmodes/etags.el
View file

@ -1858,7 +1858,8 @@ directory specification."
(error "File %s not in current tags tables" file))))) (error "File %s not in current tags tables" file)))))
(with-current-buffer "*Tags List*" (with-current-buffer "*Tags List*"
(require 'apropos) (require 'apropos)
(apropos-mode) (with-no-warnings
(apropos-mode))
(setq buffer-read-only t))) (setq buffer-read-only t)))
;;;###autoload ;;;###autoload

3
lisp/progmodes/flymake.el
View file

@ -47,7 +47,8 @@
(defsubst flymake-makehash (&optional test) (defsubst flymake-makehash (&optional test)
(if (fboundp 'make-hash-table) (if (fboundp 'make-hash-table)
(if test (make-hash-table :test test) (make-hash-table)) (if test (make-hash-table :test test) (make-hash-table))
(makehash test))) (with-no-warnings
(makehash test))))
(defalias 'flymake-float-time (defalias 'flymake-float-time
(if (fboundp 'float-time) (if (fboundp 'float-time)

26
lisp/progmodes/gdb-ui.el
View file

@ -698,6 +698,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
(define-key map "\C-c\C-z" 'gdb-inferior-io-stop) (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
(define-key map "\C-c\C-\\" 'gdb-inferior-io-quit) (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
(define-key map "\C-c\C-d" 'gdb-inferior-io-eof) (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
(define-key map "\C-d" 'gdb-inferior-io-eof)
map)) map))
(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
@ -953,7 +954,7 @@ function is used to change the focus of GUD tooltips to #define
directives." directives."
(setq gdb-active-process nil) (setq gdb-active-process nil)
(gdb-stopping ignored)) (gdb-stopping ignored))
(defun gdb-frame-begin (ignored) (defun gdb-frame-begin (ignored)
(let ((sink gdb-output-sink)) (let ((sink gdb-output-sink))
(cond (cond
@ -1303,7 +1304,8 @@ static char *magick[] = {
(looking-at "\\(\\S-+\\):\\([0-9]+\\)") (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
(let ((line (match-string 2)) (buffer-read-only nil) (let ((line (match-string 2)) (buffer-read-only nil)
(file (match-string 1))) (file (match-string 1)))
(add-text-properties (point-at-bol) (point-at-eol) (add-text-properties (line-beginning-position)
(line-end-position)
'(mouse-face highlight '(mouse-face highlight
help-echo "mouse-2, RET: visit breakpoint")) help-echo "mouse-2, RET: visit breakpoint"))
(unless (file-exists-p file) (unless (file-exists-p file)
@ -1504,13 +1506,13 @@ static char *magick[] = {
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
(goto-char (point-min)) (goto-char (point-min))
(while (< (point) (point-max)) (while (< (point) (point-max))
(add-text-properties (point-at-bol) (point-at-eol) (add-text-properties (line-beginning-position) (line-end-position)
'(mouse-face highlight '(mouse-face highlight
help-echo "mouse-2, RET: Select frame")) help-echo "mouse-2, RET: Select frame"))
(beginning-of-line) (beginning-of-line)
(when (and (looking-at "^#\\([0-9]+\\)") (when (and (looking-at "^#\\([0-9]+\\)")
(equal (match-string 1) gdb-current-stack-level)) (equal (match-string 1) gdb-current-stack-level))
(put-text-property (point-at-bol) (point-at-eol) (put-text-property (line-beginning-position) (line-end-position)
'face '(:inverse-video t))) 'face '(:inverse-video t)))
(forward-line 1)))))) (forward-line 1))))))
@ -1588,7 +1590,7 @@ static char *magick[] = {
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
(goto-char (point-min)) (goto-char (point-min))
(while (< (point) (point-max)) (while (< (point) (point-max))
(add-text-properties (point-at-bol) (point-at-eol) (add-text-properties (line-beginning-position) (line-end-position)
'(mouse-face highlight '(mouse-face highlight
help-echo "mouse-2, RET: select thread")) help-echo "mouse-2, RET: select thread"))
(forward-line 1))))) (forward-line 1)))))
@ -1974,14 +1976,14 @@ corresponding to the mode line clicked."
(let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
(with-current-buffer buf (with-current-buffer buf
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^ .*\n" nil t) (while (re-search-forward "^[ }].*\n" nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "{[-0-9, {}\]*\n" nil t) (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
(replace-match "(array);\n" nil nil)) (replace-match "(structure);\n" nil nil))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "{.*=.*\n" nil t) (while (re-search-forward "\\s-*{.*\n" nil t)
(replace-match "(structure);\n" nil nil)))) (replace-match " (array);\n" nil nil))))
(let ((buf (gdb-get-buffer 'gdb-locals-buffer))) (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
(and buf (with-current-buffer buf (and buf (with-current-buffer buf
(let ((p (point)) (let ((p (point))
@ -2316,8 +2318,8 @@ BUFFER nil or omitted means use the current buffer."
(delete-overlay overlay)))) (delete-overlay overlay))))
(defun gdb-put-breakpoint-icon (enabled bptno) (defun gdb-put-breakpoint-icon (enabled bptno)
(let ((start (progn (beginning-of-line) (- (point) 1))) (let ((start (- (line-beginning-position) 1))
(end (progn (end-of-line) (+ (point) 1))) (end (+ (line-end-position) 1))
(putstring (if enabled "B" "b"))) (putstring (if enabled "B" "b")))
(add-text-properties (add-text-properties
0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt") 0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt")

2
lisp/progmodes/idlwave.el
View file

@ -3548,7 +3548,7 @@ is non-nil."
(let ((pos (point))) (let ((pos (point)))
(if idlwave-file-header (if idlwave-file-header
(cond ((car idlwave-file-header) (cond ((car idlwave-file-header)
(insert-file (car idlwave-file-header))) (insert-file-contents (car idlwave-file-header)))
((stringp (car (cdr idlwave-file-header))) ((stringp (car (cdr idlwave-file-header)))
(insert (car (cdr idlwave-file-header)))))) (insert (car (cdr idlwave-file-header))))))
(goto-char pos))) (goto-char pos)))

14
lisp/progmodes/make-mode.el
View file

@ -484,7 +484,7 @@ not be enclosed in { } or ( )."
("\\\\\n" 0 "."))) ("\\\\\n" 0 ".")))
(defvar makefile-imenu-generic-expression (defvar makefile-imenu-generic-expression
`(("Dependencies" ,makefile-dependency-regex 1) `(("Dependencies" makefile-previous-dependency 1)
("Macro Assignment" ,makefile-macroassign-regex 1)) ("Macro Assignment" ,makefile-macroassign-regex 1))
"Imenu generic expression for Makefile mode. See `imenu-generic-expression'.") "Imenu generic expression for Makefile mode. See `imenu-generic-expression'.")
@ -854,7 +854,10 @@ Makefile mode can be configured by modifying the following variables:
"^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.+\\\\\n\\)*.+\\)") "^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.+\\\\\n\\)*.+\\)")
(setq font-lock-defaults (setq font-lock-defaults
`(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults)))) `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults))
imenu-generic-expression
`(("Functions" "^[ \t]*\\(?:make\\)?sub[ \t]+\\([A-Za-z0-9_]+\\)" 1)
,@imenu-generic-expression)))
;;;###autoload ;;;###autoload
(define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile" (define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile"
@ -866,10 +869,7 @@ Makefile mode can be configured by modifying the following variables:
(set (make-local-variable 'makefile-rule-action-regex) (set (make-local-variable 'makefile-rule-action-regex)
"^\t[ \t]*\\([-+@]*\\)[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)") "^\t[ \t]*\\([-+@]*\\)[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)")
(setq font-lock-defaults (setq font-lock-defaults
`(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults)) `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults))))
imenu-generic-expression
`(("Dependencies" ,makefile-dependency-regex 1)
,@(cdr imenu-generic-expression))))
@ -1682,7 +1682,7 @@ matched in a rule action."
(catch 'found (catch 'found
(let ((pt (point))) (let ((pt (point)))
(while (progn (skip-chars-forward makefile-dependency-skip bound) (while (progn (skip-chars-forward makefile-dependency-skip bound)
(not (eobp))) (< (point) (or bound (point-max))))
(forward-char) (forward-char)
(or (eq (char-after) ?=) (or (eq (char-after) ?=)
(get-text-property (1- (point)) 'face) (get-text-property (1- (point)) 'face)

4
lisp/progmodes/sh-script.el
View file

@ -1389,7 +1389,7 @@ with your script for an edit-interpret-debug cycle."
(cond ((looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)") (cond ((looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
(match-string 2)) (match-string 2))
((and buffer-file-name ((and buffer-file-name
(string-match "\\.m?spec$" buffer-file-name)) (string-match "\\.m?spec\\'" buffer-file-name))
"rpm"))))) "rpm")))))
(sh-set-shell (or interpreter sh-shell-file) nil nil)) (sh-set-shell (or interpreter sh-shell-file) nil nil))
(run-hooks 'sh-mode-hook)) (run-hooks 'sh-mode-hook))
@ -2290,7 +2290,7 @@ we go to the end of the previous line and do not check for continuations."
(if (looking-at "[\"'`]") (if (looking-at "[\"'`]")
(sh-safe-forward-sexp) (sh-safe-forward-sexp)
;; (> (skip-chars-forward "^ \t\n\"'`") 0) ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
(> (skip-chars-forward "-_a-zA-Z\$0-9") 0) (> (skip-chars-forward "-_a-zA-Z$0-9") 0)
)) ))
(buffer-substring start (point)) (buffer-substring start (point))
)) ))

6
lisp/progmodes/vhdl-mode.el
View file

@ -12364,8 +12364,8 @@ File statistics: \"%s\"\n\
(save-match-data (save-match-data
(goto-char (match-end 1)) (goto-char (match-end 1))
;; move to next item ;; move to next item
(if (looking-at "\\(\\s-*,\\)") (if (looking-at "\\s-*,")
(goto-char (match-end 1)) (goto-char (match-end 0))
(end-of-line) t)))) (end-of-line) t))))
(error t))) (error t)))
@ -12736,7 +12736,7 @@ This does background highlighting of translate-off regions.")
'(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
(when (fboundp 'font-lock-unset-defaults) (when (fboundp 'font-lock-unset-defaults)
(font-lock-unset-defaults)) ; not implemented in XEmacs (font-lock-unset-defaults)) ; not implemented in XEmacs
(font-lock-set-defaults) (font-lock-set-defaults) ;What for? --Stef
(font-lock-mode nil) (font-lock-mode nil)
(font-lock-mode t)) (font-lock-mode t))

9
lisp/ruler-mode.el
View file

@ -696,6 +696,9 @@ Optional argument PROPS specifies other text properties to apply."
(put-text-property (put-text-property
i (1+ i) 'face 'ruler-mode-goal-column-face i (1+ i) 'face 'ruler-mode-goal-column-face
ruler) ruler)
(put-text-property
i (1+ i) 'mouse-face 'mode-line-highlight
ruler)
(put-text-property (put-text-property
i (1+ i) 'help-echo ruler-mode-goal-column-help-echo i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
ruler)) ruler))
@ -705,6 +708,9 @@ Optional argument PROPS specifies other text properties to apply."
(put-text-property (put-text-property
i (1+ i) 'face 'ruler-mode-comment-column-face i (1+ i) 'face 'ruler-mode-comment-column-face
ruler) ruler)
(put-text-property
i (1+ i) 'mouse-face 'mode-line-highlight
ruler)
(put-text-property (put-text-property
i (1+ i) 'help-echo ruler-mode-comment-column-help-echo i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
ruler)) ruler))
@ -714,6 +720,9 @@ Optional argument PROPS specifies other text properties to apply."
(put-text-property (put-text-property
i (1+ i) 'face 'ruler-mode-fill-column-face i (1+ i) 'face 'ruler-mode-fill-column-face
ruler) ruler)
(put-text-property
i (1+ i) 'mouse-face 'mode-line-highlight
ruler)
(put-text-property (put-text-property
i (1+ i) 'help-echo ruler-mode-fill-column-help-echo i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
ruler)) ruler))

11
lisp/simple.el
View file

@ -2568,7 +2568,11 @@ With argument N, insert the Nth previous kill.
If N is negative, this is a more recent kill. If N is negative, this is a more recent kill.
The sequence of kills wraps around, so that after the oldest one The sequence of kills wraps around, so that after the oldest one
comes the newest one." comes the newest one.
When this command inserts killed text into the buffer, it honors
`yank-excluded-properties' and `yank-handler' as described in the
doc string for `insert-for-yank-1', which see."
(interactive "*p") (interactive "*p")
(if (not (eq last-command 'yank)) (if (not (eq last-command 'yank))
(error "Previous command was not a yank")) (error "Previous command was not a yank"))
@ -2600,6 +2604,11 @@ killed OR yanked. Put point at end, and set mark at beginning.
With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently killed stretch of killed With argument N, reinsert the Nth most recently killed stretch of killed
text. text.
When this command inserts killed text into the buffer, it honors
`yank-excluded-properties' and `yank-handler' as described in the
doc string for `insert-for-yank-1', which see.
See also the command \\[yank-pop]." See also the command \\[yank-pop]."
(interactive "*P") (interactive "*P")
(setq yank-window-start (window-start)) (setq yank-window-start (window-start))

16
lisp/startup.el
View file

@ -368,11 +368,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; of that dir into load-path, ;; of that dir into load-path,
;; Look for a leim-list.el file too. Loading it will register ;; Look for a leim-list.el file too. Loading it will register
;; available input methods. ;; available input methods.
(dolist (dir load-path) (let ((tail load-path) dir)
(let ((default-directory dir)) (while tail
(load (expand-file-name "subdirs.el") t t t)) (setq dir (car tail))
(let ((default-directory dir)) (let ((default-directory dir))
(load (expand-file-name "leim-list.el") t t t))) (load (expand-file-name "subdirs.el") t t t))
(let ((default-directory dir))
(load (expand-file-name "leim-list.el") t t t))
;; We don't use a dolist loop and we put this "setq-cdr" command at
;; the end, because the subdirs.el files may add elements to the end
;; of load-path and we want to take it into account.
(setq tail (cdr tail))))
(unless (eq system-type 'vax-vms) (unless (eq system-type 'vax-vms)
;; If the PWD environment variable isn't accurate, delete it. ;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD"))) (let ((pwd (getenv "PWD")))

10
lisp/subr.el
View file

@ -784,6 +784,12 @@ is converted into a string by expressing it in decimal."
baud-rate) baud-rate)
(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15") (make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")
;; These are used by VM and some old programs
(defalias 'focus-frame 'ignore "")
(make-obsolete 'focus-frame "it does nothing." "22.1")
(defalias 'unfocus-frame 'ignore "")
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
;;;; Obsolescence declarations for variables, and aliases. ;;;; Obsolescence declarations for variables, and aliases.
@ -1452,10 +1458,6 @@ BEG and END default respectively to the beginning and end of buffer."
;;;; Miscellanea. ;;;; Miscellanea.
;; A number of major modes set this locally.
;; Give it a global value to avoid compiler warnings.
(defvar font-lock-defaults nil)
(defvar suspend-hook nil (defvar suspend-hook nil
"Normal hook run by `suspend-emacs', before suspending.") "Normal hook run by `suspend-emacs', before suspending.")

537
lisp/textmodes/org.el
View file

@ -5,7 +5,7 @@
;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
;; Keywords: outlines, hypermedia, calendar ;; Keywords: outlines, hypermedia, calendar
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
;; Version: 3.08 ;; Version: 3.09
;; ;;
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; ;;
@ -31,27 +31,30 @@
;; project planning with a fast and effective plain-text system. ;; project planning with a fast and effective plain-text system.
;; ;;
;; Org-mode develops organizational tasks around a NOTES file that contains ;; Org-mode develops organizational tasks around a NOTES file that contains
;; information about projects as plain text. Org-mode is implemented on ;; information about projects as plain text. Org-mode is implemented on top
;; top of outline-mode - ideal to keep the content of large files well ;; of outline-mode - ideal to keep the content of large files well structured.
;; structured. It supports ToDo items, deadlines and time stamps, which ;; It supports ToDo items, deadlines and time stamps, which can be extracted
;; magically appear in the diary listing of the Emacs calendar. Tables are ;; to create a daily/weekly agenda that also integrates the diary of the Emacs
;; easily created with a built-in table editor. Plain text URL-like links ;; calendar. Tables are easily created with a built-in table editor. Plain
;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus), ;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST),
;; BBDB entries, and any files related to the projects. For printing and ;; Usenet messages (Gnus), BBDB entries, and any files related to the
;; sharing of notes, an Org-mode file (or a part of it) can be exported as ;; projects. For printing and sharing of notes, an Org-mode file (or a part
;; a structured ASCII file, or as HTML. ;; of it) can be exported as a structured ASCII file, or as HTML.
;; ;;
;; Installation ;; Installation
;; ------------ ;; ------------
;; The instruction below assume that you have downloaded Org-mode from the ;; If Org-mode is part of the Emacs distribution or an XEmacs package, you
;; web. If Org-mode is part of the Emacs distribution or an XEmacs package, ;; only need to copy the following lines to your .emacs file. The last two
;; you only need to add to .emacs the last three lines of Lisp code listed ;; lines define *global* keys for the commands `org-store-link' and
;; below, i.e. the `auto-mode-alist' modification and the global key bindings. ;; `org-agenda' - please choose suitable keys yourself.
;; ;;
;; Byte-compile org.el and put it on your load path. Then copy the ;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
;; following lines into .emacs. The last two lines define *global* ;; (define-key global-map "\C-cl" 'org-store-link)
;; keys for the commands `org-store-link' and `org-agenda' - please ;; (define-key global-map "\C-ca" 'org-agenda)
;; choose suitable keys yourself. ;;
;; If you have downloaded Org-mode from the Web, you must byte-compile
;; org.el and put it on your load path. In addition to the Emacs Lisp
;; lines above, you also need to add the following lines to .emacs:
;; ;;
;; (autoload 'org-mode "org" "Org mode" t) ;; (autoload 'org-mode "org" "Org mode" t)
;; (autoload 'org-diary "org" "Diary entries from Org mode") ;; (autoload 'org-diary "org" "Diary entries from Org mode")
@ -59,12 +62,9 @@
;; (autoload 'org-store-link "org" "Store a link to the current location" t) ;; (autoload 'org-store-link "org" "Store a link to the current location" t)
;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) ;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") ;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
;; (define-key global-map "\C-cl" 'org-store-link)
;; (define-key global-map "\C-ca" 'org-agenda)
;; ;;
;; This will put all files with extension ".org" into Org-mode. As an ;; This setup will put all files with extension ".org" into Org-mode. As
;; alternative, make the first line of a file look like this: ;; an alternative, make the first line of a file look like this:
;; ;;
;; MY PROJECTS -*- mode: org; -*- ;; MY PROJECTS -*- mode: org; -*-
;; ;;
@ -73,12 +73,18 @@
;; ;;
;; Documentation ;; Documentation
;; ------------- ;; -------------
;; The documentation of Org-mode can be found in the TeXInfo file. ;; The documentation of Org-mode can be found in the TeXInfo file. The
;; The distribution also contains a PDF version of it. At the homepage ;; distribution also contains a PDF version of it. At the homepage of
;; of Org-mode, you can read the same text online as HTML. ;; Org-mode, you can read the same text online as HTML. There is also an
;; excellent reference card made by Philip Rooke.
;; ;;
;; Changes: ;; Changes:
;; ------- ;; -------
;; Version 3.09
;; - Time-of-day specifications in agenda are extracted and placed
;; into the prefix. Timed entries can be placed into a time grid for
;; day.
;;
;; Version 3.08 ;; Version 3.08
;; - "|" no longer allowed as part of a link, to allow links in tables. ;; - "|" no longer allowed as part of a link, to allow links in tables.
;; - The prefix of items in the agenda buffer can be configured. ;; - The prefix of items in the agenda buffer can be configured.
@ -136,7 +142,7 @@
;; warnings about upcoming deadlines/overdue scheduled items. ;; warnings about upcoming deadlines/overdue scheduled items.
;; That functionality is now limited to the (multifile) agenda. ;; That functionality is now limited to the (multifile) agenda.
;; - When reading a date, the calendar can be manipulated with keys. ;; - When reading a date, the calendar can be manipulated with keys.
;; - Link support for RMAIL and Wanderlust (from planner.el, untested) ;; - Link support for RMAIL and Wanderlust (from planner.el, untested).
;; - Minor bug fixes and documentation improvements. ;; - Minor bug fixes and documentation improvements.
;;; Code: ;;; Code:
@ -148,16 +154,15 @@
;;; Customization variables ;;; Customization variables
(defvar org-version "3.08" (defvar org-version "3.09"
"The version number of the file org.el.") "The version number of the file org.el.")
(defun org-version () (defun org-version ()
(interactive) (interactive)
(message "Org-mode version %s" org-version)) (message "Org-mode version %s" org-version))
;; The following two constants are for compatibility with different ;; The following two constants are for compatibility with different Emacs
;; Emacs versions (Emacs versus XEmacs) and with different versions of ;; versions (Emacs versus XEmacs) and with different versions of outline.el.
;; outline.el. All the compatibility code in org.el is based on these two ;; The compatibility code in org.el is based on these two constants.
;; constants.
(defconst org-xemacs-p (featurep 'xemacs) (defconst org-xemacs-p (featurep 'xemacs)
"Are we running xemacs?") "Are we running xemacs?")
(defconst org-noutline-p (featurep 'noutline) (defconst org-noutline-p (featurep 'noutline)
@ -570,7 +575,7 @@ the grouped in categories, don't sort the categories, but keep them in
the sequence given in `org-agenda-files'. Within each category sort by the sequence given in `org-agenda-files'. Within each category sort by
priority. priority.
Leaving out the `category-keep' would mean that items will be sorted across Leaving out `category-keep' would mean that items will be sorted across
categories by priority." categories by priority."
:group 'org-agenda :group 'org-agenda
:type '(repeat :type '(repeat
@ -583,7 +588,7 @@ categories by priority."
(const priority-up) (const priority-up)
(const priority-down)))) (const priority-down))))
(defcustom org-agenda-prefix-format " %-12:c% s" (defcustom org-agenda-prefix-format " %-12:c%?-12t% s"
"Format specification for the prefix of items in the agenda buffer. "Format specification for the prefix of items in the agenda buffer.
This format works similar to a printf format, with the following meaning: This format works similar to a printf format, with the following meaning:
@ -593,22 +598,39 @@ This format works similar to a printf format, with the following meaning:
format HH:MM format HH:MM
%s Scheduling/Deadline information, a short string %s Scheduling/Deadline information, a short string
In addition to the normal printf field modifiers like field width and All specifiers work basically like the standard `%s' of printf, but may
padding instructions, in this format you can also add an additional contain two additional characters: A question mark just after the `%' and
punctuation or whitespace character just before the final format letter. a whitespace/punctuation character just before the final letter.
This character will be appended to the field value if the value is not
empty. For example, the format \"%-12:c\" leads to \"Diary: \" if
the category is \"Diary\". If the category were be empty, no additional
colon would be interted.
Including `%t' in the format string leads to a double time specification If the first character after `%' is a question mark, the entire field
because the headline/diary item will contain the time specification as will only be included if the corresponding value applies to the
well. However, using `%t' in the format will result in a canonical 24 current entry. This is useful for fields which should have fixed
hour time specification at a consistent position in the prefix, while the width when present, but zero width when absent. For example,
time specification in the headline/diary item may be at any position and in \"%?-12t\" will result in a 12 character time field if a time of the
various formats. day is specified, but will completely disappear in entries which do
Example: not contain a time.
(setq org-agenda-prefix-format \" %-12:c% t% s\")"
If there is punctuation or whitespace character just before the final
format letter, this character will be appended to the field value if
the value is not empty. For example, the format \"%-12:c\" leads to
\"Diary: \" if the category is \"Diary\". If the category were be
empty, no additional colon would be interted.
The default value of this option is \" %-12:c%?-12t% s\", meaning:
- Indent the line with two space characters
- Give the category in a 12 chars wide field, padded with whitespace on
the right (because of `-'). Append a colon if there is a category
(because of `:').
- If there is a time-of-day, put it into a 12 chars wide field. If no
time, don't put in an empty field, just skip it (because of '?').
- Finally, put the scheduling information and append a whitespace.
As another example, if you don't want the time-of-day of entries in
the prefix, you could use:
(setq org-agenda-prefix-format \" %-11:c% s\")
See also the variable `org-agenda-remove-times-when-in-prefix'."
:type 'string :type 'string
:group 'org-agenda) :group 'org-agenda)
@ -618,13 +640,64 @@ Example:
:group 'org-agenda) :group 'org-agenda)
(defvar org-prefix-format-compiled nil (defvar org-prefix-format-compiled nil
"The compiled version of `org-???-prefix-format'.") "The compiled version of the most recently used prefix format.
Depending on which command was used last, this may be the compiled version
of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
(defcustom org-agenda-use-time-grid t
"Non-nil means, show a time grid in the agenda schedule.
A time grid is a set of lines for specific times (like every two hours between
8:00 and 20:00. The items scheduled for a day at specific times are
sorted in between these lines.
For deails about when the grid will be shown, and what it will look like, see
the variable `org-agenda-time-grid'."
:group 'org-agenda
:type 'boolean)
(defcustom org-agenda-time-grid
'((daily today require-timed)
"----------------"
(800 1000 1200 1400 1600 1800 2000))
"FIXME: document"
:group 'org-agenda
:type
'(list
(set :greedy t :tag "Grid Display Options"
(const :tag "Show grid in single day agenda display" daily)
(const :tag "Show grid in weekly agenda display" weekly)
(const :tag "Always show grid for today" today)
(const :tag "Show grid only if any timed entries are present"
require-timed)
(const :tag "Skip grid times already present in an entry"
remove-match))
(string :tag "Grid String")
(repeat :tag "Grid Times" (integer :tag "Time"))))
(defcustom org-agenda-remove-times-when-in-prefix t
"Non-nil means, remove duplicate time specifications in agenda items.
When the format `org-agenda-prefix-format' contains a `%t' specifier, a
time-of-day specification in a headline or diary entry is extracted and
placed into the prefix. If this option is non-nil, the original specification
\(a timestamp or -range, or just a plain time(range) specification like
11:30-4pm) will be removed for agenda display. This makes the agenda less
cluttered.
The option can be t or nil. It may also be the symbol `beg', indicating
that the time should only be removed what it is located at the beginning of
the headline/diary entry."
:group 'org-agenda
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "When at beginning of entry" beg)))
(defcustom org-sort-agenda-notime-is-late t (defcustom org-sort-agenda-notime-is-late t
"Non-nil means, items without time are considered late. "Non-nil means, items without time are considered late.
This is only relevant for sorting. When t, items which have no explicit This is only relevant for sorting. When t, items which have no explicit
time like 15:30 will be considered as 24:01, i.e. later than any items which time like 15:30 will be considered as 24:01, i.e. later than any items which
do have a time. When nil, the default time is before 0:00." do have a time. When nil, the default time is before 0:00. You can use this
option to decide if the schedule for today should come before or after timeless
agenda entries."
:group 'org-agenda :group 'org-agenda
:type 'boolean) :type 'boolean)
@ -1370,6 +1443,14 @@ When this is non-nil, the headline after the keyword is set to the
"Face used for tables." "Face used for tables."
:group 'org-faces) :group 'org-faces)
(defface org-time-grid-face ;; font-lock-variable-name-face
'((((type tty) (class color)) (:foreground "yellow" :weight light))
(((class color) (background light)) (:foreground "DarkGoldenrod"))
(((class color) (background dark)) (:foreground "LightGoldenrod"))
(t (:bold t :italic t)))
"Face used for level 2 headlines."
:group 'org-faces)
(defvar org-level-faces (defvar org-level-faces
'( '(
org-level-1-face org-level-1-face
@ -1496,7 +1577,7 @@ The following commands are available:
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(insert " -*- mode: org -*-\n\n"))) (insert " -*- mode: org -*-\n\n")))
(run-hooks 'org-mode-hook) ;FIXME: Should be run-mode-hooks. (run-hooks 'org-mode-hook)
(unless org-inhibit-startup (unless org-inhibit-startup
(if org-startup-with-deadline-check (if org-startup-with-deadline-check
(call-interactively 'org-check-deadlines) (call-interactively 'org-check-deadlines)
@ -1565,7 +1646,7 @@ The following commands are available:
(save-excursion (save-excursion
(org-back-to-heading t) (org-back-to-heading t)
(- (match-end 0) (match-beginning 0)))) (- (match-end 0) (match-beginning 0))))
(defvar org-font-lock-keywords nil) (defvar org-font-lock-keywords nil)
(defun org-set-font-lock-defaults () (defun org-set-font-lock-defaults ()
@ -2844,13 +2925,17 @@ days in order to avoid rounding problems."
(defun org-time-string-to-time (s) (defun org-time-string-to-time (s)
(apply 'encode-time (org-parse-time-string s))) (apply 'encode-time (org-parse-time-string s)))
(defun org-parse-time-string (s) (defun org-parse-time-string (s &optional nodefault)
"Parse the standard Org-mode time string. "Parse the standard Org-mode time string.
This should be a lot faster than the normal `parse-time-string'." This should be a lot faster than the normal `parse-time-string'.
If time is not given, defaults to 0:00. However, with optional NODEFAULT,
hour and minute fields will be nil if not given."
(if (string-match org-ts-regexp1 s) (if (string-match org-ts-regexp1 s)
(list 0 (list 0
(string-to-number (or (match-string 8 s) "0")) (if (or (match-beginning 8) (not nodefault))
(string-to-number (or (match-string 7 s) "0")) (string-to-number (or (match-string 8 s) "0")))
(if (or (match-beginning 7) (not nodefault))
(string-to-number (or (match-string 7 s) "0")))
(string-to-number (match-string 4 s)) (string-to-number (match-string 4 s))
(string-to-number (match-string 3 s)) (string-to-number (match-string 3 s))
(string-to-number (match-string 2 s)) (string-to-number (match-string 2 s))
@ -3056,6 +3141,7 @@ The following commands are available:
(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary)
(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
(define-key org-agenda-mode-map "r" 'org-agenda-redo) (define-key org-agenda-mode-map "r" 'org-agenda-redo)
(define-key org-agenda-mode-map "q" 'org-agenda-quit) (define-key org-agenda-mode-map "q" 'org-agenda-quit)
(define-key org-agenda-mode-map "x" 'org-agenda-exit) (define-key org-agenda-mode-map "x" 'org-agenda-exit)
@ -3115,7 +3201,7 @@ The following commands are available:
["Decrease Priority" org-agenda-priority-down t] ["Decrease Priority" org-agenda-priority-down t]
["Show Priority" org-agenda-show-priority t]) ["Show Priority" org-agenda-show-priority t])
"--" "--"
["Rebuild" org-agenda-redo t] ["Rebuild buffer" org-agenda-redo t]
["Goto Today" org-agenda-goto-today t] ["Goto Today" org-agenda-goto-today t]
["Next Dates" org-agenda-later (local-variable-p 'starting-day)] ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
@ -3124,6 +3210,8 @@ The following commands are available:
(local-variable-p 'starting-day)] (local-variable-p 'starting-day)]
["Include Diary" org-agenda-toggle-diary ["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary :active t] :style toggle :selected org-agenda-include-diary :active t]
["Use Time Grid" org-agenda-toggle-time-grid
:style toggle :selected org-agenda-use-time-grid :active t]
"--" "--"
["New Diary Entry" org-agenda-diary-entry t] ["New Diary Entry" org-agenda-diary-entry t]
("Calendar Commands" ("Calendar Commands"
@ -3294,11 +3382,13 @@ NDAYS defaults to `org-agenda-ndays'."
(d (- nt n1))) (d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d))))) (- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start)) (day-numbers (list start))
s e rtn rtnall file date d start-pos end-pos) (inhibit-redisplay t)
s e rtn rtnall file date d start-pos end-pos todayp nd)
(setq org-agenda-redo-command (setq org-agenda-redo-command
(list 'org-agenda include-all start-day ndays)) (list 'org-agenda include-all start-day ndays))
;; Make the list of days ;; Make the list of days
(setq ndays (or ndays org-agenda-ndays)) (setq ndays (or ndays org-agenda-ndays)
nd ndays)
(while (> ndays 1) (while (> ndays 1)
(push (1+ (car day-numbers)) day-numbers) (push (1+ (car day-numbers)) day-numbers)
(setq ndays (1- ndays))) (setq ndays (1- ndays)))
@ -3324,11 +3414,15 @@ NDAYS defaults to `org-agenda-ndays'."
rtn (org-agenda-get-day-entries rtn (org-agenda-get-day-entries
file date :todo)) file date :todo))
(setq rtnall (append rtnall rtn)))) (setq rtnall (append rtnall rtn))))
(if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))) (when rtnall
(insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-link-face))
(insert (org-finalize-agenda-entries rtnall) "\n")))
(while (setq d (pop day-numbers)) (while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d) (setq date (calendar-gregorian-from-absolute d)
s (point)) s (point))
(if (or (= d today) (if (or (setq todayp (= d today))
(and (not start-pos) (= d sd))) (and (not start-pos) (= d sd)))
(setq start-pos (point)) (setq start-pos (point))
(if (and start-pos (not end-pos)) (if (and start-pos (not end-pos))
@ -3347,14 +3441,18 @@ NDAYS defaults to `org-agenda-ndays'."
(setq rtnall (append rtnall rtn)))) (setq rtnall (append rtnall rtn))))
(if (or rtnall org-agenda-show-all-dates) (if (or rtnall org-agenda-show-all-dates)
(progn (progn
(insert (format "%-9s %2d %-9s %4d\n" (insert (format "%-9s %2d %s %4d\n"
(calendar-day-name date) (calendar-day-name date)
(extract-calendar-day date) (extract-calendar-day date)
(calendar-month-name (extract-calendar-month date)) (calendar-month-name (extract-calendar-month date))
(extract-calendar-year date))) (extract-calendar-year date)))
(put-text-property s (1- (point)) 'face (put-text-property s (1- (point)) 'face
'org-link-face) 'org-link-face)
(if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (if rtnall (insert
(org-finalize-agenda-entries ;; FIXME: condition needed
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
"\n"))
(put-text-property s (1- (point)) 'day d)))) (put-text-property s (1- (point)) 'day d))))
(goto-char (point-min)) (goto-char (point-min))
(setq buffer-read-only t) (setq buffer-read-only t)
@ -3502,6 +3600,15 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(message "Diary inclusion turned %s" (message "Diary inclusion turned %s"
(if org-agenda-include-diary "on" "off"))) (if org-agenda-include-diary "on" "off")))
(defun org-agenda-toggle-time-grid ()
"Toggle follow mode in an agenda buffer."
(interactive)
(setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
(org-agenda-redo)
(org-agenda-set-mode-name)
(message "Time-grid turned %s"
(if org-agenda-use-time-grid "on" "off")))
(defun org-agenda-set-mode-name () (defun org-agenda-set-mode-name ()
"Set the mode name to indicate all the small mode settings." "Set the mode name to indicate all the small mode settings."
(setq mode-name (setq mode-name
@ -3509,7 +3616,8 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(if (equal org-agenda-ndays 1) " Day" "") (if (equal org-agenda-ndays 1) " Day" "")
(if (equal org-agenda-ndays 7) " Week" "") (if (equal org-agenda-ndays 7) " Week" "")
(if org-agenda-follow-mode " Follow" "") (if org-agenda-follow-mode " Follow" "")
(if org-agenda-include-diary " Diary" ""))) (if org-agenda-include-diary " Diary" "")
(if org-agenda-use-time-grid " Grid" "")))
(force-mode-line-update)) (force-mode-line-update))
(defun org-agenda-post-command-hook () (defun org-agenda-post-command-hook ()
@ -3524,7 +3632,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
"Get the (Emacs Calendar) diary entries for DATE." "Get the (Emacs Calendar) diary entries for DATE."
(let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
(diary-display-hook '(fancy-diary-display)) (diary-display-hook '(fancy-diary-display))
(list-diary-entries-hook (list-diary-entries-hook
(cons 'org-diary-default-entry list-diary-entries-hook)) (cons 'org-diary-default-entry list-diary-entries-hook))
entries entries
(org-disable-diary t)) (org-disable-diary t))
@ -3551,7 +3659,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(setq entries (setq entries
(mapcar (mapcar
(lambda (x) (lambda (x)
(setq x (org-format-agenda-item "" x "Diary")) (setq x (org-format-agenda-item "" x "Diary" 'time))
;; Extend the text properties to the beginning of the line ;; Extend the text properties to the beginning of the line
(add-text-properties (add-text-properties
0 (length x) 0 (length x)
@ -3764,7 +3872,7 @@ the documentation of `org-diary'."
arg results rtn) arg results rtn)
(if (not buffer) (if (not buffer)
;; If file does not exist, make sure an error message ends up in diary ;; If file does not exist, make sure an error message ends up in diary
(format "ORG-AGENDA-ERROR: No such org-file %s" file) (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer (with-current-buffer buffer
(unless (eq major-mode 'org-mode) (unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file)) (error "Agenda file %s is not in `org-mode'" file))
@ -3796,8 +3904,8 @@ the documentation of `org-diary'."
((and (eq arg :deadline) ((and (eq arg :deadline)
(equal date (calendar-current-date))) (equal date (calendar-current-date)))
(setq rtn (org-agenda-get-deadlines)) (setq rtn (org-agenda-get-deadlines))
(setq results (append results rtn)))))))))) (setq results (append results rtn))))))))
results)) results))))
(defun org-entry-is-done-p () (defun org-entry-is-done-p ()
"Is the current entry marked DONE?" "Is the current entry marked DONE?"
@ -3876,7 +3984,7 @@ the documentation of `org-diary'."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
0 11))) 0 11)))
marker hdmarker deadlinep scheduledp donep tmp priority marker hdmarker deadlinep scheduledp donep tmp priority
ee txt) ee txt timestr)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(if (not (save-match-data (org-at-date-range-p))) (if (not (save-match-data (org-at-date-range-p)))
@ -3886,9 +3994,13 @@ the documentation of `org-diary'."
(- (match-beginning 0) (- (match-beginning 0)
org-ds-keyword-length)) org-ds-keyword-length))
(match-beginning 0)) (match-beginning 0))
timestr (buffer-substring (match-beginning 0) (point-at-eol))
deadlinep (string-match org-deadline-regexp tmp) deadlinep (string-match org-deadline-regexp tmp)
scheduledp (string-match org-scheduled-regexp tmp) scheduledp (string-match org-scheduled-regexp tmp)
donep (org-entry-is-done-p)) donep (org-entry-is-done-p))
(if (string-match ">" timestr)
;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0))))
(save-excursion (save-excursion
(if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
(progn (progn
@ -3899,7 +4011,7 @@ the documentation of `org-diary'."
(format "%s%s" (format "%s%s"
(if deadlinep "Deadline: " "") (if deadlinep "Deadline: " "")
(if scheduledp "Scheduled: " "")) (if scheduledp "Scheduled: " ""))
(match-string 1)))) (match-string 1) nil timestr)))
(setq txt org-agenda-no-heading-message)) (setq txt org-agenda-no-heading-message))
(setq priority (org-get-priority txt)) (setq priority (org-get-priority txt))
(add-text-properties (add-text-properties
@ -4044,10 +4156,11 @@ the documentation of `org-diary'."
(abbreviate-file-name (buffer-file-name))))) (abbreviate-file-name (buffer-file-name)))))
(regexp org-tr-regexp) (regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date)) (d0 (calendar-absolute-from-gregorian date))
marker hdmarker ee txt d1 d2 s1 s2) marker hdmarker ee txt d1 d2 s1 s2 timestr)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(setq s1 (match-string 1) (setq timestr (match-string 0)
s1 (match-string 1)
s2 (match-string 2) s2 (match-string 2)
d1 (time-to-days (org-time-string-to-time s1)) d1 (time-to-days (org-time-string-to-time s1))
d2 (time-to-days (org-time-string-to-time s2))) d2 (time-to-days (org-time-string-to-time s2)))
@ -4062,9 +4175,9 @@ the documentation of `org-diary'."
(goto-char (match-end 1)) (goto-char (match-end 1))
(looking-at "\\*+[ \t]*\\([^\r\n]+\\)") (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
(setq txt (org-format-agenda-item (setq txt (org-format-agenda-item
(format "(%d/%d): " (format (if (= d1 d2) "" "(%d/%d): ")
(1+ (- d0 d1)) (1+ (- d2 d1))) (1+ (- d0 d1)) (1+ (- d2 d1)))
(match-string 1)))) (match-string 1) nil (if (= d0 d1) timestr))))
(setq txt org-agenda-no-heading-message)) (setq txt org-agenda-no-heading-message))
(add-text-properties (add-text-properties
0 (length txt) (append (list 'org-marker marker 0 (length txt) (append (list 'org-marker marker
@ -4077,66 +4190,187 @@ the documentation of `org-diary'."
;; Sort the entries by expiration date. ;; Sort the entries by expiration date.
(nreverse ee))) (nreverse ee)))
(defun org-format-agenda-item (prefix txt &optional category)
(defconst org-plain-time-of-day-regexp
(concat
"\\(\\<[012]?[0-9]"
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
"\\(--?"
"\\(\\<[012]?[0-9]"
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
"\\)?")
"Regular expression to match a plain time or time range.
Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
groups carry important information:
0 the full match
1 the first time, range or not
8 the second time, if it is a range.")
(defconst org-stamp-time-of-day-regexp
(concat
"<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)"
"\\([012][0-9]:[0-5][0-9]\\)>"
"\\(--?"
"<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
"Regular expression to match a timestamp time or time range.
After a match, the following groups carry important information:
0 the full match
1 date plus weekday, for backreferencing to make sure both times on same day
2 the first time, range or not
4 the second time, if it is a range.")
(defvar org-prefix-has-time nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%t'.")
(defun org-format-agenda-item (extra txt &optional category dotime noprefix)
"Format TXT to be inserted into the agenda buffer. "Format TXT to be inserted into the agenda buffer.
In particular, this indents the line and adds a category." In particular, it adds the prefix and corresponding text properties. EXTRA
(let* ((category (or category must be a string and replaces the `%s' specifier in the prefix format.
org-category CATEGORY (string, symbol or nil) may be used to overule the default
(file-name-sans-extension category taken from local variable or file name. It will replace the `%c'
(file-name-nondirectory (buffer-file-name))))) specifier in the format. DOTIME, when non-nil, indicates that a
(extra prefix) time-of-day should be extracted from TXT for sorting of this entry, and for
(time-of-day (org-get-time-of-day txt)) the `%t' specifier in the format. When DOTIME is a string, this string is
(t1 (if time-of-day (concat "0" (int-to-string time-of-day)) "0000")) searched for a time before TXT is. NOPREFIX is a flag and indicates that
(time (if time-of-day only the correctly processes TXT should be returned - this is used by
(concat (substring t1 -4 -2) `org-agenda-change-all-lines'."
":" (substring t1 -2)) (save-match-data
"")) ;; Diary entries sometimes have extra whitespace at the beginning
rtn) (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
(if (symbolp category) (setq category (symbol-name category))) (let* ((category (or category
(setq rtn (concat (eval org-prefix-format-compiled) txt)) org-category
(add-text-properties (if (buffer-file-name)
0 (length rtn) (list 'category (downcase category) (file-name-sans-extension
'prefix-length (- (length rtn) (length txt)) (file-name-nondirectory (buffer-file-name)))
'time-of-day time-of-day) "")))
rtn) time ;; needed for the eval of the prefix format
rtn)) (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn)
(when (and dotime time-of-day org-prefix-has-time)
;; Extract starting and ending time and move them to prefix
(when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
(setq plain (string-match org-plain-time-of-day-regexp ts)))
(setq s0 (match-string 0 ts)
s1 (match-string (if plain 1 2) ts)
s2 (match-string (if plain 8 4) ts))
;; If the times are in TXT (not in DOTIMES), and the prefix will list
;; them, we might want to remove them there to avoid duplication.
;; The user can turn this off with a variable.
(if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
(string-match (concat (regexp-quote s0) " *") txt)
(if (eq org-agenda-remove-times-when-in-prefix 'beg)
(= (match-beginning 0) 0)
t))
(setq txt (replace-match "" nil nil txt))))
;; Normalize the time(s) to 24 hour
(if s1 (setq s1 (org-get-time-of-day s1 'string)))
(if s2 (setq s2 (org-get-time-of-day s2 'string))))
;; Create the final string
(if noprefix
(setq rtn txt)
;; Prepare the variables needed in the eval of the compiled format
(setq time (cond (s2 (concat s1 "-" s2))
(s1 (concat s1 "......"))
(t ""))
extra (or extra "")
category (if (symbolp category) (symbol-name category) category))
;; Evaluate the compiled format
(setq rtn (concat (eval org-prefix-format-compiled) txt)))
;; And finally add the text properties
(add-text-properties
0 (length rtn) (list 'category (downcase category)
'prefix-length (- (length rtn) (length txt))
'time-of-day time-of-day
'dotime dotime)
rtn)
rtn)))
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
((member 'weekly (car org-agenda-time-grid)))
(t (throw 'exit list)))
(let* ((have (delq nil (mapcar
(lambda (x) (get-text-property 1 'time-of-day x))
list)))
(string (nth 1 org-agenda-time-grid))
(gridtimes (nth 2 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
new time)
(if (and (member 'require-timed req) (not have))
;; don't show empty grid
(throw 'exit list))
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (int-to-string time))
(push (org-format-agenda-item
nil string "" ;; FIXME: put a category?
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
1 (length (car new)) 'face 'org-time-grid-face (car new))))
(if (member 'time-up org-agenda-sorting-strategy)
(append new list)
(append list new)))))
(defun org-compile-prefix-format (format) (defun org-compile-prefix-format (format)
"Compile the prefix format into a Lisp form that can be evaluated. "Compile the prefix format into a Lisp form that can be evaluated.
The resulting form is returned and stored in the variable The resulting form is returned and stored in the variable
`org-prefix-format-compiled'." `org-prefix-format-compiled'."
(let ((start 0) varform vars (s format) c) (setq org-prefix-has-time nil)
(while (string-match "%\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" (let ((start 0) varform vars var (s format) c f opt)
(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
s start) s start)
(setq var (cdr (assoc (match-string 3 s) (setq var (cdr (assoc (match-string 4 s)
'(("c" . category) ("t" . time) ("s" . extra)))) '(("c" . category) ("t" . time) ("s" . extra))))
c (match-string 2 s) c (or (match-string 3 s) "")
opt (match-beginning 1)
start (1+ (match-beginning 0))) start (1+ (match-beginning 0)))
(if (= (length c) 1) (if (equal var 'time) (setq org-prefix-has-time t))
(setq varform `(if (equal "" ,var) "" (concat ,var ,c))) (setq f (concat "%" (match-string 2 s) "s"))
(setq varform var)) (if opt
(setq s (replace-match "%\\1s" t nil s)) (setq varform
`(if (equal "" ,var)
""
(format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
(setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c)))))
(setq s (replace-match "%s" t nil s))
(push varform vars)) (push varform vars))
(setq vars (nreverse vars)) (setq vars (nreverse vars))
(setq org-prefix-format-compiled `(format ,s ,@vars)))) (setq org-prefix-format-compiled `(format ,s ,@vars))))
(defun org-get-time-of-day (s) (defun org-get-time-of-day (s &optional string)
"Check string S for a time of day. "Check string S for a time of day.
If found, return it as a military time number between 0 and 2400. If found, return it as a military time number between 0 and 2400.
If not found, return nil." If not found, return nil.
The optional STRING argument forces conversion into a 5 character wide string
HH:MM."
(save-match-data (save-match-data
(when (or (when
(string-match (or
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\>" s) (string-match
(string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\>" s)) (string-match
(+ (* 100 (+ (string-to-number (match-string 1 s)) "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
(if (and (match-beginning 4) (let* ((t0 (+ (* 100
(equal (downcase (match-string 4 s)) "pm")) (+ (string-to-number (match-string 1 s))
12 0))) (if (and (match-beginning 4)
(if (match-beginning 3) (equal (downcase (match-string 4 s)) "pm"))
(string-to-number (match-string 3 s)) 12 0)))
0))))) (if (match-beginning 3)
(string-to-number (match-string 3 s))
0)))
(t1 (concat " " (int-to-string t0))))
(if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
(defun org-finalize-agenda-entries (list) (defun org-finalize-agenda-entries (list)
"Sort and concatenate the agenda items." "Sort and concatenate the agenda items."
@ -4295,23 +4529,30 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface)
"Change all lines in the agenda buffer which match hdmarker. "Change all lines in the agenda buffer which match hdmarker.
The new content of the line will be NEWHEAD. HDMARKER is checked with The new content of the line will be NEWHEAD (as modified by
`equal' against all `org-hd-marker' text properties in the file." `org-format-agenda-item'). HDMARKER is checked with
(let* (props m pl undone-face done-face) `equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified acording to
the new TODO state."
(let* (props m pl undone-face done-face finish new dotime)
; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
(save-excursion (save-excursion
(goto-char (point-max)) (goto-char (point-max))
(beginning-of-line 1) (beginning-of-line 1)
(while (not (bobp)) (while (not finish)
(setq finish (bobp))
(when (and (setq m (get-text-property (point) 'org-hd-marker)) (when (and (setq m (get-text-property (point) 'org-hd-marker))
(equal m hdmarker)) (equal m hdmarker))
(setq props (text-properties-at (point)) (setq props (text-properties-at (point))
dotime (get-text-property (point) 'dotime)
new (org-format-agenda-item "x" newhead "x" dotime 'noprefix)
pl (get-text-property (point) 'prefix-length) pl (get-text-property (point) 'prefix-length)
undone-face (get-text-property (point) 'undone-face) undone-face (get-text-property (point) 'undone-face)
done-face (get-text-property (point) 'done-face)) done-face (get-text-property (point) 'done-face))
(move-to-column pl) (move-to-column pl)
(if (looking-at ".*") (if (looking-at ".*")
(progn (progn
(replace-match newhead t t) (replace-match new t t)
(beginning-of-line 1) (beginning-of-line 1)
(add-text-properties (point-at-bol) (point-at-eol) props) (add-text-properties (point-at-bol) (point-at-eol) props)
(if fixface (if fixface
@ -4355,6 +4596,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(and (outline-next-heading) (and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading (org-flag-heading nil))) ; show the next heading
(funcall 'org-priority force-direction) (funcall 'org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading))) (setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker) (org-agenda-change-all-lines newhead hdmarker)
(beginning-of-line 1))) (beginning-of-line 1)))
@ -4519,7 +4761,7 @@ This is a command that has to be installed in `calendar-mode-map'."
"ISO: " (calendar-iso-date-string date) "\n" "ISO: " (calendar-iso-date-string date) "\n"
"Day of Yr: " (calendar-day-of-year-string date) "\n" "Day of Yr: " (calendar-day-of-year-string date) "\n"
"Julian: " (calendar-julian-date-string date) "\n" "Julian: " (calendar-julian-date-string date) "\n"
"Astronomic: " (calendar-astro-date-string date) "Astron. JD: " (calendar-astro-date-string date)
" (Julian date number at noon UTC)\n" " (Julian date number at noon UTC)\n"
"Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
"Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
@ -4865,10 +5107,11 @@ For file links, arg negates `org-line-numbers-in-file-links'."
((fboundp 'gnus-group-name) ((fboundp 'gnus-group-name)
(gnus-group-name)) (gnus-group-name))
(t "???")))) (t "???"))))
(setq link (concat (if (org-xor arg org-usenet-links-prefer-google) (setq link (concat
"http://groups.google.com/groups?group=" (if (org-xor arg org-usenet-links-prefer-google)
"gnus:") "http://groups.google.com/groups?group="
group)))) "gnus:")
group))))
((memq major-mode '(gnus-summary-mode gnus-article-mode)) ((memq major-mode '(gnus-summary-mode gnus-article-mode))
(and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
@ -4919,9 +5162,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
(defun org-xor (a b) (defun org-xor (a b)
"Exclusive or." "Exclusive or."
;; (if a (not b) b) (if a (not b) b))
(or (and a (not b))
(and b (not a))))
(defun org-get-header (header) (defun org-get-header (header)
"Find a header field in the current buffer." "Find a header field in the current buffer."
@ -5217,7 +5458,8 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
(point-at-bol) (point))) (point-at-bol) (point)))
(beginning-of-line 1) (beginning-of-line 1)
(newline)) (newline))
(mapcar (lambda (x) (insert line)) (make-list rows t)) ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
(dotimes (i rows) (insert line))
(goto-char pos) (goto-char pos)
(if (> rows 1) (if (> rows 1)
;; Insert a hline after the first row. ;; Insert a hline after the first row.
@ -5285,8 +5527,7 @@ Such a file can be imported into a spreadsheet program like Excel."
(unless (or (not (file-exists-p file)) (unless (or (not (file-exists-p file))
(y-or-n-p (format "Overwrite file %s? " file))) (y-or-n-p (format "Overwrite file %s? " file)))
(error "Abort")) (error "Abort"))
(save-excursion (with-current-buffer (find-file-noselect file)
(find-file file)
(setq buf (current-buffer)) (setq buf (current-buffer))
(erase-buffer) (erase-buffer)
(fundamental-mode) (fundamental-mode)
@ -5406,12 +5647,18 @@ This is being used to correctly align a single field after TAB or RET.")
(setq rfmt (concat rfmt "\n") (setq rfmt (concat rfmt "\n")
hfmt (concat (substring hfmt 0 -1) "|\n")) hfmt (concat (substring hfmt 0 -1) "|\n"))
;; Produce the new table ;; Produce the new table
(while lines ;;(while lines
(setq l (pop lines)) ;; (setq l (pop lines))
(if l ;; (if l
(setq new (concat new (apply 'format rfmt ;; (setq new (concat new (apply 'format rfmt
(append (pop fields) emptystrings)))) ;; (append (pop fields) emptystrings))))
(setq new (concat new hfmt)))) ;; (setq new (concat new hfmt))))
(setq new (mapconcat
(lambda (l)
(if l (apply 'format rfmt
(append (pop fields) emptystrings))
hfmt))
lines ""))
;; Replace the old one ;; Replace the old one
(delete-region beg end) (delete-region beg end)
(move-marker end nil) (move-marker end nil)
@ -8480,9 +8727,7 @@ to a visible line beginning. This makes the function of C-a more intuitive."
(get-char-property (point) 'invisible)) (get-char-property (point) 'invisible))
(save-excursion (save-excursion
(skip-chars-backward "^\r\n") (skip-chars-backward "^\r\n")
(if (bobp) (equal (char-before) ?\r))))
nil
(equal (char-before) ?\r)))))
(defun org-back-to-heading (&optional invisible-ok) (defun org-back-to-heading (&optional invisible-ok)
"Move to previous heading line, or beg of this line if it's a heading. "Move to previous heading line, or beg of this line if it's a heading.

2
lisp/textmodes/table.el
View file

@ -1272,7 +1272,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
(if (featurep 'xemacs) (if (featurep 'xemacs)
(progn (progn
(easy-menu-add-item nil '("Tools") table-global-menu-map)) (easy-menu-add-item nil '("Tools") table-global-menu-map))
(easy-menu-add-item (current-global-map) '("menu-bar" "tools") '("--")) (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
(easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map))) (easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

34
lisp/thumbs.el
View file

@ -83,7 +83,7 @@
(defcustom thumbs-thumbsdir-max-size 50000000 (defcustom thumbs-thumbsdir-max-size 50000000
"Max size for thumbnails directory. "Max size for thumbnails directory.
When it reach that size (in bytes), a warning is send." When it reachs that size (in bytes), a warning is sent."
:type 'string :type 'string
:group 'thumbs) :group 'thumbs)
@ -142,7 +142,7 @@ see some of your images."
;; Initialize some variable, for later use. ;; Initialize some variable, for later use.
(defvar thumbs-temp-file (defvar thumbs-temp-file
(concat thumbs-temp-dir thumbs-temp-prefix) (concat thumbs-temp-dir thumbs-temp-prefix)
"Temporary filesname for images.") "Temporary filename for images.")
(defvar thumbs-current-tmp-filename (defvar thumbs-current-tmp-filename
nil nil
@ -188,8 +188,8 @@ The name is made by appending a number to PREFIX, default \"Thumbs\"."
(defun thumbs-cleanup-thumbsdir () (defun thumbs-cleanup-thumbsdir ()
"Clean the thumbnails directory. "Clean the thumbnails directory.
If the total size of all files in 'thumbs-thumbsdir' is bigger than If the total size of all files in `thumbs-thumbsdir' is bigger than
'thumbs-thumbsdir-max-size', files are deleted until the max size is `thumbs-thumbsdir-max-size', files are deleted until the max size is
reached." reached."
(let* ((filesL (let* ((filesL
(sort (sort
@ -217,11 +217,11 @@ reached."
FILEIN is the input file, FILEIN is the input file,
FILEOUT is the output file, FILEOUT is the output file,
ACTION is the command to send to convert. ACTION is the command to send to convert.
Optional argument are: Optional arguments are:
ARG any arguments to the ACTION command, ARG any arguments to the ACTION command,
OUTPUT-FORMAT is the file format to output, default is jpeg OUTPUT-FORMAT is the file format to output (default is jpeg),
ACTION-PREFIX is the symbol to place before the ACTION command ACTION-PREFIX is the symbol to place before the ACTION command
(default to '-' but can sometime be '+')." (defaults to '-' but can sometimes be '+')."
(let ((command (format "%s %s%s %s \"%s\" \"%s:%s\"" (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
thumbs-conversion-program thumbs-conversion-program
(or action-prefix "-") (or action-prefix "-")
@ -241,7 +241,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command
(round (- n (/ (* d n) 100)))) (round (- n (/ (* d n) 100))))
(defun thumbs-increment-image-size (s) (defun thumbs-increment-image-size (s)
"Increment S (a cons of width x heigh)." "Increment S (a cons of width x height)."
(cons (cons
(thumbs-increment-image-size-element (car s) (thumbs-increment-image-size-element (car s)
thumbs-image-resizing-step) thumbs-image-resizing-step)
@ -249,7 +249,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command
thumbs-image-resizing-step))) thumbs-image-resizing-step)))
(defun thumbs-decrement-image-size (s) (defun thumbs-decrement-image-size (s)
"Decrement S (a cons of width x heigh)." "Decrement S (a cons of width x height)."
(cons (cons
(thumbs-decrement-image-size-element (car s) (thumbs-decrement-image-size-element (car s)
thumbs-image-resizing-step) thumbs-image-resizing-step)
@ -349,7 +349,7 @@ Or, alternatively, a SIZE may be specified."
"Insert image IMG at point. "Insert image IMG at point.
TYPE and RELIEF will be used in constructing the image; see `image' TYPE and RELIEF will be used in constructing the image; see `image'
in the emacs-lisp manual for further documentation. in the emacs-lisp manual for further documentation.
if MARKED is non-nil, the image is marked." If MARKED is non-nil, the image is marked."
(let ((i `(image :type ,type (let ((i `(image :type ,type
:file ,img :file ,img
:relief ,relief :relief ,relief
@ -361,7 +361,7 @@ if MARKED is non-nil, the image is marked."
(defun thumbs-insert-thumb (img &optional marked) (defun thumbs-insert-thumb (img &optional marked)
"Insert the thumbnail for IMG at point. "Insert the thumbnail for IMG at point.
if MARKED is non-nil, the image is marked" If MARKED is non-nil, the image is marked."
(thumbs-insert-image (thumbs-insert-image
(thumbs-make-thumb img) 'jpeg thumbs-relief marked) (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
(put-text-property (1- (point)) (point) (put-text-property (1- (point)) (point)
@ -403,7 +403,7 @@ and SAME-WINDOW to show thumbs in the same window."
;;;###autoload ;;;###autoload
(defun thumbs-dired-show-marked () (defun thumbs-dired-show-marked ()
"In Dired, make a thumbs buffer with all marked files." "In dired, make a thumbs buffer with all marked files."
(interactive) (interactive)
(thumbs-show-thumbs-list (dired-get-marked-files) nil t)) (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
@ -435,7 +435,7 @@ and SAME-WINDOW to show thumbs in the same window."
(defun thumbs-find-image-at-point (&optional img otherwin) (defun thumbs-find-image-at-point (&optional img otherwin)
"Display image IMG for thumbnail at point. "Display image IMG for thumbnail at point.
use another window it OTHERWIN is t." Use another window if OTHERWIN is t."
(interactive) (interactive)
(let* ((i (or img (thumbs-current-image)))) (let* ((i (or img (thumbs-current-image))))
(thumbs-find-image i (point) otherwin))) (thumbs-find-image i (point) otherwin)))
@ -499,7 +499,7 @@ Open another window."
(nreverse list)))) (nreverse list))))
(defun thumbs-delete-images () (defun thumbs-delete-images ()
"Delete the image at point (and it's thumbnail) (or marked files if any)." "Delete the image at point (and its thumbnail) (or marked files if any)."
(interactive) (interactive)
(let ((files (or thumbs-markedL (list (thumbs-current-image))))) (let ((files (or thumbs-markedL (list (thumbs-current-image)))))
(if (yes-or-no-p (format "Really delete %d files? " (length files))) (if (yes-or-no-p (format "Really delete %d files? " (length files)))
@ -520,7 +520,7 @@ Open another window."
(delq x thumbs-markedL))))))))) (delq x thumbs-markedL)))))))))
(defun thumbs-rename-images (newfile) (defun thumbs-rename-images (newfile)
"Rename the image at point (and it's thumbnail) (or marked files if any)." "Rename the image at point (and its thumbnail) (or marked files if any)."
(interactive "FRename to file or directory: ") (interactive "FRename to file or directory: ")
(let ((files (or thumbs-markedL (list (thumbs-current-image)))) (let ((files (or thumbs-markedL (list (thumbs-current-image))))
failures) failures)
@ -574,7 +574,7 @@ Open another window."
thumbs-current-image-filename i)))) thumbs-current-image-filename i))))
(defun thumbs-next-image () (defun thumbs-next-image ()
"Show next image." "Show the next image."
(interactive) (interactive)
(let* ((i (1+ thumbs-image-num)) (let* ((i (1+ thumbs-image-num))
(list (thumbs-file-alist)) (list (thumbs-file-alist))
@ -782,7 +782,7 @@ ACTION and ARG should be a valid convert command."
;;;###autoload ;;;###autoload
(defun thumbs-dired-setroot () (defun thumbs-dired-setroot ()
"In dired, Call the setroot program on the image at point." "In dired, call the setroot program on the image at point."
(interactive) (interactive)
(thumbs-call-setroot-command (dired-get-filename))) (thumbs-call-setroot-command (dired-get-filename)))

2
lisp/tmm.el
View file

@ -362,7 +362,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(if (memq c tmm-short-cuts) (if (memq c tmm-short-cuts)
(if (equal (buffer-name) "*Completions*") (if (equal (buffer-name) "*Completions*")
(progn (progn
(beginning-of-buffer) (goto-char (point-min))
(re-search-forward (re-search-forward
(concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt)) (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt))
(choose-completion)) (choose-completion))

21
lisp/vc-cvs.el
View file

@ -236,16 +236,19 @@ See also variable `vc-cvs-sticky-date-format-string'."
(defun vc-cvs-checkout-model (file) (defun vc-cvs-checkout-model (file)
"CVS-specific version of `vc-checkout-model'." "CVS-specific version of `vc-checkout-model'."
(if (or (getenv "CVSREAD") (if (getenv "CVSREAD")
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
;; (If vc-mistrust-permissions was t, we actually shouldn't
;; trust this, but there is no other way to learn this from CVS
;; at the moment (version 1.9).)
(string-match "r-..-..-." (nth 8 (file-attributes file))))
'announce 'announce
'implicit)) (let ((attrib (file-attributes file)))
(if (and attrib ;; don't check further if FILE doesn't exist
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
;; (If vc-mistrust-permissions was t, we actually shouldn't
;; trust this, but there is no other way to learn this from CVS
;; at the moment (version 1.9).)
(string-match "r-..-..-." (nth 8 attrib)))
'announce
'implicit))))
(defun vc-cvs-mode-line-string (file) (defun vc-cvs-mode-line-string (file)
"Return string for placement into the modeline for FILE. "Return string for placement into the modeline for FILE.

6
lisp/vc.el
View file

@ -46,7 +46,8 @@
;; This mode is fully documented in the Emacs user's manual. ;; This mode is fully documented in the Emacs user's manual.
;; ;;
;; Supported version-control systems presently include SCCS, RCS, and CVS. ;; Supported version-control systems presently include CVS, RCS, GNU Arch,
;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC).
;; ;;
;; Some features will not work with old RCS versions. Where ;; Some features will not work with old RCS versions. Where
;; appropriate, VC finds out which version you have, and allows or ;; appropriate, VC finds out which version you have, and allows or
@ -68,7 +69,7 @@
;; ;;
;; The vc code maintains some internal state in order to reduce expensive ;; The vc code maintains some internal state in order to reduce expensive
;; version-control operations to a minimum. Some names are only computed ;; version-control operations to a minimum. Some names are only computed
;; once. If you perform version control operations with RCS/SCCS/CVS while ;; once. If you perform version control operations with the backend while
;; vc's back is turned, or move/rename master files while vc is running, ;; vc's back is turned, or move/rename master files while vc is running,
;; vc may get seriously confused. Don't do these things! ;; vc may get seriously confused. Don't do these things!
;; ;;
@ -737,6 +738,7 @@ in their implementation of vc-BACKEND-diff.")
;; functions that operate on RCS revision numbers. This code should ;; functions that operate on RCS revision numbers. This code should
;; also be moved into the backends. It stays for now, however, since ;; also be moved into the backends. It stays for now, however, since
;; it is used in code below. ;; it is used in code below.
;;;###autoload
(defun vc-trunk-p (rev) (defun vc-trunk-p (rev)
"Return t if REV is a revision on the trunk." "Return t if REV is a revision on the trunk."
(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))

67
lisp/vms-patch.el
View file

@ -193,5 +193,72 @@ following bindings are established.
All other Emacs commands are still available." All other Emacs commands are still available."
t) t)
;;;
;;; Filename handling in the minibuffer
;;;
(defun vms-magic-right-square-brace ()
"\
Insert a right square brace, but do other things first depending on context.
During filename completion, when point is at the end of the line and the
character before is not a right square brace, do one of three things before
inserting the brace:
- If there are already two left square braces preceding, do nothing special.
- If there is a previous right-square-brace, convert it to dot.
- If the character before is dot, delete it.
Additionally, if the preceding chars are right-square-brace followed by
either \"-\" or \"..\", strip one level of directory hierarchy."
(interactive)
(when (and minibuffer-completing-file-name
(= (point) (point-max))
(not (= 93 (char-before))))
(cond
;; Avoid clobbering: user:[one.path][another.path
((search-backward "[" (field-beginning) t 2))
((search-backward "]" (field-beginning) t)
(delete-char 1)
(insert ".")
(goto-char (point-max)))
((= ?. (char-before))
(delete-char -1)))
(goto-char (point-max))
(let ((specs '(".." "-"))
(pmax (point-max)))
(while specs
(let* ((up (car specs))
(len (length up))
(cut (- (point) len)))
(when (and (< (1+ len) pmax)
(= ?. (char-before cut))
(string= up (buffer-substring cut (point))))
(delete-char (- (1+ len)))
(while (not (let ((c (char-before)))
(or (= ?. c) (= 91 c))))
(delete-char -1))
(when (= ?. (char-before)) (delete-char -1))
(setq specs nil)))
(setq specs (cdr specs)))))
(insert "]"))
(defun vms-magic-colon ()
"\
Insert a colon, but do other things first depending on context.
During filename completion, when point is at the end of the line
and the line contains a right square brace, remove all characters
from the beginning of the line up to and including such brace.
This enables one to type a new filespec without having to delete
the old one."
(interactive)
(when (and minibuffer-completing-file-name
(= (point) (point-max))
(search-backward "]" (field-beginning) t))
(delete-region (field-beginning) (1+ (point)))
(goto-char (point-max)))
(insert ":"))
(let ((m minibuffer-local-completion-map))
(define-key m "]" 'vms-magic-right-square-brace)
(define-key m "/" 'vms-magic-right-square-brace)
(define-key m ":" 'vms-magic-colon))
;;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf ;;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf
;;; vms-patch.el ends here ;;; vms-patch.el ends here

5
lisp/window.el
View file

@ -543,8 +543,7 @@ Do not shrink to less than `window-min-height' lines.
Do nothing if the buffer contains more lines than the present window height, Do nothing if the buffer contains more lines than the present window height,
or if some of the window's contents are scrolled out of view, or if some of the window's contents are scrolled out of view,
or if shrinking this window would also shrink another window. or if shrinking this window would also shrink another window.
or if the window is the only window of its frame. or if the window is the only window of its frame."
Return non-nil if the window was shrunk."
(interactive) (interactive)
(when (null window) (when (null window)
(setq window (selected-window))) (setq window (selected-window)))
@ -583,7 +582,7 @@ Return non-nil if the window was shrunk."
(defun quit-window (&optional kill window) (defun quit-window (&optional kill window)
"Quit the current buffer. Bury it, and maybe delete the selected frame. "Quit the current buffer. Bury it, and maybe delete the selected frame.
\(The frame is deleted if it is contains a dedicated window for the buffer.) \(The frame is deleted if it contains a dedicated window for the buffer.)
With a prefix argument, kill the buffer instead. With a prefix argument, kill the buffer instead.
Noninteractively, if KILL is non-nil, then kill the current buffer, Noninteractively, if KILL is non-nil, then kill the current buffer,

39
lispref/ChangeLog
View file

@ -1,3 +1,42 @@
2005-05-24 Richard M. Stallman <rms@gnu.org>
* frames.texi (Dialog Boxes): Minor fixes.
2005-05-25 Masatake YAMATO <jet@gyve.org>
* display.texi (Standard Faces): Write about `mode-line-highlight'.
2005-05-24 Luc Teirlinck <teirllm@auburn.edu>
* frames.texi (Dialog Boxes): HEADER argument to `x-popup-dialog'
is optional.
2005-05-24 Nick Roberts <nickrob@snap.net.nz>
* frames.texi (Dialog Boxes): Descibe new optional argument.
2005-05-23 Lute Kamstra <lute@gnu.org>
* modes.texi (Font Lock Basics, Syntactic Font Lock): Recommend
syntax-begin-function over font-lock-beginning-of-syntax-function.
2005-05-21 Luc Teirlinck <teirllm@auburn.edu>
* minibuf.texi (Reading File Names): Update description of
`read-directory-name'.
* modes.texi (Derived Modes): Clarify :group keyword.
2005-05-21 Eli Zaretskii <eliz@gnu.org>
* files.texi (Locating Files): New subsection. Describe
locate-file and executable-find.
2005-05-21 Kevin Ryde <user42@zip.com.au>
* frames.texi (Initial Parameters): Update cross reference to
"Emacs Invocation".
2005-05-19 Luc Teirlinck <teirllm@auburn.edu> 2005-05-19 Luc Teirlinck <teirllm@auburn.edu>
* keymaps.texi (Active Keymaps): Add anchor. * keymaps.texi (Active Keymaps): Add anchor.

5
lispref/display.texi
View file

@ -1727,6 +1727,11 @@ This face is used to show any secondary selection you have made.
@kindex highlight @r{(face name)} @kindex highlight @r{(face name)}
This face is meant to be used for highlighting for various purposes. This face is meant to be used for highlighting for various purposes.
@item mode-line-highlight
@kindex mode-line-highlight @r{(face name)}
This face is used for highlighting something on @code{mode-line} or
@code{header-line} for various purposes.
@item trailing-whitespace @item trailing-whitespace
@kindex trailing-whitespace @r{(face name)} @kindex trailing-whitespace @r{(face name)}
This face is used to display excess whitespace at the end of a line, This face is used to display excess whitespace at the end of a line,

71
lispref/files.texi
View file

@ -735,16 +735,18 @@ for its usual definition is in @file{userlock.el}.
@section Information about Files @section Information about Files
The functions described in this section all operate on strings that The functions described in this section all operate on strings that
designate file names. All the functions have names that begin with the designate file names. With a few exceptions, all the functions have
word @samp{file}. These functions all return information about actual names that begin with the word @samp{file}. These functions all
files or directories, so their arguments must all exist as actual files return information about actual files or directories, so their
or directories unless otherwise noted. arguments must all exist as actual files or directories unless
otherwise noted.
@menu @menu
* Testing Accessibility:: Is a given file readable? Writable? * Testing Accessibility:: Is a given file readable? Writable?
* Kinds of Files:: Is it a directory? A symbolic link? * Kinds of Files:: Is it a directory? A symbolic link?
* Truenames:: Eliminating symbolic links from a file name. * Truenames:: Eliminating symbolic links from a file name.
* File Attributes:: How large is it? Any other names? Etc. * File Attributes:: How large is it? Any other names? Etc.
* Locating Files:: How to find a file in standard places.
@end menu @end menu
@node Testing Accessibility @node Testing Accessibility
@ -1254,6 +1256,67 @@ is on file system number -32252.
@end table @end table
@end defun @end defun
@node Locating Files
@subsection How to Locate Files in Standard Places
@cindex locate files
@cindex find files
Sometimes, you need to find a file that could reside in one of the
standard directories. One example is when you need to look for a
program's executable file, e.g., to find out whether a given program
is installed on the user's system. Another example is the search for
Lisp libraries (@pxref{Library Search}). Such searches generally need
to try several alternative file name extensions, in addition to
looking in every standard directory where the file could be found.
Emacs provides a function for such a generalized search for a file.
@defun locate-file filename path &optional suffixes predicate
This function searches for the file whose name is @var{filename} in
a list of directories given by @var{path}. If it finds the file, it
returns its full @dfn{absolute file name} (@pxref{Relative File
Names}); if the file is not found, the function returns @code{nil}.
The optional argument @var{suffixes} gives the list of file-name
suffixes to append to @var{filename} when searching. If
@var{suffixes} is @code{nil}, it's equivalent to passing a list with a
single element that is an empty string @code{""}.
Typical values of @var{path} are @code{exec-path} (@pxref{Subprocess
Creation, exec-path}) when looking for executable programs or
@code{load-path} (@pxref{Library Search, load-path}) when looking for
Lisp files. Use @code{("/")} to disable the path search (e.g., if
@var{filename} already includes the leading directories), but still
try the extensions in @var{suffixes}.
Typical values of @var{suffixes} are @code{exec-suffixes}
(@pxref{Subprocess Creation, exec-suffixes}) and @code{load-suffixes}
(@pxref{Library Search, load-suffixes}).
The optional argument @var{predicate}, if non-@code{nil}, specifies
the predicate function to use for testing whether a candidate file is
suitable. The predicate function is passed the candidate file name as
its single argument. If @var{predicate} is @code{nil} or unspecified,
@code{locate-file} uses @code{file-readable-p} as the default
predicate. Useful non-default predicates include
@code{file-executable-p}, @code{file-directory-p}, and other
predicates described in @ref{Kinds of Files}.
For compatibility, @var{predicate} can also be one of the symbols
@code{executable}, @code{readable}, @code{writable}, @code{exists}, or
a list of one or more of these symbols.
@end defun
@cindex find executable program
@defun executable-find program
This function searches for the executable file of the named
@var{program} and returns the full absolute name of the executable,
including its file-name extensions, if any. It returns @code{nil} if
the file is not found. The functions searches in all the directories
in @code{exec-path} and tries all the file-name extensions in
@code{exec-suffixes}.
@end defun
@node Changing Files @node Changing Files
@section Changing File Names and Attributes @section Changing File Names and Attributes
@cindex renaming files @cindex renaming files

21
lispref/frames.texi
View file

@ -304,8 +304,8 @@ special-display-frame-alist}.
If you use options that specify window appearance when you invoke Emacs, If you use options that specify window appearance when you invoke Emacs,
they take effect by adding elements to @code{default-frame-alist}. One they take effect by adding elements to @code{default-frame-alist}. One
exception is @samp{-geometry}, which adds the specified position to exception is @samp{-geometry}, which adds the specified position to
@code{initial-frame-alist} instead. @xref{Command Arguments,,, emacs, @code{initial-frame-alist} instead. @xref{Emacs Invocation,, Command
The GNU Emacs Manual}. Line Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}.
@node Window Frame Parameters @node Window Frame Parameters
@subsection Window Frame Parameters @subsection Window Frame Parameters
@ -1438,13 +1438,14 @@ the menu keymap as necessary.
A dialog box is a variant of a pop-up menu---it looks a little A dialog box is a variant of a pop-up menu---it looks a little
different, it always appears in the center of a frame, and it has just different, it always appears in the center of a frame, and it has just
one level and one pane. The main use of dialog boxes is for asking one level and one or more buttons. The main use of dialog boxes is
questions that the user can answer with ``yes'', ``no'', and a few other for asking questions that the user can answer with ``yes'', ``no'',
alternatives. The functions @code{y-or-n-p} and @code{yes-or-no-p} use and a few other alternatives. With a single button, they can also
dialog boxes instead of the keyboard, when called from commands invoked force the user to acknowledge important information. The functions
by mouse clicks. @code{y-or-n-p} and @code{yes-or-no-p} use dialog boxes instead of the
keyboard, when called from commands invoked by mouse clicks.
@defun x-popup-dialog position contents @defun x-popup-dialog position contents &optional header
This function displays a pop-up dialog box and returns an indication of This function displays a pop-up dialog box and returns an indication of
what selection the user makes. The argument @var{contents} specifies what selection the user makes. The argument @var{contents} specifies
the alternatives to offer; it has this format: the alternatives to offer; it has this format:
@ -1474,6 +1475,10 @@ Dialog boxes always appear in the center of a frame; the argument
@code{x-popup-menu}, but the precise coordinates or the individual @code{x-popup-menu}, but the precise coordinates or the individual
window don't matter; only the frame matters. window don't matter; only the frame matters.
If @var{header} is non-@code{nil}, the frame title for the box is
@samp{Information}, otherwise it is @samp{Question}. The former is used
for @code{message-box} (@pxref{The Echo Area}).
In some configurations, Emacs cannot display a real dialog box; so In some configurations, Emacs cannot display a real dialog box; so
instead it displays the same items in a pop-up menu in the center of the instead it displays the same items in a pop-up menu in the center of the
frame. frame.

6
lispref/minibuf.texi
View file

@ -1309,9 +1309,9 @@ If @var{default} is @code{nil} and @var{initial} is non-@code{nil},
@code{read-directory-name} constructs a substitute default by @code{read-directory-name} constructs a substitute default by
combining @var{directory} (or the current buffer's default directory combining @var{directory} (or the current buffer's default directory
if @var{directory} is @code{nil}) and @var{initial}. If both if @var{directory} is @code{nil}) and @var{initial}. If both
@var{default} and @var{initial} are @code{nil}, this function uses the @var{default} and @var{initial} are @code{nil}, this function uses
current buffer's default directory as substitute default, ignoring @var{directory} as substitute default, or the current buffer's default
@var{directory}. directory if @var{directory} is @code{nil}.
@end defun @end defun
@defopt insert-default-directory @defopt insert-default-directory

25
lispref/modes.texi
View file

@ -1032,9 +1032,6 @@ The @var{keyword-args} are pairs of keywords and values. The values
are evaluated. The following keywords are currently supported: are evaluated. The following keywords are currently supported:
@table @code @table @code
@item :group
If this is specified, it is the customization group for this mode.
@item :syntax-table @item :syntax-table
You can use this to explicitly specify a syntax table for the new You can use this to explicitly specify a syntax table for the new
mode. If you specify a @code{nil} value, the new mode uses the same mode. If you specify a @code{nil} value, the new mode uses the same
@ -1049,6 +1046,13 @@ mode. If you specify a @code{nil} value, the new mode uses the same
abbrev table as @var{parent}, or @code{fundamental-mode-abbrev-table} abbrev table as @var{parent}, or @code{fundamental-mode-abbrev-table}
if @var{parent} is @code{nil}. (Again, a @code{nil} value is if @var{parent} is @code{nil}. (Again, a @code{nil} value is
@emph{not} equivalent to not specifying this keyword.) @emph{not} equivalent to not specifying this keyword.)
@item :group
If this is specified, the value should be the customization group for
this mode. (Not all major modes have one.) Only the (still
experimental and unadvertised) command @code{customize-mode} currently
uses this. @code{define-derived-mode} does @emph{not} automatically
define the specified customization group.
@end table @end table
Here is a hypothetical example: Here is a hypothetical example:
@ -2364,7 +2368,9 @@ syntactic fontification (@pxref{Syntax Table Functions}). The
resulting syntax table is stored in @code{font-lock-syntax-table}. resulting syntax table is stored in @code{font-lock-syntax-table}.
The fifth element, @var{syntax-begin}, specifies the value of The fifth element, @var{syntax-begin}, specifies the value of
@code{font-lock-beginning-of-syntax-function}. @code{font-lock-beginning-of-syntax-function}. We recommend setting
this variable to @code{nil} and using @code{syntax-begin-function}
instead.
All the remaining elements (if any) are collectively called All the remaining elements (if any) are collectively called
@var{other-vars}. Each of these elements should have the form @var{other-vars}. Each of these elements should have the form
@ -2876,10 +2882,6 @@ comments and strings. Specify it using @var{syntax-alist} in
@code{font-lock-defaults}. @code{font-lock-defaults}.
@end defvar @end defvar
@c ???
@c The docstring says that font-lock-syntax-table is semi-obsolete.
@c How the alternative should be used is not clear. --lute
@defvar font-lock-beginning-of-syntax-function @defvar font-lock-beginning-of-syntax-function
If this variable is non-@code{nil}, it should be a function to move If this variable is non-@code{nil}, it should be a function to move
point back to a position that is syntactically at ``top level'' and point back to a position that is syntactically at ``top level'' and
@ -2892,9 +2894,10 @@ the beginning of any enclosing syntactic block. Typical values are
be outside a syntactic block), or @code{beginning-of-defun} for be outside a syntactic block), or @code{beginning-of-defun} for
programming modes, or @code{backward-paragraph} for textual modes. programming modes, or @code{backward-paragraph} for textual modes.
If the value is @code{nil}, the beginning of the buffer is used as a If the value is @code{nil}, Font Lock uses
position outside of a syntactic block. This cannot be wrong, but it @code{syntax-begin-function} to move back outside of any comment,
can be slow. string, or sexp. This variable is semi-obsolete; we recommend setting
@code{syntax-begin-function} instead.
Specify this variable using @var{syntax-begin} in Specify this variable using @var{syntax-begin} in
@code{font-lock-defaults}. @code{font-lock-defaults}.

45
man/ChangeLog
View file

@ -1,3 +1,48 @@
2005-05-25 Jay Belanger <belanger@truman.edu>
* calc.texi: Change Calc version number throughout.
(Keypad Mode): Change location in info output.
(Keypad mode overview): Move picture of keypad.
2005-05-24 Luc Teirlinck <teirllm@auburn.edu>
* fixit.texi (Spelling): Delete confusing sentence; flyspell is
not enabled by default.
When not on a word, `ispell-word' by default checks the word
before point.
2005-05-24 Nick Roberts <nickrob@snap.net.nz>
* building.texi (Debugger Operation): Simplify last sentence.
2005-05-23 Lute Kamstra <lute@gnu.org>
* emacs.texi: Update FSF's address throughout.
(Preface): Use @cite.
(Distrib): Add cross reference to the node "Copying". Mention the
FDL. Don't refer to etc/{FTP,ORDERS}. Mention the sale of
printed manuals.
(Intro): Use @xref for the Emacs Lisp Intro.
2005-05-21 Jay Belanger <belanger@truman.edu>
* calc.texi (Storing variables): Mention that only most variables
are void to begin with.
2005-05-21 Kevin Ryde <user42@zip.com.au>
* widget.texi (Basic Types): Update cross ref from "Enabling
Mouse-1 to Follow Links" to "Links and Mouse-1" per recent
lispref/text.texi change.
2005-05-20 Carsten Dominik <dominik@science.uva.nl>
* org.texi: Version 3.09
2005-05-18 Carsten Dominik <dominik@science.uva.nl>
* reftex.texi: Version 4.28
2005-05-18 Luc Teirlinck <teirllm@auburn.edu> 2005-05-18 Luc Teirlinck <teirllm@auburn.edu>
* buffers.texi (Select Buffer): Document `C-u M-g M-g'. * buffers.texi (Select Buffer): Document `C-u M-g M-g'.

2
man/building.texi
View file

@ -518,7 +518,7 @@ value is displayed in the echo area.
With GDB in text command mode (@pxref{GDB Graphical Interface}), With GDB in text command mode (@pxref{GDB Graphical Interface}),
it is possible that use of GUD tooltips can cause a function to be it is possible that use of GUD tooltips can cause a function to be
called with harmful side-effects. In this case, Emacs disables called with harmful side-effects. In this case, Emacs disables
gud-tooltip-mode. them.
@node Commands of GUD @node Commands of GUD
@subsection Commands of GUD @subsection Commands of GUD

62
man/calc.texi
View file

@ -162,6 +162,7 @@ longer Info tutorial.)
* Store and Recall:: Storing and recalling variables. * Store and Recall:: Storing and recalling variables.
* Graphics:: Commands for making graphs of data. * Graphics:: Commands for making graphs of data.
* Kill and Yank:: Moving data into and out of Calc. * Kill and Yank:: Moving data into and out of Calc.
* Keypad Mode:: Operating Calc from a keypad.
* Embedded Mode:: Working with formulas embedded in a file. * Embedded Mode:: Working with formulas embedded in a file.
* Programming:: Calc as a programmable calculator. * Programming:: Calc as a programmable calculator.
@ -1028,7 +1029,7 @@ with the file you were editing on top and Calc on the bottom.
... ...
--**-Emacs: myfile (Fundamental)----All---------------------- --**-Emacs: myfile (Fundamental)----All----------------------
--- Emacs Calculator Mode --- |Emacs Calc Mode v2.00... --- Emacs Calculator Mode --- |Emacs Calc Mode v2.1 ...
2: 17.3 | 17.3 2: 17.3 | 17.3
1: -5 | 3 1: -5 | 3
. | 2 . | 2
@ -1149,28 +1150,30 @@ Stack; the lower window is a picture of a typical calculator keypad.
\medskip \medskip
@end tex @end tex
@smallexample @smallexample
|--- Emacs Calculator Mode --- @group
|2: 17.3 |--- Emacs Calculator Mode ---
|1: -5 |2: 17.3
| . |1: -5
|--%%-Calc: 12 Deg (Calcul | .
|----+-----Calc 2.00-----+----1 |--%%-Calc: 12 Deg (Calcul
|FLR |CEIL|RND |TRNC|CLN2|FLT | |----+-----Calc 2.1------+----1
|----+----+----+----+----+----| |FLR |CEIL|RND |TRNC|CLN2|FLT |
| LN |EXP | |ABS |IDIV|MOD | |----+----+----+----+----+----|
|----+----+----+----+----+----| | LN |EXP | |ABS |IDIV|MOD |
|SIN |COS |TAN |SQRT|y^x |1/x | |----+----+----+----+----+----|
|----+----+----+----+----+----| |SIN |COS |TAN |SQRT|y^x |1/x |
| ENTER |+/- |EEX |UNDO| <- | |----+----+----+----+----+----|
|-----+---+-+--+--+-+---++----| | ENTER |+/- |EEX |UNDO| <- |
| INV | 7 | 8 | 9 | / | |-----+---+-+--+--+-+---++----|
|-----+-----+-----+-----+-----| | INV | 7 | 8 | 9 | / |
| HYP | 4 | 5 | 6 | * | |-----+-----+-----+-----+-----|
|-----+-----+-----+-----+-----| | HYP | 4 | 5 | 6 | * |
|EXEC | 1 | 2 | 3 | - | |-----+-----+-----+-----+-----|
|-----+-----+-----+-----+-----| |EXEC | 1 | 2 | 3 | - |
| OFF | 0 | . | PI | + | |-----+-----+-----+-----+-----|
|-----+-----+-----+-----+-----+ | OFF | 0 | . | PI | + |
|-----+-----+-----+-----+-----+
@end group
@end smallexample @end smallexample
Keypad mode is much easier for beginners to learn, because there Keypad mode is much easier for beginners to learn, because there
@ -10010,7 +10013,6 @@ numeric entry, undo, numeric prefix arguments, etc.
* Numeric Entry:: * Numeric Entry::
* Algebraic Entry:: * Algebraic Entry::
* Quick Calculator:: * Quick Calculator::
* Keypad Mode::
* Prefix Arguments:: * Prefix Arguments::
* Undo:: * Undo::
* Error Messages:: * Error Messages::
@ -28292,9 +28294,9 @@ pushes the old value of @samp{a} on the stack and stores @samp{a = 6}.
@pindex calc-unstore @pindex calc-unstore
@cindex Void variables @cindex Void variables
@cindex Un-storing variables @cindex Un-storing variables
Until you store something in them, variables are ``void,'' that is, they Until you store something in them, most variables are ``void,'' that is,
contain no value at all. If they appear in an algebraic formula they they contain no value at all. If they appear in an algebraic formula
will be left alone even if you press @kbd{=} (@code{calc-evaluate}). they will be left alone even if you press @kbd{=} (@code{calc-evaluate}).
The @kbd{s u} (@code{calc-unstore}) command returns a variable to the The @kbd{s u} (@code{calc-unstore}) command returns a variable to the
void state. void state.
@ -29649,7 +29651,7 @@ whole line. So you can usually transfer a single number into Calc
just by double-clicking on it in the shell, then middle-clicking just by double-clicking on it in the shell, then middle-clicking
in the Calc window. in the Calc window.
@node Keypad Mode, Embedded Mode, Kill and Yank, Introduction @node Keypad Mode, Embedded Mode, Kill and Yank, Top
@chapter Keypad Mode @chapter Keypad Mode
@noindent @noindent
@ -29706,7 +29708,7 @@ original buffer.
@smallexample @smallexample
@group @group
|----+-----Calc 2.00-----+----1 |----+-----Calc 2.1------+----1
|FLR |CEIL|RND |TRNC|CLN2|FLT | |FLR |CEIL|RND |TRNC|CLN2|FLT |
|----+----+----+----+----+----| |----+----+----+----+----+----|
| LN |EXP | |ABS |IDIV|MOD | | LN |EXP | |ABS |IDIV|MOD |
@ -35020,7 +35022,7 @@ CVS tree. See @uref{http://savannah.gnu.org/projects/emacs}.
@appendix Calc Summary @appendix Calc Summary
@noindent @noindent
This section includes a complete list of Calc 2.02 keystroke commands. This section includes a complete list of Calc 2.1 keystroke commands.
Each line lists the stack entries used by the command (top-of-stack Each line lists the stack entries used by the command (top-of-stack
last), the keystrokes themselves, the prompts asked by the command, last), the keystrokes themselves, the prompts asked by the command,
and the result of the command (also with top-of-stack last). and the result of the command (also with top-of-stack last).

2
man/display.texi
View file

@ -1084,7 +1084,7 @@ bitmaps are displayed in the left or right fringe, respectively.
The @var{indicator} must be one of @code{top}, @code{bottom}, The @var{indicator} must be one of @code{top}, @code{bottom},
@code{up}, @code{down}, or @code{t} which specifies the default @code{up}, @code{down}, or @code{t} which specifies the default
position for the indicators not present in the alist. position for the indicators not present in the alist.
The @var{position} is one of @code{left}, @code{right}, or @code{ni} The @var{position} is one of @code{left}, @code{right}, or @code{nil}
which specifies not to show this indicator. which specifies not to show this indicator.
For example, @code{((top . left) (t . right))} places the top angle For example, @code{((top . left) (t . right))} places the top angle

68
man/emacs.texi
View file

@ -65,8 +65,8 @@ Software Foundation raise funds for GNU development.''
@sp 2 @sp 2
ISBN 1-882114-06-X @* ISBN 1-882114-06-X @*
Published by the Free Software Foundation @* Published by the Free Software Foundation @*
59 Temple Place, Suite 330 @* 51 Franklin Street, Fifth Floor @*
Boston, MA 02111-1307 USA Boston, MA 02110-1301 USA
@sp 2 @sp 2
Cover art by Etienne Suvasa. Cover art by Etienne Suvasa.
@ -951,11 +951,11 @@ files, which are also distributed along with GNU Emacs.
GNU Emacs is a member of the Emacs editor family. There are many Emacs GNU Emacs is a member of the Emacs editor family. There are many Emacs
editors, all sharing common principles of organization. For information on editors, all sharing common principles of organization. For information on
the underlying philosophy of Emacs and the lessons learned from its the underlying philosophy of Emacs and the lessons learned from its
development, write for a copy of AI memo 519a, ``Emacs, the Extensible, development, write for a copy of AI memo 519a, @cite{Emacs, the Extensible,
Customizable Self-Documenting Display Editor,'' to Publications Department, Customizable Self-Documenting Display Editor}, to Publications Department,
Artificial Intelligence Lab, 545 Tech Square, Cambridge, MA 02139, USA@. At Artificial Intelligence Lab, 545 Tech Square, Cambridge, MA 02139, USA@. At
last report they charge $2.25 per copy. Another useful publication is LCS last report they charge $2.25 per copy. Another useful publication is LCS
TM-165, ``A Cookbook for an Emacs,'' by Craig Finseth, available from TM-165, @cite{A Cookbook for an Emacs}, by Craig Finseth, available from
Publications Department, Laboratory for Computer Science, 545 Tech Square, Publications Department, Laboratory for Computer Science, 545 Tech Square,
Cambridge, MA 02139, USA@. The price today is $3. Cambridge, MA 02139, USA@. The price today is $3.
@ -971,20 +971,25 @@ manual. @xref{MS-DOS}, for information about using Emacs on MS-DOS.
@unnumbered Distribution @unnumbered Distribution
GNU Emacs is @dfn{free software}; this means that everyone is free to GNU Emacs is @dfn{free software}; this means that everyone is free to
use it and free to redistribute it on certain conditions. GNU Emacs is use it and free to redistribute it on certain conditions. GNU Emacs
not in the public domain; it is copyrighted and there are restrictions is not in the public domain; it is copyrighted and there are
on its distribution, but these restrictions are designed to permit restrictions on its distribution, but these restrictions are designed
everything that a good cooperating citizen would want to do. What is to permit everything that a good cooperating citizen would want to do.
not allowed is to try to prevent others from further sharing any version What is not allowed is to try to prevent others from further sharing
of GNU Emacs that they might get from you. The precise conditions are any version of GNU Emacs that they might get from you. The precise
found in the GNU General Public License that comes with Emacs and also conditions are found in the GNU General Public License that comes with
appears following this section. Emacs and also appears in this manual@footnote{This manual is itself
covered by the GNU Free Documentation License. This license is
similar in spirit to the General Public License, but is more suitable
for documentation. @xref{GNU Free Documentation License}.}.
@xref{Copying}.
One way to get a copy of GNU Emacs is from someone else who has it. You One way to get a copy of GNU Emacs is from someone else who has it.
need not ask for our permission to do so, or tell any one else; just You need not ask for our permission to do so, or tell any one else;
copy it. If you have access to the Internet, you can get the latest just copy it. If you have access to the Internet, you can get the
distribution version of GNU Emacs by anonymous FTP; see the file latest distribution version of GNU Emacs by anonymous FTP; see
@file{etc/FTP} in the Emacs distribution for more information. @url{http://www.gnu.org/software/emacs} on our website for more
information.
You may also receive GNU Emacs when you buy a computer. Computer You may also receive GNU Emacs when you buy a computer. Computer
manufacturers are free to distribute copies on the same terms that apply to manufacturers are free to distribute copies on the same terms that apply to
@ -995,17 +1000,17 @@ General Public License. In other words, the program must be free for you
when you get it, not just free for the manufacturer. when you get it, not just free for the manufacturer.
You can also order copies of GNU Emacs from the Free Software You can also order copies of GNU Emacs from the Free Software
Foundation. This is a convenient and reliable way to get a copy; it Foundation. This is a convenient and reliable way to get a copy; it is
is also a good way to help fund our work. (The Foundation has always also a good way to help fund our work. We also sell hardcopy versions
received most of its funds in this way.) An order form is included in of this manual and @cite{An Introduction to Programming in Emacs Lisp},
the file @file{etc/ORDERS} in the Emacs distribution, and on our web by Robert J. Chassell. You can find an order form on our web site at
site in @url{http://www.gnu.org/order/order.html}. For further @url{http://www.gnu.org/order/order.html}. For further information,
information, write to write to
@display @display
Free Software Foundation Free Software Foundation
59 Temple Place, Suite 330 51 Franklin Street, Fifth Floor
Boston, MA 02111-1307 USA Boston, MA 02110-1301
USA USA
@end display @end display
@ -1137,10 +1142,9 @@ session. Almost any part of Emacs can be replaced without making a
separate copy of all of Emacs. Most of the editing commands of Emacs separate copy of all of Emacs. Most of the editing commands of Emacs
are written in Lisp; the few exceptions could have been written are written in Lisp; the few exceptions could have been written
in Lisp but are written in C for efficiency. Although only a programmer in Lisp but are written in C for efficiency. Although only a programmer
can write an extension, anybody can use it afterward. If you want to can write an extension, anybody can use it afterward. @xref{Top,
learn Emacs Lisp programming, we recommend the @cite{Introduction to Emacs Lisp Intro, Preface, eintr, An Introduction to Programming in
Emacs Lisp} by Robert J. Chassell, also published by the Free Software Emacs Lisp}, if you want to learn Emacs Lisp programming.
Foundation.
When run under the X Window System, Emacs provides its own menus and When run under the X Window System, Emacs provides its own menus and
convenient bindings to mouse buttons. But Emacs can provide many of the convenient bindings to mouse buttons. But Emacs can provide many of the
@ -1189,7 +1193,7 @@ edit files while running shell commands.
@display @display
Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc. Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed. of this license document, but changing it is not allowed.
@ -1535,7 +1539,7 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License along You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc., with this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
@end smallexample @end smallexample
Also add information on how to contact you by electronic and paper mail. Also add information on how to contact you by electronic and paper mail.

6
man/fixit.texi
View file

@ -203,13 +203,11 @@ is useful for editing programs. Type @kbd{M-x flyspell-prog-mode} to
enable or disable this mode in the current buffer. enable or disable this mode in the current buffer.
The other Emacs spell-checking features check or look up words when The other Emacs spell-checking features check or look up words when
you give an explicit command to do so. Checking all or part of the you give an explicit command to do so.
buffer is useful when you have text that was written outside of this
Emacs session and might contain any number of misspellings.
@kindex M-$ @kindex M-$
@findex ispell-word @findex ispell-word
To check the spelling of the word around or next to point, and To check the spelling of the word around or before point, and
optionally correct it as well, use the command @kbd{M-$} optionally correct it as well, use the command @kbd{M-$}
(@code{ispell-word}). If the word is not correct, the command offers (@code{ispell-word}). If the word is not correct, the command offers
you various alternatives for what to do about it. you various alternatives for what to do about it.

229
man/org.texi
View file

@ -4,8 +4,8 @@
@setfilename ../info/org @setfilename ../info/org
@settitle Org Mode Manual @settitle Org Mode Manual
@set VERSION 3.08 @set VERSION 3.09
@set DATE April 2005 @set DATE May 2005
@dircategory Emacs @dircategory Emacs
@direntry @direntry
@ -156,7 +156,7 @@ Miscellaneous
* Completion:: M-TAB knows what you need * Completion:: M-TAB knows what you need
* Customization:: Adapting Org-mode to your taste * Customization:: Adapting Org-mode to your taste
* Tips and Tricks:: An author-imposed FAQ, sort of * FAQ:: Frequently asked questions
* Interaction:: Other Emacs packages * Interaction:: Other Emacs packages
* Acknowledgments:: These people provided feedback and more * Acknowledgments:: These people provided feedback and more
* Bugs:: Things which do not work perfectly * Bugs:: Things which do not work perfectly
@ -224,19 +224,23 @@ and example files. This page is located at
@cindex global keybindings @cindex global keybindings
@cindex keybindings, global @cindex keybindings, global
The instructions below assume that you have downloaded Org-mode from If Org-mode is part of the Emacs distribution or an XEmacs package,
the web. If Org-mode is part of the Emacs distribution or an XEmacs you only need to copy the following lines to your @file{.emacs} file.
package, you only need to add to @file{.emacs} the last three Lisp The last two lines define @emph{global} keys for the commands
lines below - all the rest will be taken care of automatically. @command{org-store-link} and @command{org-agenda} - please choose
suitable keys yourself.
Byte-compile @file{org.el} and put it on your load path. If you'd @lisp
like to use the Info documentation, copy the file @file{org} into the ;; The following lines are always needed. Choose your own keys.
directory containing info files and run the command @code{install-info (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
org}. (define-key global-map "\C-cl" 'org-store-link)
(define-key global-map "\C-ca" 'org-agenda)
@end lisp
Then copy the following lines into @file{.emacs}. The last two lines If you have downloaded Org-mode from the Web, you must byte-compile
define @emph{global} keys for the commands @command{org-store-link} @file{org.el} and put it on your load path. In addition to the Emacs
and @command{org-agenda} - please choose suitable keys yourself. Lisp lines above, you also need to add the following lines to
@file{.emacs}:
@lisp @lisp
;; These lines only if org-mode is not part of the X/Emacs distribution. ;; These lines only if org-mode is not part of the X/Emacs distribution.
@ -246,17 +250,12 @@ and @command{org-agenda} - please choose suitable keys yourself.
(autoload 'org-store-link "org" "Store a link to the current location" t) (autoload 'org-store-link "org" "Store a link to the current location" t)
(autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
(autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
;; The following lines are always needed. Choose your own keys.
(add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
(define-key global-map "\C-cl" 'org-store-link)
(define-key global-map "\C-ca" 'org-agenda)
@end lisp @end lisp
@cindex org-mode, turning on @cindex org-mode, turning on
@noindent With this setup, all files with extension @samp{.org} will be put into
This will put all files with extension @samp{.org} into Org-mode. As Org-mode. As an alternative, make the first line of a file look like
an alternative, make the first line of a file look like this: this:
@example @example
MY PROJECTS -*- mode: org; -*- MY PROJECTS -*- mode: org; -*-
@ -290,7 +289,6 @@ with clear information about:
@end enumerate @end enumerate
@noindent Thanks for helping to improve this mode. @noindent Thanks for helping to improve this mode.
@node Document Structure, Tables, Introduction, Top @node Document Structure, Tables, Introduction, Top
@chapter Document Structure @chapter Document Structure
@cindex document structure @cindex document structure
@ -500,7 +498,8 @@ An important feature of Org-mode is the ability to construct
@emph{sparse trees} for selected information in an outline tree. A @emph{sparse trees} for selected information in an outline tree. A
sparse tree means that the entire document is folded as much as sparse tree means that the entire document is folded as much as
possible, but the selected information is made visible along with the possible, but the selected information is made visible along with the
headline structure above it. Just try it out and you will see headline structure above it@footnote{See also the variable
@code{org-show-following-heading}}. Just try it out and you will see
immediately how it works. immediately how it works.
Org-mode contains several commands creating such trees. The most Org-mode contains several commands creating such trees. The most
@ -1394,8 +1393,8 @@ commands}.
@cindex agenda @cindex agenda
An agenda can be compiled from one or more org files. The main An agenda can be compiled from one or more org files. The main
purpose of this command is to act like a planner, in order to show you purpose of this command is to act like a paper agenda, showing you all
what tasks are up for the current week, similar to a paper agenda. the tasks for the current day or week.
The Org-mode files to be processed in order to generate the agenda are The Org-mode files to be processed in order to generate the agenda are
listed in the variable @code{org-agenda-files}. You can customize listed in the variable @code{org-agenda-files}. You can customize
@ -1441,7 +1440,7 @@ In the agenda buffer, each entry is preceded by a @emph{category},
which is derived from the file name. The category can also be set which is derived from the file name. The category can also be set
with a special line anywhere in the buffer, looking like this: with a special line anywhere in the buffer, looking like this:
@example @example
#+CATEGORY: Cheops #+CATEGORY: Thesis
@end example @end example
@noindent @noindent
After changing this line, press @kbd{C-c C-c} with the cursor still in After changing this line, press @kbd{C-c C-c} with the cursor still in
@ -1452,6 +1451,53 @@ Emacs.
The display in the agenda buffer looks best if the category is not The display in the agenda buffer looks best if the category is not
longer than 10 characters. longer than 10 characters.
@subsection Time Specifications
Org-mode checks each agenda item for a time specification. The time
can be part of the time stamp that triggered inclusion into the agenda,
for example as in @w{@samp{<2005-05-10 Tue 19:00>}}. Time ranges can
be specified with two time stamps, like
@c
@w{@samp{<2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>}}.
In the headline of the entry itself, a time(range) may also appear as
plain text (like @samp{12:45} or a @samp{8:30-1pm}. If the agenda
integrates the Emacs diary (@pxref{Calendar/Diary integration}), time
specifications in diary entries are recognized as well.
For agenda display, Org-mode extracts the time and displays it in a
standard 24 hour format as part of the prefix. The example times in
the previous paragraphs would end up in the agenda like this:
@example
8:30-13:00 Arthur Dent lies in front of the bulldozer
12:45...... Ford Prefect arrives and takes Arthur to the pub
19:00...... The Vogon reads his poem
20:30-22:15 Marwin escorts the Hitchhikers to the bridge
@end example
If the agenda is in single-day mode, or for the display of today, the
timed entries are embedded in a time grid, like
@example
8:00...... ------------------
8:30-13:00 Arthur Dent lies in front of the bulldozer
10:00...... ------------------
12:00...... ------------------
12:45...... Ford Prefect arrives and takes Arthur to the pub
14:00...... ------------------
16:00...... ------------------
18:00...... ------------------
19:00...... The Vogon reads his poem
20:00...... ------------------
20:30-22:15 Marwin escorts the Hitchhikers to the bridge
@end example
The time grid can be turned on and off with the variable
@code{org-agenda-use-time-grid}, and can be configured with
@code{org-agenda-time-grid}.
@subsection Sorting of agenda items @subsection Sorting of agenda items
@cindex sorting, of agenda items @cindex sorting, of agenda items
@cindex priorities, of agenda items @cindex priorities, of agenda items
@ -1462,13 +1508,6 @@ These entries will be shown at the beginning of the list, as a
categories, in the sequence given by @code{org-agenda-files}. Within categories, in the sequence given by @code{org-agenda-files}. Within
each category, items are sorted by priority (@pxref{Priorities}). each category, items are sorted by priority (@pxref{Priorities}).
A time-of-day specification looks like @samp{12:45} or @samp{3pm} and
must appear in the headline. For example, a timestamp in a headline
that contains not only a date but also a time will trigger this
mechanism. Specifications of a time in diary entries are recognized
as well, so the schedule will be mixed from diary entries and Org-mode
files.
The priority is a numerical quantity composed of the base priority The priority is a numerical quantity composed of the base priority
(2000 for priority @samp{A}, 1000 for @samp{B}, and 0 for @samp{C}), (2000 for priority @samp{A}, 1000 for @samp{B}, and 0 for @samp{C}),
plus additional increments for overdue scheduled or deadline items. plus additional increments for overdue scheduled or deadline items.
@ -1539,6 +1578,11 @@ Toggle between weekly and daily view.
@item d @item d
Toggle the inclusion of diary entries. See @ref{Calendar/Diary integration}. Toggle the inclusion of diary entries. See @ref{Calendar/Diary integration}.
@kindex g
@item g
Toggle the time grid on and off. See also the variables
@code{org-agenda-use-time-grid} and @code{org-agenda-time-grid}.
@kindex r @kindex r
@item r @item r
Recreate the agenda buffer, for example to reflect the changes Recreate the agenda buffer, for example to reflect the changes
@ -1914,7 +1958,7 @@ Toggle the COMMENT keyword at the beginning of an entry.
@menu @menu
* Completion:: M-TAB knows what you need * Completion:: M-TAB knows what you need
* Customization:: Adapting Org-mode to your taste * Customization:: Adapting Org-mode to your taste
* Tips and Tricks:: An author-imposed FAQ, sort of * FAQ:: Frequently asked questions
* Interaction:: Other Emacs packages * Interaction:: Other Emacs packages
* Acknowledgments:: These people provided feedback and more * Acknowledgments:: These people provided feedback and more
* Bugs:: Things which do not work perfectly * Bugs:: Things which do not work perfectly
@ -1950,7 +1994,7 @@ Elsewhere, complete dictionary words using ispell.
@end itemize @end itemize
@end table @end table
@node Customization, Tips and Tricks, Completion, Miscellaneous @node Customization, FAQ, Completion, Miscellaneous
@section Customization @section Customization
@cindex customization @cindex customization
@cindex options, for customization @cindex options, for customization
@ -1962,64 +2006,36 @@ describing the variables here. For an overview of customization
variables, use @kbd{M-x org-customize}. Or select @code{Browse Org variables, use @kbd{M-x org-customize}. Or select @code{Browse Org
Group} from the @code{Org->Customization} menu. Group} from the @code{Org->Customization} menu.
@node Tips and Tricks, Interaction, Customization, Miscellaneous @node FAQ, Interaction, Customization, Miscellaneous
@section Tips and Tricks @section Frequently asked questions
@itemize @bullet
@cindex README files
@item
I find Org-mode very useful for the many @file{README} files I have
scattered through my directories. So I turn on @file{org-mode} for
all @file{README} files with
@enumerate
@item @b{Org-mode seems to be useful default mode for the various
@file{README} files I have scattered through my directories. How do I
turn it on for all @file{README} files?}
@example @example
(add-to-list 'auto-mode-alist '("README$" . org-mode)) (add-to-list 'auto-mode-alist '("README$" . org-mode))
@end example @end example
@ignore @item @b{I would like to have two windows on the same Org-mode
@cindex files, adding automatically file, but with different outline visibility. Is that possible?}@*
@item
If you would like to add all org files you ever create to the list of
agenda files@footnote{Think twice. Do you @emph{really} want this?},
you could do so with
@lisp
(add-hook 'org-mode-hook 'org-add-file)
@end lisp
If you would like to add only a selection, for example everything
except the @file{README} files, this could be achieved in the
following way:
@lisp
(add-hook 'org-mode-hook
(lambda ()
(or (string-match "README\\'" (buffer-file-name))
(org-add-file))))
@end lisp
@end ignore
@cindex @code{make-indirect-buffer} @cindex @code{make-indirect-buffer}
@cindex indirect buffers @cindex indirect buffers
@item In GNU Emacs, you may use @emph{indirect buffers} which do exactly
It can be useful to have two different windows showing the same this. See the documentation on the command
Org-mode file. However, a problem here is that changes to the @code{make-indirect-buffer}. In XEmacs, this is currently not
visibility in one window immediately affect the other window. On possible because of the different outline implementation., which visit
Emacs (not on XEmacs because it uses the old outline-mode) a way out the same file, but have separate settings, also for outline
is the use of @emph{indirect buffers}, which visit the same file, but visibility.
have separate settings, also for outline visibility. See the
documentation on the command @code{make-indirect-buffer}.
@item @b{Is there an easy way to insert links to web locations?}@*
@cindex URL, paste into buffer @cindex URL, paste into buffer
@item Sure, just paste them into the buffer. A plain-text URL-like string
Paste URLs into Org-mode whenever this seems useful. For example, if is directly interpreted as a link.
you are writing notes about a paper which is available on the web, put
the corresponding URL there and a direct look at the paper is only a
mouse click away. If you have a local copy of the paper, use a
file:path link.
@cindex headline levels, for export @item @b{When I export my TODO list, every TODO item becomes a
@item separate section. How do I enforce these items to be exported as an
itemized list?}@*
If you plan to use ASCII or HTML export, make sure things you want to If you plan to use ASCII or HTML export, make sure things you want to
be exported as item lists are level 4 at least, even if that does mean be exported as item lists are level 4 at least, even if that does mean
there is a level jump. For example there is a level jump. For example
@ -2039,44 +2055,34 @@ configure the @samp{H} switch.
+OPTIONS: H:2; ... +OPTIONS: H:2; ...
@end example @end example
@item @b{I would like to export only a subtree of my file to HTML. How?}@*
@cindex exporting a subtree @cindex exporting a subtree
@item
If you want to export a subtree, mark the subtree as region and then If you want to export a subtree, mark the subtree as region and then
export. Marking can be done with @kbd{C-c @@ C-x C-x}, for example. export. Marking can be done with @kbd{C-c @@ C-x C-x}, for example.
@item @b{Is there an easy way to insert an empty table template with a
default number of rows and columns?}@*
@cindex table, empty template @cindex table, empty template
@item
To insert an empty table template, just type @samp{|-} and use To insert an empty table template, just type @samp{|-} and use
@key{TAB}. @key{TAB}. The default size can be changed with the variable
@code{org-table-default-size}.
@item @item @b{When I am in the last column of a table and just above a
In a table, to add a new column at the end, just type some text horizontal line in the table, pressing TAB creates a new table line
anywhere after the final @samp{|}. Upon the next re-align, a new @i{before} the horizontal line. How can I quickly move to the line
column will be created. @i{below} the horizontal line instead?}@*
Press @key{down} (to get on the separator line) and then @key{TAB}.
@item
In tables, @key{TAB} creates new rows before horizontal separator lines. If
the cursor is at @samp{Age} in the following table,
@example
| Name | Phone | Age |
|-------+-------+-----|
| | | |
@end example
the next @key{TAB} would create a second header line. If you want
instead to go to the first empty field below the horizontal line,
press @key{down} (to get on the separator line) and then @key{TAB}.
@item @b{How can I change the indentation of an entire table without
fixing every line by hand?}@*
@cindex indentation, of tables @cindex indentation, of tables
@item The indentation of a table is set by the first line. So just fix the
To change the indentation of a table, just change the first line and indentation of the first line and realign with @key{TAB}.
realign with @key{TAB}.
@end itemize @end enumerate
@node Interaction, Acknowledgments, Tips and Tricks, Miscellaneous @node Interaction, Acknowledgments, FAQ, Miscellaneous
@section Interaction with other packages @section Interaction with other packages
@cindex packages, interaction with other @cindex packages, interaction with other
@cindex @file{planner.el} @cindex @file{planner.el}
@ -2143,6 +2149,9 @@ Oliver Oppitz sent several useful suggestions.
Carsten Wimmer suggested some changes and helped fix a bug in linking Carsten Wimmer suggested some changes and helped fix a bug in linking
to GNUS. to GNUS.
@item @item
Pavel Chalmoviansky reported bugs and suggested improvements related
to the agenda treatment of items with specifed time.
@item
Stefan Monnier provided a patch with lots of little fixes to keep the Stefan Monnier provided a patch with lots of little fixes to keep the
Emacs-Lisp compiler happy. Emacs-Lisp compiler happy.
@end itemize @end itemize

2
man/widget.texi
View file

@ -596,7 +596,7 @@ such a string.
@vindex follow-link@r{ keyword} @vindex follow-link@r{ keyword}
@item :follow-link @item :follow-link
Specifies how to interpret a @key{mouse-1} click on the widget. Specifies how to interpret a @key{mouse-1} click on the widget.
@xref{Enabling Mouse-1 to Follow Links,,, elisp, the Emacs Lisp Reference Manual}. @xref{Links and Mouse-1,,, elisp, the Emacs Lisp Reference Manual}.
@vindex indent@r{ keyword} @vindex indent@r{ keyword}
@item :indent @item :indent

7
nt/ChangeLog
View file

@ -1,3 +1,10 @@
2005-05-24 Juanma Barranquero <lekktu@gmail.com>
* INSTALL: Add more pointers to ports of Unix tools to Windows,
and to the Emacs Wiki (which contains building instructions for
Windows). Reword image library instructions and remove obsolete
incompatibility information.
2005-04-23 David Hunter <hunterd42@comcast.net> (tiny change) 2005-04-23 David Hunter <hunterd42@comcast.net> (tiny change)
* config.nt (HAVE_PWD_H): Undef. * config.nt (HAVE_PWD_H): Undef.

44
nt/INSTALL
View file

@ -1,7 +1,7 @@
Building and Installing Emacs Building and Installing Emacs
on Windows NT/2K/XP and Windows 95/98/ME on Windows NT/2K/XP and Windows 95/98/ME
Copyright (c) 2001,2004 Free Software Foundation, Inc. Copyright (c) 2001,2004,2005 Free Software Foundation, Inc.
See the end of the file for copying permissions. See the end of the file for copying permissions.
If you used WinZip to unpack the distribution, we suggest to If you used WinZip to unpack the distribution, we suggest to
@ -21,9 +21,9 @@
in your path, and that it will create files that do not yet exist. in your path, and that it will create files that do not yet exist.
To compile Emacs, you will need either Microsoft Visual C++ 2.0 or To compile Emacs, you will need either Microsoft Visual C++ 2.0 or
later and nmake, or a Windows port of GCC 2.95 or later with Mingw later and nmake, or a Windows port of GCC 2.95 or later with MinGW
and W32 API support and a port of GNU make. You can use the Cygwin and W32 API support and a port of GNU make. You can use the Cygwin
ports of GCC, but Emacs requires the Mingw headers and libraries to ports of GCC, but Emacs requires the MinGW headers and libraries to
build (latest versions of the Cygwin toolkit, at least since v1.3.3, build (latest versions of the Cygwin toolkit, at least since v1.3.3,
include the MinGW headers and libraries as an integral part). include the MinGW headers and libraries as an integral part).
@ -34,14 +34,22 @@
like this, we recommend the use of the supported compilers mentioned like this, we recommend the use of the supported compilers mentioned
in the previous paragraph. in the previous paragraph.
You will also need a copy of the Posix cp, rm and mv programs. These You will also need a copy of the Posix cp, rm and mv programs. These
and other useful Posix utilities can be obtained from the Mingw or and other useful Posix utilities can be obtained from one of several
Cygwin projects. projects:
* http://www.mingw.org/ ( MinGW )
* http://www.cygwin.com/ ( Cygwin )
* http://unxutils.sourceforge.net/ ( UnxUtils )
* http://gnuwin32.sourceforge.net/ ( GnuWin32 )
If you build Emacs on Windows 9X or ME, not on Windows 2K/XP or If you build Emacs on Windows 9X or ME, not on Windows 2K/XP or
Windows NT, we suggest to install the Cygwin port of Bash. Windows NT, we suggest to install the Cygwin port of Bash.
Please see http://www.mingw.org for pointers to GCC/Mingw and binaries. Additional instructions and help for building Emacs on Windows can be
found at the Emacs Wiki:
http://www.emacswiki.org/cgi-bin/wiki/WThirtyTwoInstallationKit
For reference, here is a list of which builds of GNU make are known For reference, here is a list of which builds of GNU make are known
to work or not, and whether they work in the presence and/or absence to work or not, and whether they work in the presence and/or absence
@ -109,9 +117,13 @@
able to detect the headers. able to detect the headers.
To use the external image support, the DLLs implementing the To use the external image support, the DLLs implementing the
functionality must be found when Emacs is started, either on the PATH, functionality must be found when Emacs first needs them, either on the
or in the same directory as emacs.exe. Failure to find a library is PATH, or in the same directory as emacs.exe. Failure to find a
not an error; the associated image format will simply be unavailable. library is not an error; the associated image format will simply be
unavailable. Note that once Emacs has determined that a library can
not be found, there's no way to force it to try again, other than
restarting. See the variable `image-library-alist' to configure the
expected names of the libraries.
Some image libraries have dependencies on one another, or on zlib. Some image libraries have dependencies on one another, or on zlib.
For example, tiff support depends on the jpeg library. If you did not For example, tiff support depends on the jpeg library. If you did not
@ -120,14 +132,8 @@
compatible (for example, that they were built with the same compiler). compatible (for example, that they were built with the same compiler).
Binaries for the image libraries (among many others) can be found at Binaries for the image libraries (among many others) can be found at
GnuWin32 (http://gnuwin32.sourceforge.net). These are built with the GnuWin32 project. These are built with MinGW, but they can be
MinGW, and so are very compatible with GCC/MinGW builds of Emacs (like used with both GCC/MinGW and MSVC builds of Emacs.
the official binary tarballs for Windows). Compatibility with MSVC,
on the other hand, is still weak and should not be trusted in
production environments; if you really need an MSVC-compiled Emacs
with image support, you should try to build the required libraries
with the same compiler (though it can be extremely non-trivial, and
we'll be interested on hearing of any such effort).
* Building * Building
@ -162,7 +168,7 @@
* Trouble-shooting * Trouble-shooting
The main problems that are likely to be encountered when building The main problems that are likely to be encountered when building
Emacs stem from using an old version of GCC, or old Mingw or W32 API Emacs stem from using an old version of GCC, or old MinGW or W32 API
headers. Additionally, cygwin ports of GNU make may require the Emacs headers. Additionally, cygwin ports of GNU make may require the Emacs
source tree to be mounted with text!=binary, because the makefiles source tree to be mounted with text!=binary, because the makefiles
generated by configure.bat necessarily use DOS line endings. Also, generated by configure.bat necessarily use DOS line endings. Also,

66
src/ChangeLog
View file

@ -1,6 +1,70 @@
2005-05-24 Masatake YAMATO <jet@gyve.org>
* xdisp.c (note_mode_line_or_margin_highlight): Use b and e
as loop sentinels.
2005-05-24 Nick Roberts <nickrob@snap.net.nz>
* xmenu.c (Fx_popup_dialog): Add a third boolean argument to
select frame title ("Question"/"Information").
(xdialog_show): Use it.
* macmenu.c (Fx_popup_dialog, mac_dialog_show): As for xmenu.c.
* w32menu.c (Fx_popup_dialog, w32_dialog_show): As for xmenu.c.
* fns.c (Fyes_or_no_p, Fy_or_n_p): Call Fx_popup_dialog with
a third argument (Qnil).
* lisp.h: x-popup-dialog can have three arguments.
* editfns.c (Fmessage_box): Use "Information" for frame title.
2005-05-23 Thien-Thi Nguyen <ttn@gnu.org>
* termcap.c [VMS]: Include <starlet.h>.
2005-05-23 Masatake YAMATO <jet@gyve.org>
* xdisp.c (note_mode_line_or_margin_highlight): Added code
for mouse-face. Change the type of the first argument from `window'
to `List_Object'.
(note_mouse_highlight): Call note_mode_line_or_margin_highlight with
window instead of w.
2005-05-22 Andreas Schwab <schwab@suse.de>
* process.c (send_process): Move misplaced volatile.
2005-05-21 Richard M. Stallman <rms@gnu.org>
* xdisp.c (display_mode_element): If we're processing a list and
padding is specified, put it after the last element.
2005-05-21 Eli Zaretskii <eliz@gnu.org>
* fileio.c (Fexpand_file_name) [DOS_NT]: Don't try to support
"superroot" on DOS_NT systems.
2005-05-21 David Hunter <hunterd42@comcast.net> (tiny change)
* process.c (send_process): Restore the SIGPIPE handler if we
catch a SIGPIPE.
2005-05-20 Juanma Barranquero <lekktu@gmail.com>
* image.c (lookup_image, png_read_from_memory): Remove hacks (and
misleading comments).
(DEF_IMGLIB_FN): Use C calling convention for image libraries.
2005-05-20 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
* window.c (Fwindow_inside_edges, Fwindow_inside_pixel_edges):
Correct the right value.
2005-05-19 Nick Roberts <nickrob@snap.net.nz> 2005-05-19 Nick Roberts <nickrob@snap.net.nz>
* keyboard.c (syms_of_keyboard): Remove lisp variables * keyboard.c (syms_of_keyboard): Remove Lisp variables
post-command-idle-hook and post-command-idle-delay. post-command-idle-hook and post-command-idle-delay.
(command_loop_1): Don't try to execute post-command-idle-hook. (command_loop_1): Don't try to execute post-command-idle-hook.

2
src/alloc.c
View file

@ -1684,7 +1684,7 @@ static int total_string_size;
/* We check for overrun in string data blocks by appending a small /* We check for overrun in string data blocks by appending a small
"cookie" after each allocated string data block, and check for the "cookie" after each allocated string data block, and check for the
presense of this cookie during GC. */ presence of this cookie during GC. */
#define GC_STRING_OVERRUN_COOKIE_SIZE 4 #define GC_STRING_OVERRUN_COOKIE_SIZE 4
static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =

2
src/editfns.c
View file

@ -3307,7 +3307,7 @@ usage: (message-box STRING &rest ARGS) */)
pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil); pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
GCPRO1 (pane); GCPRO1 (pane);
menu = Fcons (val, pane); menu = Fcons (val, pane);
obj = Fx_popup_dialog (Qt, menu); obj = Fx_popup_dialog (Qt, menu, Qt);
UNGCPRO; UNGCPRO;
return val; return val;
} }

10
src/fileio.c
View file

@ -1655,8 +1655,16 @@ See also the function `substitute-in-file-name'. */)
p += 2; p += 2;
} }
else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
/* `/../' is the "superroot" on certain file systems. */ /* `/../' is the "superroot" on certain file systems.
Turned off on DOS_NT systems because they have no
"superroot" and because this causes us to produce
file names like "d:/../foo" which fail file-related
functions of the underlying OS. (To reproduce, try a
long series of "../../" in default_directory, longer
than the number of levels from the root.) */
#ifndef DOS_NT
&& o != target && o != target
#endif
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{ {
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))

4
src/fns.c
View file

@ -2629,7 +2629,7 @@ is nil and `use-dialog-box' is non-nil. */)
Fcons (Fcons (build_string ("No"), Qnil), Fcons (Fcons (build_string ("No"), Qnil),
Qnil)); Qnil));
menu = Fcons (prompt, pane); menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu); obj = Fx_popup_dialog (Qt, menu, Qnil);
answer = !NILP (obj); answer = !NILP (obj);
break; break;
} }
@ -2761,7 +2761,7 @@ is nil, and `use-dialog-box' is non-nil. */)
Qnil)); Qnil));
GCPRO1 (pane); GCPRO1 (pane);
menu = Fcons (prompt, pane); menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu); obj = Fx_popup_dialog (Qt, menu, Qnil);
UNGCPRO; UNGCPRO;
return obj; return obj;
} }

17
src/image.c
View file

@ -1631,11 +1631,6 @@ lookup_image (f, spec)
Lisp_Object spec; Lisp_Object spec;
{ {
struct image_cache *c = FRAME_X_IMAGE_CACHE (f); struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
#ifdef _MSC_VER
/* Work around a problem with MinGW builds of graphics libraries
not honoring calling conventions. */
static
#endif
struct image *img; struct image *img;
int i; int i;
unsigned hash; unsigned hash;
@ -1815,7 +1810,7 @@ forall_images_in_image_cache (f, fn)
#ifdef HAVE_NTGUI #ifdef HAVE_NTGUI
/* Macro for defining functions that will be loaded from image DLLs. */ /* Macro for defining functions that will be loaded from image DLLs. */
#define DEF_IMGLIB_FN(func) FARPROC fn_##func #define DEF_IMGLIB_FN(func) int (FAR CDECL *fn_##func)()
/* Macro for loading those image functions from the library. */ /* Macro for loading those image functions from the library. */
#define LOAD_IMGLIB_FN(lib,func) { \ #define LOAD_IMGLIB_FN(lib,func) { \
@ -5744,12 +5739,6 @@ struct png_memory_storage
PNG_PTR is a pointer to the PNG control structure. Copy LENGTH PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
bytes from the input to DATA. */ bytes from the input to DATA. */
#ifdef _MSC_VER
/* Work around a problem with MinGW builds of graphics libraries
not honoring calling conventions. */
#pragma optimize("g", off)
#endif
static void static void
png_read_from_memory (png_ptr, data, length) png_read_from_memory (png_ptr, data, length)
png_structp png_ptr; png_structp png_ptr;
@ -5766,10 +5755,6 @@ png_read_from_memory (png_ptr, data, length)
tbr->index = tbr->index + length; tbr->index = tbr->index + length;
} }
#ifdef _MSC_VER
/* Restore normal optimization, as specified on the command line. */
#pragma optimize("", on)
#endif
/* Load PNG image IMG for use on frame F. Value is non-zero if /* Load PNG image IMG for use on frame F. Value is non-zero if
successful. */ successful. */

2
src/lisp.h
View file

@ -3136,7 +3136,7 @@ extern Lisp_Object next_single_char_property_change P_ ((Lisp_Object,
/* defined in xmenu.c */ /* defined in xmenu.c */
EXFUN (Fx_popup_menu, 2); EXFUN (Fx_popup_menu, 2);
EXFUN (Fx_popup_dialog, 2); EXFUN (Fx_popup_dialog, 3);
extern void syms_of_xmenu P_ ((void)); extern void syms_of_xmenu P_ ((void));
/* defined in sysdep.c */ /* defined in sysdep.c */

29
src/macmenu.c
View file

@ -823,7 +823,7 @@ cached information about equivalent key sequences. */)
#ifdef HAVE_MENUS #ifdef HAVE_MENUS
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
doc: /* Pop up a dialog box and return user's selection. doc: /* Pop up a dialog box and return user's selection.
POSITION specifies which frame to use. POSITION specifies which frame to use.
This is normally a mouse button event or a window or frame. This is normally a mouse button event or a window or frame.
@ -838,9 +838,12 @@ The return value is VALUE from the chosen item.
An ITEM may also be just a string--that makes a nonselectable item. An ITEM may also be just a string--that makes a nonselectable item.
An ITEM may also be nil--that means to put all preceding items An ITEM may also be nil--that means to put all preceding items
on the left of the dialog box and all following items on the right. on the left of the dialog box and all following items on the right.
\(By default, approximately half appear on each side.) */) \(By default, approximately half appear on each side.)
(position, contents)
Lisp_Object position, contents; If HEADER is non-nil, the frame title for the box is "Information",
otherwise it is "Question". */)
(position, contents, header)
Lisp_Object position, contents, header;
{ {
FRAME_PTR f = NULL; FRAME_PTR f = NULL;
Lisp_Object window; Lisp_Object window;
@ -927,7 +930,7 @@ on the left of the dialog box and all following items on the right.
/* Display them in a dialog box. */ /* Display them in a dialog box. */
BLOCK_INPUT; BLOCK_INPUT;
selection = mac_dialog_show (f, 0, title, &error_name); selection = mac_dialog_show (f, 0, title, header, &error_name);
UNBLOCK_INPUT; UNBLOCK_INPUT;
discard_menu_items (); discard_menu_items ();
@ -2046,10 +2049,10 @@ static char * button_names [] = {
"button6", "button7", "button8", "button9", "button10" }; "button6", "button7", "button8", "button9", "button10" };
static Lisp_Object static Lisp_Object
mac_dialog_show (f, keymaps, title, error) mac_dialog_show (f, keymaps, title, header, error)
FRAME_PTR f; FRAME_PTR f;
int keymaps; int keymaps;
Lisp_Object title; Lisp_Object title, header;
char **error; char **error;
{ {
int i, nb_buttons=0; int i, nb_buttons=0;
@ -2152,11 +2155,17 @@ mac_dialog_show (f, keymaps, title, error)
wv->name = dialog_name; wv->name = dialog_name;
wv->help = Qnil; wv->help = Qnil;
/* Frame title: 'Q' = Question, 'I' = Information.
Can also have 'E' = Error if, one day, we want
a popup for errors. */
if (NILP(header))
dialog_name[0] = 'Q';
else
dialog_name[0] = 'I';
/* Dialog boxes use a really stupid name encoding /* Dialog boxes use a really stupid name encoding
which specifies how many buttons to use which specifies how many buttons to use
and how many buttons are on the right. and how many buttons are on the right. */
The Q means something also. */
dialog_name[0] = 'Q';
dialog_name[1] = '0' + nb_buttons; dialog_name[1] = '0' + nb_buttons;
dialog_name[2] = 'B'; dialog_name[2] = 'B';
dialog_name[3] = 'R'; dialog_name[3] = 'R';

3
src/process.c
View file

@ -5139,6 +5139,7 @@ send_process (proc, buf, len, object)
int rv; int rv;
struct coding_system *coding; struct coding_system *coding;
struct gcpro gcpro1; struct gcpro gcpro1;
SIGTYPE (*volatile old_sigpipe) ();
GCPRO1 (object); GCPRO1 (object);
@ -5256,7 +5257,6 @@ send_process (proc, buf, len, object)
while (len > 0) while (len > 0)
{ {
int this = len; int this = len;
SIGTYPE (*old_sigpipe)();
/* Decide how much data we can send in one batch. /* Decide how much data we can send in one batch.
Long lines need to be split into multiple batches. */ Long lines need to be split into multiple batches. */
@ -5399,6 +5399,7 @@ send_process (proc, buf, len, object)
#endif /* not VMS */ #endif /* not VMS */
else else
{ {
signal (SIGPIPE, old_sigpipe);
#ifndef VMS #ifndef VMS
proc = process_sent_to; proc = process_sent_to;
p = XPROCESS (proc); p = XPROCESS (proc);

1
src/termcap.c
View file

@ -458,6 +458,7 @@ static int name_match ();
#include <rmsdef.h> #include <rmsdef.h>
#include <fab.h> #include <fab.h>
#include <nam.h> #include <nam.h>
#include <starlet.h>
static int static int
valid_filename_p (fn) valid_filename_p (fn)

29
src/w32menu.c
View file

@ -845,7 +845,7 @@ cached information about equivalent key sequences. */)
#ifdef HAVE_MENUS #ifdef HAVE_MENUS
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
doc: /* Pop up a dialog box and return user's selection. doc: /* Pop up a dialog box and return user's selection.
POSITION specifies which frame to use. POSITION specifies which frame to use.
This is normally a mouse button event or a window or frame. This is normally a mouse button event or a window or frame.
@ -860,9 +860,12 @@ The return value is VALUE from the chosen item.
An ITEM may also be just a string--that makes a nonselectable item. An ITEM may also be just a string--that makes a nonselectable item.
An ITEM may also be nil--that means to put all preceding items An ITEM may also be nil--that means to put all preceding items
on the left of the dialog box and all following items on the right. on the left of the dialog box and all following items on the right.
\(By default, approximately half appear on each side.) */) \(By default, approximately half appear on each side.)
(position, contents)
Lisp_Object position, contents; If HEADER is non-nil, the frame title for the box is "Information",
otherwise it is "Question". */)
(position, contents, header)
Lisp_Object position, contents, header;
{ {
FRAME_PTR f = NULL; FRAME_PTR f = NULL;
Lisp_Object window; Lisp_Object window;
@ -949,7 +952,7 @@ on the left of the dialog box and all following items on the right.
/* Display them in a dialog box. */ /* Display them in a dialog box. */
BLOCK_INPUT; BLOCK_INPUT;
selection = w32_dialog_show (f, 0, title, &error_name); selection = w32_dialog_show (f, 0, title, header, &error_name);
UNBLOCK_INPUT; UNBLOCK_INPUT;
discard_menu_items (); discard_menu_items ();
@ -1995,10 +1998,10 @@ static char * button_names [] = {
"button6", "button7", "button8", "button9", "button10" }; "button6", "button7", "button8", "button9", "button10" };
static Lisp_Object static Lisp_Object
w32_dialog_show (f, keymaps, title, error) w32_dialog_show (f, keymaps, title, header, error)
FRAME_PTR f; FRAME_PTR f;
int keymaps; int keymaps;
Lisp_Object title; Lisp_Object title, header;
char **error; char **error;
{ {
int i, nb_buttons=0; int i, nb_buttons=0;
@ -2099,11 +2102,17 @@ w32_dialog_show (f, keymaps, title, error)
wv->name = dialog_name; wv->name = dialog_name;
wv->help = Qnil; wv->help = Qnil;
/* Frame title: 'Q' = Question, 'I' = Information.
Can also have 'E' = Error if, one day, we want
a popup for errors. */
if (NILP(header))
dialog_name[0] = 'Q';
else
dialog_name[0] = 'I';
/* Dialog boxes use a really stupid name encoding /* Dialog boxes use a really stupid name encoding
which specifies how many buttons to use which specifies how many buttons to use
and how many buttons are on the right. and how many buttons are on the right. */
The Q means something also. */
dialog_name[0] = 'Q';
dialog_name[1] = '0' + nb_buttons; dialog_name[1] = '0' + nb_buttons;
dialog_name[2] = 'B'; dialog_name[2] = 'B';
dialog_name[3] = 'R'; dialog_name[3] = 'R';

4
src/window.c
View file

@ -544,7 +544,7 @@ display margins, fringes, header line, and/or mode line. */)
+ WINDOW_LEFT_FRINGE_COLS (w)), + WINDOW_LEFT_FRINGE_COLS (w)),
make_number (WINDOW_TOP_EDGE_LINE (w) make_number (WINDOW_TOP_EDGE_LINE (w)
+ WINDOW_HEADER_LINE_LINES (w)), + WINDOW_HEADER_LINE_LINES (w)),
make_number (WINDOW_RIGHT_EDGE_COL (w) make_number (WINDOW_BOX_RIGHT_EDGE_COL (w)
- WINDOW_RIGHT_MARGIN_COLS (w) - WINDOW_RIGHT_MARGIN_COLS (w)
- WINDOW_RIGHT_FRINGE_COLS (w)), - WINDOW_RIGHT_FRINGE_COLS (w)),
make_number (WINDOW_BOTTOM_EDGE_LINE (w) make_number (WINDOW_BOTTOM_EDGE_LINE (w)
@ -568,7 +568,7 @@ display margins, fringes, header line, and/or mode line. */)
+ WINDOW_LEFT_FRINGE_WIDTH (w)), + WINDOW_LEFT_FRINGE_WIDTH (w)),
make_number (WINDOW_TOP_EDGE_Y (w) make_number (WINDOW_TOP_EDGE_Y (w)
+ WINDOW_HEADER_LINE_HEIGHT (w)), + WINDOW_HEADER_LINE_HEIGHT (w)),
make_number (WINDOW_RIGHT_EDGE_X (w) make_number (WINDOW_BOX_RIGHT_EDGE_X (w)
- WINDOW_RIGHT_MARGIN_WIDTH (w) - WINDOW_RIGHT_MARGIN_WIDTH (w)
- WINDOW_RIGHT_FRINGE_WIDTH (w)), - WINDOW_RIGHT_FRINGE_WIDTH (w)),
make_number (WINDOW_BOTTOM_EDGE_Y (w) make_number (WINDOW_BOTTOM_EDGE_Y (w)

133
src/xdisp.c
View file

@ -16134,7 +16134,12 @@ display_mode_element (it, depth, field_width, precision, elt, props, risky)
&& --limit > 0 && --limit > 0
&& (precision <= 0 || n < precision)) && (precision <= 0 || n < precision))
{ {
n += display_mode_element (it, depth, field_width - n, n += display_mode_element (it, depth,
/* Do padding only after the last
element in the list. */
(! CONSP (XCDR (elt))
? field_width - n
: 0),
precision - n, XCAR (elt), precision - n, XCAR (elt),
props, risky); props, risky);
elt = XCDR (elt); elt = XCDR (elt);
@ -21378,11 +21383,12 @@ define_frame_cursor1 (f, cursor, pointer)
position relative to the start of the mode line. */ position relative to the start of the mode line. */
static void static void
note_mode_line_or_margin_highlight (w, x, y, area) note_mode_line_or_margin_highlight (window, x, y, area)
struct window *w; Lisp_Object window;
int x, y; int x, y;
enum window_part area; enum window_part area;
{ {
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame); struct frame *f = XFRAME (w->frame);
Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
Cursor cursor = FRAME_X_OUTPUT (f)->nontext_cursor; Cursor cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
@ -21391,9 +21397,38 @@ note_mode_line_or_margin_highlight (w, x, y, area)
Lisp_Object string, object = Qnil; Lisp_Object string, object = Qnil;
Lisp_Object pos, help; Lisp_Object pos, help;
Lisp_Object mouse_face;
int original_x_pixel = x;
struct glyph * glyph = NULL;
struct glyph_row *row;
if (area == ON_MODE_LINE || area == ON_HEADER_LINE) if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
string = mode_line_string (w, area, &x, &y, &charpos, {
&object, &dx, &dy, &width, &height); int x0;
struct glyph *end;
string = mode_line_string (w, area, &x, &y, &charpos,
&object, &dx, &dy, &width, &height);
row = (area == ON_MODE_LINE
? MATRIX_MODE_LINE_ROW (w->current_matrix)
: MATRIX_HEADER_LINE_ROW (w->current_matrix));
/* Find glyph */
if (row->mode_line_p && row->enabled_p)
{
glyph = row->glyphs[TEXT_AREA];
end = glyph + row->used[TEXT_AREA];
for (x0 = original_x_pixel;
glyph < end && x0 >= glyph->pixel_width;
++glyph)
x0 -= glyph->pixel_width;
if (glyph >= end)
glyph = NULL;
}
}
else else
{ {
x -= WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w); x -= WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w);
@ -21471,6 +21506,91 @@ note_mode_line_or_margin_highlight (w, x, y, area)
if (!KEYMAPP (map)) if (!KEYMAPP (map))
cursor = dpyinfo->vertical_scroll_bar_cursor; cursor = dpyinfo->vertical_scroll_bar_cursor;
} }
/* Change the mouse face according to what is under X/Y. */
mouse_face = Fget_text_property (pos, Qmouse_face, string);
if (!NILP (mouse_face)
&& ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))
&& glyph)
{
Lisp_Object b, e;
struct glyph * tmp_glyph;
int gpos;
int gseq_length;
int total_pixel_width;
int ignore;
if (clear_mouse_face (dpyinfo))
cursor = No_Cursor;
b = Fprevious_single_property_change (make_number (charpos + 1),
Qmouse_face, string, Qnil);
if (NILP (b))
b = make_number (0);
e = Fnext_single_property_change (pos, Qmouse_face, string, Qnil);
if (NILP (e))
e = make_number (SCHARS (string));
/* Calculate the position(glyph position: GPOS) of GLYPH in
displayed string. GPOS is different from CHARPOS.
CHARPOS is the position of glyph in internal string
object. A mode line string format has structures which
is converted to a flatten by emacs lisp interpreter.
The internal string is an element of the structures.
The displayed string is the flatten string. */
for (tmp_glyph = glyph - 1, gpos = 0;
tmp_glyph->charpos >= XINT (b);
tmp_glyph--, gpos++)
{
if (tmp_glyph->object != glyph->object)
break;
}
/* Calculate the lenght(glyph sequence length: GSEQ_LENGTH) of
displayed string holding GLYPH.
GSEQ_LENGTH is different from SCHARS (STRING).
SCHARS (STRING) returns the length of the internal string. */
for (tmp_glyph = glyph, gseq_length = gpos;
tmp_glyph->charpos < XINT (e);
tmp_glyph++, gseq_length++)
{
if (tmp_glyph->object != glyph->object)
break;
}
total_pixel_width = 0;
for (tmp_glyph = glyph - gpos; tmp_glyph != glyph; tmp_glyph++)
total_pixel_width += tmp_glyph->pixel_width;
dpyinfo->mouse_face_beg_col = (x - gpos);
dpyinfo->mouse_face_beg_row = (area == ON_MODE_LINE
? (w->current_matrix)->nrows - 1
: 0);
dpyinfo->mouse_face_beg_x = original_x_pixel - (total_pixel_width + dx);
dpyinfo->mouse_face_beg_y = 0;
dpyinfo->mouse_face_end_col = (x - gpos) + gseq_length;
dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_beg_row;
dpyinfo->mouse_face_end_x = 0;
dpyinfo->mouse_face_end_y = 0;
dpyinfo->mouse_face_past_end = 0;
dpyinfo->mouse_face_window = window;
dpyinfo->mouse_face_face_id = face_at_string_position (w, string,
charpos,
0, 0, 0, &ignore,
glyph->face_id, 1);
show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
}
} }
define_frame_cursor1 (f, cursor, pointer); define_frame_cursor1 (f, cursor, pointer);
@ -21551,7 +21671,7 @@ note_mouse_highlight (f, x, y)
if (part == ON_MODE_LINE || part == ON_HEADER_LINE if (part == ON_MODE_LINE || part == ON_HEADER_LINE
|| part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN) || part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
{ {
note_mode_line_or_margin_highlight (w, x, y, part); note_mode_line_or_margin_highlight (window, x, y, part);
return; return;
} }
@ -21811,6 +21931,7 @@ note_mouse_highlight (f, x, y)
b = make_number (0); b = make_number (0);
if (NILP (e)) if (NILP (e))
e = make_number (SCHARS (object) - 1); e = make_number (SCHARS (object) - 1);
fast_find_string_pos (w, XINT (b), object, fast_find_string_pos (w, XINT (b), object,
&dpyinfo->mouse_face_beg_col, &dpyinfo->mouse_face_beg_col,
&dpyinfo->mouse_face_beg_row, &dpyinfo->mouse_face_beg_row,

46
src/xmenu.c
View file

@ -116,7 +116,8 @@ extern Lisp_Object Qmenu_bar_update_hook;
extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
extern XtAppContext Xt_app_con; extern XtAppContext Xt_app_con;
static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, Lisp_Object,
char **));
static void popup_get_selection P_ ((XEvent *, struct x_display_info *, static void popup_get_selection P_ ((XEvent *, struct x_display_info *,
LWLIB_ID, int)); LWLIB_ID, int));
@ -129,7 +130,8 @@ static void popup_get_selection P_ ((XEvent *, struct x_display_info *,
#include "gtkutil.h" #include "gtkutil.h"
#define HAVE_BOXES 1 #define HAVE_BOXES 1
extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); extern void set_frame_menubar P_ ((FRAME_PTR, int, int));
static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, Lisp_Object,
char **));
#endif #endif
/* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
@ -999,7 +1001,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#ifdef HAVE_MENUS #ifdef HAVE_MENUS
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
doc: /* Pop up a dialog box and return user's selection. doc: /* Pop up a dialog box and return user's selection.
POSITION specifies which frame to use. POSITION specifies which frame to use.
This is normally a mouse button event or a window or frame. This is normally a mouse button event or a window or frame.
@ -1007,7 +1009,7 @@ If POSITION is t, it means to use the frame the mouse is on.
The dialog box appears in the middle of the specified frame. The dialog box appears in the middle of the specified frame.
CONTENTS specifies the alternatives to display in the dialog box. CONTENTS specifies the alternatives to display in the dialog box.
It is a list of the form (TITLE ITEM1 ITEM2...). It is a list of the form (DIALOG ITEM1 ITEM2...).
Each ITEM is a cons cell (STRING . VALUE). Each ITEM is a cons cell (STRING . VALUE).
The return value is VALUE from the chosen item. The return value is VALUE from the chosen item.
@ -1016,11 +1018,14 @@ An ITEM may also be nil--that means to put all preceding items
on the left of the dialog box and all following items on the right. on the left of the dialog box and all following items on the right.
\(By default, approximately half appear on each side.) \(By default, approximately half appear on each side.)
If HEADER is non-nil, the frame title for the box is "Information",
otherwise it is "Question".
If the user gets rid of the dialog box without making a valid choice, If the user gets rid of the dialog box without making a valid choice,
for instance using the window manager, then this produces a quit and for instance using the window manager, then this produces a quit and
`x-popup-dialog' does not return. */) `x-popup-dialog' does not return. */)
(position, contents) (position, contents, header)
Lisp_Object position, contents; Lisp_Object position, contents, header;
{ {
FRAME_PTR f = NULL; FRAME_PTR f = NULL;
Lisp_Object window; Lisp_Object window;
@ -1115,7 +1120,7 @@ for instance using the window manager, then this produces a quit and
/* Display them in a dialog box. */ /* Display them in a dialog box. */
BLOCK_INPUT; BLOCK_INPUT;
selection = xdialog_show (f, 0, title, &error_name); selection = xdialog_show (f, 0, title, header, &error_name);
UNBLOCK_INPUT; UNBLOCK_INPUT;
unbind_to (specpdl_count, Qnil); unbind_to (specpdl_count, Qnil);
@ -3020,11 +3025,11 @@ static char * button_names [] = {
"button6", "button7", "button8", "button9", "button10" }; "button6", "button7", "button8", "button9", "button10" };
static Lisp_Object static Lisp_Object
xdialog_show (f, keymaps, title, error) xdialog_show (f, keymaps, title, header, error_name)
FRAME_PTR f; FRAME_PTR f;
int keymaps; int keymaps;
Lisp_Object title; Lisp_Object title, header;
char **error; char **error_name;
{ {
int i, nb_buttons=0; int i, nb_buttons=0;
char dialog_name[6]; char dialog_name[6];
@ -3036,11 +3041,11 @@ xdialog_show (f, keymaps, title, error)
/* 1 means we've seen the boundary between left-hand elts and right-hand. */ /* 1 means we've seen the boundary between left-hand elts and right-hand. */
int boundary_seen = 0; int boundary_seen = 0;
*error = NULL; *error_name = NULL;
if (menu_items_n_panes > 1) if (menu_items_n_panes > 1)
{ {
*error = "Multiple panes in dialog box"; *error_name = "Multiple panes in dialog box";
return Qnil; return Qnil;
} }
@ -3077,7 +3082,7 @@ xdialog_show (f, keymaps, title, error)
if (NILP (item_name)) if (NILP (item_name))
{ {
free_menubar_widget_value_tree (first_wv); free_menubar_widget_value_tree (first_wv);
*error = "Submenu in dialog items"; *error_name = "Submenu in dialog items";
return Qnil; return Qnil;
} }
if (EQ (item_name, Qquote)) if (EQ (item_name, Qquote))
@ -3091,7 +3096,7 @@ xdialog_show (f, keymaps, title, error)
if (nb_buttons >= 9) if (nb_buttons >= 9)
{ {
free_menubar_widget_value_tree (first_wv); free_menubar_widget_value_tree (first_wv);
*error = "Too many dialog items"; *error_name = "Too many dialog items";
return Qnil; return Qnil;
} }
@ -3121,11 +3126,18 @@ xdialog_show (f, keymaps, title, error)
wv = xmalloc_widget_value (); wv = xmalloc_widget_value ();
wv->name = dialog_name; wv->name = dialog_name;
wv->help = Qnil; wv->help = Qnil;
/* Frame title: 'Q' = Question, 'I' = Information.
Can also have 'E' = Error if, one day, we want
a popup for errors. */
if (NILP(header))
dialog_name[0] = 'Q';
else
dialog_name[0] = 'I';
/* Dialog boxes use a really stupid name encoding /* Dialog boxes use a really stupid name encoding
which specifies how many buttons to use which specifies how many buttons to use
and how many buttons are on the right. and how many buttons are on the right. */
The Q means something also. */
dialog_name[0] = 'Q';
dialog_name[1] = '0' + nb_buttons; dialog_name[1] = '0' + nb_buttons;
dialog_name[2] = 'B'; dialog_name[2] = 'B';
dialog_name[3] = 'R'; dialog_name[3] = 'R';