Mercurial > emacs
changeset 90195:a1b34dec1104
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-63
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 358-423)
- Update from CVS
- Remove "-face" suffix from widget faces
- Remove "-face" suffix from custom faces
- Remove "-face" suffix from change-log faces
- Remove "-face" suffix from compilation faces
- Remove "-face" suffix from diff-mode faces
- lisp/longlines.el (longlines-visible-face): Face removed
- Remove "-face" suffix from woman faces
- Remove "-face" suffix from whitespace-highlight face
- Remove "-face" suffix from ruler-mode faces
- Remove "-face" suffix from show-paren faces
- Remove "-face" suffix from log-view faces
- Remove "-face" suffix from smerge faces
- Remove "-face" suffix from show-tabs faces
- Remove "-face" suffix from highlight-changes faces
- Remove "-face" suffix from and downcase info faces
- Remove "-face" suffix from pcvs faces
- Update uses of renamed pcvs faces
- Tweak ChangeLog
- Remove "-face" suffix from strokes-char face
- Remove "-face" suffix from compare-windows face
- Remove "-face" suffix from calendar faces
- Remove "-face" suffix from diary-button face
- Remove "-face" suffix from testcover faces
- Remove "-face" suffix from viper faces
- Remove "-face" suffix from org faces
- Remove "-face" suffix from sgml-namespace face
- Remove "-face" suffix from table-cell face
- Remove "-face" suffix from tex-mode faces
- Remove "-face" suffix from texinfo-heading face
- Remove "-face" suffix from flyspell faces
- Remove "-face" suffix from gomoku faces
- Remove "-face" suffix from mpuz faces
- Merge from gnus--rel--5.10
- Remove "-face" suffix from Buffer-menu-buffer face
- Remove "-face" suffix from antlr-mode faces
- Remove "-face" suffix from ebrowse faces
- Remove "-face" suffix from flymake faces
- Remove "-face" suffix from idlwave faces
- Remove "-face" suffix from sh-script faces
- Remove "-face" suffix from vhdl-mode faces
- Remove "-face" suffix from which-func face
- Remove "-face" suffix from cperl-mode faces
- Remove "-face" suffix from ld-script faces
- Fix cperl-mode font-lock problem
- Tweak which-func face
* gnus--rel--5.10 (patch 80-82)
- Merge from emacs--cvs-trunk--0
- Update from CVS
line wrap: on
line diff
--- a/admin/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/admin/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,8 @@ +2005-06-10 Lute Kamstra <lute@gnu.org> + + * admin.el (set-version): Set version in lisp manual too. + * make-tarball.txt: Commit lispref/elisp.texi too. + 2005-06-04 Richard M. Stallman <rms@gnu.org> * emacs-pretesters: Refer to etc/DEBUG instead of duplicating it.
--- a/admin/FOR-RELEASE Thu Jun 09 07:36:24 2005 +0000 +++ b/admin/FOR-RELEASE Wed Jun 15 23:32:15 2005 +0000 @@ -18,7 +18,6 @@ ** Enhance scroll-bar to handle tall line (similar to line-move). -** Adapt mouse-sel-mode to mouse-1-click-follows-link. * FATAL ERRORS @@ -82,6 +81,8 @@ ** Finish updating the Emacs Lisp manual. +*** Update lispref/README. + ** Update the Emacs manual. *** Update man/info.texi. @@ -187,7 +188,7 @@ lispref/customize.texi Chong Yidong lispref/debugging.texi Joakim Verona <joakim@verona.se> Lute Kamstra lispref/display.texi Chong Yidong -lispref/edebug.texi Chong Yidong +lispref/edebug.texi Chong Yidong "Luc Teirlinck" lispref/elisp.texi "Luc Teirlinck" Lute Kamstra lispref/errors.texi "Luc Teirlinck" lispref/eval.texi "Luc Teirlinck" Chong Yidong
--- a/admin/admin.el Thu Jun 09 07:36:24 2005 +0000 +++ b/admin/admin.el Wed Jun 15 23:32:15 2005 +0000 @@ -84,6 +84,9 @@ (submatch (1+ (in "0-9.")))))) (set-version-in-file root "man/emacs.texi" version (rx (and "EMACSVER" (1+ space) + (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "lispref/elisp.texi" version + (rx (and "EMACSVER" (1+ space) (submatch (1+ (in "0-9."))))))) ;;; arch-tag: 4ea83636-2293-408b-884e-ad64f22a3bf5
--- a/admin/make-tarball.txt Thu Jun 09 07:36:24 2005 +0000 +++ b/admin/make-tarball.txt Wed Jun 15 23:32:15 2005 +0000 @@ -22,10 +22,10 @@ 5. rm configure; make bootstrap 6. Commit configure, README, AUTHORS, lisp/cus-load.el, - lisp/finder-inf.el, lisp/version.el, man/emacs.texi. - Copy lisp/loaddefs.el to lisp/ldefs-boot.el and commit - lisp/ldefs-boot.el. For a release, also commit the ChangeLog - files in all directories. + lisp/finder-inf.el, lisp/version.el, man/emacs.texi, + lispref/elisp.texi. Copy lisp/loaddefs.el to lisp/ldefs-boot.el + and commit lisp/ldefs-boot.el. For a release, also commit the + ChangeLog files in all directories. 7. make-dist --snapshot. Check the contents of the new tar with admin/diff-tar-files against an older tar file. Some old pretest
--- a/etc/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/etc/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,13 @@ +2005-06-11 Eli Zaretskii <eliz@gnu.org> + + * DEBUG: Mention emacs-buffer.gdb. + +2005-06-10 Noah Friedman <friedman@splode.com> + + * emacs-buffer.gdb (ybuffer-list): Don't use $filename; can't use + char as placeholder when buffer has no file name and process is + still live. Use different printf cases instead. + 2005-06-08 Kim F. Storm <storm@cua.dk> * PROBLEMS: Linux kernel 2.6.10 may corrupt process output.
--- a/etc/DEBUG Thu Jun 09 07:36:24 2005 +0000 +++ b/etc/DEBUG Wed Jun 15 23:32:15 2005 +0000 @@ -576,6 +576,13 @@ bitfield definitions (which will cause each such field to use a full int). +** How to recover buffer contents from an Emacs core dump file + +The file etc/emacs-buffer.gdb defines a set of GDB commands for +recovering the contents of Emacs buffers from a core dump file. You +might also find those commands useful for displaying the list of +buffers in human-readable format from within the debugger. + ** Some suggestions for debugging on MS Windows: (written by Marc Fleischeuers, Geoff Voelker and Andrew Innes)
--- a/etc/NEWS Thu Jun 09 07:36:24 2005 +0000 +++ b/etc/NEWS Wed Jun 15 23:32:15 2005 +0000 @@ -3140,6 +3140,10 @@ Emacs 21.1, but was not documented then. +++ +*** New function `add-to-ordered-list' is like `add-to-list' but +associates a numeric ordering of each element added to the list. + ++++ *** New function `copy-tree' makes a copy of a tree. It recursively copyies through both CARs and CDRs. @@ -3463,6 +3467,13 @@ --- *** The function `insert-string' is now obsolete. +** Filling changes. + ++++ +*** In determining an adaptive fill prefix, Emacs now tries the function in +`adaptive-fill-function' _before_ matching the buffer line against +`adaptive-fill-regexp' rather than _after_ it. + +++ ** Atomic change groups.
--- a/etc/emacs-buffer.gdb Thu Jun 09 07:36:24 2005 +0000 +++ b/etc/emacs-buffer.gdb Wed Jun 15 23:32:15 2005 +0000 @@ -116,13 +116,13 @@ if $buf->filename != Qnil ygetptr $buf->filename - set $filename = ((struct Lisp_String *) $ptr)->data + printf "%2d %c %9d %-20s %-10s %s\n", \ + $i, $modp, ($buf->text->z_byte - 1), $name, $mode, \ + ((struct Lisp_String *) $ptr)->data else - set $filename = ' ' + printf "%2d %c %9d %-20s %-10s\n", \ + $i, $modp, ($buf->text->z_byte - 1), $name, $mode end - - printf "%2d %c %9d %-20s %-10s %s\n", \ - $i, $modp, ($buf->text->z_byte - 1), $name, $mode, $filename end set $i++
--- a/lib-src/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lib-src/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,13 @@ +2005-06-13 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(DOC)): Fix last change. + +2005-06-12 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(DOC)): Depend on make-docfile.exe, + temacs.exe, and the preloaded *.elc files. This avoids + unnecessary dumping and DOC rebuilding. + 2005-06-04 Eli Zaretskii <eliz@gnu.org> * ntlib.h (fileno): Don't define if already defined.
--- a/lib-src/makefile.w32-in Thu Jun 09 07:36:24 2005 +0000 +++ b/lib-src/makefile.w32-in Wed Jun 15 23:32:15 2005 +0000 @@ -248,7 +248,7 @@ DOC = DOC -$(DOC): make-docfile +$(DOC): $(BLD) $(BLD)/make-docfile.exe ../src/$(BLD)/temacs.exe $(lisp1) $(lisp2) - $(DEL) $(DOC) "$(THISDIR)/$(BLD)/make-docfile" -o $(DOC) -d ../src $(obj) "$(THISDIR)/$(BLD)/make-docfile" -a $(DOC) -d ../src $(lisp1)
--- a/lisp/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,806 @@ +2005-06-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (add-to-ordered-list): Use a weak hash-table to avoid leaks. + +2005-06-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-Preamble): Enclose BibTeX preamble + by field delimiters. + +2005-06-15 David Ponce <david@dponce.com> + + * tree-widget.el: eval-and-compile inlined functions so they will + be available at run-time too. + (tree-widget-super-format-handler) + (tree-widget-format-handler): Remove. + (tree-widget-value-create): Handle the :indent property. + +2005-06-15 Miles Bader <miles@gnu.org> + + * progmodes/which-func.el (which-func): Only inherit + `font-lock-function-name-face' when that makes sense against the + default mode-line face, otherwise set the face color explicitly. + + * progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl + faces instead of (non-existent) variables. + +2005-06-14 Miles Bader <miles@gnu.org> + + * progmodes/ld-script.el (ld-script-location-counter): + Remove "-face" suffix from face name. + (ld-script-location-counter-face): + New backward-compatibility alias for renamed face. + (ld-script-location-counter-face): Use renamed face. + + * progmodes/cperl-mode.el (cperl-nonoverridable, cperl-array) + (cperl-hash): Remove "-face" suffix from face names. + (cperl-nonoverridable-face, cperl-array-face, cperl-hash-face): + New backward-compatibility aliases for renamed faces. + (cperl-find-pods-heres, cperl-init-faces, cperl-ps-print-init) + (cperl-ps-print-face-properties): Use renamed cperl-mode faces. + + * progmodes/which-func.el (which-func): Remove "-face" suffix from face + name. + (which-func-face): New backward-compatibility alias for renamed face. + (which-func-format): Use renamed which-func face. + + * progmodes/vhdl-mode.el (vhdl-prompt, vhdl-attribute, vhdl-enumvalue) + (vhdl-function, vhdl-directive, vhdl-reserved-word) + (vhdl-translate-off): Remove "-face" suffix and "font-lock-" from face + names. + (vhdl-speedbar-entity, vhdl-speedbar-architecture) + (vhdl-speedbar-configuration, vhdl-speedbar-package) + (vhdl-speedbar-library, vhdl-speedbar-instantiation) + (vhdl-speedbar-subprogram, vhdl-speedbar-entity-selected) + (vhdl-speedbar-architecture-selected) + (vhdl-speedbar-configuration-selected) + (vhdl-speedbar-package-selected) + (vhdl-speedbar-instantiation-selected): Remove "-face" suffix from face + names. + (vhdl-font-lock-keywords-2, vhdl-font-lock-keywords-5): + Use renamed faces. + (vhdl-prompt-face, vhdl-attribute-face, vhdl-enumvalue-face) + (vhdl-function-face, vhdl-directive-face, vhdl-reserved-words-face) + (vhdl-translate-off-face): Variables renamed to remove "font-lock-". + Use renamed faces. + (syntax-alist): Don't use "font-lock-" or "-face" in generated face + names. + (vhdl-font-lock-init, vhdl-ps-print-settings): Use renamed faces. + (vhdl-speedbar-insert-hierarchy, vhdl-speedbar-expand-entity) + (vhdl-speedbar-expand-package, vhdl-speedbar-update-current-unit) + (vhdl-speedbar-make-inst-line, vhdl-speedbar-make-pack-line) + (vhdl-speedbar-make-subpack-line, vhdl-speedbar-make-subprogram-line) + (vhdl-speedbar-item-info, vhdl-speedbar-check-unit): Use renamed faces. + + * progmodes/sh-script.el (sh-heredoc): Remove "-face" suffix from + face name. + (sh-heredoc-face): New backward-compatibility alias for renamed face. + (sh-heredoc-face): Use renamed sh-heredoc face. + + * progmodes/idlw-help.el (idlwave-help-link): + Remove "-face" suffix from face name. + (idlwave-help-link-face): + New backward-compatibility alias for renamed face. + (idlwave-highlight-linked-completions): Use renamed idlwave-help faces. + + * progmodes/idlw-shell.el (idlwave-shell-bp-face) + (idlwave-shell-disabled-bp): Remove "-face" suffix from face names. + (idlwave-shell-bp-face, idlwave-shell-disabled-bp): + New backward-compatibility aliases for renamed faces. + (idlwave-shell-disabled-breakpoint-face) + (idlwave-shell-breakpoint-face): Use renamed idlwave-shell faces. + + * progmodes/flymake.el (flymake-errline, flymake-warnline): + Remove "-face" suffix from face names. + (flymake-errline-face, flymake-warnline-face): + New backward-compatibility aliases for renamed faces. + (flymake-highlight-line): Use renamed flymake faces. + + * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class) + (ebrowse-file-name, ebrowse-default, ebrowse-member-attribute) + (ebrowse-member-class, ebrowse-progress): + Remove "-face" suffix from face names. + (ebrowse-tree-mark-face, ebrowse-root-class-face) + (ebrowse-file-name-face, ebrowse-default-face) + (ebrowse-member-attribute-face, ebrowse-member-class-face) + (ebrowse-progress-face): + New backward-compatibility aliases for renamed faces. + (ebrowse-show-progress, ebrowse-show-file-name-at-point) + (ebrowse-set-mark-props, ebrowse-draw-tree-fn) + (ebrowse-draw-member-buffer-class-line, ebrowse-draw-member-long-fn) + (ebrowse-draw-member-short-fn): Use renamed ebrowse faces. + + * progmodes/antlr-mode.el (antlr-default, antlr-keyword, antlr-syntax) + (antlr-ruledef, antlr-tokendef, antlr-ruleref, antlr-tokenref) + (antlr-literal): Remove "-face" suffix and "font-lock-" from face names. + (antlr-font-lock-default-face, antlr-font-lock-keyword-face) + (antlr-font-lock-syntax-face, antlr-font-lock-ruledef-face) + (antlr-font-lock-tokendef-face, antlr-font-lock-ruleref-face) + (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face): + New backward-compatibility aliases for renamed faces. + (antlr-default-face, antlr-keyword-face, antlr-syntax-face) + (antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face) + (antlr-tokenref-face, antlr-literal-face): Variables renamed to remove + "font-lock-". Use renamed antlr-mode faces. + (antlr-font-lock-additional-keywords): Use renamed faces. + Replace literal face-names with face variable references. + + * buff-menu.el (Buffer-menu-buffer): Remove "-face" suffix from + face name. + (Buffer-menu-buffer-face): New backward-compatibility alias for + renamed face. + (list-buffers-noselect): Use renamed Buffer-menu-buffer face. + +2005-06-15 Daniel Pfeiffer <occitan@esperanto.org> + + * progmodes/make-mode.el (makefile-space, makefile-makepp-perl): + Eliminate "-face" suffix. + (makefile-targets): Inherit from font-lock-function-name-face and + eliminate "-face" suffix. + (makefile-shell): Remove attributes and eliminate "-face" suffix. + (makefile-*-font-lock-keywords): Append makefile-targets in rule + actions, instead of prepending, to make it less visible. + (makefile-previous-dependency, makefile-match-dependency): + Don't match a target on a continuation line. + + * files.el (auto-mode-alist): Put Makefile in gmake mode. + +2005-06-15 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-tooltip-print): + Respect tooltip-use-echo-area. + (menu): Re-order menu items. + + * progmodes/gud.el (tooltip-use-echo-area): Remove alias. + Define in tooltip.el. + (gud-tooltip-process-output): Respect tooltip-use-echo-area. + (gud-tooltip-tips): Respect tooltip-use-echo-area and + gud-tooltip-echo-area. + + * tooltip.el (tooltip-use-echo-area): Restore from gud.el for + backward compatibility and make obsolete. + (tooltip-help-tips): Use tooltip-use-echo-area. + (tooltip-show-help-function): Rename to... + (tooltip-show-help): ...this, because it is a function. + (tooltip-mode, tooltip-help-message): Call tooltip-show-help. + +2005-06-14 Luc Teirlinck <teirllm@auburn.edu> + + * emacs-lisp/edebug.el (edebug-all-defs, edebug-initial-mode) + (edebug-print-length, edebug-print-level, edebug-print-circle) + (edebug-modify-breakpoint, edebug-eval-last-sexp) + (edebug-eval-print-last-sexp): Doc fixes. + +2005-06-14 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-mode): Make a new keymap every time we enable ido, + as the coverage buffer/file/both may change. + +2005-06-14 Lute Kamstra <lute@gnu.org> + + * net/ange-ftp.el (internal-ange-ftp-mode): Use delay-mode-hooks + and run-mode-hooks. Simplify. + + * mail/rmailedit.el (rmail-edit-mode): + * progmodes/octave-inf.el (inferior-octave-mode): + * progmodes/sql.el (sql-interactive-mode): Use delay-mode-hooks. + + * recentf.el (recentf-dialog-mode): Use kill-all-local-variables + and run-mode-hooks. + (recentf-edit-list, recentf-open-files): Don't call + kill-all-local-variables directly. + + * emacs-lisp/debug.el (debug-on-entry): Fix docstring. + +2005-06-14 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/byte-run.el (make-obsolete) + (define-obsolete-function-alias): Rename arguments FUNCTION and + NEW to OBSOLETE-NAME and CURRENT-NAME respectively. + (make-obsolete-variable, define-obsolete-variable-alias): + Rename arguments VARIABLE and NEW to OBSOLETE-NAME and CURRENT-NAME + respectively. + + * isearchb.el (isearchb-activate): + * pcvs.el (cvs-mode): + * ses.el (ses-load): + * vc-arch.el (vc-arch-checkin, vc-arch-diff): + * net/tramp.el (tramp-find-file-exists-command) + (tramp-find-shell): + * progmodes/ada-mode.el (ada-create-case-exception) + (ada-create-case-exception-substring, ada-make-subprogram-body): + * progmodes/idlw-shell.el (idlwave-shell-move-to-bp): + * progmodes/idlwave.el (idlwave-complete-class-structure-tag-help): + * progmodes/vhdl-mode.el (vhdl-speedbar-place-component): + * textmodes/org.el (org-promote, org-evaluate-time-range) + (org-agenda-next-date-line, org-agenda-previous-date-line) + (org-agenda-error, org-open-at-point, org-table-move-row) + (org-format-table-table-html-using-table-generate-source) + (org-shiftcursor-error, org-ctrl-c-ctrl-c): + * textmodes/reftex.el (reftex-access-scan-info): + * textmodes/reftex-toc.el (reftex-toc-dframe-p) + (reftex-toc-promote-prepare): Follow error conventions. + + * diff-mode.el (diff-mode): Fix typo in docstring. + + * forms.el (forms--intuit-from-file): Fix reference to + `forms-number-of-fields' in error message. + (forms-print): Fix quoting in error message. + + * forms.el (forms-mode): + * emulation/vi.el (vi-goto-insert-state): + * progmodes/flymake.el (flymake-new-err-info) + (flymake-start-syntax-check-for-current-buffer) + (flymake-simple-cleanup): + * eshell/esh-var.el (eshell/export): + * progmodes/gud.el (xdb): + * textmodes/flyspell.el (flyspell-incorrect-hook) + (flyspell-maybe-correct-transposition) + (flyspell-maybe-correct-doubling): Fix quoting in docstring. + +2005-06-13 Luc Teirlinck <teirllm@auburn.edu> + + * emacs-lisp/debug.el (cancel-debug-on-entry): Mention default in + minibuffer prompt. + +2005-06-13 Kim F. Storm <storm@cua.dk> + + * subr.el (add-to-ordered-list): New defun. + + * emulation/cua-base.el (cua-mode): Use add-to-ordered-list to + add cua--keymap-alist to emulation-mode-map-alists. + +2005-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (complete-in-turn): New macro. + (dynamic-completion-table, lazy-completion-table): Add debug info. + + * faces.el (read-face-name): Use complete-in-turn complete non-aliases + in preference to face aliases. + + * textmodes/fill.el (fill-match-adaptive-prefix): New function. + (fill-context-prefix): Use it to avoid guessing absurdly long prefixes. + Remove unused vars `start' and `firstline'. + (fill-nobreak-p): Fix line-move-invisible -> line-move-invisible-p. + (justify-current-line, fill-individual-paragraphs): Remove unused vars. + +2005-06-13 Eli Zaretskii <eliz@gnu.org> + + * cus-start.el (all): Don't complain about missing GTK-related + variables, unless either `gtk' is boundp or this isn't a + `windows-nt' build. + +2005-06-13 Lute Kamstra <lute@gnu.org> + + * abbrev.el (edit-abbrevs-mode): Use kill-all-local-variables and + run-mode-hooks. + + * ediff-mult.el (ediff-meta-mode): + * ediff-util.el (ediff-mode): Use run-mode-hooks. + + * ledit.el (ledit-mode): Use delay-mode-hooks. + + * woman.el (woman-mode-line-format): Delete constant. + (woman-mode-map): Initialize it properly. + (woman-mode): Set mode-class property to special. + Use delay-mode-hooks and run-mode-hooks. Use the right keymap. + Set major-mode and mode-name. Don't set mode-line-format directly. + (Man-getpage-in-background): Don't reference woman-mode-line-format. + + * emacs-lisp/debug.el (cancel-debug-on-entry): Make the empty + string argument obsolete. + +2005-06-13 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-CUA-compatible): New option. + (org-disputed-keys): New variable. + (org-key): New function. + (orgtbl-make-binding): Add docstring to the created function. + (org-mode): Set paragraph start/separate regexps. + (orgtbl-mode): Don't start `orgtbl-mode' in `org-mode' buffers. + (org-archive-location, org-archive-mark-done) + (org-archive-stamp-time): New options. + (org-archive-subtree): New command. + (org-fill-paragraph): New function. + (org-mode): Set `fill-paragraph-function' to `org-fill-paragraph'. + (org-fake-empty-table-line): Function removed. + (org-format-org-table-html): Do not create empty table lines at + separator lines. Improved table header treatment. + (org-link-format): New option. + (org-make-link): New function. + (org-insert-link, org-store-link): Use org-make-link. + (org-open-file): Quote file name for shell command, to allow + spaces in file names. + (org-link-regexp): Fix bug with mailto link. + (org-link-maybe-angles-regexp, org-protected-link-regexp): + New constants. + (org-export-as-html): Deal with the optional angles around a link. + Better treatment of file: links. + (org-open-at-point): Replace @{ and @} with < and >. + (org-run-mode-hooks): Function removed. + (org-agenda-mode): No longer use `org-run-mode-hooks'. + +2005-06-13 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-registers-mode): Let gdbmi use + MI command -data-list-register-values. + (gdb-post-prompt): Indent properly. + +2005-06-13 Juanma Barranquero <lekktu@gmail.com> + + * hilit-chg.el (highlight-changes-colors): Rename from + `highlight-changes-colours'. + (highlight-changes-colours): Keep as obsolete alias. + (highlight-changes-face-list): Doc fix. + (hilit-chg-make-list): Use `highlight-changes-colors'. + +2005-06-12 Mark A. Hershberger <mah@everybody.org> + + * progmodes/cperl-mode.el (cperl-mode): Remove stray paren in + defun-prompt-regexp. + +2005-06-12 Eli Zaretskii <eliz@gnu.org> + + * loadup.el: Don't say we are dumping under 2 names on windows-nt + and cygwin. + + * makefile.w32-in (bootstrap-clean-CMD, bootstrap-clean-SH): + Don't use an old loaddefs.el, as in Makefile.in. + +2005-06-12 Lute Kamstra <lute@gnu.org> + + * Makefile.in (bootstrap-prepare): Don't use an old loaddefs.el. + + * man.el (Man-mode-map): Initialize it properly. + (Man-mode): Set mode-class property to special. + + * calendar/calendar.el (calendar-mode): Use run-mode-hooks. + +2005-06-11 Luc Teirlinck <teirllm@auburn.edu> + + * menu-bar.el (menu-bar-make-toggle): Remove stray backslash. + A newline is needed in the docstring there. + + * emacs-lisp/debug.el (debug-on-entry, cancel-debug-on-entry): + Doc fixes. + +2005-06-11 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * printing.el: Doc fix. The menubar is no more changed when printing + is loaded, it only changes when pr-menu-bind or pr-update-menus is + called. Now, the menubar changing will work in Emacs 20, 21 and 22. + (pr-version): New version number (6.8.4). + (pr-menu-bind): New command. + (pr-update-menus): Docstring and code fix. + (pr-menu-print-item): Now is a global var in Emacs and XEmacs. + Docstring fix. + (pr-txt-printer-alist, pr-ps-printer-alist, pr-gv-command) + (pr-gs-command, pr-gs-switches, pr-ps-utility-alist): Docstring fix. + +2005-06-11 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el: Doc fixes for public funcs: + "Returns" to "return", document useful return values, etc. + +2005-06-11 Alan Mackenzie <acm@muc.de> + + * fill.el (fill-context-prefix): Try `adaptive-fill-function' + BEFORE `adaptive-fill-regexp' when determining a fill prefix. + (adaptive-file-function): Minor amendment to doc-string. + +2005-06-11 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE> + + * thumbs.el (thumbs-per-line, thumbs-thumbsdir-max-size) + (thumbs-relief, thumbs-margin, thumbs-image-resizing-step): + Fix :type--it is `integer', not `string'. + + * faces.el (modeline-highlight): Rename from (the erroneous) + `modeline-higilight'. + +2005-06-11 Lute Kamstra <lute@gnu.org> + + * emacs-lisp/edebug.el (edebug-eval-mode-map): Don't copy + lisp-interaction-mode-map but make it the parent. + (edebug-eval-mode): Use define-derived-mode. + +2005-06-11 Andreas Schwab <schwab@suse.de> + + * bindings.el: Add binding of `ESC functionkey' for every + `M-functionkey'. + * hexl.el (hexl-mode-map): Likewise. + +2005-06-10 Michael Hotchin <michael@hotchin.net> (tiny change) + + * progmodes/compile.el (compilation-error-regexp-alist-alist) + [msft]: update regexp for newer msft compilers. + +2005-06-10 Mark A. Hershberger <mah@everybody.org> + + * xml.el (start-chars, xml-parse-dtd): Add the ability to skip + ATTLIST portions of included DTDs. + (xml-parse-dtd): Eliminate use of inefficient match-data. + +2005-06-10 Miles Bader <miles@gnu.org> + + * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial) + (mpuz-text): Remove "-face" suffix from face names. + (mpuz-unsolved-face, mpuz-solved-face, mpuz-trivial-face) + (mpuz-text-face): New backward-compatibility aliases for renamed faces. + (mpuz-create-buffer, mpuz-paint-digit): Use renamed mpuz faces. + + * play/gomoku.el (gomoku-O, gomoku-X): + Remove "-face" suffix from face names. + (gomoku-font-lock-O-face, gomoku-font-lock-X-face): + New backward-compatibility aliases for renamed faces. + (gomoku-font-lock-keywords): Use renamed gomoku faces. + +2005-06-10 Juanma Barranquero <lekktu@gmail.com> + + * thumbs.el: Fixes for changes of 2005-06-09. + (thumbs-thumbsdir): Force `thumbs-thumbsdir' to be interpretable + as a directory. + (thumbs-thumbname): Remove directory separator from format string; + `thumbs-thumbsdir' now returns a valid directory name. + (thumbs-temp-dir): New defsubst. + (thumbs-temp-file, thumbs-resize-image, thumbs-modify-image): + Use it. + + * cus-edit.el (minibuffer): + * files.el (make-backup-file-name-function): + * filesets.el (filesets-external-viewers): + * hilit-chg.el (highlight-changes-colours) + (highlight-changes-face-list, highlight-changes-rotate-faces): + * ielm.el (ielm-dynamic-return, inferior-emacs-lisp-mode): + * kmacro.el (kmacro-call-macro): + * log-edit.el (log-edit-changelog-full-paragraphs): + * mouse.el (mouse-1-click-follows-link): + * skeleton.el (skeleton-autowrap): + * subr.el (insert-for-yank-1): + * tempo.el (tempo-insert-region): + * terminal.el (terminal-emulator): + * time.el (display-time-mail-face): + * vc.el (vc-annotate): + * vcursor.el (vcursor-copy-line): + * woman.el (woman-bold-headings, woman-ignore) + (woman-default-faces, woman-monochrome-faces): + * calendar/todo-mode.el (todo-insert-threshold): + * emulation/pc-select.el (pc-select-selection-keys-only) + (pc-selection-mode): + * emulation/vip.el (vip-find-char-forward): + * emulation/viper-cmd.el (viper-find-char-forward): + * international/mule-cmds.el (select-safe-coding-system-accept-default-p) + (input-method-exit-on-invalid-key): + * international/mule-diag.el (describe-coding-system): + * international/ucs-tables.el (unify-8859-on-encoding-mode): + * net/browse-url.el (browse-url-xterm-program): + * obsolete/lazy-lock.el (lazy-lock-mode): + * progmodes/cperl-mode.el (cperl-info-on-command-no-prompt) + (cperl-mode): + * progmodes/cpp.el (cpp-face-light-name-list) + (cpp-face-dark-name-list): + * progmodes/delphi.el (delphi-newline-always-indents): + Fix spellings in docstrings. + + * ido.el (ido-mode, ido-file-extensions-order) + (ido-default-file-method, ido-default-buffer-method) + (ido-max-prospects, ido-slow-ftp-hosts, ido-setup-hook) + (ido-decorations, ido-read-file-name-as-directory-commands) + (ido-read-file-name-non-ido, ido-work-directory-list) + (ido-ignore-item-temp-list, ido-current-directory) + (ido-magic-forward-char, ido-enter-find-file) + (ido-enter-switch-buffer, ido-visit-buffer, ido-switch-buffer) + (ido-find-file, ido-read-buffer): Fix typos in docstrings. + +2005-06-10 Lute Kamstra <lute@gnu.org> + + * play/dunnet.el (dun-mode): Use define-derived-mode. + (dungeon-mode-map): Rename to dun-mode-map. Keep old name as an + obsolete alias. + + * play/doctor.el (doctor-mode-map): Remove defvar. + (doctor-mode): Use define-derived-mode. + + * mail/mspools.el (mspools-mode): + * net/eudc-hotlist.el (eudc-hotlist-mode): + * play/blackbox.el (blackbox-mode): Use run-mode-hooks. + +2005-06-10 Miles Bader <miles@gnu.org> + + * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): + Remove "-face" suffix from face names. + (flyspell-incorrect-face, flyspell-duplicate-face): + New backward-compatibility aliases for renamed faces. + (flyspell-mode-on, make-flyspell-overlay) + (flyspell-highlight-incorrect-region) + (flyspell-highlight-duplicate-region) + (flyspell-display-next-corrections) + (flyspell-auto-correct-previous-word): Use renamed flyspell faces. + + * textmodes/texinfo.el (texinfo-heading): Remove "-face" suffix + from face name. + (texinfo-heading-face): New backward-compatibility alias for + renamed face. + (texinfo-heading-face): Use renamed texinfo-heading face. + + * textmodes/tex-mode.el (tex-math, tex-verbatim): Remove "-face" + suffix from face names. + (tex-math-face, tex-verbatim-face): + New backward-compatibility aliases for renamed faces. + (tex-math-face, tex-verbatim-face): Use renamed tex-mode faces. + (tex-insert-quote): Use `tex-verbatim-face' variable instead of + literal face name. + + * textmodes/table.el (table-cell): Remove "-face" suffix from face + name. + (table-cell-face): New backward-compatibility alias for renamed face. + (table--put-cell-face-property, table--update-cell-face): + Use renamed table-cell face. + + * textmodes/sgml-mode.el (sgml-namespace): Remove "-face" suffix + from face name. + (sgml-namespace-face): New backward-compatibility alias for + renamed face. + (sgml-namespace-face): Use renamed sgml-namespace face. + + * textmodes/org.el (org-level-1, org-level-2, org-level-3) + (org-level-4, org-level-5, org-level-6, org-level-7) + (org-level-8, org-warning, org-headline-done) + (org-deadline-announce, org-scheduled-today) + (org-scheduled-previously, org-link, org-done, org-table) + (org-time-grid): Remove "-face" suffix from face names. + (org-level-1-face, org-level-2-face, org-level-3-face) + (org-level-4-face, org-level-5-face, org-level-6-face) + (org-level-7-face, org-level-8-face, org-warning-face) + (org-headline-done-face, org-deadline-announce-face) + (org-scheduled-today-face, org-scheduled-previously-face) + (org-link-face, org-done-face, org-table-face) + (org-time-grid-face): + New backward-compatibility aliases for renamed faces. + (org-level-faces, org-set-font-lock-defaults, org-timeline) + (org-agenda, org-agenda-get-todos, org-agenda-get-deadlines) + (org-agenda-get-timestamps, org-agenda-get-scheduled) + (org-agenda-add-time-grid-maybe, org-table-p): Use renamed org faces. + + * emulation/viper-init.el (viper-search, viper-replace-overlay) + (viper-minibuffer-emacs, viper-minibuffer-insert) + (viper-minibuffer-vi): Remove "-face" suffix from face names. + (viper-search-face, viper-replace-overlay-face) + (viper-minibuffer-emacs-face, viper-minibuffer-insert-face) + (viper-minibuffer-vi-face): + New backward-compatibility aliases for renamed faces. + (viper-search-face, viper-replace-overlay-face) + (viper-minibuffer-emacs-face, viper-minibuffer-insert-face) + (viper-minibuffer-vi-face): Use renamed viper faces. + + * emacs-lisp/testcover.el (testcover-nohits, testcover-1value): + Remove "-face" suffix from face names. + (testcover-nohits-face, testcover-1value-face): + New backward-compatibility aliases for renamed faces. + (testcover-mark): Use renamed testcover faces. + + * calendar/diary-lib.el (diary-button): Remove "-face" suffix from + face name. + (diary-button-face): New backward-compatibility alias for renamed face. + (diary-entry): Use renamed diary-button face. + + * calendar/calendar.el (diary, calendar-today, holiday) + (mark-visible-calendar-date): Remove "-face" suffix from face names. + (diary-face, calendar-today-face, holiday-face): + New backward-compatibility aliases for renamed faces. + (eval-after-load "facemenu", diary-entry-marker) + (calendar-today-marker, calendar-holiday-marker, diary-face): + Use renamed calendar faces. + + * compare-w.el (compare-windows): Remove "-face" suffix from face name. + (compare-windows-face): New backward-compatibility alias for + renamed face. + (compare-windows-highlight): Use renamed compare-windows face. + + * strokes.el (strokes-char): Remove "-face" suffix from face name. + (strokes-char-face): New backward-compatibility alias for renamed face. + (strokes-encode-buffer): Use renamed strokes-char face. + + * pcvs-info.el (cvs-header, cvs-filename, cvs-unknown) + (cvs-handled, cvs-need-action, cvs-marked, cvs-msg): + Remove "-face" suffix from face names. + (cvs-header-face, cvs-filename-face, cvs-unknown-face) + (cvs-handled-face, cvs-need-action-face, cvs-marked-face) + (cvs-msg-face): New backward-compatibility aliases for renamed faces. + (cvs-fi-up-to-date-face, cvs-fi-unknown-face, cvs-fileinfo-pp): + Use renamed pcvs faces. + * pcvs.el (cvs-mode-find-file): Use renamed pcvs faces. + * pcvs-defs.el (cvs-mode-map): Likewise. + * cvs-status.el (cvs-status-font-lock-keywords): Likewise. + + * info.el (info-title-1, info-title-2, info-title-3) + (info-title-4): Remove "-face" suffix from and downcase face names. + (Info-title-1-face, Info-title-2-face, Info-title-3-face) + (Info-title-4-face): + New backward-compatibility aliases for renamed faces. + (Info-fontify-node): Use renamed info faces. + + * hilit-chg.el (highlight-changes, highlight-changes-delete): + Remove "-face" suffix from face names. + (highlight-changes-face, highlight-changes-delete-face): + New backward-compatibility aliases for renamed faces. + (hilit-chg-cust-fix-changes-face-list, hilit-chg-make-ov) + (hilit-chg-make-list): Use renamed highlight-changes faces. + + * generic-x.el (show-tabs-tab, show-tabs-space): + Remove "-face" suffix from face names. + (show-tabs-tab-face, show-tabs-space-face): + New backward-compatibility aliases for renamed faces. + (show-tabs-generic-mode-font-lock-defaults-1) + (show-tabs-generic-mode-font-lock-defaults-2): + Use renamed show-tabs faces. + + * smerge-mode.el (smerge-mine, smerge-other, smerge-base) + (smerge-markers): Remove "-face" suffix from face names. + (smerge-mine-face, smerge-other-face, smerge-base-face) + (smerge-markers-face): + New backward-compatibility aliases for renamed faces. + (smerge-mine-face, smerge-other-face, smerge-base-face) + (smerge-markers-face): Use renamed smerge faces. + + * log-view.el (log-view-file, log-view-message): + Remove "-face" suffix from face names. + (log-view-file-face, log-view-message-face): + New backward-compatibility aliases for renamed faces. + (log-view-file-face, log-view-message-face): Use renamed log-view faces. + + * paren.el (show-paren-match, show-paren-mismatch): + Remove "-face" suffix from face names. + (show-paren-match-face, show-paren-mismatch-face): + New backward-compatibility aliases for renamed faces. + (show-paren-function): Use renamed show-paren faces. + + * ruler-mode.el (ruler-mode-default, ruler-mode-pad) + (ruler-mode-margins, ruler-mode-fringes) + (ruler-mode-column-number, ruler-mode-fill-column) + (ruler-mode-comment-column, ruler-mode-goal-column) + (ruler-mode-tab-stop, ruler-mode-current-column): + Remove "-face" suffix from face names. + (ruler-mode-default-face, ruler-mode-pad-face) + (ruler-mode-margins-face, ruler-mode-fringes-face) + (ruler-mode-column-number-face, ruler-mode-fill-column-face) + (ruler-mode-comment-column-face, ruler-mode-goal-column-face) + (ruler-mode-tab-stop-face, ruler-mode-current-column-face): + New backward-compatibility aliases for renamed faces. + (ruler-mode-pad, ruler-mode-margins, ruler-mode-fringes) + (ruler-mode-column-number, ruler-mode-fill-column) + (ruler-mode-comment-column, ruler-mode-goal-column) + (ruler-mode-tab-stop, ruler-mode-current-column) + (ruler-mode-mouse-grab-any-column, ruler-mode-ruler): Use renamed faces. + + * whitespace.el (whitespace-highlight): Remove "-face" suffix from + face name. + (whitespace-highlight-the-space): Use renamed face. + (whitespace-highlight-face): New backward-compatibility alias for + renamed face. + + * woman.el (woman-italic, woman-bold, woman-unknown) + (woman-addition, woman-symbol-face): + Remove "-face" suffix from face names. + (woman-italic-face, woman-bold-face, woman-unknown-face) + (woman-addition-face): + New backward-compatibility aliases for renamed faces. + (woman-default-faces, woman-monochrome-faces, woman-man-buffer) + (woman-decode-region, woman-replace-match) + (woman-display-extended-fonts, woman-special-characters) + (woman-font-alist, woman-change-fonts, woman2-TH, woman2-SH): + Use renamed woman faces. + + * longlines.el (longlines-visible-face): Face removed. + + * diff-mode.el (diff-header, diff-file-header, diff-index) + (diff-hunk-header, diff-removed, diff-added, diff-changed) + (diff-function, diff-context, diff-nonexistent): Remove "-face" + suffix from face names. + (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): New backward-compatibility aliases for + renamed faces. + (diff-header-face, diff-file-header-face) + (diff-index, diff-index-face, diff-hunk-header) + (diff-hunk-header-face, diff-removed, diff-removed-face) + (diff-added, diff-added-face, diff-changed-face, diff-function) + (diff-function-face, diff-context-face, diff-nonexistent) + (diff-nonexistent-face): Use renamed diff-mode faces. + + * progmodes/compile.el (compilation-warning-face) + (compilation-info-face): Remove "-face" suffix from face names. + (compilation-warning-face, compilation-info-face): + New backward-compatibility aliases for renamed faces. + (compilation-warning-face, compilation-info-face): + Use renamed compilation faces. + + * add-log.el (change-log-date, change-log-name) + (change-log-email, change-log-file, change-log-list) + (change-log-conditionals, change-log-function) + (change-log-acknowledgement): Remove "-face" suffix from face names. + (change-log-date-face, change-log-name-face) + (change-log-email-face, change-log-file-face) + (change-log-list-face, change-log-conditionals-face) + (change-log-function-face, change-log-acknowledgement-face): + New backward-compatibility aliases for renamed faces. + (change-log-font-lock-keywords): Use renamed change-log faces. + + * cus-edit.el (custom-invalid, custom-rogue, custom-modified) + (custom-set, custom-changed, custom-saved, custom-button) + (custom-button-pressed, custom-documentation, custom-state) + (custom-comment, custom-comment-tag, custom-variable-tag) + (custom-variable-button, custom-face-tag, custom-group-tag-1) + (custom-group-tag): Remove "-face" suffix from face names. + (custom-magic-alist, custom-magic-value-create) + (custom-group-sample-face-get, custom-mode): Use renamed custom faces. + (custom-invalid-face, custom-rogue-face, custom-modified-face) + (custom-set-face, custom-changed-face, custom-saved-face) + (custom-button-face, custom-button-pressed-face) + (custom-documentation-face, custom-state-face) + (custom-comment-face, custom-comment-tag-face) + (custom-variable-tag-face, custom-variable-button-face) + (custom-face-tag-face, custom-group-tag-face-1) + (custom-group-tag-face): + New backward-compatibility aliases for renamed faces. + + * wid-edit.el (widget-documentation, widget-button) + (widget-field, widget-single-line-field, widget-inactive) + (widget-button-pressed): "-face" suffix removed from face names. + (widget-documentation-face, widget-button-face) + (widget-field-face, widget-single-line-field-face) + (widget-inactive-face, widget-button-pressed-face): + New backward-compatibility aliases for renamed faces. + (widget-documentation-face, widget-button-face) + (widget-button-pressed-face, widget-specify-field) + (widget-specify-inactive): Use renamed widget faces. + +2005-06-10 Kenichi Handa <handa@m17n.org> + + * term/x-win.el (x-clipboard-yank): Remove condition-case + wrapping. + +2005-06-11 Kenichi Handa <handa@m17n.org> + + * add-log.el (change-log-font-lock-keywords): Make the regexp for + date lines stricter. + +2005-06-10 Zhang Wei <id.brep@gmail.com> (tiny change) + + * term/x-win.el (x-clipboard-yank): Use x-selection-value instead + of x-get-selection. + +2005-06-10 Juanma Barranquero <lekktu@gmail.com> + + * comint.el (comint-mode, comint-snapshot-last-prompt): + * frame.el (frame-current-scroll-bars): + * term.el (term-mode, term-check-proc, term-input-sender) + (term-simple-send, term-extract-string, term-word) + (term-match-partial-filename): + * window.el (window-current-scroll-bars): + * emulation/cua-base.el (cua-normal-cursor-color) + (cua-read-only-cursor-color, cua-overwrite-cursor-color) + (cua-global-mark-cursor-color): + * mail/undigest.el (rmail-forward-separator-regex): + Fix typos in docstrings. + + * comint.el (comint-check-proc, make-comint-in-buffer) + (comint-source-default): Doc fixes. + + * term.el (term-send-string): Improve argument/docstring + consistency. + +2005-06-09 Luc Teirlinck <teirllm@auburn.edu> + + * comint.el (comint-send-input): Bind `inhibit-read-only' around + call to `delete-region'. + (comint-mode-hook): Do not enable Font Lock by default. + +2005-06-09 Lute Kamstra <lute@gnu.org> + + * textmodes/ispell.el (ispell-menu-map-needed): flyspell-mode + could be void. + 2005-06-09 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/debug.el (debugger-will-be-back): New var. @@ -9,6 +812,9 @@ 2005-06-09 Juanma Barranquero <lekktu@gmail.com> + * window.el (shrink-window-if-larger-than-buffer) + (window-size-fixed): Fix typo in docstring. + * thumbs.el: Don't set `auto-image-file-mode'. Do not create the thumbnails directory on loading. (thumbs-conversion-program): Use `eq' to check the system type, @@ -9719,7 +10525,7 @@ * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses icon diropen. New tool bar item find-file-existing uses icon open. - * dired.el (dired-read-dir-and-switches): Call read-driectory-name + * dired.el (dired-read-dir-and-switches): Call read-directory-name instead of read-file-name. 2004-11-02 Ulf Jasper <ulf.jasper@web.de> @@ -17838,8 +18644,8 @@ 2004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> - * term/x-win.el: Call menu-bar-enable-clipboard and make Paste - use clipboard first. + * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): Call + menu-bar-enable-clipboard and make Paste use clipboard first. 2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
--- a/lisp/Makefile.in Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/Makefile.in Wed Jun 15 23:32:15 2005 +0000 @@ -217,21 +217,19 @@ # Prepare a bootstrap in the lisp subdirectory. # -# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, -# that might lead to errors during the bootstrap because something fails to -# autoload as expected. However, if there is no emacs binary, then we can't -# build autoloads yet, so just make sure there's some loaddefs.el file, as -# it's necessary for generating the binary (because loaddefs.el is an -# automatically generated file, we don't want to store it in the source -# repository). +# Build loaddefs.el to make sure it's up-to-date. If it's not, that +# might lead to errors during the bootstrap because something fails to +# autoload as expected. If there is no emacs binary, then we can't +# build autoloads yet. In that case we have to use ldefs-boot.el; +# bootstrap should always work with ldefs-boot.el. (Because +# loaddefs.el is an automatically generated file, we don't want to +# store it in the source repository). bootstrap-prepare: if test -x $(EMACS); then \ $(MAKE) $(MFLAGS) autoloads; \ else \ - if test ! -r $(lisp)/loaddefs.el; then \ - cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \ - fi \ + cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \ fi maintainer-clean: distclean
--- a/lisp/abbrev.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/abbrev.el Wed Jun 15 23:32:15 2005 +0000 @@ -134,9 +134,11 @@ "Major mode for editing the list of abbrev definitions. \\{edit-abbrevs-map}" (interactive) + (kill-all-local-variables) (setq major-mode 'edit-abbrevs-mode) (setq mode-name "Edit-Abbrevs") - (use-local-map edit-abbrevs-map)) + (use-local-map edit-abbrevs-map) + (run-mode-hooks 'edit-abbrevs-mode-hook)) (defun edit-abbrevs () "Alter abbrev definitions by editing a list of them.
--- a/lisp/add-log.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/add-log.el Wed Jun 15 23:32:15 2005 +0000 @@ -166,86 +166,102 @@ :type '(repeat regexp) :group 'change-log) -(defface change-log-date-face +(defface change-log-date '((t (:inherit font-lock-string-face))) "Face used to highlight dates in date lines." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-date-face 'face-alias 'change-log-date) -(defface change-log-name-face +(defface change-log-name '((t (:inherit font-lock-constant-face))) "Face for highlighting author names." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-name-face 'face-alias 'change-log-name) -(defface change-log-email-face +(defface change-log-email '((t (:inherit font-lock-variable-name-face))) "Face for highlighting author email addresses." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-email-face 'face-alias 'change-log-email) -(defface change-log-file-face +(defface change-log-file '((t (:inherit font-lock-function-name-face))) "Face for highlighting file names." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-file-face 'face-alias 'change-log-file) -(defface change-log-list-face +(defface change-log-list '((t (:inherit font-lock-keyword-face))) "Face for highlighting parenthesized lists of functions or variables." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-list-face 'face-alias 'change-log-list) -(defface change-log-conditionals-face +(defface change-log-conditionals '((t (:inherit font-lock-variable-name-face))) "Face for highlighting conditionals of the form `[...]'." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-conditionals-face 'face-alias 'change-log-conditionals) -(defface change-log-function-face +(defface change-log-function '((t (:inherit font-lock-variable-name-face))) "Face for highlighting items of the form `<....>'." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-function-face 'face-alias 'change-log-function) -(defface change-log-acknowledgement-face +(defface change-log-acknowledgement '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1" :group 'change-log) +;; backward-compatibility alias +(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) (defvar change-log-font-lock-keywords '(;; ;; Date lines, new and old styles. ("^\\sw.........[0-9:+ ]*" - (0 'change-log-date-face) + (0 'change-log-date) ;; Name and e-mail; some people put e-mail in parens, not angles. ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil - (1 'change-log-name-face) - (2 'change-log-email-face))) + (1 'change-log-name) + (2 'change-log-email))) ;; ;; File names. ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" - (2 'change-log-file-face) + (2 'change-log-file) ;; Possibly further names in a list: - ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face)) + ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) ;; Possibly a parenthesized list of names: ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" - nil nil (1 'change-log-list-face)) + nil nil (1 'change-log-list)) ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" - nil nil (1 'change-log-list-face))) + nil nil (1 'change-log-list))) ;; ;; Function or variable names. ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" - (2 'change-log-list-face) + (2 'change-log-list) ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil - (1 'change-log-list-face))) + (1 'change-log-list))) ;; ;; Conditionals. - ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals-face)) + ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals)) ;; ;; Function of change. - ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face)) + ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function)) ;; ;; Acknowledgements. ;; Don't include plain "From" because that is vague; @@ -254,7 +270,7 @@ ;; is to put the name of the author of the changes at the top ;; of the change log entry. ("\\(^\\( +\\|\t\\)\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)" - 3 'change-log-acknowledgement-face)) + 3 'change-log-acknowledgement)) "Additional expressions to highlight in Change Log mode.") (defvar change-log-mode-map
--- a/lisp/bindings.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/bindings.el Wed Jun 15 23:32:15 2005 +0000 @@ -745,6 +745,7 @@ (define-key global-map [home] 'beginning-of-line) (define-key global-map [C-home] 'beginning-of-buffer) (define-key global-map [M-home] 'beginning-of-buffer-other-window) +(define-key esc-map [home] 'beginning-of-buffer-other-window) (define-key global-map [left] 'backward-char) (define-key global-map [up] 'previous-line) (define-key global-map [right] 'forward-char) @@ -757,13 +758,17 @@ (put 'scroll-left 'disabled t) (define-key global-map [C-next] 'scroll-left) (define-key global-map [M-next] 'scroll-other-window) +(define-key esc-map [next] 'scroll-other-window) (define-key global-map [M-prior] 'scroll-other-window-down) +(define-key esc-map [prior] 'scroll-other-window-down) (define-key esc-map [?\C-\S-v] 'scroll-other-window-down) (define-key global-map [end] 'end-of-line) (define-key global-map [C-end] 'end-of-buffer) (define-key global-map [M-end] 'end-of-buffer-other-window) +(define-key esc-map [end] 'end-of-buffer-other-window) (define-key global-map [begin] 'beginning-of-buffer) (define-key global-map [M-begin] 'beginning-of-buffer-other-window) +(define-key esc-map [begin] 'beginning-of-buffer-other-window) ;; (define-key global-map [select] 'function-key-error) ;; (define-key global-map [print] 'function-key-error) (define-key global-map [execute] 'execute-extended-command) @@ -927,7 +932,9 @@ (define-key global-map "\C-c" 'mode-specific-command-prefix) (global-set-key [M-right] 'forward-word) +(define-key esc-map [right] 'forward-word) (global-set-key [M-left] 'backward-word) +(define-key esc-map [left] 'backward-word) ;; ilya@math.ohio-state.edu says these bindings are standard on PC editors. (global-set-key [C-right] 'forward-word) (global-set-key [C-left] 'backward-word) @@ -937,12 +944,18 @@ ;; This is "move to the clipboard", or as close as we come. (global-set-key [S-delete] 'kill-region) -(global-set-key [C-M-left] 'backward-sexp) -(global-set-key [C-M-right] 'forward-sexp) -(global-set-key [C-M-up] 'backward-up-list) -(global-set-key [C-M-down] 'down-list) -(global-set-key [C-M-home] 'beginning-of-defun) -(global-set-key [C-M-end] 'end-of-defun) +(global-set-key [C-M-left] 'backward-sexp) +(define-key esc-map [C-left] 'backward-sexp) +(global-set-key [C-M-right] 'forward-sexp) +(define-key esc-map [C-right] 'forward-sexp) +(global-set-key [C-M-up] 'backward-up-list) +(define-key esc-map [C-up] 'backward-up-list) +(global-set-key [C-M-down] 'down-list) +(define-key esc-map [C-down] 'down-list) +(global-set-key [C-M-home] 'beginning-of-defun) +(define-key esc-map [C-home] 'beginning-of-defun) +(global-set-key [C-M-end] 'end-of-defun) +(define-key esc-map [C-end] 'end-of-defun) (define-key esc-map "\C-f" 'forward-sexp) (define-key esc-map "\C-b" 'backward-sexp)
--- a/lisp/buff-menu.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/buff-menu.el Wed Jun 15 23:32:15 2005 +0000 @@ -74,11 +74,13 @@ :type 'boolean :group 'Buffer-menu) -(defface Buffer-menu-buffer-face +(defface Buffer-menu-buffer '((t (:weight bold))) "Face used to highlight buffer name." :group 'Buffer-menu :group 'font-lock-highlighting-faces) +;; backward-compatibility alias +(put 'Buffer-menu-buffer-face 'face-alias 'Buffer-menu-buffer) (defcustom Buffer-menu-buffer+size-width 26 "*How wide to jointly make the buffer name and size columns." @@ -773,7 +775,7 @@ (int-to-string (nth 3 buffer)) `(buffer-name ,(nth 2 buffer) buffer ,(car buffer) - font-lock-face Buffer-menu-buffer-face + font-lock-face Buffer-menu-buffer mouse-face highlight help-echo "mouse-2: select this buffer")) " "
--- a/lisp/calendar/calendar.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/calendar/calendar.el Wed Jun 15 23:32:15 2005 +0000 @@ -206,9 +206,9 @@ :type 'boolean :group 'view) -(defvar diary-face 'diary-face +(defvar diary-face 'diary "Face name to use for diary entries.") -(defface diary-face +(defface diary '((((min-colors 88) (class color) (background light)) :foreground "red1") (((class color) (background light)) @@ -221,13 +221,17 @@ :weight bold)) "Face for highlighting diary entries." :group 'diary) - -(defface calendar-today-face +;; backward-compatibility alias +(put 'diary-face 'face-alias 'diary) + +(defface calendar-today '((t (:underline t))) "Face for indicating today's date." :group 'diary) - -(defface holiday-face +;; backward-compatibility alias +(put 'calendar-today-face 'face-alias 'calendar-today) + +(defface holiday '((((class color) (background light)) :background "pink") (((class color) (background dark)) @@ -236,17 +240,19 @@ :inverse-video t)) "Face for indicating dates that have holidays." :group 'diary) +;; backward-compatibility alias +(put 'holiday-face 'face-alias 'holiday) (eval-after-load "facemenu" '(progn - (add-to-list 'facemenu-unlisted-faces 'diary-face) - (add-to-list 'facemenu-unlisted-faces 'calendar-today-face) - (add-to-list 'facemenu-unlisted-faces 'holiday-face))) + (add-to-list 'facemenu-unlisted-faces 'diary) + (add-to-list 'facemenu-unlisted-faces 'calendar-today) + (add-to-list 'facemenu-unlisted-faces 'holiday))) (defcustom diary-entry-marker (if (not (display-color-p)) "+" - 'diary-face) + 'diary) "*How to mark dates that have diary entries. The value can be either a single-character string or a face." :type '(choice string face) @@ -255,7 +261,7 @@ (defcustom calendar-today-marker (if (not (display-color-p)) "=" - 'calendar-today-face) + 'calendar-today) "*How to mark today's date in the calendar. The value can be either a single-character string or a face. Marking today's date is done only if you set up `today-visible-calendar-hook' @@ -266,7 +272,7 @@ (defcustom calendar-holiday-marker (if (not (display-color-p)) "*" - 'holiday-face) + 'holiday) "*How to mark notable dates in the calendar. The value can be either a single-character string or a face." :type '(choice string face) @@ -2441,7 +2447,6 @@ \\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar. \\<calendar-mode-map>\\{calendar-mode-map}" - (kill-all-local-variables) (setq major-mode 'calendar-mode) (setq mode-name "Calendar") @@ -2454,7 +2459,8 @@ (make-local-variable 'displayed-month);; Month in middle of window. (make-local-variable 'displayed-year) ;; Year in middle of window. (set (make-local-variable 'font-lock-defaults) - '(calendar-font-lock-keywords t))) + '(calendar-font-lock-keywords t)) + (run-mode-hooks 'calendar-mode-hook)) (defun calendar-string-spread (strings char length) "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. @@ -2943,7 +2949,7 @@ (forward-char -2)) (let ; attr list ((temp-face - (make-symbol (apply 'concat "temp-face-" + (make-symbol (apply 'concat "temp-" (mapcar '(lambda (sym) (cond ((symbolp sym) (symbol-name sym)) ((numberp sym) (int-to-string sym))
--- a/lisp/calendar/diary-lib.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/calendar/diary-lib.el Wed Jun 15 23:32:15 2005 +0000 @@ -543,15 +543,17 @@ (set-window-start window (point-min)))) (message "Preparing diary...done")))) -(defface diary-button-face '((((type pc) (class color)) - (:foreground "lightblue"))) +(defface diary-button '((((type pc) (class color)) + (:foreground "lightblue"))) "Default face used for buttons." :version "22.1" :group 'diary) +;; backward-compatibility alias +(put 'diary-button-face 'face-alias 'diary-button) (define-button-type 'diary-entry 'action #'diary-goto-entry - 'face #'diary-button-face) + 'face 'diary-button) (defun diary-goto-entry (button) (let ((marker (button-get button 'marker)))
--- a/lisp/calendar/todo-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/calendar/todo-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -311,7 +311,7 @@ lower bound will coincide at the end of the loop and you will insert your item just before that point. If you set the threshhold to, e.g. 8, it will stop as soon as the window size drops below that -amount and will insert the item in the approximate centre of that +amount and will insert the item in the approximate center of that window." :type 'integer :group 'todo)
--- a/lisp/comint.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/comint.el Wed Jun 15 23:32:15 2005 +0000 @@ -423,7 +423,7 @@ (make-obsolete-variable 'comint-use-prompt-regexp-instead-of-fields 'comint-use-prompt-regexp "22.1") -(defcustom comint-mode-hook '(turn-on-font-lock) +(defcustom comint-mode-hook nil "Hook run upon entry to `comint-mode'. This is run before the process is cranked up." :type 'hook @@ -583,7 +583,7 @@ Setting variable `comint-eol-on-send' means jump to the end of the line before submitting new input. -This mode is customised to create major modes such as Inferior Lisp +This mode is customized to create major modes such as Inferior Lisp mode, Shell mode, etc. This can be done by setting the hooks `comint-input-filter-functions', `comint-input-filter', `comint-input-sender' and `comint-get-old-input' to appropriate functions, and the variable @@ -654,7 +654,7 @@ (set (make-local-variable 'next-line-add-newlines) nil)) (defun comint-check-proc (buffer) - "Return t if there is a living process associated w/buffer BUFFER. + "Return non-nil if there is a living process associated w/buffer BUFFER. Living means the status is `open', `run', or `stop'. BUFFER can be either a buffer or the name of one." (let ((proc (get-buffer-process buffer))) @@ -667,7 +667,7 @@ PROGRAM should be either a string denoting an executable program to create via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP connection to be opened via `open-network-stream'. If there is already a -running process in that buffer, it is not restarted. Optional third arg +running process in that buffer, it is not restarted. Optional fourth arg STARTFILE is the name of a file to send the contents of to the process. If PROGRAM is a string, any more args are arguments to PROGRAM." @@ -1547,8 +1547,12 @@ nil comint-last-input-start comint-last-input-end nil comint-last-input-end (+ comint-last-input-end echo-len)))) - (delete-region comint-last-input-end - (+ comint-last-input-end echo-len))))) + ;; Certain parts of the text to be deleted may have + ;; been mistaken for prompts. We have to prevent + ;; problems when `comint-prompt-read-only' is non-nil. + (let ((inhibit-read-only t)) + (delete-region comint-last-input-end + (+ comint-last-input-end echo-len)))))) ;; This used to call comint-output-filter-functions, ;; but that scrolled the buffer in undesirable ways. @@ -1579,7 +1583,7 @@ (defun comint-snapshot-last-prompt () "`snapshot' any current `comint-last-prompt-overlay'. -freeze its attributes in place, even when more input comes a long +Freeze its attributes in place, even when more input comes along and moves the prompt overlay." (when comint-last-prompt-overlay (let ((inhibit-read-only t) @@ -2385,7 +2389,7 @@ "Compute the defaults for `load-file' and `compile-file' commands. PREVIOUS-DIR/FILE is a pair (directory . filename) from the last -source-file processing command. nil if there hasn't been one yet. +source-file processing command, or nil if there hasn't been one yet. SOURCE-MODES is a list used to determine what buffers contain source files: if the major mode of the buffer is in SOURCE-MODES, it's source. Typically, (lisp-mode) or (scheme-mode).
--- a/lisp/compare-w.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/compare-w.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; compare-w.el --- compare text between windows for Emacs -;; Copyright (C) 1986,1989,1993,1997,2003,2004 Free Software Foundation, Inc. +;; Copyright (C) 1986,1989,1993,1997,2003,2004,2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: convenience files @@ -116,7 +116,7 @@ :type 'boolean :group 'compare-w) -(defface compare-windows-face +(defface compare-windows '((((class color) (min-colors 88) (background light)) (:background "paleturquoise")) (((class color) (min-colors 88) (background dark)) @@ -126,6 +126,8 @@ (t (:underline t))) "Face for highlighting of compare-windows difference regions." :group 'compare-w) +;; backward-compatibility alias +(put 'compare-windows-face 'face-alias 'compare-windows) (defvar compare-windows-overlay1 nil) (defvar compare-windows-overlay2 nil) @@ -341,13 +343,13 @@ (if compare-windows-overlay1 (move-overlay compare-windows-overlay1 beg1 end1 b1) (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) - (overlay-put compare-windows-overlay1 'face 'compare-windows-face) + (overlay-put compare-windows-overlay1 'face 'compare-windows) (overlay-put compare-windows-overlay1 'priority 1)) (overlay-put compare-windows-overlay1 'window w1) (if compare-windows-overlay2 (move-overlay compare-windows-overlay2 beg2 end2 b2) (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) - (overlay-put compare-windows-overlay2 'face 'compare-windows-face) + (overlay-put compare-windows-overlay2 'face 'compare-windows) (overlay-put compare-windows-overlay2 'priority 1)) (overlay-put compare-windows-overlay2 'window w2) ;; Remove highlighting before next command is executed
--- a/lisp/cus-edit.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/cus-edit.el Wed Jun 15 23:32:15 2005 +0000 @@ -417,7 +417,7 @@ :group 'development) (defgroup minibuffer nil - "Controling the behaviour of the minibuffer." + "Controling the behavior of the minibuffer." :link '(custom-manual "(emacs)Minibuffer") :group 'environment) @@ -1636,50 +1636,62 @@ :group 'custom-faces :group 'custom-buffer) -(defface custom-invalid-face '((((class color)) - (:foreground "yellow1" :background "red1")) - (t - (:weight bold :slant italic :underline t))) +(defface custom-invalid '((((class color)) + (:foreground "yellow1" :background "red1")) + (t + (:weight bold :slant italic :underline t))) "Face used when the customize item is invalid." :group 'custom-magic-faces) - -(defface custom-rogue-face '((((class color)) - (:foreground "pink" :background "black")) - (t - (:underline t))) +;; backward-compatibility alias +(put 'custom-invalid-face 'face-alias 'custom-invalid) + +(defface custom-rogue '((((class color)) + (:foreground "pink" :background "black")) + (t + (:underline t))) "Face used when the customize item is not defined for customization." :group 'custom-magic-faces) - -(defface custom-modified-face '((((min-colors 88) (class color)) - (:foreground "white" :background "blue1")) - (((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic :bold))) +;; backward-compatibility alias +(put 'custom-rogue-face 'face-alias 'custom-rogue) + +(defface custom-modified '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (:slant italic :bold))) "Face used when the customize item has been modified." :group 'custom-magic-faces) - -(defface custom-set-face '((((min-colors 88) (class color)) - (:foreground "blue1" :background "white")) - (((class color)) - (:foreground "blue" :background "white")) - (t - (:slant italic))) +;; backward-compatibility alias +(put 'custom-modified-face 'face-alias 'custom-modified) + +(defface custom-set '((((min-colors 88) (class color)) + (:foreground "blue1" :background "white")) + (((class color)) + (:foreground "blue" :background "white")) + (t + (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) - -(defface custom-changed-face '((((min-colors 88) (class color)) - (:foreground "white" :background "blue1")) - (((class color)) - (:foreground "white" :background "blue")) - (t - (:slant italic))) +;; backward-compatibility alias +(put 'custom-set-face 'face-alias 'custom-set) + +(defface custom-changed '((((min-colors 88) (class color)) + (:foreground "white" :background "blue1")) + (((class color)) + (:foreground "white" :background "blue")) + (t + (:slant italic))) "Face used when the customize item has been changed." :group 'custom-magic-faces) - -(defface custom-saved-face '((t (:underline t))) +;; backward-compatibility alias +(put 'custom-changed-face 'face-alias 'custom-changed) + +(defface custom-saved '((t (:underline t))) "Face used when the customize item has been saved." :group 'custom-magic-faces) +;; backward-compatibility alias +(put 'custom-saved-face 'face-alias 'custom-saved) (defconst custom-magic-alist '((nil "#" underline "\ @@ -1689,21 +1701,21 @@ (hidden "-" default "\ HIDDEN, invoke \"Show\" in the previous line to show." "\ group now hidden, invoke \"Show\", above, to show contents.") - (invalid "x" custom-invalid-face "\ + (invalid "x" custom-invalid "\ INVALID, the displayed value cannot be set.") - (modified "*" custom-modified-face "\ + (modified "*" custom-modified "\ EDITED, shown value does not take effect until you set or save it." "\ something in this group has been edited but not set.") - (set "+" custom-set-face "\ + (set "+" custom-set "\ SET for current session only." "\ something in this group has been set but not saved.") - (changed ":" custom-changed-face "\ + (changed ":" custom-changed "\ CHANGED outside Customize; operating on it here may be unreliable." "\ something in this group has been changed outside customize.") - (saved "!" custom-saved-face "\ + (saved "!" custom-saved "\ SAVED and set." "\ something in this group has been set and saved.") - (rogue "@" custom-rogue-face "\ + (rogue "@" custom-rogue "\ NO CUSTOMIZATION DATA; you should not see this." "\ something in this group is not prepared for customization.") (standard " " nil "\ @@ -1830,7 +1842,7 @@ (insert " (lisp)")) ((eq form 'mismatch) (insert " (mismatch)"))) - (put-text-property start (point) 'face 'custom-state-face)) + (put-text-property start (point) 'face 'custom-state)) (insert "\n")) (when (and (eq category 'group) (not (and (eq custom-buffer-style 'links) @@ -1864,7 +1876,7 @@ ;;; The `custom' Widget. -(defface custom-button-face +(defface custom-button '((((type x w32 mac) (class color)) ; Like default modeline (:box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) @@ -1873,8 +1885,10 @@ "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) - -(defface custom-button-pressed-face +;; backward-compatibility alias +(put 'custom-button-face 'face-alias 'custom-button) + +(defface custom-button-pressed '((((type x w32 mac) (class color)) (:box (:line-width 2 :style pressed-button) :background "lightgrey" :foreground "black")) @@ -1883,20 +1897,26 @@ "Face used for buttons in customization buffers." :version "21.1" :group 'custom-faces) - -(defface custom-documentation-face nil +;; backward-compatibility alias +(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed) + +(defface custom-documentation nil "Face used for documentation strings in customization buffers." :group 'custom-faces) - -(defface custom-state-face '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) +;; backward-compatibility alias +(put 'custom-documentation-face 'face-alias 'custom-documentation) + +(defface custom-state '((((class color) + (background dark)) + (:foreground "lime green")) + (((class color) + (background light)) + (:foreground "dark green")) + (t nil)) "Face used for State descriptions in the customize buffer." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-state-face 'face-alias 'custom-state) (define-widget 'custom 'default "Customize a user option." @@ -2092,20 +2112,22 @@ ;;; The `custom-comment' Widget. ;; like the editable field -(defface custom-comment-face '((((class grayscale color) - (background light)) - (:background "gray85")) - (((class grayscale color) - (background dark)) - (:background "dim gray")) - (t - (:slant italic))) +(defface custom-comment '((((class grayscale color) + (background light)) + (:background "gray85")) + (((class grayscale color) + (background dark)) + (:background "dim gray")) + (t + (:slant italic))) "Face used for comments on variables or faces" :version "21.1" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-comment-face 'face-alias 'custom-comment) ;; like font-lock-comment-face -(defface custom-comment-tag-face +(defface custom-comment-tag '((((class color) (background dark)) (:foreground "gray80")) (((class color) (background light)) (:foreground "blue4")) (((class grayscale) (background light)) @@ -2115,6 +2137,8 @@ (t (:weight bold))) "Face used for variables or faces comment tags" :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag) (define-widget 'custom-comment 'string "User comment." @@ -2154,7 +2178,7 @@ ;; When this was underlined blue, users confused it with a ;; Mosaic-style hyperlink... -(defface custom-variable-tag-face +(defface custom-variable-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) @@ -2163,14 +2187,18 @@ (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) (((class color) (background light)) - (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) + (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) (t (:weight bold))) "Face used for unpushable variable tags." :group 'custom-faces) - -(defface custom-variable-button-face '((t (:underline t :weight bold))) +;; backward-compatibility alias +(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag) + +(defface custom-variable-button '((t (:underline t :weight bold))) "Face used for pushable variable tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-variable-button-face 'face-alias 'custom-variable-button) (defcustom custom-variable-default-form 'edit "Default form of displaying variable values." @@ -2874,10 +2902,12 @@ ;;; The `custom-face' Widget. -(defface custom-face-tag-face +(defface custom-face-tag `((t (:weight bold :height 1.2 :inherit variable-pitch))) "Face used for face tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-face-tag-face 'face-alias 'custom-face-tag) (defcustom custom-face-default-form 'selected "Default form of displaying face definition." @@ -3396,12 +3426,11 @@ ;; Fixme: make it do so in Emacs. "Face used for group tags. The first member is used for level 1 groups, the second for level 2, -and so forth. The remaining group tags are shown with -`custom-group-tag-face'." +and so forth. The remaining group tags are shown with `custom-group-tag'." :type '(repeat face) :group 'custom-faces) -(defface custom-group-tag-face-1 +(defface custom-group-tag-1 `((((class color) (background dark)) (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) @@ -3414,8 +3443,10 @@ (t (:weight bold))) "Face used for group tags." :group 'custom-faces) - -(defface custom-group-tag-face +;; backward-compatibility alias +(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1) + +(defface custom-group-tag `((((class color) (background dark)) (:foreground "light blue" :weight bold :height 1.2)) @@ -3428,6 +3459,8 @@ (t (:weight bold))) "Face used for low level group tags." :group 'custom-faces) +;; backward-compatibility alias +(put 'custom-group-tag-face 'face-alias 'custom-group-tag) (define-widget 'custom-group 'custom "Customize group." @@ -3448,7 +3481,7 @@ (defun custom-group-sample-face-get (widget) ;; Use :sample-face. (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) - 'custom-group-tag-face)) + 'custom-group-tag)) (define-widget 'custom-group-visibility 'visibility "An indicator and manipulator for hidden group contents." @@ -4261,13 +4294,12 @@ (make-local-variable 'custom-options) (make-local-variable 'custom-local-buffer) (make-local-variable 'widget-documentation-face) - (setq widget-documentation-face 'custom-documentation-face) + (setq widget-documentation-face 'custom-documentation) (make-local-variable 'widget-button-face) - (setq widget-button-face 'custom-button-face) - (set (make-local-variable 'widget-button-pressed-face) - 'custom-button-pressed-face) + (setq widget-button-face 'custom-button) + (set (make-local-variable 'widget-button-pressed-face) 'custom-button-pressed) (set (make-local-variable 'widget-mouse-face) - 'custom-button-pressed-face) ; buttons `depress' when moused + 'custom-button-pressed) ; buttons `depress' when moused ;; When possible, use relief for buttons, not bracketing. This test ;; may not be optimal. (when custom-raised-buttons
--- a/lisp/cus-start.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/cus-start.el Wed Jun 15 23:32:15 2005 +0000 @@ -325,6 +325,8 @@ (eq system-type 'ms-dos)) ((string-match "\\`w32-" (symbol-name symbol)) (eq system-type 'windows-nt)) + ((string-match "\\`x-.*gtk" (symbol-name symbol)) + (or (boundp 'gtk) (not (eq system-type 'windows-nt)))) ((string-match "\\`x-" (symbol-name symbol)) (fboundp 'x-create-frame)) (t t))))
--- a/lisp/cvs-status.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/cvs-status.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- -;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs cvs status tree tools @@ -73,8 +73,8 @@ (defconst cvs-status-font-lock-keywords `((,cvs-status-entry-leader-re - (1 'cvs-filename-face) - (2 'cvs-need-action-face)) + (1 'cvs-filename) + (2 'cvs-need-action)) (,cvs-status-tags-leader-re (,cvs-status-rev-re (save-excursion (re-search-forward "^\n" nil 'move) (point))
--- a/lisp/diff-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/diff-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -175,7 +175,7 @@ ;;;; font-lock support ;;;; -(defface diff-header-face +(defface diff-header '((((class color) (min-colors 88) (background light)) :background "grey85") (((class color) (min-colors 88) (background dark)) @@ -187,9 +187,11 @@ (t :weight bold)) "`diff-mode' face inherited by hunk and index header faces." :group 'diff-mode) -(defvar diff-header-face 'diff-header-face) +;; backward-compatibility alias +(put 'diff-header-face 'face-alias 'diff-header) +(defvar diff-header-face 'diff-header) -(defface diff-file-header-face +(defface diff-file-header '((((class color) (min-colors 88) (background light)) :background "grey70" :weight bold) (((class color) (min-colors 88) (background dark)) @@ -201,58 +203,76 @@ (t :weight bold)) ; :height 1.3 "`diff-mode' face used to highlight file header lines." :group 'diff-mode) -(defvar diff-file-header-face 'diff-file-header-face) +;; backward-compatibility alias +(put 'diff-file-header-face 'face-alias 'diff-file-header) +(defvar diff-file-header-face 'diff-file-header) -(defface diff-index-face - '((t :inherit diff-file-header-face)) +(defface diff-index + '((t :inherit diff-file-header)) "`diff-mode' face used to highlight index header lines." :group 'diff-mode) -(defvar diff-index-face 'diff-index-face) +;; backward-compatibility alias +(put 'diff-index-face 'face-alias 'diff-index) +(defvar diff-index-face 'diff-index) -(defface diff-hunk-header-face - '((t :inherit diff-header-face)) +(defface diff-hunk-header + '((t :inherit diff-header)) "`diff-mode' face used to highlight hunk header lines." :group 'diff-mode) -(defvar diff-hunk-header-face 'diff-hunk-header-face) +;; backward-compatibility alias +(put 'diff-hunk-header-face 'face-alias 'diff-hunk-header) +(defvar diff-hunk-header-face 'diff-hunk-header) -(defface diff-removed-face - '((t :inherit diff-changed-face)) +(defface diff-removed + '((t :inherit diff-changed)) "`diff-mode' face used to highlight removed lines." :group 'diff-mode) -(defvar diff-removed-face 'diff-removed-face) +;; backward-compatibility alias +(put 'diff-removed-face 'face-alias 'diff-removed) +(defvar diff-removed-face 'diff-removed) -(defface diff-added-face - '((t :inherit diff-changed-face)) +(defface diff-added + '((t :inherit diff-changed)) "`diff-mode' face used to highlight added lines." :group 'diff-mode) -(defvar diff-added-face 'diff-added-face) +;; backward-compatibility alias +(put 'diff-added-face 'face-alias 'diff-added) +(defvar diff-added-face 'diff-added) -(defface diff-changed-face +(defface diff-changed '((((type tty pc) (class color) (background light)) :foreground "magenta" :weight bold :slant italic) (((type tty pc) (class color) (background dark)) :foreground "yellow" :weight bold :slant italic)) "`diff-mode' face used to highlight changed lines." :group 'diff-mode) -(defvar diff-changed-face 'diff-changed-face) +;; backward-compatibility alias +(put 'diff-changed-face 'face-alias 'diff-changed) +(defvar diff-changed-face 'diff-changed) -(defface diff-function-face - '((t :inherit diff-context-face)) +(defface diff-function + '((t :inherit diff-context)) "`diff-mode' face used to highlight function names produced by \"diff -p\"." :group 'diff-mode) -(defvar diff-function-face 'diff-function-face) +;; backward-compatibility alias +(put 'diff-function-face 'face-alias 'diff-function) +(defvar diff-function-face 'diff-function) -(defface diff-context-face +(defface diff-context '((t :inherit shadow)) "`diff-mode' face used to highlight context and other side-information." :group 'diff-mode) -(defvar diff-context-face 'diff-context-face) +;; backward-compatibility alias +(put 'diff-context-face 'face-alias 'diff-context) +(defvar diff-context-face 'diff-context) -(defface diff-nonexistent-face - '((t :inherit diff-file-header-face)) +(defface diff-nonexistent + '((t :inherit diff-file-header)) "`diff-mode' face used to highlight nonexistent files in recursive diffs." :group 'diff-mode) -(defvar diff-nonexistent-face 'diff-nonexistent-face) +;; backward-compatibility alias +(put 'diff-nonexistent-face 'face-alias 'diff-nonexistent) +(defvar diff-nonexistent-face 'diff-nonexistent) (defconst diff-yank-handler '(diff-yank-function)) (defun diff-yank-function (text) @@ -915,7 +935,7 @@ Supports unified and context diffs as well as (to a lesser extent) normal diffs. When the buffer is read-only, the ESC prefix is not necessary. -IF you edit the buffer manually, diff-mode will try to update the hunk +If you edit the buffer manually, diff-mode will try to update the hunk headers for you on-the-fly. You can also switch between context diff and unified diff with \\[diff-context->unified],
--- a/lisp/ediff-mult.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ediff-mult.el Wed Jun 15 23:32:15 2005 +0000 @@ -410,7 +410,8 @@ \\{ediff-meta-buffer-map}" (kill-all-local-variables) (setq major-mode 'ediff-meta-mode) - (setq mode-name "MetaEdiff")) + (setq mode-name "MetaEdiff") + (run-mode-hooks 'ediff-meta-mode-hook)) ;; the keymap for the buffer showing directory differences
--- a/lisp/ediff-util.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ediff-util.el Wed Jun 15 23:32:15 2005 +0000 @@ -117,7 +117,7 @@ (kill-all-local-variables) (setq major-mode 'ediff-mode) (setq mode-name "Ediff") - (run-hooks 'ediff-mode-hook)) + (run-mode-hooks 'ediff-mode-hook))
--- a/lisp/emacs-lisp/bindat.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/bindat.el Wed Jun 15 23:32:15 2005 +0000 @@ -85,7 +85,7 @@ ;; (items u8) ;; (fill 3) ;; (item repeat (items) -;; ((struct data-spec))))) +;; (struct data-spec)))) ;; ;; ;; A binary data representation may look like @@ -131,7 +131,7 @@ ;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes ;; | ( [FIELD] struct SPEC_NAME ) ;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] ) -;; | ( [FIELD] repeat COUNT SPEC ) +;; | ( [FIELD] repeat COUNT ITEM... ) ;; -- In (eval EXPR), the value of the last field is available in ;; the dynamically bound variable `last'. @@ -151,7 +151,8 @@ ;; -- Note: 32 bit values may be limited by emacs' INTEGER ;; implementation limits. ;; -;; -- Example: bits 2 will map bytes 0x1c 0x28 to list (2 3 7 11 13) +;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13) +;; and 0x1c 0x28 to (3 5 10 11 12). ;; FIELD ::= ( eval EXPR ) -- use result as NAME ;; | NAME
--- a/lisp/emacs-lisp/byte-run.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/byte-run.el Wed Jun 15 23:32:15 2005 +0000 @@ -100,23 +100,23 @@ (eval-and-compile (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) -(defun make-obsolete (function new &optional when) - "Make the byte-compiler warn that FUNCTION is obsolete. -The warning will say that NEW should be used instead. -If NEW is a string, that is the `use instead' message. +(defun make-obsolete (obsolete-name current-name &optional when) + "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. +The warning will say that CURRENT-NAME should be used instead. +If CURRENT-NAME is a string, that is the `use instead' message. If provided, WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number." (interactive "aMake function obsolete: \nxObsoletion replacement: ") - (let ((handler (get function 'byte-compile))) + (let ((handler (get obsolete-name 'byte-compile))) (if (eq 'byte-compile-obsolete handler) - (setq handler (nth 1 (get function 'byte-obsolete-info))) - (put function 'byte-compile 'byte-compile-obsolete)) - (put function 'byte-obsolete-info (list new handler when))) - function) + (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info))) + (put obsolete-name 'byte-compile 'byte-compile-obsolete)) + (put obsolete-name 'byte-obsolete-info (list current-name handler when))) + obsolete-name) -(defmacro define-obsolete-function-alias (function new +(defmacro define-obsolete-function-alias (obsolete-name current-name &optional when docstring) - "Set FUNCTION's function definition to NEW and mark it obsolete. + "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete. \(define-obsolete-function-alias 'old-fun 'new-fun \"22.1\" \"old-fun's doc.\") @@ -127,13 +127,13 @@ See the docstrings of `defalias' and `make-obsolete' for more details." `(progn - (defalias ,function ,new ,docstring) - (make-obsolete ,function ,new ,when))) + (defalias ,obsolete-name ,current-name ,docstring) + (make-obsolete ,obsolete-name ,current-name ,when))) -(defun make-obsolete-variable (variable new &optional when) - "Make the byte-compiler warn that VARIABLE is obsolete. -The warning will say that NEW should be used instead. -If NEW is a string, that is the `use instead' message. +(defun make-obsolete-variable (obsolete-name current-name &optional when) + "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. +The warning will say that CURRENT-NAME should be used instead. +If CURRENT-NAME is a string, that is the `use instead' message. If provided, WHEN should be a string indicating when the variable was first made obsolete, for example a date or a release number." (interactive @@ -142,12 +142,12 @@ (if (equal str "") (error "")) (intern str)) (car (read-from-string (read-string "Obsoletion replacement: "))))) - (put variable 'byte-obsolete-variable (cons new when)) - variable) + (put obsolete-name 'byte-obsolete-variable (cons current-name when)) + obsolete-name) -(defmacro define-obsolete-variable-alias (variable new +(defmacro define-obsolete-variable-alias (obsolete-name current-name &optional when docstring) - "Make VARIABLE a variable alias for NEW and mark it obsolete. + "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. \(define-obsolete-variable-alias 'old-var 'new-var \"22.1\" \"old-var's doc.\") @@ -159,8 +159,8 @@ See the docstrings of `defvaralias' and `make-obsolete-variable' or Info node `(elisp)Variable Aliases' for more details." `(progn - (defvaralias ,variable ,new ,docstring) - (make-obsolete-variable ,variable ,new ,when))) + (defvaralias ,obsolete-name ,current-name ,docstring) + (make-obsolete-variable ,obsolete-name ,current-name ,when))) (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled).
--- a/lisp/emacs-lisp/debug.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/debug.el Wed Jun 15 23:32:15 2005 +0000 @@ -614,7 +614,7 @@ (terpri)) (with-current-buffer (get-buffer debugger-record-buffer) - (message "%s" + (message "%s" (buffer-substring (line-beginning-position 0) (line-end-position 0))))) @@ -656,22 +656,29 @@ ;;;###autoload (defun debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. -If you tell the debugger to continue, FUNCTION's execution proceeds. -This works by modifying the definition of FUNCTION, -which must be written in Lisp, not predefined. + +When called interactively, prompt for FUNCTION in the minibuffer. + +This works by modifying the definition of FUNCTION. If you tell the +debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a +normal function or a macro written in Lisp, you can also step through +its execution. FUNCTION can also be a primitive that is not a special +form, in which case stepping is not possible. Break-on-entry for +primitive functions only works when that function is called from Lisp. + Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive "aDebug on entry (to function): ") - (when (and (subrp (symbol-function function)) + (when (and (subrp (symbol-function function)) (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) (error "Function %s is a special form" function)) - (if (or (symbolp (symbol-function function)) + (if (or (symbolp (symbol-function function)) (subrp (symbol-function function))) ;; The function is built-in or aliased to another function. ;; Create a wrapper in which we can add the debug call. (fset function `(lambda (&rest debug-on-entry-args) ,(interactive-form (symbol-function function)) - (apply ',(symbol-function function) + (apply ',(symbol-function function) debug-on-entry-args))) (when (eq (car-safe (symbol-function function)) 'autoload) ;; The function is autoloaded. Load its real definition. @@ -692,14 +699,19 @@ ;;;###autoload (defun cancel-debug-on-entry (&optional function) "Undo effect of \\[debug-on-entry] on FUNCTION. -If argument is nil or an empty string, cancel for all functions." +If FUNCTION is nil, cancel debug-on-entry for all functions. +When called interactively, prompt for FUNCTION in the minibuffer. +To specify a nil argument interactively, exit with an empty minibuffer." (interactive (list (let ((name - (completing-read "Cancel debug on entry (to function): " - (mapcar 'symbol-name debug-function-list) - nil t nil))) - (if name (intern name))))) - (if (and function (not (string= function ""))) + (completing-read + "Cancel debug on entry to function (default: all functions): " + (mapcar 'symbol-name debug-function-list) nil t))) + (when name + (unless (string= name "") + (intern name)))))) + (if (and function + (not (string= function ""))) ; Pre 22.1 compatibility test. (progn (let ((defn (debug-on-entry-1 function nil))) (condition-case nil @@ -739,7 +751,7 @@ (defun debug-on-entry-1 (function flag) (let* ((defn (symbol-function function)) (tail defn)) - (when (eq (car-safe tail) 'macro) + (when (eq (car-safe tail) 'macro) (setq tail (cdr tail))) (if (not (eq (car-safe tail) 'lambda)) ;; Only signal an error when we try to set debug-on-entry.
--- a/lisp/emacs-lisp/derived.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/derived.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,5 +1,5 @@ ;;; derived.el --- allow inheritance of major modes -;;; (formerly mode-clone.el) +;; (formerly mode-clone.el) ;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc. @@ -221,6 +221,12 @@ (get (quote ,parent) 'mode-class))) ; Set up maps and tables. (unless (keymap-parent ,map) + ;; It would probably be better to set the keymap's parent + ;; at the toplevel rather than inside the mode function, + ;; but this is not easy for at least the following reasons: + ;; - the parent (and its keymap) may not yet be loaded. + ;; - the parent's keymap name may be called something else + ;; than <parent>-mode-map. (set-keymap-parent ,map (current-local-map))) ,(when declare-syntax `(let ((parent (char-table-parent ,syntax))) @@ -440,5 +446,5 @@ (provide 'derived) -;;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0 +;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0 ;;; derived.el ends here
--- a/lisp/emacs-lisp/edebug.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/edebug.el Wed Jun 15 23:32:15 2005 +0000 @@ -80,7 +80,7 @@ ;;;###autoload (defcustom edebug-all-defs nil - "*If non-nil, evaluation of any defining forms will instrument for Edebug. + "*If non-nil, evaluating defining forms instruments for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and `eval-current-buffer'. `eval-region' is also called by `eval-last-sexp', and `eval-print-last-sexp'. @@ -141,10 +141,10 @@ :group 'edebug) (defcustom edebug-initial-mode 'step - "*Initial execution mode for Edebug, if non-nil. If this variable -is non-@code{nil}, it specifies the initial execution mode for Edebug -when it is first activated. Possible values are step, next, go, -Go-nonstop, trace, Trace-fast, continue, and Continue-fast." + "*Initial execution mode for Edebug, if non-nil. +If this variable is non-nil, it specifies the initial execution mode +for Edebug when it is first activated. Possible values are step, next, +go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast." :type '(choice (const step) (const next) (const go) (const Go-nonstop) (const trace) (const Trace-fast) (const continue) @@ -180,15 +180,15 @@ (defcustom edebug-print-length 50 - "*Default value of `print-length' to use while printing results in Edebug." + "*Default value of `print-length' for printing results in Edebug." :type 'integer :group 'edebug) (defcustom edebug-print-level 50 - "*Default value of `print-level' to use while printing results in Edebug." + "*Default value of `print-level' for printing results in Edebug." :type 'integer :group 'edebug) (defcustom edebug-print-circle t - "*Default value of `print-circle' to use while printing results in Edebug." + "*Default value of `print-circle' for printing results in Edebug." :type 'boolean :group 'edebug) @@ -3189,8 +3189,8 @@ (defun edebug-modify-breakpoint (flag &optional condition temporary) - "Modify the breakpoint for the form at point or after it according -to FLAG: set if t, clear if nil. Then move to that point. + "Modify the breakpoint for the form at point or after it. +Set it if FLAG is non-nil, clear it otherwise. Then move to that point. If CONDITION or TEMPORARY are non-nil, add those attributes to the breakpoint. " (let ((edebug-stop-point (edebug-find-stop-point))) @@ -3729,12 +3729,13 @@ (eval-expression-print-format (car values)))))) (defun edebug-eval-last-sexp () - "Evaluate sexp before point in the outside environment; value in minibuffer." + "Evaluate sexp before point in the outside environment. +Print value in minibuffer." (interactive) (edebug-eval-expression (edebug-last-sexp))) (defun edebug-eval-print-last-sexp () - "Evaluate sexp before point in the outside environment; insert the value. + "Evaluate sexp before point in outside environment; insert value. This prints the value into current buffer." (interactive) (let* ((edebug-form (edebug-last-sexp)) @@ -4014,20 +4015,19 @@ (defvar edebug-eval-mode-map nil "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") -(if edebug-eval-mode-map - nil - (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map)) +(unless edebug-eval-mode-map + (setq edebug-eval-mode-map (make-sparse-keymap)) + (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map) (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where) (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item) (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list) (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) - (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp) - ) + (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)) (put 'edebug-eval-mode 'mode-class 'special) -(defun edebug-eval-mode () +(define-derived-mode edebug-eval-mode lisp-interaction-mode "Edebug Eval" "Mode for evaluation list buffer while in Edebug. In addition to all Interactive Emacs Lisp commands there are local and @@ -4039,12 +4039,7 @@ \\{edebug-eval-mode-map} Global commands prefixed by global-edebug-prefix: -\\{global-edebug-map} -" - (lisp-interaction-mode) - (setq major-mode 'edebug-eval-mode) - (setq mode-name "Edebug Eval") - (use-local-map edebug-eval-mode-map)) +\\{global-edebug-map}") ;;; Interface with standard debugger.
--- a/lisp/emacs-lisp/ewoc.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/ewoc.el Wed Jun 15 23:32:15 2005 +0000 @@ -264,7 +264,7 @@ (defun ewoc--delete-node-internal (ewoc node) "Delete a data string from EWOC. -Can not be used on the footer. Returns the wrapper that is deleted. +Can not be used on the footer. Return the wrapper that is deleted. The start-marker in the wrapper is set to nil, so that it doesn't consume any more resources." (let ((dll (ewoc--dll ewoc)) @@ -334,25 +334,27 @@ (defalias 'ewoc-data 'ewoc--node-data) (defun ewoc-enter-first (ewoc data) - "Enter DATA first in EWOC." + "Enter DATA first in EWOC. +Return the new node." (ewoc--set-buffer-bind-dll ewoc (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data))) (defun ewoc-enter-last (ewoc data) - "Enter DATA last in EWOC." + "Enter DATA last in EWOC. +Return the new node." (ewoc--set-buffer-bind-dll ewoc (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) (defun ewoc-enter-after (ewoc node data) "Enter a new element DATA after NODE in EWOC. -Returns the new NODE." +Return the new node." (ewoc--set-buffer-bind-dll ewoc (ewoc-enter-before ewoc (ewoc--node-next dll node) data))) (defun ewoc-enter-before (ewoc node data) "Enter a new element DATA before NODE in EWOC. -Returns the new NODE." +Return the new node." (ewoc--set-buffer-bind-dll ewoc (ewoc--node-enter-before node @@ -362,15 +364,15 @@ (ewoc--node-start-marker node))))) (defun ewoc-next (ewoc node) - "Get the next node. -Returns nil if NODE is nil or the last element." + "Return the node in EWOC that follows NODE. +Return nil if NODE is nil or the last element." (when node (ewoc--filter-hf-nodes ewoc (ewoc--node-next (ewoc--dll ewoc) node)))) (defun ewoc-prev (ewoc node) - "Get the previous node. -Returns nil if NODE is nil or the first element." + "Return the node in EWOC that precedes NODE. +Return nil if NODE is nil or the first element." (when node (ewoc--filter-hf-nodes ewoc @@ -497,16 +499,16 @@ best-guess))))))) (defun ewoc-invalidate (ewoc &rest nodes) - "Refresh some elements. -The pretty-printer set for EWOC will be called for all NODES." + "Call EWOC's pretty-printer for each element in NODES. +Delete current text first, thus effecting a \"refresh\"." (ewoc--set-buffer-bind-dll ewoc (dolist (node nodes) (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)))) (defun ewoc-goto-prev (ewoc arg) - "Move point to the ARGth previous element. + "Move point to the ARGth previous element in EWOC. Don't move if we are at the first element, or if EWOC is empty. -Returns the node we moved to." +Return the node we moved to." (ewoc--set-buffer-bind-dll-let* ewoc ((node (ewoc-locate ewoc (point)))) (when node @@ -522,8 +524,8 @@ (ewoc-goto-node ewoc node)))) (defun ewoc-goto-next (ewoc arg) - "Move point to the ARGth next element. -Returns the node (or nil if we just passed the last node)." + "Move point to the ARGth next element in EWOC. +Return the node (or nil if we just passed the last node)." (ewoc--set-buffer-bind-dll-let* ewoc ((node (ewoc-locate ewoc (point)))) (while (and node (> arg 0)) @@ -535,7 +537,7 @@ (ewoc-goto-node ewoc node))) (defun ewoc-goto-node (ewoc node) - "Move point to NODE." + "Move point to NODE in EWOC." (ewoc--set-buffer-bind-dll ewoc (goto-char (ewoc--node-start-marker node)) (if goal-column (move-to-column goal-column)) @@ -586,7 +588,7 @@ (defun ewoc-buffer (ewoc) "Return the buffer that is associated with EWOC. -Returns nil if the buffer has been deleted." +Return nil if the buffer has been deleted." (let ((buf (ewoc--buffer ewoc))) (when (buffer-name buf) buf)))
--- a/lisp/emacs-lisp/testcover.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emacs-lisp/testcover.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;;; testcover.el -- Visual code-coverage tool -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2005 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> @@ -150,15 +150,19 @@ 1-valued, no error if actually multi-valued." :group 'testcover) -(defface testcover-nohits-face +(defface testcover-nohits '((t (:background "DeepPink2"))) "Face for forms that had no hits during coverage test" :group 'testcover) +;; backward-compatibility alias +(put 'testcover-nohits-face 'face-alias 'testcover-nohits) -(defface testcover-1value-face +(defface testcover-1value '((t (:background "Wheat2"))) "Face for forms that always produced the same value during coverage test" :group 'testcover) +;; backward-compatibility alias +(put 'testcover-1value-face 'face-alias 'testcover-1value) ;;;========================================================================= @@ -477,8 +481,8 @@ (defun testcover-mark (def) "Marks one DEF (a function or macro symbol) to highlight its contained forms that did not get completely tested during coverage tests. - A marking of testcover-nohits-face (default = red) indicates that the -form was never evaluated. A marking of testcover-1value-face + A marking with the face `testcover-nohits' (default = red) indicates that the +form was never evaluated. A marking using the `testcover-1value' face \(default = tan) indicates that the form always evaluated to the same value. The forms throw, error, and signal are not marked. They do not return and would always get a red mark. Some forms that always return the same @@ -506,8 +510,8 @@ (setq ov (make-overlay (1- j) j)) (overlay-put ov 'face (if (memq data '(unknown 1value)) - 'testcover-nohits-face - 'testcover-1value-face)))) + 'testcover-nohits + 'testcover-1value)))) (set-buffer-modified-p changed)))) (defun testcover-mark-all (&optional buffer)
--- a/lisp/emulation/cua-base.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/cua-base.el Wed Jun 15 23:32:15 2005 +0000 @@ -447,13 +447,13 @@ (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (cons :tag "Color and Type" (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (color :tag "Color"))) :group 'cua) @@ -471,13 +471,13 @@ (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (cons :tag "Color and Type" (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (color :tag "Color"))) :group 'cua) @@ -495,13 +495,13 @@ (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (cons :tag "Color and Type" (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (color :tag "Color"))) :group 'cua) @@ -520,13 +520,13 @@ (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (cons :tag "Color and Type" (choice :tag "Type" (const :tag "Filled box" box) (const :tag "Vertical bar" bar) - (const :tag "Horisontal bar" hbar) + (const :tag "Horizontal bar" hbar) (const :tag "Hollow box" hollow)) (color :tag "Color"))) :group 'cua) @@ -1360,7 +1360,7 @@ (if (not cua-mode) (setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists)) - (add-to-list 'emulation-mode-map-alists 'cua--keymap-alist) + (add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400) (cua--select-keymaps)) (cond
--- a/lisp/emulation/pc-select.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/pc-select.el Wed Jun 15 23:32:15 2005 +0000 @@ -99,7 +99,7 @@ (defcustom pc-select-selection-keys-only nil "*Non-nil means only bind the basic selection keys when started. Other keys that emulate pc-behavior will be untouched. -This gives mostly Emacs-like behaviour with only the selection keys enabled." +This gives mostly Emacs-like behavior with only the selection keys enabled." :type 'boolean :group 'pc-select) @@ -825,7 +825,7 @@ ;;;###autoload (define-minor-mode pc-selection-mode - "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style. + "Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style. This mode enables Delete Selection mode and Transient Mark mode. @@ -971,7 +971,7 @@ ;;;###autoload (defcustom pc-selection-mode nil "Toggle PC Selection mode. -Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style, +Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style, and cursor movement commands. This mode enables Delete Selection mode and Transient Mark mode. Setting this variable directly does not take effect;
--- a/lisp/emulation/vi.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/vi.el Wed Jun 15 23:32:15 2005 +0000 @@ -520,7 +520,7 @@ "Go into insert state, the text entered will be repeated if REPETITION > 1. If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. In any case, the prefix-code will be done before each 'redo-insert'. -This function expects 'overwrite-mode' being set properly beforehand." +This function expects `overwrite-mode' being set properly beforehand." (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) (setq vi-ins-point (point)) (setq vi-ins-repetition repetition)
--- a/lisp/emulation/vip.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/vip.el Wed Jun 15 23:32:15 2005 +0000 @@ -1342,7 +1342,7 @@ (defun vip-find-char-forward (arg) "Find char on the line. If called interactively read the char to find from the terminal, and if called from vip-repeat, the char last used is -used. This behaviour is controlled by the sign of prefix numeric value." +used. This behavior is controlled by the sign of prefix numeric value." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getcom arg))) (if (> val 0)
--- a/lisp/emulation/viper-cmd.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/viper-cmd.el Wed Jun 15 23:32:15 2005 +0000 @@ -3131,7 +3131,7 @@ (defun viper-find-char-forward (arg) "Find char on the line. If called interactively read the char to find from the terminal, and if -called from viper-repeat, the char last used is used. This behaviour is +called from viper-repeat, the char last used is used. This behavior is controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) @@ -3672,8 +3672,8 @@ (sit-for 2) (viper-unrecord-kbd-macro "///" 'vi-state))) )) - - + + (defun viper-set-parsing-style-toggling-macro (unset) "Set `%%%' to be a macro that toggles whether comment fields should be parsed for matching parentheses. This is used in conjunction with the `%' command.
--- a/lisp/emulation/viper-init.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/emulation/viper-init.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; viper-init.el --- some common definitions for Viper -;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc. +;; Copyright (C) 1997, 98, 99, 2000, 01, 02, 05 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> @@ -850,74 +850,84 @@ :group 'viper) -(defface viper-search-face +(defface viper-search '((((class color)) (:foreground "Black" :background "khaki")) (t (:underline t :stipple "gray3"))) "*Face used to flash out the search pattern." :group 'viper-highlighting) +;; backward-compatibility alias +(put 'viper-search-face 'face-alias 'viper-search) ;; An internal variable. Viper takes the face from here. -(defvar viper-search-face 'viper-search-face +(defvar viper-search-face 'viper-search "Face used to flash out the search pattern. DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `viper-search-face' this variable represents.") -(viper-hide-face 'viper-search-face) +(viper-hide-face 'viper-search) -(defface viper-replace-overlay-face +(defface viper-replace-overlay '((((class color)) (:foreground "Black" :background "darkseagreen2")) (t (:underline t :stipple "gray3"))) "*Face for highlighting replace regions on a window display." :group 'viper-highlighting) +;; backward-compatibility alias +(put 'viper-replace-overlay-face 'face-alias 'viper-replace-overlay) ;; An internal variable. Viper takes the face from here. -(defvar viper-replace-overlay-face 'viper-replace-overlay-face +(defvar viper-replace-overlay-face 'viper-replace-overlay "Face for highlighting replace regions on a window display. DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `viper-replace-overlay-face' this variable represents.") -(viper-hide-face 'viper-replace-overlay-face) +(viper-hide-face 'viper-replace-overlay) -(defface viper-minibuffer-emacs-face +(defface viper-minibuffer-emacs '((((class color)) (:foreground "Black" :background "darkseagreen2")) (t (:weight bold))) "Face used in the Minibuffer when it is in Emacs state." :group 'viper-highlighting) +;; backward-compatibility alias +(put 'viper-minibuffer-emacs-face 'face-alias 'viper-minibuffer-emacs) ;; An internal variable. Viper takes the face from here. -(defvar viper-minibuffer-emacs-face 'viper-minibuffer-emacs-face +(defvar viper-minibuffer-emacs-face 'viper-minibuffer-emacs "Face used in the Minibuffer when it is in Emacs state. DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `viper-minibuffer-emacs-face' this variable represents.") -(viper-hide-face 'viper-minibuffer-emacs-face) +(viper-hide-face 'viper-minibuffer-emacs) -(defface viper-minibuffer-insert-face +(defface viper-minibuffer-insert '((((class color)) (:foreground "Black" :background "pink")) (t (:slant italic))) "Face used in the Minibuffer when it is in Insert state." :group 'viper-highlighting) +;; backward-compatibility alias +(put 'viper-minibuffer-insert-face 'face-alias 'viper-minibuffer-insert) ;; An internal variable. Viper takes the face from here. -(defvar viper-minibuffer-insert-face 'viper-minibuffer-insert-face +(defvar viper-minibuffer-insert-face 'viper-minibuffer-insert "Face used in the Minibuffer when it is in Insert state. DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `viper-minibuffer-insert-face' this variable represents.") -(viper-hide-face 'viper-minibuffer-insert-face) +(viper-hide-face 'viper-minibuffer-insert) -(defface viper-minibuffer-vi-face +(defface viper-minibuffer-vi '((((class color)) (:foreground "DarkGreen" :background "grey")) (t (:inverse-video t))) "Face used in the Minibuffer when it is in Vi state." :group 'viper-highlighting) +;; backward-compatibility alias +(put 'viper-minibuffer-vi-face 'face-alias 'viper-minibuffer-vi) ;; An internal variable. Viper takes the face from here. -(defvar viper-minibuffer-vi-face 'viper-minibuffer-vi-face +(defvar viper-minibuffer-vi-face 'viper-minibuffer-vi "Face used in the Minibuffer when it is in Vi state. DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `viper-minibuffer-vi-face' this variable represents.") -(viper-hide-face 'viper-minibuffer-vi-face) +(viper-hide-face 'viper-minibuffer-vi) ;; the current face to be used in the minibuffer (viper-deflocalvar
--- a/lisp/eshell/esh-var.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/eshell/esh-var.el Wed Jun 15 23:32:15 2005 +0000 @@ -297,7 +297,7 @@ nil) (defun eshell/export (&rest sets) - "This alias allows the 'export' command to act as bash users expect." + "This alias allows the `export' command to act as bash users expect." (while sets (if (and (stringp (car sets)) (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets)))
--- a/lisp/faces.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/faces.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; faces.el --- Lisp faces -;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004 +;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004,2005 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -854,6 +854,8 @@ Otherwise, return a single face." (let ((faceprop (or (get-char-property (point) 'read-face-name) (get-char-property (point) 'face))) + (aliasfaces nil) + (nonaliasfaces nil) faces) ;; Make a list of the named faces that the `face' property uses. (if (and (listp faceprop) @@ -870,6 +872,13 @@ (memq (intern-soft (thing-at-point 'symbol)) (face-list))) (setq faces (list (intern-soft (thing-at-point 'symbol))))) + ;; Build up the completion tables. + (mapatoms (lambda (s) + (if (custom-facep s) + (if (get s 'face-alias) + (push (symbol-name s) aliasfaces) + (push (symbol-name s) nonaliasfaces))))) + ;; If we only want one, and the default is more than one, ;; discard the unwanted ones now. (unless multiple @@ -883,7 +892,7 @@ (if faces (mapconcat 'symbol-name faces ", ") string-describing-default)) (format "%s: " prompt)) - obarray 'custom-facep t)) + (complete-in-turn nonaliasfaces aliasfaces) nil t)) ;; Canonicalize the output. (output (if (equal input "") @@ -1864,7 +1873,7 @@ ;; Make `modeline' an alias for `mode-line', for compatibility. (put 'modeline 'face-alias 'mode-line) (put 'modeline-inactive 'face-alias 'mode-line-inactive) -(put 'modeline-higilight 'face-alias 'mode-line-highlight) +(put 'modeline-highlight 'face-alias 'mode-line-highlight) (defface header-line '((default @@ -2290,5 +2299,5 @@ (provide 'faces) -;;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 +;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 ;;; faces.el ends here
--- a/lisp/files.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/files.el Wed Jun 15 23:32:15 2005 +0000 @@ -1766,12 +1766,12 @@ ("\\.ad[abs]\\'" . ada-mode) ("\\.ad[bs].dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) - ("GNUmakefile\\'" . makefile-gmake-mode) ,@(if (memq system-type '(berkeley-unix next-mach darwin)) '(("\\.mk\\'" . makefile-bsdmake-mode) + ("GNUmakefile\\'" . makefile-gmake-mode) ("[Mm]akefile\\'" . makefile-bsdmake-mode)) '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage - ("[Mm]akefile\\'" . makefile-mode))) + ("[Mm]akefile\\'" . makefile-gmake-mode))) ("Makeppfile\\'" . makefile-makepp-mode) ("\\.am\\'" . makefile-automake-mode) ;; Less common extensions come here @@ -2854,7 +2854,7 @@ (defcustom make-backup-file-name-function nil "A function to use instead of the default `make-backup-file-name'. -A value of nil gives the default `make-backup-file-name' behaviour. +A value of nil gives the default `make-backup-file-name' behavior. This could be buffer-local to do something special for specific files. If you define it, you may need to change `backup-file-name-p'
--- a/lisp/filesets.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/filesets.el Wed Jun 15 23:32:15 2005 +0000 @@ -650,8 +650,8 @@ Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a function or a command name as string. -Properties is an association list determining filesets' behaviour in -several conditions. Choose one from this list: +Properties is an association list determining filesets' behavior in +several conditions. Choose one from this list: :ignore-on-open-all ... Don't open files of this type automatically -- i.e. on open-all-files-events or when running commands
--- a/lisp/forms.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/forms.el Wed Jun 15 23:32:15 2005 +0000 @@ -550,7 +550,7 @@ (eq (length forms-multi-line) 1)) (if (string= forms-multi-line forms-field-sep) (error (concat "Forms control file error: " - "`forms-multi-line' is equal to 'forms-field-sep'"))) + "`forms-multi-line' is equal to `forms-field-sep'"))) (error (concat "Forms control file error: " "`forms-multi-line' must be nil or a one-character string")))) (or (fboundp 'set-text-properties) @@ -1207,7 +1207,7 @@ ;; Need a file to do this. (if (not (file-exists-p forms-file)) - (error "Need existing file or explicit 'forms-number-of-records'") + (error "Need existing file or explicit `forms-number-of-fields'") ;; Visit the file and extract the first record. (setq forms--file-buffer (find-file-noselect forms-file)) @@ -1983,7 +1983,7 @@ (goto-char (aref forms--markers (1- (length forms--markers))))))) (defun forms-print () - "Send the records to the printer with 'print-buffer', one record per page." + "Send the records to the printer with `print-buffer', one record per page." (interactive) (let ((inhibit-read-only t) (save-record forms--current-record)
--- a/lisp/frame.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/frame.el Wed Jun 15 23:32:15 2005 +0000 @@ -969,9 +969,9 @@ (defun frame-current-scroll-bars (&optional frame) "Return the current scroll-bar settings in frame FRAME. -Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the +Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the current location of the vertical scroll-bars (left, right, or nil), -and HORISONTAL specifies the current location of the horisontal scroll +and HORIZONTAL specifies the current location of the horizontal scroll bars (top, bottom, or nil)." (let ((vert (frame-parameter frame 'vertical-scroll-bars)) (hor nil))
--- a/lisp/generic-x.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/generic-x.el Wed Jun 15 23:32:15 2005 +0000 @@ -1733,17 +1733,17 @@ (defconst show-tabs-generic-mode-font-lock-defaults-1 '(;; trailing spaces must come before... - ("[ \t]+$" . 'show-tabs-space-face) + ("[ \t]+$" . 'show-tabs-space) ;; ...embedded tabs - ("[^\n\t]\\(\t+\\)" (1 'show-tabs-tab-face)))) + ("[^\n\t]\\(\t+\\)" (1 'show-tabs-tab)))) (defconst show-tabs-generic-mode-font-lock-defaults-2 '(;; trailing spaces must come before... - ("[ \t]+$" . 'show-tabs-space-face) + ("[ \t]+$" . 'show-tabs-space) ;; ...tabs - ("\t+" . 'show-tabs-tab-face)))) + ("\t+" . 'show-tabs-tab)))) -(defface show-tabs-tab-face +(defface show-tabs-tab '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) (((class grayscale) (background dark)) (:background "LightGray" :weight bold)) (((class color) (min-colors 88)) (:background "red1")) @@ -1751,8 +1751,10 @@ (t (:weight bold))) "Font Lock mode face used to highlight TABs." :group 'generic-x) +;; backward-compatibility alias +(put 'show-tabs-tab-face 'face-alias 'show-tabs-tab) -(defface show-tabs-space-face +(defface show-tabs-space '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) (((class grayscale) (background dark)) (:background "LightGray" :weight bold)) (((class color) (min-colors 88)) (:background "yellow1")) @@ -1760,6 +1762,8 @@ (t (:weight bold))) "Font Lock mode face used to highlight spaces." :group 'generic-x) +;; backward-compatibility alias +(put 'show-tabs-space-face 'face-alias 'show-tabs-space) (define-generic-mode show-tabs-generic-mode nil ;; no comment char
--- a/lisp/gnus/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,22 @@ +2005-06-14 Juanma Barranquero <lekktu@gmail.com> + + * gnus-sieve.el (gnus-sieve-article-add-rule): + * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): + * spam-stat.el (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-change-to-non-spam): Follow error conventions. + + * message.el (message-is-yours-p): + * gnus-sum.el (gnus-auto-select-subject): Fix quoting in docstring. + +2005-06-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-view.el (mm-inline-text): Withdraw the last change. + +2005-06-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while + executing enriched-decode. + 2005-06-04 Luc Teirlinck <teirllm@auburn.edu> * gnus-art.el (article-update-date-lapsed): Use `save-match-data'. @@ -71,7 +90,7 @@ 2005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-group.el (): Require gnus-sum and autoload functions to + * gnus-group.el: Require gnus-sum and autoload functions to resolve warnings when gnus-group.el compiled alone. 2005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
--- a/lisp/gnus/gnus-sieve.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/gnus-sieve.el Wed Jun 15 23:32:15 2005 +0000 @@ -129,7 +129,7 @@ (let ((rule (gnus-sieve-guess-rule-for-article)) (info (gnus-get-info gnus-newsgroup-name))) (if (null rule) - (error "Could not guess rule for article.") + (error "Could not guess rule for article") (gnus-info-set-params info (cons rule (gnus-info-params info))) (message "Added rule in group %s for article: %s" gnus-newsgroup-name rule)))))
--- a/lisp/gnus/gnus-sum.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/gnus-sum.el Wed Jun 15 23:32:15 2005 +0000 @@ -320,7 +320,7 @@ first subject), `unread' (place point on the subject line of the first unread article), `best' (place point on the subject line of the higest-scored article), `unseen' (place point on the subject line of -the first unseen article), 'unseen-or-unread' (place point on the subject +the first unseen article), `unseen-or-unread' (place point on the subject line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line."
--- a/lisp/gnus/legacy-gnus-agent.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/legacy-gnus-agent.el Wed Jun 15 23:32:15 2005 +0000 @@ -25,7 +25,7 @@ ((file-directory-p member) (push member search-in)) ((equal (file-name-nondirectory member) ".agentview") - (setq converted-something + (setq converted-something (or (gnus-agent-convert-agentview member) converted-something)))))) @@ -175,7 +175,7 @@ (t t)))))) (kill-buffer buffer)) - (error "Change gnus-agent-expire-days to an integer for gnus to start.")))) + (error "Change gnus-agent-expire-days to an integer for gnus to start")))) ;; The gnus-agent-unlist-expire-days has its own conversion prompt. ;; Therefore, hide the default prompt. @@ -198,8 +198,8 @@ (when (cond ((eq (type-of func) 'compiled-function) ;; Search def. of compiled function for gnus-agent-do-once string - (let* (definition - print-level + (let* (definition + print-level print-length (standard-output (lambda (char)
--- a/lisp/gnus/message.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/message.el Wed Jun 15 23:32:15 2005 +0000 @@ -5912,9 +5912,9 @@ (defun message-is-yours-p () "Non-nil means current article is yours. -If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles +If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles are yours except those that have Cancel-Lock header not belonging to you. -Instead of shooting GNKSA feet, you should modify 'message-alternative-emails' +Instead of shooting GNKSA feet, you should modify `message-alternative-emails' regexp to match all of yours addresses." ;; Canlock-logic as suggested by Per Abrahamsen ;; <abraham@dina.kvl.dk>
--- a/lisp/gnus/spam-stat.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/gnus/spam-stat.el Wed Jun 15 23:32:15 2005 +0000 @@ -370,7 +370,7 @@ (lambda (word count) (let ((entry (gethash word spam-stat))) (if (not entry) - (error "This buffer has unknown words in it.") + (error "This buffer has unknown words in it") (spam-stat-set-good entry (- (spam-stat-good entry) count)) (spam-stat-set-bad entry (+ (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry)) @@ -386,7 +386,7 @@ (lambda (word count) (let ((entry (gethash word spam-stat))) (if (not entry) - (error "This buffer has unknown words in it.") + (error "This buffer has unknown words in it") (spam-stat-set-good entry (+ (spam-stat-good entry) count)) (spam-stat-set-bad entry (- (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry))
--- a/lisp/hexl.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/hexl.el Wed Jun 15 23:32:15 2005 +0000 @@ -988,7 +988,9 @@ (define-key hexl-mode-map [up] 'hexl-previous-line) (define-key hexl-mode-map [down] 'hexl-next-line) (define-key hexl-mode-map [M-left] 'hexl-backward-short) + (define-key hexl-mode-map [?\e left] 'hexl-backward-short) (define-key hexl-mode-map [M-right] 'hexl-forward-short) + (define-key hexl-mode-map [?\e right] 'hexl-forward-short) (define-key hexl-mode-map [next] 'hexl-scroll-up) (define-key hexl-mode-map [prior] 'hexl-scroll-down) (define-key hexl-mode-map [home] 'hexl-beginning-of-line)
--- a/lisp/hilit-chg.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/hilit-chg.el Wed Jun 15 23:32:15 2005 +0000 @@ -37,9 +37,9 @@ ;; it on to active mode to see them, then toggle it back off to avoid ;; distraction. ;; -;; When active, changes are displayed in `highlight-changes-face'. When -;; text is deleted, the following character is displayed in -;; `highlight-changes-delete-face' face. +;; When active, changes are displayed in the `highlight-changes' face. +;; When text is deleted, the following character is displayed in the +;; `highlight-changes-delete' face. ;; ;; ;; You can "age" different sets of changes by using @@ -48,10 +48,10 @@ ;; changes. You can customize these "rotated" faces in two ways. You can ;; either explicitly define each face by customizing ;; `highlight-changes-face-list'. If, however, the faces differ from -;; `highlight-changes-face' only in the foreground color, you can simply set -;; `highlight-changes-colours'. If `highlight-changes-face-list' is nil when +;; the `highlight-changes' face only in the foreground color, you can simply set +;; `highlight-changes-colors'. If `highlight-changes-face-list' is nil when ;; the faces are required they will be constructed from -;; `highlight-changes-colours'. +;; `highlight-changes-colors'. ;; ;; ;; When a Highlight Changes mode is on (either active or passive) you can go @@ -212,42 +212,49 @@ ;; However, having it set for non-delete changes can be annoying because all ;; indentation on inserts gets underlined (which can look pretty ugly!). -(defface highlight-changes-face +(defface highlight-changes '((((min-colors 88) (class color)) (:foreground "red1" )) (((class color)) (:foreground "red" )) (t (:inverse-video t))) "Face used for highlighting changes." :group 'highlight-changes) +;; backward-compatibility alias +(put 'highlight-changes-face 'face-alias 'highlight-changes) ;; This looks pretty ugly, actually. Maybe the underline should be removed. -(defface highlight-changes-delete-face +(defface highlight-changes-delete '((((min-colors 88) (class color)) (:foreground "red1" :underline t)) (((class color)) (:foreground "red" :underline t)) (t (:inverse-video t))) "Face used for highlighting deletions." :group 'highlight-changes) +;; backward-compatibility alias +(put 'highlight-changes-delete-face 'face-alias 'highlight-changes-delete) -;; A (not very good) default list of colours to rotate through. +;; A (not very good) default list of colors to rotate through. ;; -(defcustom highlight-changes-colours +(defcustom highlight-changes-colors (if (eq (frame-parameter nil 'background-mode) 'light) ;; defaults for light background: '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue") ;; defaults for dark background: '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid")) - "*Colours used by `highlight-changes-rotate-faces'. + "*Colors used by `highlight-changes-rotate-faces'. The newest rotated change will be displayed in the first element of this list, the next older will be in the second element etc. This list is used if `highlight-changes-face-list' is nil, otherwise that variable overrides this list. If you only care about foreground -colours then use this, if you want fancier faces then set +colors then use this, if you want fancier faces then set `highlight-changes-face-list'." :type '(repeat color) :group 'highlight-changes) +(define-obsolete-variable-alias 'highlight-changes-colours + 'highlight-changes-colors "22.1") + ;; If you invoke highlight-changes-mode with no argument, should it start in ;; active or passive mode? @@ -347,15 +354,15 @@ ) (while p (setq old-name (car p)) - (setq new-name (intern (format "highlight-changes-face-%d" n))) + (setq new-name (intern (format "highlight-changes-%d" n))) (if (eq old-name new-name) nil ;; A new face has been inserted: we don't want to modify the ;; default face so copy it. Better, though, (I think) is to ;; make a new face have the same attributes as - ;; highlight-changes-face . + ;; the `highlight-changes' face. (if (eq old-name 'default) - (copy-face 'highlight-changes-face new-name) + (copy-face 'highlight-changes new-name) (copy-face old-name new-name) )) (setq new-list (append (list new-name) new-list)) @@ -377,16 +384,16 @@ (defcustom highlight-changes-face-list nil "*A list of faces used when rotating changes. Normally the variable is initialized to nil and the list is created from -`highlight-changes-colours' when needed. However, you can set this variable +`highlight-changes-colors' when needed. However, you can set this variable to any list of faces. You will have to do this if you want faces which -don't just differ from `highlight-changes-face' by the foreground colour. +don't just differ from the `highlight-changes' face by the foreground color. Otherwise, this list will be constructed when needed from -`highlight-changes-colours'." +`highlight-changes-colors'." :type '(choice (repeat :notify hilit-chg-cust-fix-changes-face-list face ) - (const :tag "Derive from highlight-changes-colours" nil) + (const :tag "Derive from highlight-changes-colors" nil) ) :group 'highlight-changes) @@ -445,7 +452,7 @@ (let ((ov (make-overlay start end)) face) (if (eq prop 'hilit-chg-delete) - (setq face 'highlight-changes-delete-face) + (setq face 'highlight-changes-delete) (setq face (nth 1 (member prop hilit-chg-list)))) (if face (progn @@ -727,24 +734,24 @@ ;; so we pick up any changes? (if (or (null highlight-changes-face-list) ; Don't do it if it force) ; already exists unless FORCE non-nil. - (let ((p highlight-changes-colours) + (let ((p highlight-changes-colors) (n 1) name) (setq highlight-changes-face-list nil) (while p - (setq name (intern (format "highlight-changes-face-%d" n))) - (copy-face 'highlight-changes-face name) + (setq name (intern (format "highlight-changes-%d" n))) + (copy-face 'highlight-changes name) (set-face-foreground name (car p)) (setq highlight-changes-face-list (append highlight-changes-face-list (list name))) (setq p (cdr p)) (setq n (1+ n))))) - (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face)) + (setq hilit-chg-list (list 'hilit-chg 'highlight-changes)) (let ((p highlight-changes-face-list) (n 1) last-category last-face) (while p (setq last-category (intern (format "change-%d" n))) - ;; (setq last-face (intern (format "highlight-changes-face-%d" n))) + ;; (setq last-face (intern (format "highlight-changes-%d" n))) (setq last-face (car p)) (setq hilit-chg-list (append hilit-chg-list @@ -774,7 +781,7 @@ face described by the second element, and so on. Very old changes remain shown in the last face in the list. -You can automatically rotate colours when the buffer is saved +You can automatically rotate colors when the buffer is saved by adding the following to `local-write-file-hooks', by evaling it in the buffer to be saved): @@ -842,7 +849,7 @@ (setq change-a (car change-info)) (setq change-b (car (cdr change-info))) - + (hilit-chg-make-list) (while change-a (setq a-start (nth 0 (car change-a))) @@ -886,11 +893,11 @@ changes are made, so \\[highlight-changes-next-change] and \\[highlight-changes-previous-change] will not work." (interactive - (list + (list (get-buffer (read-buffer "buffer-a " (current-buffer) t)) (get-buffer (read-buffer "buffer-b " - (window-buffer (next-window (selected-window))) t)))) + (window-buffer (next-window (selected-window))) t)))) (let ((file-a (buffer-file-name buf-a)) (file-b (buffer-file-name buf-b))) (highlight-markup-buffers buf-a file-a buf-b file-b) @@ -917,10 +924,10 @@ nil ;; default 'yes ;; must exist (let ((f (buffer-file-name (current-buffer)))) - (if f + (if f (progn (setq f (make-backup-file-name f)) - (or (file-exists-p f) + (or (file-exists-p f) (setq f nil))) ) f))))
--- a/lisp/ido.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ido.el Wed Jun 15 23:32:15 2005 +0000 @@ -345,7 +345,7 @@ ;;;###autoload (defcustom ido-mode nil "Determines for which functional group \(buffer and files) ido behavior -should be enabled. The following values are possible: +should be enabled. The following values are possible: - `buffer': Turn only on ido buffer behavior \(switching, killing, displaying...) - `file': Turn only on ido file behavior \(finding, writing, inserting...) @@ -414,7 +414,7 @@ "*List of file extensions specifying preferred order of file selections. Each element is either a string with `.' as the first char, an empty string matching files without extension, or t which is the default order -of for files with an unlisted file extension." +for files with an unlisted file extension." :type '(repeat (choice string (const :tag "Default order" t))) :group 'ido) @@ -453,9 +453,9 @@ `otherframe' Show new file in another frame `maybe-frame' If a file is visible in another frame, prompt to ask if you you want to see the file in the same window of the current - frame or in the other frame. + frame or in the other frame `always-frame' If a file is visible in another frame, raise that - frame. Otherwise, visit the file in the same window." + frame; otherwise, visit the file in the same window" :type '(choice (const samewindow) (const otherwindow) (const display) @@ -466,7 +466,7 @@ (defcustom ido-default-buffer-method 'always-frame "*How to switch to new buffer when using `ido-switch-buffer'. -See ido-default-file-method for details." +See `ido-default-file-method' for details." :type '(choice (const samewindow) (const otherwindow) (const display) @@ -530,7 +530,7 @@ (defcustom ido-max-prospects 12 "*Non-zero means that the prospect list will be limited to than number of items. For a long list of prospects, building the full list for the minibuffer can take a -non-negletable amount of time; setting this variable reduces that time." +non-negligible amount of time; setting this variable reduces that time." :type 'integer :group 'ido) @@ -615,7 +615,7 @@ (defcustom ido-slow-ftp-hosts nil "*List of slow ftp hosts where ido prompting should not be used. If an ftp host is on this list, ido automatically switches to the non-ido -equivalent function, e.g. find-file rather than ido-find-file." +equivalent function, e.g. `find-file' rather than `ido-find-file'." :type '(repeat string) :group 'ido) @@ -706,7 +706,7 @@ :group 'ido) (defcustom ido-setup-hook nil - "*Hook run after the ido variables and keymap has been setup. + "*Hook run after the ido variables and keymap have been setup. The dynamic variable `ido-cur-item' contains the current type of item that is read by ido, possible values are file, dir, buffer, and list. Additional keys can be defined in `ido-mode-map'." @@ -727,9 +727,9 @@ 4th element is the string inserted at the end of a truncated list of prospects, 5th and 6th elements are used as brackets around the common match string which can be completed using TAB, -7th element is the string displayed when there are a no matches, and -8th element is displayed if there is a single match (and faces are not used). -9th element is displayed when the current directory is non-readable. +7th element is the string displayed when there are no matches, and +8th element is displayed if there is a single match (and faces are not used), +9th element is displayed when the current directory is non-readable, 10th element is displayed when directory exceeds `ido-max-directory-size'." :type '(repeat string) :group 'ido) @@ -864,14 +864,14 @@ (defcustom ido-read-file-name-as-directory-commands '() "List of commands which uses read-file-name to read a directory name. When `ido-everywhere' is non-nil, the commands in this list will read -the directory using ido-read-directory-name." +the directory using `ido-read-directory-name'." :type '(repeat symbol) :group 'ido) (defcustom ido-read-file-name-non-ido '() "List of commands which shall not read file names the ido way. When `ido-everywhere' is non-nil, the commands in this list will read -the file name using normal read-file-name style." +the file name using normal `read-file-name' style." :type '(repeat symbol) :group 'ido) @@ -895,7 +895,7 @@ (defvar ido-work-directory-list nil "List of actual working directory names. The current directory is inserted at the front of this list whenever a -file is opened with ido-find-file and family.") +file is opened with `ido-find-file' and family.") (defvar ido-work-file-list nil "List of actual work file names. @@ -909,7 +909,7 @@ (defvar ido-ignore-item-temp-list nil "List of items to ignore in current ido invocation. -Intended to be let-bound by functions which calls ido repeatedly. +Intended to be let-bound by functions which call ido repeatedly. Should never be set permanently.") ;; Temporary storage @@ -949,7 +949,7 @@ selected.") (defvar ido-current-directory nil - "Current directory for ido-find-file.") + "Current directory for `ido-find-file'.") (defvar ido-auto-merge-timer nil "Delay timer for auto merge.") @@ -1320,7 +1320,8 @@ (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook) - (unless ido-minor-mode-map-entry + (if ido-minor-mode-map-entry + (setcdr ido-minor-mode-map-entry (make-sparse-keymap)) (setq ido-minor-mode-map-entry (cons 'ido-mode (make-sparse-keymap))) (add-to-list 'minor-mode-map-alist ido-minor-mode-map-entry)) @@ -2271,7 +2272,7 @@ (defun ido-magic-forward-char () "Move forward in user input or perform magic action. -If no user input is present or at end of input, perform magic actions: +If no user input is present, or at end of input, perform magic actions: C-x C-b ... C-f switch to ido-find-file. C-x C-f ... C-f fallback to non-ido find-file. C-x C-d ... C-f fallback to non-ido brief dired. @@ -2414,13 +2415,13 @@ (exit-minibuffer)) (defun ido-enter-find-file () - "Drop into find-file from buffer switching." + "Drop into `find-file' from buffer switching." (interactive) (setq ido-exit 'find-file) (exit-minibuffer)) (defun ido-enter-switch-buffer () - "Drop into ido-switch-buffer from file switching." + "Drop into `ido-switch-buffer' from file switching." (interactive) (setq ido-exit 'switch-to-buffer) (exit-minibuffer)) @@ -3016,7 +3017,7 @@ (defun ido-make-buffer-list (default) ;; Return the current list of buffers. ;; Currently visible buffers are put at the end of the list. - ;; The hook `ido-make-buflist-hook' is run after the list has been + ;; The hook `ido-make-buffer-list-hook' is run after the list has been ;; created to allow the user to further modify the order of the buffer names ;; in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, ;; it is put to the start of the list. @@ -3496,7 +3497,7 @@ ;;; VISIT CHOSEN BUFFER (defun ido-visit-buffer (buffer method &optional record) "Visit file named FILE according to METHOD. -Record command in command-history if optional RECORD is non-nil." +Record command in `command-history' if optional RECORD is non-nil." (let (win newframe) (cond @@ -3569,9 +3570,9 @@ As you type in a string, all of the buffers matching the string are displayed if substring-matching is used \(default). Look at -`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the -buffer you want, it can then be selected. As you type, most keys have their -normal keybindings, except for the following: \\<ido-mode-map> +`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the +buffer you want, it can then be selected. As you type, most keys have +their normal keybindings, except for the following: \\<ido-mode-map> RET Select the buffer at the front of the list of matches. If the list is empty, possibly prompt to create new buffer. @@ -3654,11 +3655,11 @@ default is to show it in the same window, unless it is already visible in another frame. -The file name is selected interactively by typing a substring. As you type -in a string, all of the filenames matching the string are displayed if -substring-matching is used \(default). Look at `ido-enable-prefix' and -`ido-toggle-prefix'. When you have found the filename you want, it can -then be selected. As you type, most keys have their normal keybindings, +The file name is selected interactively by typing a substring. As you +type in a string, all of the filenames matching the string are displayed +if substring-matching is used \(default). Look at `ido-enable-prefix' and +`ido-toggle-prefix'. When you have found the filename you want, it can +then be selected. As you type, most keys have their normal keybindings, except for the following: \\<ido-mode-map> RET Select the file at the front of the list of matches. If the @@ -4171,7 +4172,7 @@ Return the name of a buffer selected. PROMPT is the prompt to give to the user. DEFAULT if given is the default buffer to be selected, which will go to the front of the list. -If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." +If REQUIRE-MATCH is non-nil, an existing buffer must be selected." (let* ((ido-current-directory nil) (ido-directory-nonreadable nil) (ido-directory-too-big nil)
--- a/lisp/ielm.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ielm.el Wed Jun 15 23:32:15 2005 +0000 @@ -102,7 +102,7 @@ customizes `ielm-prompt'.") (defcustom ielm-dynamic-return t - "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM. + "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in IELM. If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline and indents for incomplete sexps. If nil, always inserts newlines." :type 'boolean @@ -468,7 +468,7 @@ Expressions evaluated by IELM are not subject to `debug-on-quit' or `debug-on-error'. -The behaviour of IELM may be customized with the following variables: +The behavior of IELM may be customized with the following variables: * To stop beeping on error, set `ielm-noisy' to nil. * If you don't like the prompt, you can change it by setting `ielm-prompt'. * If you do not like that the prompt is (by default) read-only, set
--- a/lisp/info.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/info.el Wed Jun 15 23:32:15 2005 +0000 @@ -3524,29 +3524,37 @@ (t (Info-goto-emacs-command-node command))))) -(defface Info-title-1-face +(defface info-title-1 '((((type tty pc) (class color)) :foreground "green" :weight bold) - (t :height 1.2 :inherit Info-title-2-face)) - "Face for Info titles at level 1." + (t :height 1.2 :inherit info-title-2)) + "Face for info titles at level 1." :group 'info) - -(defface Info-title-2-face +;; backward-compatibility alias +(put 'Info-title-1-face 'face-alias 'info-title-1) + +(defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) - (t :height 1.2 :inherit Info-title-3-face)) - "Face for Info titles at level 2." + (t :height 1.2 :inherit info-title-3)) + "Face for info titles at level 2." :group 'info) - -(defface Info-title-3-face +;; backward-compatibility alias +(put 'Info-title-2-face 'face-alias 'info-title-2) + +(defface info-title-3 '((((type tty pc) (class color)) :weight bold) - (t :height 1.2 :inherit Info-title-4-face)) - "Face for Info titles at level 3." + (t :height 1.2 :inherit info-title-4)) + "Face for info titles at level 3." :group 'info) - -(defface Info-title-4-face +;; backward-compatibility alias +(put 'Info-title-3-face 'face-alias 'info-title-3) + +(defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) - "Face for Info titles at level 4." + "Face for info titles at level 4." :group 'info) +;; backward-compatibility alias +(put 'Info-title-4-face 'face-alias 'info-title-4) (defface info-menu-header '((((type tty pc)) @@ -3686,10 +3694,10 @@ nil t) (let* ((c (preceding-char)) (face - (cond ((= c ?*) 'Info-title-1-face) - ((= c ?=) 'Info-title-2-face) - ((= c ?-) 'Info-title-3-face) - (t 'Info-title-4-face)))) + (cond ((= c ?*) 'info-title-1) + ((= c ?=) 'info-title-2) + ((= c ?-) 'info-title-3) + (t 'info-title-4)))) (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face face)) ;; This is a serious problem for trying to handle multiple
--- a/lisp/international/mule-cmds.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/international/mule-cmds.el Wed Jun 15 23:32:15 2005 +0000 @@ -607,7 +607,7 @@ only if the user was explicitly asked and specified a coding system.") (defvar select-safe-coding-system-accept-default-p nil - "If non-nil, a function to control the behaviour of coding system selection. + "If non-nil, a function to control the behavior of coding system selection. The meaning is the same as the argument ACCEPT-DEFAULT-P of the function `select-safe-coding-system' (which see). This variable overrides that argument.") @@ -1552,7 +1552,7 @@ :group 'mule) (defvar input-method-exit-on-invalid-key nil - "This flag controls the behaviour of an input method on invalid key input. + "This flag controls the behavior of an input method on invalid key input. Usually, when a user types a key which doesn't start any character handled by the input method, the key is handled by turning off the input method temporarily. After that key, the input method is re-enabled.
--- a/lisp/isearchb.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/isearchb.el Wed Jun 15 23:32:15 2005 +0000 @@ -213,7 +213,7 @@ ((eq last-command 'isearchb-activate) (if isearchb-last-buffer (switch-to-buffer isearchb-last-buffer) - (error "isearchb: There is no previous buffer to toggle to.")) + (error "isearchb: There is no previous buffer to toggle to")) (isearchb-stop nil t)) (t (message "isearchb: ")
--- a/lisp/iswitchb.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/iswitchb.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,7 @@ ;;; iswitchb.el --- switch between buffers using substrings -;; Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005 +;; Free Software Foundation, Inc. ;; Author: Stephen Eglen <stephen@gnu.org> ;; Maintainer: Stephen Eglen <stephen@gnu.org> @@ -871,10 +872,8 @@ (defun iswitchb-to-end (lst) "Move the elements from LST to the end of `iswitchb-temp-buflist'." - (mapcar - (lambda (elem) - (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist))) - lst) + (dolist (elem lst) + (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist))) (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst))) (defun iswitchb-get-buffers-in-frames (&optional current) @@ -915,33 +914,19 @@ "Return buffers matching REGEXP. If STRING-FORMAT is nil, consider REGEXP as just a string. BUFFER-LIST can be list of buffers or list of strings." - (let* ((case-fold-search (iswitchb-case)) - ;; need reverse since we are building up list backwards - (list (reverse buffer-list)) - (do-string (stringp (car list))) - name - ret) + (let* ((case-fold-search (iswitchb-case)) + name ret) + (if (null string-format) (setq regexp (regexp-quote regexp))) (setq iswitchb-invalid-regexp nil) - (catch 'invalid-regexp - (mapcar - (lambda (x) - - (if do-string - (setq name x) ;We already have the name - (setq name (buffer-name x))) - - (cond - ((and (if (not string-format) - (string-match (regexp-quote regexp) name) - (condition-case error - (string-match regexp name) - (invalid-regexp - (setq iswitchb-invalid-regexp t) - (throw 'invalid-regexp (setq ret (cdr error)))))) - (not (iswitchb-ignore-buffername-p name))) - (setq ret (cons name ret))))) - list)) - ret)) + (condition-case error + (dolist (x buffer-list (nreverse ret)) + (setq name (if (stringp x) x (buffer-name x))) + (when (and (string-match regexp name) + (not (iswitchb-ignore-buffername-p name))) + (push name ret))) + (invalid-regexp + (setq iswitchb-invalid-regexp t) + (cdr error))))) (defun iswitchb-ignore-buffername-p (bufname) "Return t if the buffer BUFNAME should be ignored." @@ -1476,5 +1461,5 @@ (provide 'iswitchb) -;;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a +;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a ;;; iswitchb.el ends here
--- a/lisp/kmacro.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/kmacro.el Wed Jun 15 23:32:15 2005 +0000 @@ -631,7 +631,7 @@ When you call the macro, you can call the macro again by repeating just the last key in the key sequence that you used to call this command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg' -for details on how to adjust or disable this behaviour. +for details on how to adjust or disable this behavior. To make a macro permanent so you can call it even after defining others, use \\[kmacro-name-last-macro]."
--- a/lisp/ledit.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ledit.el Wed Jun 15 23:32:15 2005 +0000 @@ -144,7 +144,7 @@ To make Lisp mode automatically change to Ledit mode, do (setq lisp-mode-hook 'ledit-from-lisp-mode)" (interactive) - (lisp-mode) + (delay-mode-hooks (lisp-mode)) (ledit-from-lisp-mode)) ;;;###autoload
--- a/lisp/loadup.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/loadup.el Wed Jun 15 23:32:15 2005 +0000 @@ -313,7 +313,7 @@ (setq name (concat (downcase (substring name 0 (match-beginning 0))) "-" (substring name (match-end 0))))) - (if (eq system-type 'ms-dos) + (if (memq system-type '(ms-dos windows-nt cygwin)) (message "Dumping under the name emacs") (message "Dumping under names emacs and %s" name))) (condition-case ()
--- a/lisp/log-edit.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/log-edit.el Wed Jun 15 23:32:15 2005 +0000 @@ -154,12 +154,12 @@ You could argue that the log entry for a file should contain the full ChangeLog paragraph mentioning the change to the file, even though it may mention other files, because that gives you the full context you -need to understand the change. This is the behaviour you get when this +need to understand the change. This is the behavior you get when this variable is set to t. On the other hand, you could argue that the log entry for a change should contain only the text for the changes which occurred in that -file, because the log is per-file. This is the behaviour you get +file, because the log is per-file. This is the behavior you get when this variable is set to nil.") ;;;; Internal global or buffer-local vars
--- a/lisp/log-view.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/log-view.el Wed Jun 15 23:32:15 2005 +0000 @@ -63,21 +63,25 @@ (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") -(defface log-view-file-face +(defface log-view-file '((((class color) (background light)) (:background "grey70" :weight bold)) (t (:weight bold))) "Face for the file header line in `log-view-mode'." :group 'log-view) -(defvar log-view-file-face 'log-view-file-face) +;; backward-compatibility alias +(put 'log-view-file-face 'face-alias 'log-view-file) +(defvar log-view-file-face 'log-view-file) -(defface log-view-message-face +(defface log-view-message '((((class color) (background light)) (:background "grey85")) (t (:weight bold))) "Face for the message header line in `log-view-mode'." :group 'log-view) -(defvar log-view-message-face 'log-view-message-face) +;; backward-compatibility alias +(put 'log-view-message-face 'face-alias 'log-view-message) +(defvar log-view-message-face 'log-view-message) (defconst log-view-file-re (concat "^\\("
--- a/lisp/longlines.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/longlines.el Wed Jun 15 23:32:15 2005 +0000 @@ -153,11 +153,6 @@ ;; Showing the effect of hard newlines in the buffer -(defface longlines-visible-face - '((t (:background "red"))) - "Face used to make hard newlines visible in `longlines-mode'." - :group 'longlines) - (defun longlines-show-hard-newlines (&optional arg) "Make hard newlines visible by adding a face. With optional argument ARG, make the hard newlines invisible again."
--- a/lisp/mail/mspools.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mail/mspools.el Wed Jun 15 23:32:15 2005 +0000 @@ -357,7 +357,7 @@ (use-local-map mspools-mode-map) (setq major-mode 'mspools-mode) (setq mode-name "MSpools") - ) + (run-mode-hooks 'mspools-mode-hook)) (defun mspools-get-spool-files () "Find the list of spool files and display them in *spools* buffer."
--- a/lisp/mail/rmailedit.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mail/rmailedit.el Wed Jun 15 23:32:15 2005 +0000 @@ -57,7 +57,7 @@ * \\[rmail-cease-edit] makes them permanent. This functions runs the normal hook `rmail-edit-mode-hook'. \\{rmail-edit-map}" - (text-mode) + (delay-mode-hooks (text-mode)) (use-local-map rmail-edit-map) (setq major-mode 'rmail-edit-mode) (setq mode-name "RMAIL Edit")
--- a/lisp/mail/undigest.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mail/undigest.el Wed Jun 15 23:32:15 2005 +0000 @@ -40,7 +40,7 @@ "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage" "*Regexp to match the string that introduces forwarded messages. This is not a header, but a string contained in the body of the message. -You may need to customise it for local needs." +You may need to customize it for local needs." :type 'regexp :group 'rmail-headers)
--- a/lisp/makefile.w32-in Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/makefile.w32-in Wed Jun 15 23:32:15 2005 +0000 @@ -289,13 +289,13 @@ # Prepare a bootstrap in the lisp subdirectory. # -# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, -# that might lead to errors during the bootstrap because something fails to -# autoload as expected. However, if there is no emacs binary, then we can't -# build autoloads yet, so just make sure there's some loaddefs.el file, as -# it's necessary for generating the binary (because loaddefs.el is an -# automatically generated file, we don't want to store it in the source -# repository). +# Build loaddefs.el to make sure it's up-to-date. If it's not, that +# might lead to errors during the bootstrap because something fails to +# autoload as expected. If there is no emacs binary, then we can't +# build autoloads yet. In that case we have to use ldefs-boot.el; +# bootstrap should always work with ldefs-boot.el. (Because +# loaddefs.el is an automatically generated file, we don't want to +# store it in the source repository). # # Remove compiled Lisp files so that bootstrap-emacs will be built from # sources only. @@ -305,15 +305,13 @@ bootstrap-clean-CMD: # if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads - if not exist $(lisp)\loaddefs.el cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el + cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g bootstrap-clean-SH: # if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi # -rm -f $(lisp)/*.elc $(lisp)/*/*.elc - if ! test -r $(lisp)/loaddefs.el; then \ - cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \ - fi + cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el -for dir in . $(WINS); do rm -f $$dir/*.elc; done # Generate/update files for the bootstrap process.
--- a/lisp/man.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/man.el Wed Jun 15 23:32:15 2005 +0000 @@ -391,10 +391,11 @@ table) "Syntax table used in Man mode buffers.") -(if Man-mode-map - nil - (setq Man-mode-map (copy-keymap button-buffer-map)) +(unless Man-mode-map + (setq Man-mode-map (make-sparse-keymap)) (suppress-keymap Man-mode-map) + (set-keymap-parent Man-mode-map button-buffer-map) + (define-key Man-mode-map " " 'scroll-up) (define-key Man-mode-map "\177" 'scroll-down) (define-key Man-mode-map "n" 'Man-next-section) @@ -410,8 +411,7 @@ (define-key Man-mode-map "k" 'Man-kill) (define-key Man-mode-map "q" 'Man-quit) (define-key Man-mode-map "m" 'man) - (define-key Man-mode-map "?" 'describe-mode) - ) + (define-key Man-mode-map "?" 'describe-mode)) ;; buttons (define-button-type 'Man-xref-man-page @@ -1023,6 +1023,8 @@ ;; ====================================================================== ;; set up manual mode in buffer and build alists +(put 'Man-mode 'mode-class 'special) + (defun Man-mode () "A mode for browsing Un*x manual pages.
--- a/lisp/menu-bar.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/menu-bar.el Wed Jun 15 23:32:15 2005 +0000 @@ -606,7 +606,7 @@ `(progn (defun ,name (&optional interactively) ,(concat "Toggle whether to " (downcase (substring help 0 1)) - (substring help 1) ".\ + (substring help 1) ". In an interactive call, record this option as a candidate for saving by \"Save Options\" in Custom buffers.") (interactive "p")
--- a/lisp/mh-e/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mh-e/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,7 @@ +2005-06-14 Juanma Barranquero <lekktu@gmail.com> + + * mh-mime.el (mh-secure-message): Follow error conventions. + 2005-05-28 Bill Wohler <wohler@newt.com> Released MH-E version 7.84.
--- a/lisp/mh-e/mh-mime.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mh-e/mh-mime.el Wed Jun 15 23:32:15 2005 +0000 @@ -597,7 +597,7 @@ (let ((valid-methods (list "pgpmime" "pgp" "smime")) (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) (if (not (member method valid-methods)) - (error (format "Sorry. METHOD \"%s\" is invalid." method))) + (error (format "Sorry. METHOD \"%s\" is invalid" method))) (if (not (member mode valid-modes)) (error (format "Sorry. MODE \"%s\" is invalid" mode))) (mml-unsecure-message)
--- a/lisp/mouse.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/mouse.el Wed Jun 15 23:32:15 2005 +0000 @@ -64,7 +64,7 @@ The absolute numeric value specifices the maximum duration of a \"short click\" in milliseconds. A positive value means that a short click follows the link, and a longer click performs the -normal action. A negative value gives the opposite behaviour. +normal action. A negative value gives the opposite behavior. If value is `double', a double click follows the link.
--- a/lisp/net/ange-ftp.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/net/ange-ftp.el Wed Jun 15 23:32:15 2005 +0000 @@ -1964,35 +1964,34 @@ \\{comint-mode-map}" (interactive) - (comint-mode) + (delay-mode-hooks (comint-mode)) (setq major-mode 'internal-ange-ftp-mode) (setq mode-name "Internal Ange-ftp") - (let ((proc (get-buffer-process (current-buffer)))) - (make-local-variable 'ange-ftp-process-string) - (setq ange-ftp-process-string "") - (make-local-variable 'ange-ftp-process-busy) - (make-local-variable 'ange-ftp-process-result) - (make-local-variable 'ange-ftp-process-msg) - (make-local-variable 'ange-ftp-process-multi-skip) - (make-local-variable 'ange-ftp-process-result-line) - (make-local-variable 'ange-ftp-process-continue) - (make-local-variable 'ange-ftp-hash-mark-count) - (make-local-variable 'ange-ftp-binary-hash-mark-size) - (make-local-variable 'ange-ftp-ascii-hash-mark-size) - (make-local-variable 'ange-ftp-hash-mark-unit) - (make-local-variable 'ange-ftp-xfer-size) - (make-local-variable 'ange-ftp-last-percent) - (setq ange-ftp-hash-mark-count 0) - (setq ange-ftp-xfer-size 0) - (setq ange-ftp-process-result-line "") - - (setq comint-prompt-regexp "^ftp> ") - (make-local-variable 'comint-password-prompt-regexp) - ;; This is a regexp that can't match anything. - ;; ange-ftp has its own ways of handling passwords. - (setq comint-password-prompt-regexp "^a\\'z") - (make-local-variable 'paragraph-start) - (setq paragraph-start comint-prompt-regexp))) + (make-local-variable 'ange-ftp-process-string) + (setq ange-ftp-process-string "") + (make-local-variable 'ange-ftp-process-busy) + (make-local-variable 'ange-ftp-process-result) + (make-local-variable 'ange-ftp-process-msg) + (make-local-variable 'ange-ftp-process-multi-skip) + (make-local-variable 'ange-ftp-process-result-line) + (make-local-variable 'ange-ftp-process-continue) + (make-local-variable 'ange-ftp-hash-mark-count) + (make-local-variable 'ange-ftp-binary-hash-mark-size) + (make-local-variable 'ange-ftp-ascii-hash-mark-size) + (make-local-variable 'ange-ftp-hash-mark-unit) + (make-local-variable 'ange-ftp-xfer-size) + (make-local-variable 'ange-ftp-last-percent) + (setq ange-ftp-hash-mark-count 0) + (setq ange-ftp-xfer-size 0) + (setq ange-ftp-process-result-line "") + (setq comint-prompt-regexp "^ftp> ") + (make-local-variable 'comint-password-prompt-regexp) + ;; This is a regexp that can't match anything. + ;; ange-ftp has its own ways of handling passwords. + (setq comint-password-prompt-regexp "^a\\'z") + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp) + (run-mode-hooks 'internal-ange-ftp-mode-hook)) (defcustom ange-ftp-raw-login nil "*Use raw ftp commands for login, if account password is not nil.
--- a/lisp/net/browse-url.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/net/browse-url.el Wed Jun 15 23:32:15 2005 +0000 @@ -487,7 +487,7 @@ (defcustom browse-url-xterm-program "xterm" "*The name of the terminal emulator used by `browse-url-lynx-xterm'. -This might, for instance, be a separate colour version of xterm." +This might, for instance, be a separate color version of xterm." :type 'string :group 'browse-url)
--- a/lisp/net/eudc-hotlist.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/net/eudc-hotlist.el Wed Jun 15 23:32:15 2005 +0000 @@ -56,7 +56,8 @@ (featurep 'menubar)) (set-buffer-menubar current-menubar) (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (run-mode-hooks 'eudc-hotlist-mode-hook)) ;;;###autoload (defun eudc-edit-hotlist ()
--- a/lisp/net/tramp.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/net/tramp.el Wed Jun 15 23:32:15 2005 +0000 @@ -5095,7 +5095,7 @@ (and (setq tramp-file-exists-command "ls -d %s") (file-exists-p existing) (not (file-exists-p nonexisting)))) - (error "Couldn't find command to check if file exists.")))) + (error "Couldn't find command to check if file exists")))) ;; CCC test ksh or bash found for tilde expansion? @@ -5131,7 +5131,7 @@ 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'" tramp-shell-prompt-pattern shell-prompt-pattern)) (pop-to-buffer (buffer-name)) - (error "Couldn't find remote `%s' prompt." shell)) + (error "Couldn't find remote `%s' prompt" shell)) (tramp-message 9 "Setting remote shell prompt...") ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
--- a/lisp/obsolete/lazy-lock.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/obsolete/lazy-lock.el Wed Jun 15 23:32:15 2005 +0000 @@ -506,7 +506,7 @@ been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. This is useful if any buffer has any deferred fontification. -Basic Font Lock mode on-the-fly fontification behaviour fontifies modified +Basic Font Lock mode on-the-fly fontification behavior fontifies modified lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode on-the-fly fontification may fontify differently, albeit correctly. In any event, to refontify some lines you can use \\[font-lock-fontify-block].
--- a/lisp/paren.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/paren.el Wed Jun 15 23:32:15 2005 +0000 @@ -71,7 +71,7 @@ :group 'paren-showing :version "20.3") -(defface show-paren-match-face +(defface show-paren-match '((((class color) (background light)) :background "turquoise") ; looks OK on tty (becomes cyan) (((class color) (background dark)) @@ -83,13 +83,17 @@ "Show Paren mode face used for a matching paren." :group 'faces :group 'paren-showing) +;; backward-compatibility alias +(put 'show-paren-match-face 'face-alias 'show-paren-match) -(defface show-paren-mismatch-face +(defface show-paren-mismatch '((((class color)) (:foreground "white" :background "purple")) (t (:inverse-video t))) "Show Paren mode face used for a mismatching paren." :group 'faces :group 'paren-showing) +;; backward-compatibility alias +(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch) (defvar show-paren-highlight-openparen t "*Non-nil turns on openparen highlighting when matching forward.") @@ -193,8 +197,8 @@ (progn (if show-paren-ring-bell-on-mismatch (beep)) - (setq face 'show-paren-mismatch-face)) - (setq face 'show-paren-match-face)) + (setq face 'show-paren-mismatch)) + (setq face 'show-paren-match)) ;; ;; If matching backwards, highlight the closeparen ;; before point as well as its matching open.
--- a/lisp/pcvs-defs.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/pcvs-defs.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,7 +1,7 @@ ;;; pcvs-defs.el --- variable definitions for PCL-CVS ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2003, 2004 Free Software Foundation, Inc. +;; 2000, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs @@ -381,7 +381,7 @@ ;; mouse bindings ([mouse-2] . cvs-mode-find-file) ([follow-link] . (lambda (pos) - (if (eq (get-char-property pos 'face) 'cvs-filename-face) t))) + (if (eq (get-char-property pos 'face) 'cvs-filename) t))) ([(down-mouse-3)] . cvs-menu) ;; dired-like bindings ("\C-o" . cvs-mode-display-file)
--- a/lisp/pcvs-info.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/pcvs-info.el Wed Jun 15 23:32:15 2005 +0000 @@ -61,7 +61,7 @@ ;;;; Faces for fontification ;;;; -(defface cvs-header-face +(defface cvs-header '((((class color) (background dark)) (:foreground "lightyellow" :weight bold)) (((class color) (background light)) @@ -69,8 +69,10 @@ (t (:weight bold))) "PCL-CVS face used to highlight directory changes." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-header-face 'face-alias 'cvs-header) -(defface cvs-filename-face +(defface cvs-filename '((((class color) (background dark)) (:foreground "lightblue")) (((class color) (background light)) @@ -78,8 +80,10 @@ (t ())) "PCL-CVS face used to highlight file names." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-filename-face 'face-alias 'cvs-filename) -(defface cvs-unknown-face +(defface cvs-unknown '((((class color) (background dark)) (:foreground "red")) (((class color) (background light)) @@ -87,8 +91,10 @@ (t (:slant italic))) "PCL-CVS face used to highlight unknown file status." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-unknown-face 'face-alias 'cvs-unknown) -(defface cvs-handled-face +(defface cvs-handled '((((class color) (background dark)) (:foreground "pink")) (((class color) (background light)) @@ -96,8 +102,10 @@ (t ())) "PCL-CVS face used to highlight handled file status." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-handled-face 'face-alias 'cvs-handled) -(defface cvs-need-action-face +(defface cvs-need-action '((((class color) (background dark)) (:foreground "orange")) (((class color) (background light)) @@ -105,8 +113,10 @@ (t (:slant italic))) "PCL-CVS face used to highlight status of files needing action." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-need-action-face 'face-alias 'cvs-need-action) -(defface cvs-marked-face +(defface cvs-marked '((((min-colors 88) (class color) (background dark)) (:foreground "green1" :weight bold)) (((class color) (background dark)) @@ -116,14 +126,18 @@ (t (:weight bold))) "PCL-CVS face used to highlight marked file indicator." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-marked-face 'face-alias 'cvs-marked) -(defface cvs-msg-face +(defface cvs-msg '((t (:slant italic))) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) +;; backward-compatibility alias +(put 'cvs-msg-face 'face-alias 'cvs-msg) -(defvar cvs-fi-up-to-date-face 'cvs-handled-face) -(defvar cvs-fi-unknown-face 'cvs-unknown-face) +(defvar cvs-fi-up-to-date-face 'cvs-handled) +(defvar cvs-fi-unknown-face 'cvs-unknown) (defvar cvs-fi-conflict-face 'font-lock-warning-face) ;; There is normally no need to alter the following variable, but if @@ -332,19 +346,17 @@ (case type (DIRCHANGE (concat "In directory " (cvs-add-face (cvs-fileinfo->full-name fileinfo) - 'cvs-header-face t - 'cvs-goal-column t) + 'cvs-header t 'cvs-goal-column t) ":")) (MESSAGE (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) - 'cvs-msg-face)) + 'cvs-msg)) (t (let* ((status (if (cvs-fileinfo->marked fileinfo) - (cvs-add-face "*" 'cvs-marked-face) + (cvs-add-face "*" 'cvs-marked) " ")) (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo) - 'cvs-filename-face t - 'cvs-goal-column t)) + 'cvs-filename t 'cvs-goal-column t)) (base (or (cvs-fileinfo->base-rev fileinfo) "")) (head (cvs-fileinfo->head-rev fileinfo)) (type @@ -357,7 +369,7 @@ (downcase (symbol-name type)) "-face")))) (or (and (boundp sym) (symbol-value sym)) - 'cvs-need-action-face)))) + 'cvs-need-action)))) (cvs-add-face str face cvs-status-map))) (side (or ;; maybe a subtype
--- a/lisp/pcvs.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/pcvs.el Wed Jun 15 23:32:15 2005 +0000 @@ -944,9 +944,9 @@ (defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir) "Run cvs checkout against the current branch. The files are stored to DIR." - (interactive + (interactive (let* ((branch (cvs-prefix-get 'cvs-branch-prefix)) - (prompt (format "CVS Checkout Directory for `%s%s': " + (prompt (format "CVS Checkout Directory for `%s%s': " (cvs-get-module) (if branch (format " (branch: %s)" branch) "")))) @@ -1123,7 +1123,7 @@ ("->" cvs-secondary-branch-prefix)))) " " cvs-mode-line-process)) (if buffer-file-name - (error "Use M-x cvs-quickdir to get a *cvs* buffer.")) + (error "Use M-x cvs-quickdir to get a *cvs* buffer")) (buffer-disable-undo) ;;(set (make-local-variable 'goal-column) cvs-cursor-column) (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer) @@ -1980,7 +1980,7 @@ (when (and (/= (point) (progn (posn-set-point (event-end e)) (point))) (not (memq (get-text-property (1- (line-end-position)) 'font-lock-face) - '(cvs-header-face cvs-filename-face)))) + '(cvs-header cvs-filename)))) (error "Not a file name")) (cvs-mode! (lambda (&optional rev)
--- a/lisp/play/blackbox.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/play/blackbox.el Wed Jun 15 23:32:15 2005 +0000 @@ -117,14 +117,14 @@ \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. \\[bb-romp] -- send in a ray from point, or toggle a ball at point -\\[bb-done] -- end game and get score -" +\\[bb-done] -- end game and get score" (interactive) (kill-all-local-variables) (use-local-map blackbox-mode-map) (setq truncate-lines t) (setq major-mode 'blackbox-mode) - (setq mode-name "Blackbox")) + (setq mode-name "Blackbox") + (run-mode-hooks 'blackbox-mode-hook)) ;;;###autoload (defun blackbox (num)
--- a/lisp/play/doctor.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/play/doctor.el Wed Jun 15 23:32:15 2005 +0000 @@ -59,30 +59,21 @@ (set what ww) first)) -(defvar doctor-mode-map nil) -(if doctor-mode-map - nil - (setq doctor-mode-map (make-sparse-keymap)) - (define-key doctor-mode-map "\n" 'doctor-read-print) - (define-key doctor-mode-map "\r" 'doctor-ret-or-read)) - -(defun doctor-mode () +(define-derived-mode doctor-mode text-mode "Doctor" "Major mode for running the Doctor (Eliza) program. Like Text mode with Auto Fill mode except that RET when point is after a newline, or LFD at any time, reads the sentence before point, and prints the Doctor's answer." - (interactive) - (text-mode) (make-doctor-variables) - (use-local-map doctor-mode-map) - (setq major-mode 'doctor-mode) - (setq mode-name "Doctor") (turn-on-auto-fill) (doctor-type '(i am the psychotherapist \. (doc$ please) (doc$ describe) your (doc$ problems) \. each time you are finished talking, type \R\E\T twice \.)) (insert "\n")) +(define-key doctor-mode-map "\n" 'doctor-read-print) +(define-key doctor-mode-map "\r" 'doctor-ret-or-read) + (defun make-doctor-variables () (make-local-variable 'typos) (setq typos
--- a/lisp/play/dunnet.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/play/dunnet.el Wed Jun 15 23:32:15 2005 +0000 @@ -53,15 +53,10 @@ ;;;; Mode definitions for interactive mode -(defun dun-mode () +(define-derived-mode dun-mode text-mode "Dungeon" "Major mode for running dunnet." - (interactive) - (text-mode) (make-local-variable 'scroll-step) - (setq scroll-step 2) - (use-local-map dungeon-mode-map) - (setq major-mode 'dun-mode) - (setq mode-name "Dungeon")) + (setq scroll-step 2)) (defun dun-parse (arg) "Function called when return is pressed in interactive mode to parse line." @@ -1366,9 +1361,8 @@ (setq dun-current-room 1) (setq dun-exitf nil) (setq dun-badcd nil) -(defvar dungeon-mode-map nil) -(setq dungeon-mode-map (make-sparse-keymap)) -(define-key dungeon-mode-map "\r" 'dun-parse) +(define-obsolete-variable-alias 'dungeon-mode-map 'dun-mode-map "22.1") +(define-key dun-mode-map "\r" 'dun-parse) (defvar dungeon-batch-map (make-keymap)) (if (string= (substring emacs-version 0 2) "18") (let (n) @@ -2594,7 +2588,7 @@ (if dun-logged-in (progn (setq dungeon-mode 'unix) - (define-key dungeon-mode-map "\r" 'dun-unix-parse) + (define-key dun-mode-map "\r" 'dun-unix-parse) (dun-mprinc "$ ")))) (defun dun-login () @@ -2860,7 +2854,7 @@ (defun dun-uexit (args) (setq dungeon-mode 'dungeon) (dun-mprincl "\nYou step back from the console.") - (define-key dungeon-mode-map "\r" 'dun-parse) + (define-key dun-mode-map "\r" 'dun-parse) (if (not dun-batch-mode) (dun-messages))) @@ -3059,7 +3053,7 @@ (defun dun-dos-interface () (dun-dos-boot-msg) (setq dungeon-mode 'dos) - (define-key dungeon-mode-map "\r" 'dun-dos-parse) + (define-key dun-mode-map "\r" 'dun-dos-parse) (dun-dos-prompt)) (defun dun-dos-type (args) @@ -3117,7 +3111,7 @@ (defun dun-dos-exit (args) (setq dungeon-mode 'dungeon) (dun-mprincl "\nYou power down the machine and step back.") - (define-key dungeon-mode-map "\r" 'dun-parse) + (define-key dun-mode-map "\r" 'dun-parse) (if (not dun-batch-mode) (dun-messages)))
--- a/lisp/play/gomoku.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/play/gomoku.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; gomoku.el --- Gomoku game between you and Emacs -;; Copyright (C) 1988, 1994, 1996, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 1996, 2001, 2003, 2005 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> ;; Maintainer: FSF @@ -160,22 +160,24 @@ (defvar gomoku-emacs-won () "For making font-lock use the winner's face for the line.") -(defface gomoku-font-lock-O-face +(defface gomoku-O '((((class color)) (:foreground "red" :weight bold))) "Face to use for Emacs' O." :group 'gomoku) +;; backward-compatibility alias +(put 'gomoku-font-lock-O-face 'face-alias 'gomoku-O) -(defface gomoku-font-lock-X-face +(defface gomoku-X '((((class color)) (:foreground "green" :weight bold))) "Face to use for your X." :group 'gomoku) +;; backward-compatibility alias +(put 'gomoku-font-lock-X-face 'face-alias 'gomoku-X) (defvar gomoku-font-lock-keywords - '(("O" . 'gomoku-font-lock-O-face) - ("X" . 'gomoku-font-lock-X-face) - ("[-|/\\]" 0 (if gomoku-emacs-won - 'gomoku-font-lock-O-face - 'gomoku-font-lock-X-face))) + '(("O" . 'gomoku-O) + ("X" . 'gomoku-X) + ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X))) "*Font lock rules for Gomoku.") (put 'gomoku-mode 'front-sticky
--- a/lisp/play/mpuz.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/play/mpuz.el Wed Jun 15 23:32:15 2005 +0000 @@ -57,28 +57,36 @@ :type 'boolean :group 'mpuz) -(defface mpuz-unsolved-face +(defface mpuz-unsolved '((((class color)) (:foreground "red1" :bold t)) (t (:bold t))) "*Face to use for letters to be solved." :group 'mpuz) +;; backward-compatibility alias +(put 'mpuz-unsolved-face 'face-alias 'mpuz-unsolved) -(defface mpuz-solved-face +(defface mpuz-solved '((((class color)) (:foreground "green1" :bold t)) (t (:bold t))) "*Face to use for solved digits." :group 'mpuz) +;; backward-compatibility alias +(put 'mpuz-solved-face 'face-alias 'mpuz-solved) -(defface mpuz-trivial-face +(defface mpuz-trivial '((((class color)) (:foreground "blue" :bold t)) (t (:bold t))) "*Face to use for trivial digits solved for you." :group 'mpuz) +;; backward-compatibility alias +(put 'mpuz-trivial-face 'face-alias 'mpuz-trivial) -(defface mpuz-text-face +(defface mpuz-text '((t (:inherit variable-pitch))) "*Face to use for text on right." :group 'mpuz) +;; backward-compatibility alias +(put 'mpuz-text-face 'face-alias 'mpuz-text) ;; Mpuz mode and keymaps @@ -296,7 +304,7 @@ (defun mpuz-create-buffer () "Create (or recreate) the puzzle buffer. Return it." (let ((buf (get-buffer-create "*Mult Puzzle*")) - (face '(face mpuz-text-face)) + (face '(face mpuz-text)) buffer-read-only) (save-excursion (set-buffer buf) @@ -347,9 +355,9 @@ (+ digit ?0) (+ (mpuz-to-letter digit) ?A))) (face `(face - ,(cond ((aref mpuz-trivial-digits digit) 'mpuz-trivial-face) - ((aref mpuz-found-digits digit) 'mpuz-solved-face) - ('mpuz-unsolved-face)))) + ,(cond ((aref mpuz-trivial-digits digit) 'mpuz-trivial) + ((aref mpuz-found-digits digit) 'mpuz-solved) + ('mpuz-unsolved)))) buffer-read-only) (mapc (lambda (square) (goto-line (car square)) ; line before column!
--- a/lisp/printing.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/printing.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,17 +1,17 @@ ;;; printing.el --- printing utilities -;; Copyright (C) 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Time-stamp: <2004/11/21 20:56:53 vinicius> +;; Time-stamp: <2005/06/11 19:51:32 vinicius> ;; Keywords: wp, print, PostScript -;; Version: 6.8.3 +;; Version: 6.8.4 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst pr-version "6.8.3" - "printing.el, v 6.8.3 <2004/11/17 vinicius> +(defconst pr-version "6.8.4" + "printing.el, v 6.8.4 <2005/06/11 vinicius> Please send all bug fixes and enhancements to Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -143,7 +143,7 @@ ;; One way to set variables is by calling `pr-customize', customize all ;; variables and save the customization by future sessions (see Options ;; section). Other way is by coding your settings on Emacs init file (that is, -;; .emacs file), see below for a first setting template that it should be +;; ~/.emacs file), see below for a first setting template that it should be ;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT ;; or MS-DOS): ;; @@ -259,9 +259,9 @@ ;; PostScript printer. So, please, don't include this printer in ;; `pr-txt-printer-alist' (which see). ;; -;; 5. Use gsprint instead of ghostscript to print monochrome PostScript files -;; in Windows. The gsprint utility is faster than ghostscript to print -;; monochrome PostScript. +;; 5. You can use gsprint instead of ghostscript to print monochrome PostScript +;; files in Windows. The gsprint utility documentation says that it is more +;; efficient than ghostscript to print monochrome PostScript. ;; ;; To print non-monochrome PostScript file, the efficiency of ghostscript ;; is similar to gsprint. @@ -271,6 +271,31 @@ ;; For more information about gsprint see ;; `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. ;; +;; As an example of gsprint declaration: +;; +;; (setq pr-ps-printer-alist +;; '((A "gsprint" ("-all" "-twoup") "-printer " "my-b/w-printer-name") +;; (B "gsprint" ("-all" "-twoup") nil "-printer my-b/w-printer-name") +;; ;; some other printer declaration +;; )) +;; +;; The example above declares that printer A prints all pages (-all) and two +;; pages per sheet (-twoup). The printer B declaration does the same as the +;; printer A declaration, the only difference is the printer name selection. +;; +;; There are other command line options like: +;; +;; -mono Render in monochrome as 1bit/pixel (only black and white). +;; -grey Render in greyscale as 8bits/pixel. +;; -color Render in color as 24bits/pixel. +;; +;; The default is `-mono'. So, printer A and B in the example above are +;; using implicitly the `-mono' option. Note that in `-mono' no gray tone +;; or color is printed, this includes the zebra stripes, that is, in `-mono' +;; the zebra stripes are not printed. +;; +;; See also documentation for `pr-ps-printer-alist'. +;; ;; ;; Using `printing' ;; ---------------- @@ -279,8 +304,10 @@ ;; using Windows 9x/NT or MS-DOS): ;; ;; (require 'printing) -;; -;; When `printing' is loaded: +;; ;; ...some user settings... +;; (pr-update-menus t) +;; +;; During `pr-update-menus' evaluation: ;; * On Emacs 20: ;; it replaces the Tools/Print menu by Tools/Printing menu. ;; * On Emacs 21: @@ -885,6 +912,7 @@ ;; (lps_06b "print" nil nil "\\\\printers\\lps_06b") ;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c") ;; (lps_08c nil nil nil "\\\\printers\\lps_08c") +;; (b/w "gsprint" ("-all" "-twoup") "-printer " "b/w-pr-name") ;; (LPT1 "" nil "" "LPT1:") ;; (PRN "" nil "" "PRN") ;; (standard "redpr.exe" nil "" "") @@ -923,6 +951,9 @@ ;; ;; `pr-update-menus' Update utility, PostScript and text printer menus. ;; +;; `pr-menu-bind' Install `printing' menu in the menubar. +;; +;; ;; Below are some URL where you can find good utilities. ;; ;; * For `printing' package: @@ -934,7 +965,7 @@ ;; ;; gs, gv `http://www.gnu.org/software/ghostscript/ghostscript.html' ;; enscript `http://people.ssh.fi/mtr/genscript/' -;; psnup `http://www.dcs.ed.ac.uk/home/ajcd/psutils/index.html' +;; psnup `http://www.knackered.org/angus/psutils/' ;; mpage `http://www.mesa.nl/pub/mpage/' ;; ;; * For Windows system: @@ -943,7 +974,7 @@ ;; `http://www.gnu.org/software/ghostscript/ghostscript.html' ;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. ;; enscript `http://people.ssh.fi/mtr/genscript/' -;; psnup `http://www.dcs.ed.ac.uk/home/ajcd/psutils/index.html' +;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm' ;; redmon `http://www.cs.wisc.edu/~ghost/redmon/' ;; ;; @@ -1400,7 +1431,27 @@ (prt_07c nil nil \"/D:\\\\\\\\printers\\\\prt_07c\") (PRN \"\" nil \"PRN\") (standard \"redpr.exe\" nil \"\") - )" + ) + +Useful links: + +* Information about the print command (print.exe) + `http://www.computerhope.com/printhlp.htm' + +* RedMon - Redirection Port Monitor (redpr.exe) + `http://www.cs.wisc.edu/~ghost/redmon/index.htm' + +* Redirection Port Monitor (redpr.exe on-line help) + `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' + +* UNIX man pages: lpr (or type `man lpr') + `http://bama.ua.edu/cgi-bin/man-cgi?lpr' + `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr' + +* UNIX man pages: lp (or type `man lp') + `http://bama.ua.edu/cgi-bin/man-cgi?lp' + `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp' +" :type '(repeat (list :tag "Text Printer" (symbol :tag "Printer Symbol Name") @@ -1448,6 +1499,7 @@ ;; (lps_06b "print" nil nil "\\\\printers\\lps_06b") ;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c") ;; (lps_08c nil nil nil "\\\\printers\\lps_08c") + ;; (b/w "gsprint" ("-all" "-twoup") "-printer " "b/w-pr-name") ;; (LPT1 "" nil "" "LPT1:") ;; (PRN "" nil "" "PRN") ;; (standard "redpr.exe" nil "" "") @@ -1486,6 +1538,7 @@ \"lpr\" \"lp\" \"cp\" + \"gsprint\" SWITCHES List of sexp's to pass as extra options for PostScript printer program. It is recommended to set NAME (see text below) @@ -1495,6 +1548,9 @@ '(\"-#3\" \"-l\") nil + . for gsprint.exe + '(\"-all\" \"-twoup\") + PRINTER-SWITCH A string that specifies PostScript printer name switch. If it's necessary to have a space between PRINTER-SWITCH and NAME, it should be inserted at the end of PRINTER-SWITCH string. @@ -1511,6 +1567,9 @@ . for print.exe \"/D:\" + . for gsprint.exe + \"-printer \" + NAME A string that specifies a PostScript printer name. On Unix-like systems, a string value should be a name understood by lpr's -P option (or lp's -d option). @@ -1526,7 +1585,7 @@ . for cp.exe \"\\\\\\\\host\\\\share-name\" - . for print.exe + . for print.exe or gsprint.exe \"/D:\\\\\\\\host\\\\share-name\" \"\\\\\\\\host\\\\share-name\" \"LPT1:\" @@ -1575,10 +1634,80 @@ (lps_06b \"print\" nil nil \"\\\\\\\\printers\\\\lps_06b\") (lps_07c \"print\" nil \"\" \"/D:\\\\\\\\printers\\\\lps_07c\") (lps_08c nil nil nil \"\\\\\\\\printers\\\\lps_08c\") + (b/w1 \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"b/w-pr-name\") + (b/w2 \"gsprint\" (\"-all\" \"-twoup\") nil \"-printer \\\\\\\\printers\\\\lps_06a\") (LPT1 \"\" nil \"\" \"LPT1:\") (PRN \"\" nil \"\" \"PRN\") (standard \"redpr.exe\" nil \"\" \"\") - )" + ) + + +gsprint: + +You can use gsprint instead of ghostscript to print monochrome PostScript files +in Windows. The gsprint utility documentation says that it is more efficient +than ghostscript to print monochrome PostScript. + +To print non-monochrome PostScript file, the efficiency of ghostscript is +similar to gsprint. + +Also the gsprint utility comes together with gsview distribution. + +As an example of gsprint declaration: + + (setq pr-ps-printer-alist + '((A \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"lps_015\") + (B \"gsprint\" (\"-all\" \"-twoup\") nil \"-printer lps_015\") + ;; some other printer declaration + )) + +The example above declares that printer A prints all pages (-all) and two pages +per sheet (-twoup). The printer B declaration does the same as the printer A +declaration, the only difference is the printer name selection. + +There are other command line options like: + + -mono Render in monochrome as 1bit/pixel (only black and white). + -grey Render in greyscale as 8bits/pixel. + -color Render in color as 24bits/pixel. + +The default is `-mono'. So, printer A and B in the example above are using +implicitly the `-mono' option. Note that in `-mono' no gray tone or color is +printed, this includes the zebra stripes, that is, in `-mono' the zebra stripes +are not printed. + + +Useful links: + +* GSPRINT - Ghostscript print to Windows printer + `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm' + +* Introduction to Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + +* How to use Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + +* Information about the print command (print.exe) + `http://www.computerhope.com/printhlp.htm' + +* RedMon - Redirection Port Monitor (redpr.exe) + `http://www.cs.wisc.edu/~ghost/redmon/index.htm' + +* Redirection Port Monitor (redpr.exe on-line help) + `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm' + +* UNIX man pages: lpr (or type `man lpr') + `http://bama.ua.edu/cgi-bin/man-cgi?lpr' + `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr' + +* UNIX man pages: lp (or type `man lp') + `http://bama.ua.edu/cgi-bin/man-cgi?lp' + `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp' + +* GNU utilities for Win32 (cp.exe) + `http://unxutils.sourceforge.net/' +" :type '(repeat (list :tag "PostScript Printer" @@ -1674,7 +1803,37 @@ "gv") "*Specify path and name of the gsview/gv utility. -See also `pr-path-alist'." +See also `pr-path-alist'. + +Useful links: + +* GNU gv manual + `http://www.gnu.org/software/gv/manual/gv.html' + +* GSview Help + `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm' + +* GSview Help - Common Problems + `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems' + +* GSview Readme (compilation & installation) + `http://www.cs.wisc.edu/~ghost/gsview/Readme.htm' + +* GSview (main site) + `http://www.cs.wisc.edu/~ghost/gsview/index.htm' + +* Ghostscript, Ghostview and GSview + `http://www.cs.wisc.edu/~ghost/' + +* Ghostview + `http://www.cs.wisc.edu/~ghost/gv/index.htm' + +* gv 3.5, June 1997 + `http://www.cs.wisc.edu/~ghost/gv/gv_doc/gv.html' + +* MacGSView (MacOS) + `http://www.cs.wisc.edu/~ghost/macos/index.htm' +" :type '(string :tag "Ghostview Utility") :version "20" :group 'printing) @@ -1686,7 +1845,22 @@ "gs") "*Specify path and name of the ghostscript utility. -See also `pr-path-alist'." +See also `pr-path-alist'. + +Useful links: + +* Ghostscript, Ghostview and GSview + `http://www.cs.wisc.edu/~ghost/' + +* Introduction to Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + +* How to use Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + +* Printer compatibility + `http://www.cs.wisc.edu/~ghost/doc/printer.htm' +" :type '(string :tag "Ghostscript Utility") :version "20" :group 'printing) @@ -1717,7 +1891,19 @@ - for full documentation, see in a browser the file c:/gstools/gs5.50/index.html, that is, the file index.html which is located in the same directory as gswin32.exe. - - for brief documentation, type: gswin32.exe -h" + - for brief documentation, type: gswin32.exe -h + +Useful links: + +* Introduction to Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/intro.htm' + +* How to use Ghostscript + `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm' + +* Printer compatibility + `http://www.cs.wisc.edu/~ghost/doc/printer.htm' +" :type '(repeat (string :tag "Ghostscript Switch")) :version "20" :group 'printing) @@ -2184,7 +2370,35 @@ '((psnup \"c:/psutils/psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \" nil (pr-file-duplex . nil) (pr-file-tumble . nil)) - )" + ) + +Useful links: + +* mpage download (GNU or Unix) + `http://www.mesa.nl/pub/mpage/' + +* mpage documentation (GNU or Unix - or type `man mpage') + `http://www.cs.umd.edu/faq/guides/manual_unix/node48.html' + `http://www.rt.com/man/mpage.1.html' + +* psnup (Windows, GNU or Unix) + `http://www.knackered.org/angus/psutils/' + `http://gershwin.ens.fr/vdaniel/Doc-Locale/Outils-Gnu-Linux/PsUtils/' + +* psnup (PsUtils for Windows) + `http://gnuwin32.sourceforge.net/packages/psutils.htm' + +* psnup documentation (GNU or Unix - or type `man psnup') + `http://linux.about.com/library/cmd/blcmdl1_psnup.htm' + `http://amath.colorado.edu/computing/software/man/psnup.html' + +* GNU Enscript (Windows, GNU or Unix) + `http://people.ssh.com/mtr/genscript/' + +* GNU Enscript documentation (Windows, GNU or Unix) + `http://people.ssh.com/mtr/genscript/enscript.man.html' + (on GNU or Unix, type `man enscript') +" :type '(repeat (list :tag "PS File Utility" (symbol :tag "Utility Symbol") @@ -2845,43 +3059,65 @@ ))) -(cond - ((featurep 'xemacs) ; XEmacs - ;; Menu binding - (pr-xemacs-global-menubar - (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))) - - - (t ; GNU Emacs - ;; Menu binding - (require 'easymenu) - ;; Replace existing "print" item by "Printing" item. - ;; If you're changing this file, you'll load it a second, - ;; third... time, but "print" item exists only in the first load. - (defvar pr-menu-print-item "print") +(defvar pr-menu-print-item "print" + "Non-nil means that menu binding was not done. + +Used by `pr-menu-bind' and `pr-update-menus'.") + + +(defun pr-menu-bind () + "Install `printing' menu in the menubar. + +On Emacs 20, it replaces the Tools/Print menu by Tools/Printing menu. + +On Emacs 21 and 22, it replaces the File/Print* menu entries by File/Print +menu. + +Calls `pr-update-menus' to adjust menus." + (interactive) (cond - ;; Emacs 20 - ((string< emacs-version "21.") - (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item) - (when pr-menu-print-item - (easy-menu-remove-item nil '("tools") pr-menu-print-item) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar 'tools - (pr-get-symbol "Printing"))))) - ;; Emacs 21 - (pr-menu-print-item - (easy-menu-change '("file") "Print" pr-menu-spec "print-buffer") - (let ((items '("print-buffer" "print-region" - "ps-print-buffer-faces" "ps-print-region-faces" - "ps-print-buffer" "ps-print-region"))) - (while items - (easy-menu-remove-item nil '("file") (car items)) - (setq items (cdr items))) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar 'file - (pr-get-symbol "Print"))))) - (t - (easy-menu-change '("file") "Print" pr-menu-spec))))) + ((featurep 'xemacs) ; XEmacs + ;; Menu binding + (pr-xemacs-global-menubar + (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) + (setq pr-menu-print-item nil)) + + + (t ; GNU Emacs + ;; Menu binding + (require 'easymenu) + ;; Replace existing "print" item by "Printing" item. + ;; If you're changing this file, you'll load it a second, + ;; third... time, but "print" item exists only in the first load. + (cond + ;; Emacs 20 + ((string< emacs-version "21.") + (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item) + (when pr-menu-print-item + (easy-menu-remove-item nil '("tools") pr-menu-print-item) + (setq pr-menu-print-item nil + pr-menu-bar (vector 'menu-bar 'tools + (pr-get-symbol "Printing"))))) + ;; Emacs 21 & 22 + (t + (let* ((has-file (lookup-key global-map (vector 'menu-bar 'file))) + (item-file (if has-file '("file") '("files")))) + (cond + (pr-menu-print-item + (easy-menu-change item-file "Print" pr-menu-spec "print-buffer") + (let ((items '("print-buffer" "print-region" + "ps-print-buffer-faces" "ps-print-region-faces" + "ps-print-buffer" "ps-print-region"))) + (while items + (easy-menu-remove-item nil item-file (car items)) + (setq items (cdr items))) + (setq pr-menu-print-item nil + pr-menu-bar (vector 'menu-bar + (if has-file 'file 'files) + (pr-get-symbol "Print"))))) + (t + (easy-menu-change item-file "Print" pr-menu-spec)))))))) + (pr-update-menus t)) ;; Key binding @@ -4712,12 +4948,20 @@ otherwise, update PostScript printer menu iff `pr-ps-printer-menu-modified' is non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is -non-nil." +non-nil. + +If menu binding was not done, calls `pr-menu-bind'." (interactive "P") - (pr-update-var 'pr-ps-name pr-ps-printer-alist) - (pr-update-var 'pr-txt-name pr-txt-printer-alist) - (pr-update-var 'pr-ps-utility pr-ps-utility-alist) - (pr-do-update-menus force)) + (if pr-menu-print-item ; since v6.8.4 + ;; There was no menu binding yet, so do it now! + ;; This is a hack to be compatible with old versions of printing. + ;; So, user does not need to change printing calling in init files. + (pr-menu-bind) + ;; Here menu binding is ok. + (pr-update-var 'pr-ps-name pr-ps-printer-alist) + (pr-update-var 'pr-txt-name pr-txt-printer-alist) + (pr-update-var 'pr-ps-utility pr-ps-utility-alist) + (pr-do-update-menus force))) (defvar pr-ps-printer-menu-modified t @@ -6434,10 +6678,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Files are not supposed to change Emacs behavior when you merely load them. -;;; (pr-update-menus t) - - (provide 'printing)
--- a/lisp/progmodes/ada-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/ada-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -1462,7 +1462,7 @@ (setq file-name (car ada-case-exception-file))) (t (error (concat "No exception file specified. " - "See variable ada-case-exception-file.")))) + "See variable ada-case-exception-file")))) (set-syntax-table ada-mode-symbol-syntax-table) (unless word @@ -1501,7 +1501,7 @@ (car ada-case-exception-file)) (t (error (concat "No exception file specified. " - "See variable ada-case-exception-file.")))))) + "See variable ada-case-exception-file")))))) ;; Find the substring to define as an exception. Order is: the parameter, ;; if any, or the selected region, or the word under the cursor @@ -5398,7 +5398,7 @@ (setq body-file (ada-get-body-name)) (if body-file (find-file body-file) - (error "No body found for the package. Create it first.")) + (error "No body found for the package. Create it first")) (save-restriction (widen)
--- a/lisp/progmodes/antlr-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/antlr-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; antlr-mode.el --- major mode for ANTLR grammar files -;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Free Software Foundation, Inc. ;; ;; Author: Christoph.Wedler@sap.com ;; Keywords: languages, ANTLR, code generator @@ -827,58 +827,72 @@ in the grammar's actions and semantic predicates, see `antlr-font-lock-maximum-decoration'.") -(defvar antlr-font-lock-default-face 'antlr-font-lock-default-face) -(defface antlr-font-lock-default-face nil +(defvar antlr-default-face 'antlr-default) +(defface antlr-default "Face to prevent strings from language dependent highlighting. Do not change." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-default-face 'face-alias 'antlr-default) -(defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face) -(defface antlr-font-lock-keyword-face +(defvar antlr-keyword-face 'antlr-keyword) +(defface antlr-keyword (cond-emacs-xemacs '((((class color) (background light)) (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR keywords." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword) -(defvar antlr-font-lock-syntax-face 'antlr-font-lock-keyword-face) -(defface antlr-font-lock-syntax-face +(defvar antlr-syntax-face 'antlr-keyword) +(defface antlr-syntax (cond-emacs-xemacs '((((class color) (background light)) (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR syntax symbols like :, |, (, ), ...." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax) -(defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face) -(defface antlr-font-lock-ruledef-face +(defvar antlr-ruledef-face 'antlr-ruledef) +(defface antlr-ruledef (cond-emacs-xemacs '((((class color) (background light)) (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR rule references (definition)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef) -(defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face) -(defface antlr-font-lock-tokendef-face +(defvar antlr-tokendef-face 'antlr-tokendef) +(defface antlr-tokendef (cond-emacs-xemacs '((((class color) (background light)) (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) "ANTLR token references (definition)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef) -(defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face) -(defface antlr-font-lock-ruleref-face +(defvar antlr-ruleref-face 'antlr-ruleref) +(defface antlr-ruleref '((((class color) (background light)) (:foreground "blue4"))) "ANTLR rule references (usage)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref) -(defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face) -(defface antlr-font-lock-tokenref-face +(defvar antlr-tokenref-face 'antlr-tokenref) +(defface antlr-tokenref '((((class color) (background light)) (:foreground "orange4"))) "ANTLR token references (usage)." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref) -(defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face) -(defface antlr-font-lock-literal-face +(defvar antlr-literal-face 'antlr-literal) +(defface antlr-literal (cond-emacs-xemacs '((((class color) (background light)) (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)))) @@ -886,6 +900,8 @@ It is used to highlight strings matched by the first regexp group of `antlr-font-lock-literal-regexp'." :group 'antlr) +;; backward-compatibility alias +(put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal) (defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" "Regexp matching literals with special syntax highlighting, or nil. @@ -904,56 +920,56 @@ (cond-emacs-xemacs `((antlr-invalidate-context-cache) ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" - (1 antlr-font-lock-tokendef-face)) - ("\\$\\sw+" (0 font-lock-keyword-face)) + (1 antlr-tokendef-face)) + ("\\$\\sw+" (0 keyword-face)) ;; the tokens are already fontified as string/docstrings: (,(lambda (limit) - (if antlr-font-lock-literal-regexp + (if antlr-literal-regexp (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) - (1 antlr-font-lock-literal-face t) + (1 antlr-literal-face t) :XEMACS (0 nil)) ; XEmacs bug workaround (,(lambda (limit) (antlr-re-search-forward antlr-class-header-regexp limit)) - (1 antlr-font-lock-keyword-face) - (2 antlr-font-lock-ruledef-face) - (3 antlr-font-lock-keyword-face) + (1 antlr-keyword-face) + (2 antlr-ruledef-face) + (3 antlr-keyword-face) (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) - 'antlr-font-lock-keyword-face - 'font-lock-type-face))) + antlr-keyword-face + type-face))) (,(lambda (limit) (antlr-re-search-forward "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" limit)) - (1 antlr-font-lock-keyword-face)) + (1 antlr-keyword-face)) (,(lambda (limit) (antlr-re-search-forward "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" limit)) (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad (3 (if (antlr-upcase-p (char-after (match-beginning 3))) - 'antlr-font-lock-tokendef-face - 'antlr-font-lock-ruledef-face) nil t) - (4 antlr-font-lock-syntax-face nil t)) + antlr-tokendef-face + antlr-ruledef-face) nil t) + (4 antlr-syntax-face nil t)) (,(lambda (limit) (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) (1 (if (antlr-upcase-p (char-after (match-beginning 0))) - 'antlr-font-lock-tokendef-face - 'antlr-font-lock-ruledef-face) nil t) - (2 antlr-font-lock-syntax-face nil t)) + antlr-tokendef-face + antlr-ruledef-face) nil t) + (2 antlr-syntax-face nil t)) (,(lambda (limit) ;; v:ruleref and v:"literal" is allowed... (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) (1 (if (match-beginning 2) (if (eq (char-after (match-beginning 2)) ?=) - 'antlr-font-lock-default-face - 'font-lock-variable-name-face) + antlr-default-face + font-lock-variable-name-face) (if (antlr-upcase-p (char-after (match-beginning 1))) - 'antlr-font-lock-tokenref-face - 'antlr-font-lock-ruleref-face))) - (2 antlr-font-lock-default-face nil t)) + antlr-tokenref-face + antlr-ruleref-face))) + (2 antlr-default-face nil t)) (,(lambda (limit) (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) - (0 'antlr-font-lock-syntax-face)))) + (0 antlr-syntax-face)))) "Font-lock keywords for ANTLR's normal grammar code. See `antlr-font-lock-keywords-alist' for the keywords of actions.")
--- a/lisp/progmodes/compile.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/compile.el Wed Jun 15 23:32:15 2005 +0000 @@ -246,8 +246,8 @@ " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) (msft - "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ -: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) + "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ +: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4)) (oracle "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ @@ -468,15 +468,17 @@ ;; History of compile commands. (defvar compile-history nil) -(defface compilation-warning-face +(defface compilation-warning '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) (((class color)) (:foreground "cyan" :weight bold)) (t (:weight bold))) "Face used to highlight compiler warnings." :group 'font-lock-highlighting-faces :version "22.1") +;; backward-compatibility alias +(put 'compilation-warning-face 'face-alias 'compilation-warning) -(defface compilation-info-face +(defface compilation-info '((((class color) (min-colors 16) (background light)) (:foreground "Green3" :weight bold)) (((class color) (min-colors 88) (background dark)) @@ -488,6 +490,8 @@ "Face used to highlight compiler warnings." :group 'font-lock-highlighting-faces :version "22.1") +;; backward-compatibility alias +(put 'compilation-info-face 'face-alias 'compilation-info) (defvar compilation-message-face nil "Face name to use for whole messages. @@ -498,10 +502,10 @@ (defvar compilation-error-face 'font-lock-warning-face "Face name to use for file name in error messages.") -(defvar compilation-warning-face 'compilation-warning-face +(defvar compilation-warning-face 'compilation-warning "Face name to use for file name in warning messages.") -(defvar compilation-info-face 'compilation-info-face +(defvar compilation-info-face 'compilation-info "Face name to use for file name in informational messages.") (defvar compilation-line-face 'font-lock-variable-name-face
--- a/lisp/progmodes/cperl-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/cperl-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -343,7 +343,7 @@ :group 'cperl-indentation-details) (defvar cperl-vc-header-alist nil) -(make-obsolete-variable +(make-obsolete-variable 'cperl-vc-header-alist "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.") @@ -369,7 +369,7 @@ (defcustom cperl-info-on-command-no-prompt nil "*Not-nil (and non-null) means not to prompt on C-h f. -The opposite behaviour is always available if prefixed with C-c. +The opposite behavior is always available if prefixed with C-c. Can be overwritten by `cperl-hairy' if nil." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) @@ -564,11 +564,11 @@ (font-lock-variable-name-face nil nil bold) (font-lock-function-name-face nil nil bold italic box) (font-lock-constant-face nil "LightGray" bold) - (cperl-array-face nil "LightGray" bold underline) - (cperl-hash-face nil "LightGray" bold italic underline) + (cperl-array nil "LightGray" bold underline) + (cperl-hash nil "LightGray" bold italic underline) (font-lock-comment-face nil "LightGray" italic) (font-lock-string-face nil nil italic underline) - (cperl-nonoverridable-face nil nil italic underline) + (cperl-nonoverridable nil nil italic underline) (font-lock-type-face nil nil underline) (underline nil "LightGray" strikeout)) "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." @@ -583,7 +583,7 @@ (defvar cperl-dark-foreground (cperl-choose-color "orchid1" "orange")) -(defface cperl-nonoverridable-face +(defface cperl-nonoverridable `((((class grayscale) (background light)) (:background "Gray90" :slant italic :underline t)) (((class grayscale) (background dark)) @@ -595,8 +595,10 @@ (t (:weight bold :underline t))) "Font Lock mode face used non-overridable keywords and modifiers of regexps." :group 'cperl-faces) - -(defface cperl-array-face +;; backward-compatibility alias +(put 'cperl-nonoverridable-face 'face-alias 'cperl-nonoverridable) + +(defface cperl-array `((((class grayscale) (background light)) (:background "Gray90" :weight bold)) (((class grayscale) (background dark)) @@ -608,8 +610,10 @@ (t (:weight bold))) "Font Lock mode face used to highlight array names." :group 'cperl-faces) - -(defface cperl-hash-face +;; backward-compatibility alias +(put 'cperl-array-face 'face-alias 'cperl-array) + +(defface cperl-hash `((((class grayscale) (background light)) (:background "Gray90" :weight bold :slant italic)) (((class grayscale) (background dark)) @@ -621,6 +625,8 @@ (t (:weight bold :slant italic))) "Font Lock mode face used to highlight hash names." :group 'cperl-faces) +;; backward-compatibility alias +(put 'cperl-hash-face 'face-alias 'cperl-hash) @@ -867,8 +873,8 @@ (defvar cperl-tips-faces 'please-ignore-this-line "CPerl mode uses following faces for highlighting: - `cperl-array-face' Array names - `cperl-hash-face' Hash names + `cperl-array' Array names + `cperl-hash' Hash names `font-lock-comment-face' Comments, PODs and whatever is considered syntaxically to be not code `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of @@ -879,7 +885,7 @@ (except those conflicting with Perl operators), package names (when recognized), format names `font-lock-keyword-face' Control flow switch constructs, declarators - `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen + `cperl-nonoverridable' Non-overridable keywords, modifiers of RExen `font-lock-string-face' Strings, qw() constructs, RExen, POD sections, literal parts and the terminator of formats and whatever is syntaxically considered @@ -887,7 +893,7 @@ `font-lock-type-face' Overridable keywords `font-lock-variable-name-face' Variable declarations, indirect array and hash names, POD headers/item names - `cperl-invalid-face' Trailing whitespace + `cperl-invalid' Trailing whitespace Note that in several situations the highlighting tries to inform about possible confusion, such as different colors for function names in @@ -1303,7 +1309,7 @@ and you are on a boundary of a statement inside braces, it will transform the construct into a multiline and will place you into an appropriately indented blank line. If you need a usual -`newline-and-indent' behaviour, it is on \\[newline-and-indent], +`newline-and-indent' behavior, it is on \\[newline-and-indent], see documentation on `cperl-electric-linefeed'. Use \\[cperl-invert-if-unless] to change a construction of the form @@ -1481,7 +1487,7 @@ (make-local-variable 'comment-start-skip) (setq comment-start-skip "#+ *") (make-local-variable 'defun-prompt-regexp) - (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)") + (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'cperl-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) @@ -3167,7 +3173,7 @@ (cperl-nonoverridable-face (if (boundp 'cperl-nonoverridable-face) cperl-nonoverridable-face - 'cperl-nonoverridable-face)) + 'cperl-nonoverridable)) (stop-point (if ignore-max (point-max) max)) @@ -3661,7 +3667,7 @@ (forward-word 1) ; skip modifiers s///s (if tail (cperl-commentify tail (point) t)) (cperl-postpone-fontification - e1 (point) 'face 'cperl-nonoverridable-face))) + e1 (point) 'face 'cperl-nonoverridable))) ;; Check whether it is m// which means "previous match" ;; and highlight differently (setq is-REx @@ -4710,7 +4716,7 @@ "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually "\\|[sm]" ; Added manually - "\\)\\>") 2 'cperl-nonoverridable-face) + "\\)\\>") 2 'cperl-nonoverridable) ;; (mapconcat 'identity ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" ;; "#include" "#define" "#undef") @@ -4773,15 +4779,15 @@ '( ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 (if (eq (char-after (match-beginning 2)) ?%) - cperl-hash-face - cperl-array-face) + 'cperl-hash + 'cperl-array) t) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) (if (eq (char-after (match-beginning 3)) ?{) - cperl-hash-face - cperl-array-face) ; arrays and hashes + 'cperl-hash + 'cperl-array) ; arrays and hashes font-lock-variable-name-face) ; Just to put something t) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") @@ -4854,21 +4860,21 @@ [nil nil t t t] nil [nil nil t t t]) - (list 'cperl-nonoverridable-face + (list 'cperl-nonoverridable ["chartreuse3" ("orchid1" "orange") nil "Gray80"] [nil nil "gray90"] [nil nil nil t t] [nil nil t t] [nil nil t t t]) - (list 'cperl-array-face + (list 'cperl-array ["blue" "yellow" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] t nil nil) - (list 'cperl-hash-face + (list 'cperl-hash ["red" "red" nil "Gray80"] ["lightyellow2" ("navy" "os2blue" "darkgreen") "gray90"] @@ -4891,15 +4897,15 @@ "Face for variable names") (cperl-force-face font-lock-type-face "Face for data types") - (cperl-force-face cperl-nonoverridable-face + (cperl-force-face cperl-nonoverridable "Face for data types from another group") (cperl-force-face font-lock-comment-face "Face for comments") (cperl-force-face font-lock-function-name-face "Face for function names") - (cperl-force-face cperl-hash-face + (cperl-force-face cperl-hash "Face for hashes") - (cperl-force-face cperl-array-face + (cperl-force-face cperl-array "Face for arrays") ;;(defvar font-lock-constant-face 'font-lock-constant-face) ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) @@ -4909,7 +4915,7 @@ ;; "Face to use for data types.")) ;;(or (boundp 'cperl-nonoverridable-face) ;; (defconst cperl-nonoverridable-face - ;; 'cperl-nonoverridable-face + ;; 'cperl-nonoverridable ;; "Face to use for data types from another group.")) ;;(if (not cperl-xemacs-p) nil ;; (or (boundp 'font-lock-comment-face) @@ -4925,26 +4931,24 @@ ;; 'font-lock-function-name-face ;; "Face to use for function names."))) (if (and - (not (cperl-is-face 'cperl-array-face)) + (not (cperl-is-face 'cperl-array)) (cperl-is-face 'font-lock-emphasized-face)) - (copy-face 'font-lock-emphasized-face 'cperl-array-face)) + (copy-face 'font-lock-emphasized-face 'cperl-array)) (if (and - (not (cperl-is-face 'cperl-hash-face)) + (not (cperl-is-face 'cperl-hash)) (cperl-is-face 'font-lock-other-emphasized-face)) - (copy-face 'font-lock-other-emphasized-face - 'cperl-hash-face)) + (copy-face 'font-lock-other-emphasized-face 'cperl-hash)) (if (and - (not (cperl-is-face 'cperl-nonoverridable-face)) + (not (cperl-is-face 'cperl-nonoverridable)) (cperl-is-face 'font-lock-other-type-face)) - (copy-face 'font-lock-other-type-face - 'cperl-nonoverridable-face)) + (copy-face 'font-lock-other-type-face 'cperl-nonoverridable)) ;;(or (boundp 'cperl-hash-face) ;; (defconst cperl-hash-face - ;; 'cperl-hash-face + ;; 'cperl-hash ;; "Face to use for hashes.")) ;;(or (boundp 'cperl-array-face) ;; (defconst cperl-array-face - ;; 'cperl-array-face + ;; 'cperl-array ;; "Face to use for arrays.")) ;; Here we try to guess background (let ((background @@ -4983,17 +4987,17 @@ "pink"))) (t (set-face-background 'font-lock-type-face "gray90")))) - (if (cperl-is-face 'cperl-nonoverridable-face) + (if (cperl-is-face 'cperl-nonoverridable) nil - (copy-face 'font-lock-type-face 'cperl-nonoverridable-face) + (copy-face 'font-lock-type-face 'cperl-nonoverridable) (cond ((eq background 'light) - (set-face-foreground 'cperl-nonoverridable-face + (set-face-foreground 'cperl-nonoverridable (if (x-color-defined-p "chartreuse3") "chartreuse3" "chartreuse"))) ((eq background 'dark) - (set-face-foreground 'cperl-nonoverridable-face + (set-face-foreground 'cperl-nonoverridable (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) @@ -5045,20 +5049,15 @@ '(setq ps-bold-faces ;; font-lock-variable-name-face ;; font-lock-constant-face - (append '(cperl-array-face - cperl-hash-face) + (append '(cperl-array cperl-hash) ps-bold-faces) ps-italic-faces ;; font-lock-constant-face - (append '(cperl-nonoverridable-face - cperl-hash-face) + (append '(cperl-nonoverridable cperl-hash) ps-italic-faces) ps-underlined-faces ;; font-lock-type-face - (append '(cperl-array-face - cperl-hash-face - underline - cperl-nonoverridable-face) + (append '(cperl-array cperl-hash underline cperl-nonoverridable) ps-underlined-faces)))) (defvar ps-print-face-extension-alist) @@ -5091,27 +5090,27 @@ ;;; (defvar ps-italic-faces nil) ;;; (setq ps-bold-faces ;;; (append '(font-lock-emphasized-face -;;; cperl-array-face +;;; cperl-array ;;; font-lock-keyword-face ;;; font-lock-variable-name-face ;;; font-lock-constant-face ;;; font-lock-reference-face ;;; font-lock-other-emphasized-face -;;; cperl-hash-face) +;;; cperl-hash) ;;; ps-bold-faces)) ;;; (setq ps-italic-faces -;;; (append '(cperl-nonoverridable-face +;;; (append '(cperl-nonoverridable ;;; font-lock-constant-face ;;; font-lock-reference-face ;;; font-lock-other-emphasized-face -;;; cperl-hash-face) +;;; cperl-hash) ;;; ps-italic-faces)) ;;; (setq ps-underlined-faces ;;; (append '(font-lock-emphasized-face -;;; cperl-array-face +;;; cperl-array ;;; font-lock-other-emphasized-face -;;; cperl-hash-face -;;; cperl-nonoverridable-face font-lock-type-face) +;;; cperl-hash +;;; cperl-nonoverridable font-lock-type-face) ;;; ps-underlined-faces)) ;;; (cons 'font-lock-type-face ps-underlined-faces))
--- a/lisp/progmodes/cpp.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/cpp.el Wed Jun 15 23:32:15 2005 +0000 @@ -144,7 +144,7 @@ '("light gray" "light blue" "light cyan" "light yellow" "light pink" "pale green" "beige" "orange" "magenta" "violet" "medium purple" "turquoise") - "Background colours useful with dark foreground colors." + "Background colors useful with dark foreground colors." :type '(repeat string) :group 'cpp) @@ -152,7 +152,7 @@ '("dim gray" "blue" "cyan" "yellow" "red" "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" "dark turquoise") - "Background colours useful with light foreground colors." + "Background colors useful with light foreground colors." :type '(repeat string) :group 'cpp)
--- a/lisp/progmodes/delphi.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/delphi.el Wed Jun 15 23:32:15 2005 +0000 @@ -152,8 +152,8 @@ (defcustom delphi-newline-always-indents t "*Non-nil means NEWLINE in Delphi mode should always reindent the current line, insert a blank line and move to the default indent column of the blank -line. If nil, then no indentation occurs, and NEWLINE does the usual -behaviour. This is useful when one needs to do customized indentation that +line. If nil, then no indentation occurs, and NEWLINE does the usual +behavior. This is useful when one needs to do customized indentation that differs from the default." :type 'boolean :group 'delphi)
--- a/lisp/progmodes/ebrowse.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/ebrowse.el Wed Jun 15 23:32:15 2005 +0000 @@ -157,50 +157,64 @@ :group 'ebrowse) -(defface ebrowse-tree-mark-face +(defface ebrowse-tree-mark '((((min-colors 88)) (:foreground "red1")) (t (:foreground "red"))) "*The face used for the mark character in the tree." :group 'ebrowse-faces) - - -(defface ebrowse-root-class-face +;; backward-compatibility alias +(put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark) + + +(defface ebrowse-root-class '((((min-colors 88)) (:weight bold :foreground "blue1")) (t (:weight bold :foreground "blue"))) "*The face used for root classes in the tree." :group 'ebrowse-faces) - - -(defface ebrowse-file-name-face +;; backward-compatibility alias +(put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class) + + +(defface ebrowse-file-name '((t (:italic t))) "*The face for filenames displayed in the tree." :group 'ebrowse-faces) - - -(defface ebrowse-default-face +;; backward-compatibility alias +(put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name) + + +(defface ebrowse-default '((t nil)) "*Face for everything else in the tree not having other faces." :group 'ebrowse-faces) - - -(defface ebrowse-member-attribute-face +;; backward-compatibility alias +(put 'ebrowse-default-face 'face-alias 'ebrowse-default) + + +(defface ebrowse-member-attribute '((((min-colors 88)) (:foreground "red1")) (t (:foreground "red"))) "*Face used to display member attributes." :group 'ebrowse-faces) - - -(defface ebrowse-member-class-face +;; backward-compatibility alias +(put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute) + + +(defface ebrowse-member-class '((t (:foreground "purple"))) "*Face used to display the class title in member buffers." :group 'ebrowse-faces) - - -(defface ebrowse-progress-face +;; backward-compatibility alias +(put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class) + + +(defface ebrowse-progress '((((min-colors 88)) (:background "blue1")) (t (:background "blue"))) "*Face for progress indicator." :group 'ebrowse-faces) +;; backward-compatibility alias +(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress) @@ -883,7 +897,7 @@ (message (concat title ": " (propertize (make-string ebrowse-n-boxes (if (display-color-p) ?\ ?+)) - 'face 'ebrowse-progress-face))))) + 'face 'ebrowse-progress))))) ;;; Reading a tree from disk @@ -1310,7 +1324,7 @@ (ebrowse-ts-class tree)) "unknown") ")")) - (ebrowse-set-face start (point) 'ebrowse-file-name-face) + (ebrowse-set-face start (point) 'ebrowse-file-name) (beginning-of-line) (forward-line 1)))))) @@ -1828,7 +1842,7 @@ start end `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree help-echo "double-mouse-1: mark/unmark")) - (ebrowse-set-face start end 'ebrowse-tree-mark-face)) + (ebrowse-set-face start end 'ebrowse-tree-mark)) (defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start) @@ -1855,8 +1869,8 @@ (when (ebrowse-template-p class) (insert "<>")) (ebrowse-set-face start (point) (if (zerop level) - 'ebrowse-root-class-face - 'ebrowse-default-face)) + 'ebrowse-root-class + 'ebrowse-default)) (setf start-of-class-name start end-of-class-name (point)) ;; If filenames are to be displayed... @@ -1867,7 +1881,7 @@ (or (ebrowse-cs-file class) "unknown") ")") - (ebrowse-set-face start (point) 'ebrowse-file-name-face)) + (ebrowse-set-face start (point) 'ebrowse-file-name)) (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) (add-text-properties start-of-class-name end-of-class-name @@ -2694,7 +2708,7 @@ (insert "<>")) (setq class-name-end (point)) (insert ":\n\n") - (ebrowse-set-face start (point) 'ebrowse-member-class-face) + (ebrowse-set-face start (point) 'ebrowse-member-class) (add-text-properties class-name-start class-name-end '(ebrowse-what class-name @@ -2810,7 +2824,7 @@ (ebrowse-draw-member-attributes member-struc) (insert ">") (ebrowse-set-face start (point) - 'ebrowse-member-attribute-face))) + 'ebrowse-member-attribute))) (insert " ") (ebrowse-draw-member-regexp member-struc)))) (insert "\n") @@ -2841,7 +2855,7 @@ (ebrowse-draw-member-attributes member) (insert "> ") (ebrowse-set-face start-of-entry (point) - 'ebrowse-member-attribute-face)) + 'ebrowse-member-attribute)) ;; insert member name truncated to column width (setq start-of-name (point)) (insert (substring name 0
--- a/lisp/progmodes/flymake.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/flymake.el Wed Jun 15 23:32:15 2005 +0000 @@ -704,7 +704,7 @@ (nth 1 err-info)) (defvar flymake-new-err-info nil - "Same as 'flymake-err-info', effective when a syntax check is in progress.") + "Same as `flymake-err-info', effective when a syntax check is in progress.") (make-variable-buffer-local 'flymake-new-err-info) @@ -839,19 +839,23 @@ (setq ov (cdr ov))) has-flymake-overlays)) -(defface flymake-errline-face +(defface flymake-errline ;;+ '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) ;;+ '((((class color)) (:underline "OrangeRed")) '((((class color)) (:background "LightPink")) (t (:bold t))) "Face used for marking error lines." :group 'flymake) +;; backward-compatibility alias +(put 'flymake-errline-face 'face-alias 'flymake-errline) -(defface flymake-warnline-face +(defface flymake-warnline '((((class color)) (:background "LightBlue2")) (t (:bold t))) "Face used for marking warning lines." :group 'flymake) +;; backward-compatibility alias +(put 'flymake-warnline-face 'face-alias 'flymake-warnline) (defun flymake-highlight-line (line-no line-err-info-list) "Highlight line LINE-NO in current buffer. @@ -886,8 +890,8 @@ (setq end (point))) (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (setq face 'flymake-errline-face) - (setq face 'flymake-warnline-face)) + (setq face 'flymake-errline) + (setq face 'flymake-warnline)) (flymake-make-overlay beg end tooltip-text face nil))) @@ -1312,7 +1316,7 @@ (flymake-start-syntax-check buffer))))) (defun flymake-start-syntax-check-for-current-buffer () - "Run 'flymake-start-syntax-check' for current buffer if it isn't already running." + "Run `flymake-start-syntax-check' for current buffer if it isn't already running." (interactive) (flymake-start-syntax-check (current-buffer))) @@ -1655,7 +1659,7 @@ temp-source-file-name)) (defun flymake-simple-cleanup (buffer) - "Do cleanup after 'flymake-init-create-temp-buffer-copy'. + "Do cleanup after `flymake-init-create-temp-buffer-copy'. Delete temp file." (let* ((temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name"))) (flymake-safe-delete-file temp-source-file-name)
--- a/lisp/progmodes/gdb-ui.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/gdb-ui.el Wed Jun 15 23:32:15 2005 +0000 @@ -250,7 +250,7 @@ (let ((string (buffer-string))) ;; remove newline for gud-tooltip-echo-area (substring string 0 (- (length string) 1)))) - gud-tooltip-echo-area)) + (or gud-tooltip-echo-area tooltip-use-echo-area))) ;; If expr is a macro for a function don't print because of possible dangerous ;; side-effects. Also printing a function within a tooltip generates an @@ -994,24 +994,24 @@ This begins the collection of output from the current command if that happens to be appropriate." (unless gdb-pending-triggers - (gdb-get-selected-frame) - (gdb-invalidate-frames) - (gdb-invalidate-breakpoints) - ;; Do this through gdb-get-selected-frame -> gdb-frame-handler - ;; so gdb-frame-address is updated. - ;; (gdb-invalidate-assembler) - (gdb-invalidate-registers) - (gdb-invalidate-memory) - (gdb-invalidate-locals) - (gdb-invalidate-threads) - (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. - ;; FIXME: with GDB-6 on Darwin, this might very well work. - ;; only needed/used with speedbar/watch expressions - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (setq gdb-var-changed t) ; force update - (dolist (var gdb-var-list) - (setcar (nthcdr 5 var) nil)) - (gdb-var-update)))) + (gdb-get-selected-frame) + (gdb-invalidate-frames) + (gdb-invalidate-breakpoints) + ;; Do this through gdb-get-selected-frame -> gdb-frame-handler + ;; so gdb-frame-address is updated. + ;; (gdb-invalidate-assembler) + (gdb-invalidate-registers) + (gdb-invalidate-memory) + (gdb-invalidate-locals) + (gdb-invalidate-threads) + (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. + ;; FIXME: with GDB-6 on Darwin, this might very well work. + ;; only needed/used with speedbar/watch expressions + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) + (setq gdb-var-changed t) ; force update + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)) + (gdb-var-update)))) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) @@ -1695,7 +1695,9 @@ (setq buffer-read-only t) (use-local-map gdb-registers-mode-map) (run-mode-hooks 'gdb-registers-mode-hook) - 'gdb-invalidate-registers) + (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + 'gdb-invalidate-registers + 'gdbmi-invalidate-registers)) (defun gdb-registers-buffer-name () (with-current-buffer gud-comint-buffer @@ -2172,18 +2174,18 @@ (let ((menu (make-sparse-keymap "GDB-UI"))) (define-key gud-menu-map [ui] `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba))) - (define-key menu [gdb-restore-windows] - '(menu-item "Restore Window Layout" gdb-restore-windows - :help "Restore standard layout for debug session.")) + (define-key menu [gdb-use-inferior-io] + (menu-bar-make-toggle toggle-gdb-use-inferior-io-buffer + gdb-use-inferior-io-buffer + "Separate inferior IO" "Use separate IO %s" + "Toggle separate IO for inferior.")) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows :help "Toggle display of locals, stack and breakpoint information" :button (:toggle . gdb-many-windows))) - (define-key menu [gdb-use-inferior-io] - (menu-bar-make-toggle toggle-gdb-use-inferior-io-buffer - gdb-use-inferior-io-buffer - "Separate inferior IO" "Use separate IO %s" - "Toggle separate IO for inferior."))) + (define-key menu [gdb-restore-windows] + '(menu-item "Restore Window Layout" gdb-restore-windows + :help "Restore standard layout for debug session."))) (defadvice toggle-gdb-use-inferior-io-buffer (after gdb-kill-io-buffer activate) (unless gdb-use-inferior-io-buffer
--- a/lisp/progmodes/gud.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/gud.el Wed Jun 15 23:32:15 2005 +0000 @@ -1220,7 +1220,7 @@ The directory containing FILE becomes the initial working directory and source-file directory for your debugger. -You can set the variable 'gud-xdb-directories' to a list of program source +You can set the variable `gud-xdb-directories' to a list of program source directories if your program contains sources from more than one directory." (interactive (list (gud-query-cmdline 'xdb))) @@ -3139,8 +3139,6 @@ 'gud-tooltip-modes "22.1") (define-obsolete-variable-alias 'tooltip-gud-display 'gud-tooltip-display "22.1") -(define-obsolete-variable-alias 'tooltip-use-echo-area - 'gud-tooltip-echo-area "22.1") ;;; Reacting on mouse movements @@ -3242,7 +3240,7 @@ ; This will only display data that comes in one chunk. ; Larger arrays (say 400 elements) are displayed in -; the tootip incompletely and spill over into the gud buffer. +; the tooltip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and ; it may be difficult to do better. Using annotations as in ; gdb-ui.el gets round this problem. @@ -3250,7 +3248,7 @@ "Process debugger output and show it in a tooltip window." (set-process-filter process gud-tooltip-original-filter) (tooltip-show (tooltip-strip-prompt process output) - gud-tooltip-echo-area)) + (or gud-tooltip-echo-area tooltip-use-echo-area))) (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR. @@ -3295,7 +3293,9 @@ (cddr mouse)))) (let ((define-elt (assoc expr gdb-define-alist))) (unless (null define-elt) - (tooltip-show (cdr define-elt)) + (tooltip-show + (cdr define-elt) + (or gud-tooltip-echo-area tooltip-use-echo-area)) expr)))) (let ((cmd (gud-tooltip-print-command expr))) (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb))
--- a/lisp/progmodes/idlw-help.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/idlw-help.el Wed Jun 15 23:32:15 2005 +0000 @@ -182,12 +182,14 @@ :group 'idlwave-online-help :type 'string) -(defface idlwave-help-link-face +(defface idlwave-help-link '((((min-colors 88) (class color)) (:foreground "Blue1")) (((class color)) (:foreground "Blue")) (t (:weight bold))) "Face for highlighting links into IDLWAVE online help." :group 'idlwave-online-help) +;; backward-compatibility alias +(put 'idlwave-help-link-face 'face-alias 'idlwave-help-link) (defvar idlwave-help-activate-links-aggressively nil "Obsolete variable.") @@ -586,12 +588,12 @@ (defun idlwave-highlight-linked-completions () "Highlight all completions for which help is available and attach link. Those words in `idlwave-completion-help-links' have links. The -`idlwave-help-link-face' face is used for this." +`idlwave-help-link' face is used for this." (if idlwave-highlight-help-links-in-completion (with-current-buffer (get-buffer "*Completions*") (save-excursion (let* ((case-fold-search t) - (props (list 'face 'idlwave-help-link-face)) + (props (list 'face 'idlwave-help-link)) (info idlwave-completion-help-info) ; global passed in (what (nth 0 info)) ; what was completed, or a func (class (nth 3 info)) ; any class
--- a/lisp/progmodes/idlw-shell.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/idlw-shell.el Wed Jun 15 23:32:15 2005 +0000 @@ -510,40 +510,44 @@ (defvar idlwave-shell-use-breakpoint-glyph t "Obsolete variable. See `idlwave-shell-mark-breakpoints.") -(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp-face +(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp "*The face for breakpoint lines in the source code. Allows you to choose the font, color and other properties for lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." :group 'idlwave-shell-highlighting-and-faces :type 'symbol) -(if idlwave-shell-have-new-custom - ;; We have the new customize - use it to define a customizable face - (defface idlwave-shell-bp-face - '((((class color)) (:foreground "Black" :background "Pink")) - (t (:underline t))) - "Face for highlighting lines with breakpoints." - :group 'idlwave-shell-highlighting-and-faces) - ;; Just copy the underline face to be on the safe side. - (copy-face 'underline 'idlwave-shell-bp-face)) +(if (not idlwave-shell-have-new-custom) + ;; Just copy the underline face to be on the safe side. + (copy-face 'underline 'idlwave-shell-bp) + ;; We have the new customize - use it to define a customizable face + (defface idlwave-shell-bp + '((((class color)) (:foreground "Black" :background "Pink")) + (t (:underline t))) + "Face for highlighting lines with breakpoints." + :group 'idlwave-shell-highlighting-and-faces) + ;; backward-compatibility alias + (put 'idlwave-shell-bp-face 'face-alias 'idlwave-shell-bp)) (defcustom idlwave-shell-disabled-breakpoint-face - 'idlwave-shell-disabled-bp-face + 'idlwave-shell-disabled-bp "*The face for disabled breakpoint lines in the source code. Allows you to choose the font, color and other properties for lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." :group 'idlwave-shell-highlighting-and-faces :type 'symbol) -(if idlwave-shell-have-new-custom - ;; We have the new customize - use it to define a customizable face - (defface idlwave-shell-disabled-bp-face - '((((class color)) (:foreground "Black" :background "gray")) - (t (:underline t))) - "Face for highlighting lines with breakpoints." - :group 'idlwave-shell-highlighting-and-faces) - ;; Just copy the underline face to be on the safe side. - (copy-face 'underline 'idlwave-shell-disabled-bp-face)) +(if (not idlwave-shell-have-new-custom) + ;; Just copy the underline face to be on the safe side. + (copy-face 'underline 'idlwave-shell-disabled-bp) + ;; We have the new customize - use it to define a customizable face + (defface idlwave-shell-disabled-bp + '((((class color)) (:foreground "Black" :background "gray")) + (t (:underline t))) + "Face for highlighting lines with breakpoints." + :group 'idlwave-shell-highlighting-and-faces) + ;; backward-compatibility alias + (put 'idlwave-shell-disabled-bp-face 'face-alias 'idlwave-shell-disabled-bp)) (defcustom idlwave-shell-expression-face 'secondary-selection @@ -2734,7 +2738,7 @@ (funcall orig-func cur-line orig-bp-line) (or (not bp-line) (funcall closer-func cur-line bp-line))) (setq bp-line cur-line)))) - (unless bp-line (error "No further breakpoints.")) + (unless bp-line (error "No further breakpoints")) (goto-line bp-line))) ;; Examine Commands ------------------------------------------------------
--- a/lisp/progmodes/idlwave.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/idlwave.el Wed Jun 15 23:32:15 2005 +0000 @@ -70,7 +70,7 @@ ;; of the documentation is available from the maintainers webpage (see ;; SOURCE). ;; -;; +;; ;; ACKNOWLEDGMENTS ;; =============== ;; @@ -120,7 +120,7 @@ ;; up inserting the character that expanded the abbrev after moving ;; point backward, e.g., "\cl" expanded with a space becomes ;; "LONG( )" with point before the close paren. This is solved by -;; using a temporary function in `post-command-hook' - not pretty, +;; using a temporary function in `post-command-hook' - not pretty, ;; but it works. ;; ;; Tabs and spaces are treated equally as whitespace when filling a @@ -166,13 +166,13 @@ nil ;; We've got what we needed ;; We have the old or no custom-library, hack around it! (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) + (defmacro defcustom (var value doc &rest args) `(defvar ,var ,value ,doc)))) (defgroup idlwave nil "Major mode for editing IDL .pro files" :tag "IDLWAVE" - :link '(url-link :tag "Home Page" + :link '(url-link :tag "Home Page" "http://idlwave.org") :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" "idlw-shell.el") @@ -286,8 +286,8 @@ (defcustom idlwave-auto-fill-split-string t "*If non-nil then auto fill will split strings with the IDL `+' operator. -When the line end falls within a string, string concatenation with the -'+' operator will be used to distribute a long string over lines. +When the line end falls within a string, string concatenation with the +'+' operator will be used to distribute a long string over lines. If nil and a string is split then a terminal beep and warning are issued. This variable is ignored when `idlwave-fill-comment-line-only' is @@ -351,7 +351,7 @@ Initializing the routine info can take long, in particular if a large library catalog is involved. When Emacs is idle for more than the number of seconds specified by this variable, it starts the initialization. -The process is split into five steps, in order to keep possible work +The process is split into five steps, in order to keep possible work interruption as short as possible. If one of the steps finishes, and no user input has arrived in the mean time, initialization proceeds immediately to the next step. @@ -403,7 +403,7 @@ (const :tag "When saving a buffer" save-buffer) (const :tag "After a buffer was killed" kill-buffer) (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) - + (defcustom idlwave-rinfo-max-source-lines 5 "*Maximum number of source files displayed in the Routine Info window. When an integer, it is the maximum number of source files displayed. @@ -436,7 +436,7 @@ :group 'idlwave-routine-info :type 'directory) -(defcustom idlwave-config-directory +(defcustom idlwave-config-directory (convert-standard-filename "~/.idlwave") "*Directory for configuration files and user-library catalog." :group 'idlwave-routine-info @@ -451,7 +451,7 @@ (defcustom idlwave-special-lib-alist nil "Alist of regular expressions matching special library directories. When listing routine source locations, IDLWAVE gives a short hint where -the file defining the routine is located. By default it lists `SystemLib' +the file defining the routine is located. By default it lists `SystemLib' for routines in the system library `!DIR/lib' and `Library' for anything else. This variable can define additional types. The car of each entry is a regular expression matching the file name (they normally will match @@ -462,7 +462,7 @@ (cons regexp string))) (defcustom idlwave-auto-write-paths t - "Write out path (!PATH) and system directory (!DIR) info automatically. + "Write out path (!PATH) and system directory (!DIR) info automatically. Path info is needed to locate library catalog files. If non-nil, whenever the path-list changes as a result of shell-query, etc., it is written to file. Otherwise, the menu option \"Write Paths\" can be @@ -493,7 +493,7 @@ This variable determines the case (UPPER/lower/Capitalized...) of words inserted into the buffer by completion. The preferred case can be specified separately for routine names, keywords, classes and -methods. +methods. This alist should therefore have entries for `routine' (normal functions and procedures, i.e. non-methods), `keyword', `class', and `method'. Plausible values are @@ -580,7 +580,7 @@ for which to assume this can be set here." :group 'idlwave-routine-info :type '(repeat (regexp :tag "Match method:"))) - + (defcustom idlwave-completion-show-classes 1 "*Number of classes to show when completing object methods and keywords. @@ -645,7 +645,7 @@ specify if the class should be found during method and keyword completion, respectively. -The alist may have additional entries specifying exceptions from the +The alist may have additional entries specifying exceptions from the keyword completion rule for specific methods, like INIT or GETPROPERTY. In order to turn on class specification for the INIT method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." @@ -669,7 +669,7 @@ value of the variable `idlwave-query-class'. When you specify a class, this information can be stored as a text -property on the `->' arrow in the source code, so that during the same +property on the `->' arrow in the source code, so that during the same editing session, IDLWAVE will not have to ask again. When this variable is non-nil, IDLWAVE will store and reuse the class information. The class stored can be checked and removed with `\\[idlwave-routine-info]' @@ -1049,7 +1049,7 @@ :group 'idlwave-misc :type 'boolean) -(defcustom idlwave-default-font-lock-items +(defcustom idlwave-default-font-lock-items '(pros-and-functions batch-files idlwave-idl-keywords label goto common-blocks class-arrows) "Items which should be fontified on the default fontification level 2. @@ -1111,25 +1111,25 @@ ;;; and Carsten Dominik... ;; The following are the reserved words in IDL. Maybe we should -;; highlight some more stuff as well? +;; highlight some more stuff as well? ;; Procedure declarations. Fontify keyword plus procedure name. (defvar idlwave-idl-keywords - ;; To update this regexp, update the list of keywords and + ;; To update this regexp, update the list of keywords and ;; evaluate the form. - ;; (insert + ;; (insert ;; (prin1-to-string - ;; (concat + ;; (concat ;; "\\<\\(" - ;; (regexp-opt + ;; (regexp-opt ;; '("||" "&&" "and" "or" "xor" "not" - ;; "eq" "ge" "gt" "le" "lt" "ne" + ;; "eq" "ge" "gt" "le" "lt" "ne" ;; "for" "do" "endfor" - ;; "if" "then" "endif" "else" "endelse" + ;; "if" "then" "endif" "else" "endelse" ;; "case" "of" "endcase" ;; "switch" "break" "continue" "endswitch" ;; "begin" "end" ;; "repeat" "until" "endrep" - ;; "while" "endwhile" + ;; "while" "endwhile" ;; "goto" "return" ;; "inherits" "mod" ;; "compile_opt" "forward_function" @@ -1152,7 +1152,7 @@ (2 font-lock-reference-face nil t) ; block name (font-lock-match-c++-style-declaration-item-and-skip-to-next ;; Start with point after block name and comma - (goto-char (match-end 0)) ; needed for XEmacs, could be nil + (goto-char (match-end 0)) ; needed for XEmacs, could be nil nil (1 font-lock-variable-name-face) ; variable names ))) @@ -1207,7 +1207,7 @@ ;; All operators (not used because too noisy) (all-operators '("[-*^#+<>/]" (0 font-lock-keyword-face))) - + ;; Arrows with text property `idlwave-class' (class-arrows '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) @@ -1244,14 +1244,14 @@ (defvar idlwave-font-lock-defaults '((idlwave-font-lock-keywords - idlwave-font-lock-keywords-1 + idlwave-font-lock-keywords-1 idlwave-font-lock-keywords-2 idlwave-font-lock-keywords-3) - nil t - ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) + nil t + ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) beginning-of-line)) -(put 'idlwave-mode 'font-lock-defaults +(put 'idlwave-mode 'font-lock-defaults idlwave-font-lock-defaults) ; XEmacs (defconst idlwave-comment-line-start-skip "^[ \t]*;" @@ -1259,7 +1259,7 @@ That is the _beginning_ of a line containing a comment delimiter `;' preceded only by whitespace.") -(defconst idlwave-begin-block-reg +(defconst idlwave-begin-block-reg "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" "Regular expression to find the beginning of a block. The case does not matter. The search skips matches in comments.") @@ -1336,17 +1336,17 @@ '(goto . ("goto\\>" nil)) '(case . ("case\\>" nil)) '(switch . ("switch\\>" nil)) - (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" + (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" "\\(" idlwave-method-call "\\s *\\)?" idlwave-identifier "\\s *(") nil)) - (cons 'call (list (concat + (cons 'call (list (concat "\\(" idlwave-method-call "\\s *\\)?" - idlwave-identifier + idlwave-identifier "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) - (cons 'assign (list (concat + (cons 'assign (list (concat "\\(" idlwave-variable "\\) *=") nil))) - + "Associated list of statement matching regular expressions. Each regular expression matches the start of an IDL statement. The first element of each association is a symbol giving the statement @@ -1540,15 +1540,15 @@ (not (equal idlwave-shell-debug-modifiers '()))) ;; Bind the debug commands also with the special modifiers. (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) - (mods-noshift (delq 'shift + (mods-noshift (delq 'shift (copy-sequence idlwave-shell-debug-modifiers)))) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?C ?c)))) 'idlwave-shell-save-and-run) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?B ?b)))) 'idlwave-shell-break-here) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?E ?e)))) 'idlwave-shell-run-region))) (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) @@ -1584,7 +1584,7 @@ (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) (define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) -(define-key idlwave-mode-map +(define-key idlwave-mode-map (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) 'idlwave-mouse-context-help) @@ -1595,7 +1595,7 @@ ; (lambda (char) 0))) (idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) ;; Binding works for both > and ->, by changing the length of the token. -(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 +(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 'idlwave-gtr-pad-hook)) (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t) (idlwave-action-and-binding "," '(idlwave-surround 0 -1)) @@ -1629,7 +1629,7 @@ (error (apply 'define-abbrev args))))) (condition-case nil - (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) + (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) "w" idlwave-mode-syntax-table) (error nil)) @@ -1702,7 +1702,7 @@ (idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) - + ;; This section is reserved words only. (From IDL user manual) ;; (idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) @@ -1751,7 +1751,7 @@ (defvar imenu-extract-index-name-function) (defvar imenu-prev-index-position-function) ;; defined later - so just make the compiler hush -(defvar idlwave-mode-menu) +(defvar idlwave-mode-menu) (defvar idlwave-mode-debug-menu) ;;;###autoload @@ -1836,7 +1836,7 @@ \\i IF statement template \\elif IF-ELSE statement template \\b BEGIN - + For a full list, use \\[idlwave-list-abbrevs]. Some templates also have direct keybindings - see the list of keybindings below. @@ -1878,26 +1878,26 @@ (interactive) (kill-all-local-variables) - + (if idlwave-startup-message (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) (setq idlwave-startup-message nil) - + (setq local-abbrev-table idlwave-mode-abbrev-table) (set-syntax-table idlwave-mode-syntax-table) - + (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) - + (make-local-variable idlwave-comment-indent-function) (set idlwave-comment-indent-function 'idlwave-comment-hook) - + (set (make-local-variable 'comment-start-skip) ";+[ \t]*") (set (make-local-variable 'comment-start) ";") (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'abbrev-all-caps) t) (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'completion-ignore-case) t) - + (use-local-map idlwave-mode-map) (when (featurep 'easymenu) @@ -1907,11 +1907,11 @@ (setq mode-name "IDLWAVE") (setq major-mode 'idlwave-mode) (setq abbrev-mode t) - + (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) (setq comment-end "") (set (make-local-variable 'comment-multi-line) nil) - (set (make-local-variable 'paragraph-separate) + (set (make-local-variable 'paragraph-separate) "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) @@ -1920,7 +1920,7 @@ ;; Set tag table list to use IDLTAGS as file name. (if (boundp 'tag-table-alist) (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) - + ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow ;; Following line is for Emacs - XEmacs uses the corresponding property ;; on the `idlwave-mode' symbol. @@ -1961,18 +1961,18 @@ (unless idlwave-setup-done (if (not (file-directory-p idlwave-config-directory)) (make-directory idlwave-config-directory)) - (setq idlwave-user-catalog-file (expand-file-name - idlwave-user-catalog-file + (setq idlwave-user-catalog-file (expand-file-name + idlwave-user-catalog-file idlwave-config-directory) - idlwave-path-file (expand-file-name - idlwave-path-file + idlwave-path-file (expand-file-name + idlwave-path-file idlwave-config-directory)) (idlwave-read-paths) ; we may need these early (setq idlwave-setup-done t))) ;; ;; Code Formatting ---------------------------------------------------- -;; +;; (defun idlwave-push-mark (&rest rest) "Push mark for compatibility with Emacs 18/19." @@ -2121,7 +2121,7 @@ (if (> end-pos eol-pos) (setq end-pos pos)) (goto-char end-pos) - (setq end (buffer-substring + (setq end (buffer-substring (progn (skip-chars-backward "a-zA-Z") (point)) @@ -2143,7 +2143,7 @@ (sit-for 1)) (t (beep) - (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" + (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" end1 end) (sit-for 1)))))))) ;;(delete-char 1)) @@ -2155,8 +2155,8 @@ ((looking-at "pro\\|case\\|switch\\|function\\>") (assoc (downcase (match-string 0)) idlwave-block-matches)) ((looking-at "begin\\>") - (let ((limit (save-excursion - (idlwave-beginning-of-statement) + (let ((limit (save-excursion + (idlwave-beginning-of-statement) (point)))) (cond ((re-search-backward ":[ \t]*\\=" limit t) @@ -2184,9 +2184,9 @@ (insert "end") (idlwave-show-begin))) -(defun idlwave-gtr-pad-hook (char) +(defun idlwave-gtr-pad-hook (char) "Let the > symbol expand around -> if present. The new token length -is returned." +is returned." 2) (defun idlwave-surround (&optional before after escape-chars length ec-hook) @@ -2216,8 +2216,8 @@ (let* ((length (or length 1)) ; establish a default for LENGTH (prev-char (char-after (- (point) (1+ length))))) (when (or (not (memq prev-char escape-chars)) - (and (fboundp ec-hook) - (setq length + (and (fboundp ec-hook) + (setq length (save-excursion (funcall ec-hook prev-char))))) (backward-char length) (save-restriction @@ -2439,7 +2439,7 @@ (let ((eos (save-excursion (idlwave-block-jump-out -1 'nomark) (point)))) - (if (setq status (idlwave-find-key + (if (setq status (idlwave-find-key idlwave-end-block-reg -1 'nomark eos)) (idlwave-beginning-of-statement) (message "No nested block before beginning of containing block."))) @@ -2447,7 +2447,7 @@ (let ((eos (save-excursion (idlwave-block-jump-out 1 'nomark) (point)))) - (if (setq status (idlwave-find-key + (if (setq status (idlwave-find-key idlwave-begin-block-reg 1 'nomark eos)) (idlwave-end-of-statement) (message "No nested block before end of containing block.")))) @@ -2461,7 +2461,7 @@ (here (point))) (goto-char (point-max)) (if (re-search-backward idlwave-doclib-start nil t) - (progn + (progn (setq beg (progn (beginning-of-line) (point))) (if (re-search-forward idlwave-doclib-end nil t) (progn @@ -2495,7 +2495,7 @@ ((eq major-mode 'idlwave-shell-mode) (if (re-search-backward idlwave-shell-prompt-pattern nil t) (goto-char (match-end 0)))) - (t + (t (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) (idlwave-previous-statement) (beginning-of-line))))) @@ -2572,7 +2572,7 @@ (let ((save-point (point))) (when (re-search-forward ".*&" lim t) (goto-char (match-end 0)) - (if (idlwave-quoted) + (if (idlwave-quoted) (goto-char save-point) (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) (point))) @@ -2589,7 +2589,7 @@ ;; - not in parenthesis (like a[0:3]) ;; - not followed by another ":" in explicit class, ala a->b::c ;; As many in this mode, this function is heuristic and not an exact - ;; parser. + ;; parser. (let* ((start (point)) (eos (save-excursion (idlwave-end-of-statement) (point))) (end (idlwave-find-key ":" 1 'nomark eos))) @@ -2666,7 +2666,7 @@ `idlwave-pad-keyword' is t then keyword assignment is treated just like assignment statements. When nil, spaces are removed for keyword assignment. Any other value keeps the current space around the `='. -Limits in for loops are treated as keyword assignment. +Limits in for loops are treated as keyword assignment. Starting with IDL 6.0, a number of op= assignments are available. Since ambiguities of the form: @@ -2681,25 +2681,25 @@ See `idlwave-surround'." (if idlwave-surround-by-blank - (let + (let ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") - (an-ops + (an-ops "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") (len 1)) - - (save-excursion + + (save-excursion (let ((case-fold-search t)) (backward-char) - (if (or + (if (or (re-search-backward non-an-ops nil t) ;; Why doesn't ##? work for both? - (re-search-backward "\\(#\\)\\=" nil t)) + (re-search-backward "\\(#\\)\\=" nil t)) (setq len (1+ (length (match-string 1)))) (when (re-search-backward an-ops nil t) (setq begin nil) ; won't modify begin (setq len (1+ (length (match-string 1)))))))) - - (if (eq t idlwave-pad-keyword) + + (if (eq t idlwave-pad-keyword) ;; Everything gets padded equally (idlwave-surround before after nil len) ;; Treating keywords/for variables specially... @@ -2710,22 +2710,22 @@ (skip-chars-backward "= \t") (nth 2 (idlwave-where))))) (cond ((or (memq what '(function-keyword procedure-keyword)) - (memq (caar st) '(for pdef))) - (cond + (memq (caar st) '(for pdef))) + (cond ((null idlwave-pad-keyword) (idlwave-surround 0 0) ) ; remove space (t))) ; leave any spaces alone (t (idlwave-surround before after nil len)))))))) - + (defun idlwave-indent-and-action (&optional arg) "Call `idlwave-indent-line' and do expand actions. With prefix ARG non-nil, indent the entire sub-statement." (interactive "p") (save-excursion - (if (and idlwave-expand-generic-end - (re-search-backward "\\<\\(end\\)\\s-*\\=" + (if (and idlwave-expand-generic-end + (re-search-backward "\\<\\(end\\)\\s-*\\=" (max 0 (- (point) 10)) t) (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) (progn (goto-char (match-end 1)) @@ -2735,7 +2735,7 @@ (when (and (not arg) current-prefix-arg) (setq arg current-prefix-arg) (setq current-prefix-arg nil)) - (if arg + (if arg (idlwave-indent-statement) (idlwave-indent-line t))) @@ -2868,7 +2868,7 @@ (save-excursion (cond ;; Beginning of file - ((prog1 + ((prog1 (idlwave-previous-statement) (setq beg-prev-pos (point))) 0) @@ -2878,7 +2878,7 @@ idlwave-main-block-indent)) ;; Begin block ((idlwave-look-at idlwave-begin-block-reg t) - (+ (idlwave-min-current-statement-indent) + (+ (idlwave-min-current-statement-indent) idlwave-block-indent)) ;; End Block ((idlwave-look-at idlwave-end-block-reg t) @@ -2889,7 +2889,7 @@ (idlwave-min-current-statement-indent))) ;; idlwave-end-offset ;; idlwave-block-indent)) - + ;; Default to current indent ((idlwave-current-statement-indent)))))) ;; adjust the indentation based on the current statement @@ -2905,7 +2905,7 @@ (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) "Calculate the continuation indent inside a paren group. -Returns a cons-cell with (open . indent), where open is the +Returns a cons-cell with (open . indent), where open is the location of the open paren" (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) ;; Found an innermost open paren. @@ -2946,24 +2946,24 @@ (end-reg (progn (beginning-of-line) (point))) (beg-last-statement (save-excursion (idlwave-previous-statement) (point))) - (beg-reg (progn (idlwave-start-of-substatement 'pre) + (beg-reg (progn (idlwave-start-of-substatement 'pre) (if (eq (line-beginning-position) end-reg) (goto-char beg-last-statement) (point)))) (basic-indent (+ (idlwave-min-current-statement-indent end-reg) idlwave-continuation-indent)) fancy-nonparen-indent fancy-paren-indent) - (cond + (cond ;; Align then with its matching if, etc. ((let ((matchers '(("\\<if\\>" . "[ \t]*then") ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") - ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . + ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . "[ \t]*until") ("\\<case\\>" . "[ \t]*of"))) match cont-re) (goto-char end-reg) - (and + (and (setq cont-re (catch 'exit (while (setq match (car matchers)) @@ -2972,7 +2972,7 @@ (setq matchers (cdr matchers))))) (idlwave-find-key cont-re -1 'nomark beg-last-statement))) (if (looking-at "end") ;; that one's special - (- (idlwave-current-indent) + (- (idlwave-current-indent) (+ idlwave-block-indent idlwave-end-offset)) (idlwave-current-indent))) @@ -2998,7 +2998,7 @@ (let* ((end-reg end-reg) (close-exp (progn (goto-char end-reg) - (skip-chars-forward " \t") + (skip-chars-forward " \t") (looking-at "\\s)"))) indent-cons) (catch 'loop @@ -3032,12 +3032,12 @@ (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) nil (current-column))) - + ;; Continued assignment (with =): ((catch 'assign ; (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") (goto-char (match-end 0)) - (if (null (idlwave-what-function beg-reg)) + (if (null (idlwave-what-function beg-reg)) (throw 'assign t)))) (unless (or (idlwave-in-quote) @@ -3099,7 +3099,7 @@ (let* ((here (point)) (case-fold-search t) (limit (if (>= dir 0) (point-max) (point-min))) - (block-limit (if (>= dir 0) + (block-limit (if (>= dir 0) idlwave-begin-block-reg idlwave-end-block-reg)) found @@ -3110,7 +3110,7 @@ (idlwave-find-key idlwave-begin-unit-reg dir t limit) (end-of-line) - (idlwave-find-key + (idlwave-find-key idlwave-end-unit-reg dir t limit))) limit))) (if (>= dir 0) (end-of-line)) ;Make sure we are in current block @@ -3135,7 +3135,7 @@ (or (null end-reg) (< (point) end-reg))) (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) (if (or comm-or-empty (and end-reg (>= (point) end-reg))) - min + min (min min (idlwave-current-indent)))))) (defun idlwave-current-statement-indent (&optional last-line) @@ -3161,10 +3161,10 @@ Blank or comment-only lines following regular continuation lines (with `$') count as continuations too." (save-excursion - (or + (or (idlwave-look-at "\\<\\$") (catch 'loop - (while (and (looking-at "^[ \t]*\\(;.*\\)?$") + (while (and (looking-at "^[ \t]*\\(;.*\\)?$") (eq (forward-line -1) 0)) (if (idlwave-look-at "\\<\\$") (throw 'loop t))))))) @@ -3262,7 +3262,7 @@ (beginning-of-line) (point)) (point)))) "[^;]")) - + ;; Mark the beginning and end of the paragraph (goto-char bcl) (while (and (looking-at fill-prefix-reg) @@ -3326,7 +3326,7 @@ (insert (make-string diff ?\ )))) (forward-line -1)) ) - + ;; No hang. Instead find minimum indentation of paragraph ;; after first line. ;; For the following while statement, since START is at the @@ -3358,7 +3358,7 @@ t) (current-column)) indent)) - + ;; try to keep point at its original place (goto-char here) @@ -3407,7 +3407,7 @@ (current-column))))) (defun idlwave-auto-fill () - "Called to break lines in auto fill mode. + "Called to break lines in auto fill mode. Only fills non-comment lines if `idlwave-fill-comment-line-only' is non-nil. Places a continuation character at the end of the line if not in a comment. Splits strings with IDL concatenation operator `+' @@ -3558,7 +3558,7 @@ (insert (current-time-string)) (insert ", " (user-full-name)) (if (boundp 'user-mail-address) - (insert " <" user-mail-address ">") + (insert " <" user-mail-address ">") (insert " <" (user-login-name) "@" (system-name) ">")) ;; Remove extra spaces from line (idlwave-fill-paragraph) @@ -3584,7 +3584,7 @@ (setq end (match-end 0))) (progn (goto-char beg) - (if (re-search-forward + (if (re-search-forward (concat idlwave-doc-modifications-keyword ":") end t) (end-of-line) @@ -3682,7 +3682,7 @@ (not (idlwave-in-quote)) (save-excursion (forward-char) - (re-search-backward (concat "\\(" idlwave-idl-keywords + (re-search-backward (concat "\\(" idlwave-idl-keywords "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) @@ -3728,7 +3728,7 @@ (indent-region beg end nil)) (if (stringp prompt) (message prompt))))) - + (defun idlwave-rw-case (string) "Make STRING have the case required by `idlwave-reserved-word-upcase'." (if idlwave-reserved-word-upcase @@ -3746,7 +3746,7 @@ (defun idlwave-case () "Build skeleton IDL case statement." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "case") (idlwave-rw-case " of\n\nendcase") "Selector expression")) @@ -3754,7 +3754,7 @@ (defun idlwave-switch () "Build skeleton IDL switch statement." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "switch") (idlwave-rw-case " of\n\nendswitch") "Selector expression")) @@ -3762,7 +3762,7 @@ (defun idlwave-for () "Build skeleton for loop statment." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "for") (idlwave-rw-case " do begin\n\nendfor") "Loop expression")) @@ -3777,14 +3777,14 @@ (defun idlwave-procedure () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "pro") (idlwave-rw-case "\n\nreturn\nend") "Procedure name")) (defun idlwave-function () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "function") (idlwave-rw-case "\n\nreturn\nend") "Function name")) @@ -3798,7 +3798,7 @@ (defun idlwave-while () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "while") (idlwave-rw-case " do begin\n\nendwhile") "Entry condition")) @@ -3877,8 +3877,8 @@ (defun idlwave-count-outlawed-buffers (tag) "How many outlawed buffers have tag TAG?" (length (delq nil - (mapcar - (lambda (x) (eq (cdr x) tag)) + (mapcar + (lambda (x) (eq (cdr x) tag)) idlwave-outlawed-buffers)))) (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) @@ -3892,9 +3892,9 @@ (memq (cdr entry) reasons)) (kill-buffer (car entry)) (incf cnt) - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers)))) (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) @@ -3906,7 +3906,7 @@ (entry (assq buf idlwave-outlawed-buffers))) ;; Revoke license (if entry - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) ;; Remove this function from the hook. (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) @@ -3925,7 +3925,7 @@ (defun idlwave-expand-lib-file-name (file) ;; Find FILE on the scanned lib path and return a buffer visiting it ;; This is for, e.g., finding source with no user catalog - (cond + (cond ((null file) nil) ((file-name-absolute-p file) file) (t (idlwave-locate-lib-file file)))) @@ -3940,7 +3940,7 @@ (interactive) (let (directory directories cmd append status numdirs dir getsubdirs buffer save_buffer files numfiles item errbuf) - + ;; ;; Read list of directories (setq directory (read-string "Tag Directories: " ".")) @@ -3992,7 +3992,7 @@ (message (concat "Tagging " item "...")) (setq errbuf (get-buffer-create "*idltags-error*")) (setq status (+ status - (if (eq 0 (call-process + (if (eq 0 (call-process "sh" nil errbuf nil "-c" (concat cmd append item))) 0 @@ -4006,13 +4006,13 @@ (setq numfiles (1+ numfiles)) (setq item (nth numfiles files)) ))) - + (setq numdirs (1+ numdirs)) (setq dir (nth numdirs directories))) (progn (setq numdirs (1+ numdirs)) (setq dir (nth numdirs directories))))) - + (setq errbuf (get-buffer-create "*idltags-error*")) (if (= status 0) (kill-buffer errbuf)) @@ -4088,7 +4088,7 @@ ;; Make sure the hash functions are accessible. (if (or (not (fboundp 'gethash)) (not (fboundp 'puthash))) - (progn + (progn (require 'cl) (or (fboundp 'puthash) (defalias 'puthash 'cl-puthash)))) @@ -4107,7 +4107,7 @@ ;; Reset the system & library hash (loop for entry in entries for var = (car entry) for size = (nth 1 entry) - do (setcdr (symbol-value var) + do (setcdr (symbol-value var) (make-hash-table ':size size ':test 'equal))) (setq idlwave-sint-dirs nil idlwave-sint-libnames nil)) @@ -4117,7 +4117,7 @@ ;; Reset the buffer & shell hash (loop for entry in entries for var = (car entry) for size = (nth 1 entry) - do (setcar (symbol-value var) + do (setcar (symbol-value var) (make-hash-table ':size size ':test 'equal)))))) (defun idlwave-sintern-routine-or-method (name &optional class set) @@ -4204,11 +4204,11 @@ (setq class (idlwave-sintern-class class set)) (setq name (idlwave-sintern-method name set))) (setq name (idlwave-sintern-routine name set))) - + ;; The source (let ((source-type (car source)) (source-file (nth 1 source)) - (source-dir (if default-dir + (source-dir (if default-dir (file-name-as-directory default-dir) (nth 2 source))) (source-lib (nth 3 source))) @@ -4217,7 +4217,7 @@ (if (stringp source-lib) (setq source-lib (idlwave-sintern-libname source-lib set))) (setq source (list source-type source-file source-dir source-lib))) - + ;; The keywords (setq kwds (mapcar (lambda (x) (idlwave-sintern-keyword-list x set)) @@ -4355,10 +4355,10 @@ "-l" (expand-file-name "~/.emacs") "-l" "idlwave" "-f" "idlwave-rescan-catalog-directories")) - (process (apply 'start-process "idlcat" + (process (apply 'start-process "idlcat" nil emacs args))) (setq idlwave-catalog-process process) - (set-process-sentinel + (set-process-sentinel process (lambda (pro why) (when (string-match "finished" why) @@ -4431,7 +4431,7 @@ ;; The override-idle means, even if the idle timer has done some ;; preparing work, load and renormalize everything anyway. (override-idle (or arg idlwave-buffer-case-takes-precedence))) - + (setq idlwave-buffer-routines nil idlwave-compiled-routines nil idlwave-unresolved-routines nil) @@ -4442,7 +4442,7 @@ (idlwave-reset-sintern (cond (load t) ((null idlwave-system-routines) t) (t 'bufsh)))) - + (if idlwave-buffer-case-takes-precedence ;; We can safely scan the buffer stuff first (progn @@ -4457,9 +4457,9 @@ (idlwave-shell-is-running))) (ask-shell (and shell-is-running idlwave-query-shell-for-routine-info))) - + ;; Load the library catalogs again, first re-scanning the path - (when arg + (when arg (if shell-is-running (idlwave-shell-send-command idlwave-shell-path-query '(progn @@ -4479,7 +4479,7 @@ ;; Therefore, we do a concatenation now, even though ;; the shell might do it again. (idlwave-concatenate-rinfo-lists nil 'run-hooks)) - + (when ask-shell ;; Ask the shell about the routines it knows of. (message "Querying the shell") @@ -4541,7 +4541,7 @@ (progn (setq idlwave-library-routines nil) (ding) - (message "Outdated user catalog: %s... recreate" + (message "Outdated user catalog: %s... recreate" idlwave-user-catalog-file)) (message "Loading user catalog in idle time...done")) (aset arr 2 t) @@ -4549,15 +4549,15 @@ (when (not (aref arr 3)) (when idlwave-user-catalog-routines (message "Normalizing user catalog routines in idle time...") - (setq idlwave-user-catalog-routines + (setq idlwave-user-catalog-routines (idlwave-sintern-rinfo-list idlwave-user-catalog-routines 'sys)) - (message + (message "Normalizing user catalog routines in idle time...done")) (aset arr 3 t) (throw 'exit t)) (when (not (aref arr 4)) - (idlwave-scan-library-catalogs + (idlwave-scan-library-catalogs "Loading and normalizing library catalogs in idle time...") (aset arr 4 t) (throw 'exit t)) @@ -4598,8 +4598,8 @@ (setq idlwave-true-path-alist nil) (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) (message "Normalizing user catalog routines...") - (setq idlwave-user-catalog-routines - (idlwave-sintern-rinfo-list + (setq idlwave-user-catalog-routines + (idlwave-sintern-rinfo-list idlwave-user-catalog-routines 'sys)) (message "Normalizing user catalog routines...done"))) (when (or force (not (aref idlwave-load-rinfo-steps-done 4))) @@ -4610,11 +4610,11 @@ (defun idlwave-update-buffer-routine-info () (let (res) - (cond + (cond ((eq idlwave-scan-all-buffers-for-routine-info t) ;; Scan all buffers, current buffer last (message "Scanning all buffers...") - (setq res (idlwave-get-routine-info-from-buffers + (setq res (idlwave-get-routine-info-from-buffers (reverse (buffer-list))))) ((null idlwave-scan-all-buffers-for-routine-info) ;; Don't scan any buffers @@ -4627,12 +4627,12 @@ (setq res (idlwave-get-routine-info-from-buffers (list (current-buffer)))))))) ;; Put the result into the correct variable - (setq idlwave-buffer-routines + (setq idlwave-buffer-routines (idlwave-sintern-rinfo-list res 'set)))) (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) "Put the different sources for routine information together." - ;; The sequence here is important because earlier definitions shadow + ;; The sequence here is important because earlier definitions shadow ;; later ones. We assume that if things in the buffers are newer ;; then in the shell of the system, they are meant to be different. (setcdr idlwave-last-system-routine-info-cons-cell @@ -4644,7 +4644,7 @@ ;; Give a message with information about the number of routines we have. (unless quiet - (message + (message "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" (length idlwave-buffer-routines) (length idlwave-compiled-routines) @@ -4662,7 +4662,7 @@ (when (and (setq class (nth 2 x)) (not (assq class idlwave-class-alist))) (push (list class) idlwave-class-alist))) - idlwave-class-alist))) + idlwave-class-alist))) ;; Three functions for the hooks (defun idlwave-save-buffer-update () @@ -4695,7 +4695,7 @@ (defun idlwave-replace-buffer-routine-info (file new) "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." - (let ((list idlwave-buffer-routines) + (let ((list idlwave-buffer-routines) found) (while list ;; The following test uses eq to make sure it works correctly @@ -4706,7 +4706,7 @@ (setcar list nil) (setq found t)) (if found - ;; End of that section reached. Jump. + ;; End of that section reached. Jump. (setq list nil))) (setq list (cdr list))) (setq idlwave-buffer-routines @@ -4738,11 +4738,11 @@ (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) (setq string (buffer-substring-no-properties (match-beginning 0) - (progn + (progn (idlwave-end-of-statement) (point)))) (setq entry (idlwave-parse-definition string)) @@ -4780,7 +4780,7 @@ (push (match-string 1 string) args))) ;; Normalize and sort. (setq args (nreverse args)) - (setq keywords (sort keywords (lambda (a b) + (setq keywords (sort keywords (lambda (a b) (string< (downcase a) (downcase b))))) ;; Make and return the entry ;; We don't know which argument are optional, so this information @@ -4790,7 +4790,7 @@ class (cond ((not (boundp 'idlwave-scanning-lib)) (list 'buffer (buffer-file-name))) -; ((string= (downcase +; ((string= (downcase ; (file-name-sans-extension ; (file-name-nondirectory (buffer-file-name)))) ; (downcase name)) @@ -4798,7 +4798,7 @@ ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) (t (list 'user (file-name-nondirectory (buffer-file-name)) idlwave-scanning-lib-dir "UserLib"))) - (concat + (concat (if (string= type "function") "Result = " "") (if class "Obj ->[%s::]" "") "%s" @@ -4842,10 +4842,10 @@ (> (length idlwave-user-catalog-file) 0) (file-accessible-directory-p (file-name-directory idlwave-user-catalog-file)) - (not (string= "" (file-name-nondirectory + (not (string= "" (file-name-nondirectory idlwave-user-catalog-file)))) (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) - + (cond ;; Rescan the known directories ((and arg idlwave-path-alist @@ -4855,13 +4855,13 @@ ;; Expand the directories from library-path and run the widget (idlwave-library-path (idlwave-display-user-catalog-widget - (if idlwave-true-path-alist + (if idlwave-true-path-alist ;; Propagate any flags on the existing path-alist (mapcar (lambda (x) (let ((path-entry (assoc (file-truename x) idlwave-true-path-alist))) (if path-entry - (cons x (cdr path-entry)) + (cons x (cdr path-entry)) (list x)))) (idlwave-expand-path idlwave-library-path)) (mapcar 'list (idlwave-expand-path idlwave-library-path))))) @@ -4886,7 +4886,7 @@ (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) (idlwave-display-user-catalog-widget idlwave-path-alist))) -(defconst idlwave-user-catalog-widget-help-string +(defconst idlwave-user-catalog-widget-help-string "This is the front-end to the creation of the IDLWAVE user catalog. Please select the directories on IDL's search path from which you would like to extract routine information, to be stored in the file: @@ -4921,7 +4921,7 @@ (make-local-variable 'idlwave-widget) (widget-insert (format idlwave-user-catalog-widget-help-string idlwave-user-catalog-file)) - + (widget-create 'push-button :notify 'idlwave-widget-scan-user-lib-files "Scan & Save") @@ -4931,7 +4931,7 @@ "Delete File") (widget-insert " ") (widget-create 'push-button - :notify + :notify '(lambda (&rest ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (mapcar (lambda (x) @@ -4942,7 +4942,7 @@ "Select All Non-Lib") (widget-insert " ") (widget-create 'push-button - :notify + :notify '(lambda (&rest ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (mapcar (lambda (x) @@ -4958,18 +4958,18 @@ (widget-insert "\n\n") (widget-insert "Select Directories: \n") - + (setq idlwave-widget (apply 'widget-create 'checklist - :value (delq nil (mapcar (lambda (x) - (if (memq 'user (cdr x)) + :value (delq nil (mapcar (lambda (x) + (if (memq 'user (cdr x)) (car x))) dirs-list)) :greedy t :tag "List of directories" - (mapcar (lambda (x) - (list 'item + (mapcar (lambda (x) + (list 'item (if (memq 'lib (cdr x)) (concat "[LIB] " (car x) ) (car x)))) dirs-list))) @@ -4979,7 +4979,7 @@ (widget-setup) (goto-char (point-min)) (delete-other-windows)) - + (defun idlwave-delete-user-catalog-file (&rest ignore) (if (yes-or-no-p (format "Delete file %s " idlwave-user-catalog-file)) @@ -4995,7 +4995,7 @@ (this-path-alist path-alist) dir-entry) (while (setq dir-entry (pop this-path-alist)) - (if (member + (if (member (if (memq 'lib (cdr dir-entry)) (concat "[LIB] " (car dir-entry)) (car dir-entry)) @@ -5092,7 +5092,7 @@ ;; Define the variable which knows the value of "!DIR" (insert (format "\n(setq idlwave-system-directory \"%s\")\n" idlwave-system-directory)) - + ;; Define the variable which contains a list of all scanned directories (insert "\n(setq idlwave-path-alist\n '(") (let ((standard-output (current-buffer))) @@ -5132,7 +5132,7 @@ (when (file-directory-p dir) (setq files (nreverse (directory-files dir t "[^.]"))) (while (setq file (pop files)) - (if (file-directory-p file) + (if (file-directory-p file) (push (file-name-as-directory file) path))) (push dir path1))) path1)) @@ -5141,7 +5141,7 @@ ;;----- Scanning the library catalogs ------------------ (defun idlwave-scan-library-catalogs (&optional message-base no-load) - "Scan for library catalog files (.idlwave_catalog) and ingest. + "Scan for library catalog files (.idlwave_catalog) and ingest. All directories on `idlwave-path-alist' (or `idlwave-library-path' instead, if present) are searched. Print MESSAGE-BASE along with the @@ -5149,7 +5149,7 @@ NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can be set to nil to disable library catalog scanning." (when idlwave-use-library-catalogs - (let ((dirs + (let ((dirs (if idlwave-library-path (idlwave-expand-path idlwave-library-path) (mapcar 'car idlwave-path-alist))) @@ -5158,7 +5158,7 @@ (if message-base (message message-base)) (while (setq dir (pop dirs)) (catch 'continue - (when (file-readable-p + (when (file-readable-p (setq catalog (expand-file-name ".idlwave_catalog" dir))) (unless no-load (setq idlwave-library-catalog-routines nil) @@ -5166,20 +5166,20 @@ (condition-case nil (load catalog t t t) (error (throw 'continue t))) - (when (and - message-base - (not (string= idlwave-library-catalog-libname + (when (and + message-base + (not (string= idlwave-library-catalog-libname old-libname))) - (message (concat message-base + (message (concat message-base idlwave-library-catalog-libname)) (setq old-libname idlwave-library-catalog-libname)) (when idlwave-library-catalog-routines (setq all-routines - (append + (append (idlwave-sintern-rinfo-list idlwave-library-catalog-routines 'sys dir) all-routines)))) - + ;; Add a 'lib flag if on path-alist (when (and idlwave-path-alist (setq dir-entry (assoc dir idlwave-path-alist))) @@ -5190,17 +5190,17 @@ ;;----- Communicating with the Shell ------------------- ;; First, here is the idl program which can be used to query IDL for -;; defined routines. +;; defined routines. (defconst idlwave-routine-info.pro " ;; START OF IDLWAVE SUPPORT ROUTINES pro idlwave_print_info_entry,name,func=func,separator=sep ;; See if it's an object method if name eq '' then return - func = keyword_set(func) + func = keyword_set(func) methsep = strpos(name,'::') meth = methsep ne -1 - + ;; Get routine info pars = routine_info(name,/parameters,functions=func) source = routine_info(name,/source,functions=func) @@ -5208,12 +5208,12 @@ nkw = pars.num_kw_args if nargs gt 0 then args = pars.args if nkw gt 0 then kwargs = pars.kw_args - + ;; Trim the class, and make the name - if meth then begin + if meth then begin class = strmid(name,0,methsep) name = strmid(name,methsep+2,strlen(name)-1) - if nargs gt 0 then begin + if nargs gt 0 then begin ;; remove the self argument wh = where(args ne 'SELF',nargs) if nargs gt 0 then args = args[wh] @@ -5222,7 +5222,7 @@ ;; No class, just a normal routine. class = \"\" endelse - + ;; Calling sequence cs = \"\" if func then cs = 'Result = ' @@ -5243,9 +5243,9 @@ kwstring = kwstring + ' ' + kwargs[j] endfor endif - + ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] - + print,ret + ': ' + name + sep + class + sep + source[0].path $ + sep + cs + sep + kwstring end @@ -5285,7 +5285,7 @@ if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) end ;; END OF IDLWAVE SUPPORT ROUTINES -" +" "The idl programs to get info from the shell.") (defvar idlwave-idlwave_routine_info-compiled nil @@ -5308,12 +5308,12 @@ (erase-buffer) (insert idlwave-routine-info.pro) (save-buffer 0)) - (idlwave-shell-send-command + (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file) nil 'hide wait) ; (message "SENDING SAVE") ; ???????????????????????? (idlwave-shell-send-command - (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" + (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" (idlwave-shell-temp-file 'rinfo)) nil 'hide wait)) @@ -5396,7 +5396,7 @@ (completion-regexp-list (if (equal arg '(16)) (list (read-string (concat "Completion Regexp: ")))))) - + (if (and module (string-match "::" module)) (setq class (substring module 0 (match-beginning 0)) module (substring module (match-end 0)))) @@ -5417,7 +5417,7 @@ ;; Check for any special completion functions ((and idlwave-complete-special (idlwave-call-special idlwave-complete-special))) - + ((null what) (error "Nothing to complete here")) @@ -5434,7 +5434,7 @@ (idlwave-all-class-inherits class-selector))) (isa (concat "procedure" (if class-selector "-method" ""))) (type-selector 'pro)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'routine nil type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'procedure (if class-selector 'method 'routine) @@ -5442,8 +5442,8 @@ (format "Select a %s name%s" isa (if class-selector - (format " (class is %s)" - (if (eq class-selector t) + (format " (class is %s)" + (if (eq class-selector t) "unknown" class-selector)) "")) isa @@ -5457,7 +5457,7 @@ (idlwave-all-class-inherits class-selector))) (isa (concat "function" (if class-selector "-method" ""))) (type-selector 'fun)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'routine nil type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'function (if class-selector 'method 'routine) @@ -5465,7 +5465,7 @@ (format "Select a %s name%s" isa (if class-selector - (format " (class is %s)" + (format " (class is %s)" (if (eq class-selector t) "unknown" class-selector)) "")) @@ -5495,14 +5495,14 @@ (setq list (idlwave-fix-keywords name 'pro class list super-classes)) (unless list (error (format "No keywords available for procedure %s" (idlwave-make-full-name class name)))) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'keyword name type-selector class-selector entry super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for procedure %s%s" (idlwave-make-full-name class name) (if (or (member '("_EXTRA") list) - (member '("_REF_EXTRA") list)) + (member '("_REF_EXTRA") list)) " (note _EXTRA)" "")) isa 'idlwave-attach-keyword-classes))) @@ -5533,13 +5533,13 @@ (idlwave-make-full-name class name))) (unless list (error (format "No keywords available for function %s" msg-name))) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'keyword name type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for function %s%s" msg-name (if (or (member '("_EXTRA") list) - (member '("_REF_EXTRA") list)) + (member '("_REF_EXTRA") list)) " (note _EXTRA)" "")) isa 'idlwave-attach-keyword-classes))) @@ -5577,10 +5577,10 @@ ("class"))) (module (idlwave-sintern-routine-or-method module class)) (class (idlwave-sintern-class class)) - (what (cond + (what (cond ((equal what 0) (setq what - (intern (completing-read + (intern (completing-read "Complete what? " what-list nil t)))) ((integerp what) (setq what (intern (car (nth (1- what) what-list))))) @@ -5602,7 +5602,7 @@ (super-classes nil) (type-selector 'pro) (pro (or module - (idlwave-completing-read + (idlwave-completing-read "Procedure: " (idlwave-routines) 'idlwave-selector)))) (setq pro (idlwave-sintern-routine pro)) (list nil-list nil-list 'procedure-keyword @@ -5616,7 +5616,7 @@ (super-classes nil) (type-selector 'fun) (func (or module - (idlwave-completing-read + (idlwave-completing-read "Function: " (idlwave-routines) 'idlwave-selector)))) (setq func (idlwave-sintern-routine func)) (list nil-list nil-list 'function-keyword @@ -5656,7 +5656,7 @@ ((eq what 'class) (list nil-list nil-list 'class nil-list nil)) - + (t (error "Invalid value for WHAT"))))) (defun idlwave-completing-read (&rest args) @@ -5679,7 +5679,7 @@ (stringp idlwave-shell-default-directory) (file-directory-p idlwave-shell-default-directory)) idlwave-shell-default-directory - default-directory))) + default-directory))) (comint-dynamic-complete-filename))) (defun idlwave-make-full-name (class name) @@ -5688,7 +5688,7 @@ (defun idlwave-rinfo-assoc (name type class list) "Like `idlwave-rinfo-assq', but sintern strings first." - (idlwave-rinfo-assq + (idlwave-rinfo-assq (idlwave-sintern-routine-or-method name class) type (idlwave-sintern-class class) list)) @@ -5712,7 +5712,7 @@ (setq classes nil))) rtn)) -(defun idlwave-best-rinfo-assq (name type class list &optional with-file +(defun idlwave-best-rinfo-assq (name type class list &optional with-file keep-system) "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. If WITH-FILE is passed, find the best rinfo entry with a file @@ -5737,7 +5737,7 @@ twins))))) (car twins))) -(defun idlwave-best-rinfo-assoc (name type class list &optional with-file +(defun idlwave-best-rinfo-assoc (name type class list &optional with-file keep-system) "Like `idlwave-best-rinfo-assq', but sintern strings first." (idlwave-best-rinfo-assq @@ -5828,7 +5828,7 @@ Must accept two arguments: `apos' and `info'") (defun idlwave-determine-class (info type) - ;; Determine the class of a routine call. + ;; Determine the class of a routine call. ;; INFO is the `cw-list' structure as returned by idlwave-where. ;; The second element in this structure is the class. When nil, we ;; return nil. When t, try to get the class from text properties at @@ -5848,7 +5848,7 @@ (dassoc (cdr dassoc)) (t t))) (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) - (is-self + (is-self (and arrow (save-excursion (goto-char apos) (forward-word -1) @@ -5869,19 +5869,19 @@ (setq class (or (nth 2 (idlwave-current-routine)) class))) ;; Before prompting, try any special class determination routines - (when (and (eq t class) + (when (and (eq t class) idlwave-determine-class-special (not force-query)) - (setq special-class + (setq special-class (idlwave-call-special idlwave-determine-class-special apos)) - (if special-class + (if special-class (setq class (idlwave-sintern-class special-class) store idlwave-store-inquired-class))) - + ;; Prompt for a class, if we need to (when (and (eq class t) (or force-query query)) - (setq class-alist + (setq class-alist (mapcar 'list (idlwave-all-method-classes (car info) type))) (setq class (idlwave-sintern-class @@ -5890,9 +5890,9 @@ (error "No classes available with method %s" (car info))) ((and (= (length class-alist) 1) (not force-query)) (car (car class-alist))) - (t + (t (setq store idlwave-store-inquired-class) - (idlwave-completing-read + (idlwave-completing-read (format "Class%s: " (if (stringp (car info)) (format " for %s method %s" type (car info)) @@ -5904,9 +5904,9 @@ ;; We have a real class here (when (and store arrow) (condition-case () - (add-text-properties - apos (+ apos 2) - `(idlwave-class ,class face ,idlwave-class-arrow-face + (add-text-properties + apos (+ apos 2) + `(idlwave-class ,class face ,idlwave-class-arrow-face rear-nonsticky t)) (error nil))) (setf (nth 2 info) class)) @@ -5934,14 +5934,14 @@ (defun idlwave-where () - "Find out where we are. + "Find out where we are. The return value is a list with the following stuff: \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) PRO-LIST (PRO POINT CLASS ARROW) FUNC-LIST (FUNC POINT CLASS ARROW) COMPLETE-WHAT a symbol indicating what kind of completion makes sense here -CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can +CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can be completed here. LAST-CHAR last relevant character before point (non-white non-comment, not part of current identifier or leading slash). @@ -5953,7 +5953,7 @@ CLASS: What class has the routine (nil=no, t=is method, but class unknown) ARROW: Location of the arrow" (idlwave-routines) - (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) + (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) (func-entry (idlwave-what-function bos)) (func (car func-entry)) @@ -5975,8 +5975,8 @@ ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" match-string) (setq cw 'class)) - ((string-match - "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" + ((string-match + "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" (if (> pro-point 0) (buffer-substring pro-point (point)) match-string)) @@ -5987,11 +5987,11 @@ nil) ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" match-string) - (setq cw 'class)) + (setq cw 'class)) ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" match-string) - (setq cw 'class)) - ((and func + (setq cw 'class)) + ((and func (> func-point pro-point) (= func-level 1) (memq last-char '(?\( ?,))) @@ -6037,7 +6037,7 @@ ;; searches to this point. (catch 'exit - (let (pos + (let (pos func-point (cnt 0) func arrow-start class) @@ -6052,18 +6052,18 @@ (setq pos (point)) (incf cnt) (when (and (= (following-char) ?\() - (re-search-backward + (re-search-backward "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" bound t)) (setq func (match-string 2) func-point (goto-char (match-beginning 2)) pos func-point) - (if (re-search-backward + (if (re-search-backward "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) (setq arrow-start (copy-marker (match-beginning 0)) class (or (match-string 2) t))) - (throw - 'exit + (throw + 'exit (list (idlwave-sintern-routine-or-method func class) (idlwave-sintern-class class) @@ -6079,18 +6079,18 @@ ;; searches to this point. (let ((pos (point)) pro-point pro class arrow-start string) - (save-excursion + (save-excursion ;;(idlwave-beginning-of-statement) (idlwave-start-of-substatement 'pre) (setq string (buffer-substring (point) pos)) - (if (string-match + (if (string-match "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) (setq pro (match-string 1 string) pro-point (+ (point) (match-beginning 1))) (if (and (idlwave-skip-object) (setq string (buffer-substring (point) pos)) - (string-match - "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" + (string-match + "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" string)) (setq pro (if (match-beginning 4) (match-string 4 string)) @@ -6134,7 +6134,7 @@ (throw 'exit nil)))) (goto-char pos) nil))) - + (defun idlwave-last-valid-char () "Return the last character before point which is not white or a comment and also not part of the current identifier. Since we do this in @@ -6224,23 +6224,23 @@ ((or (eq completion t) (and (= 1 (length (setq all-completions (idlwave-uniquify - (all-completions part list - (or special-selector + (all-completions part list + (or special-selector selector)))))) (equal dpart dcompletion))) ;; This is already complete (idlwave-after-successful-completion type slash beg) (message "%s is already the complete %s" part isa) nil) - (t + (t ;; We cannot add something - offer a list. (message "Making completion list...") - + (unless idlwave-completion-help-links ; already set somewhere? (mapcar (lambda (x) ; Pass link prop through to highlight-linked (let ((link (get-text-property 0 'link (car x)))) (if link - (push (cons (car x) link) + (push (cons (car x) link) idlwave-completion-help-links)))) list)) (let* ((list all-completions) @@ -6250,7 +6250,7 @@ ; (completion-fixup-function ; Emacs ; (lambda () (and (eq (preceding-char) ?>) ; (re-search-backward " <" beg t))))) - + (setq list (sort list (lambda (a b) (string< (downcase a) (downcase b))))) (if prepare-display-function @@ -6260,7 +6260,7 @@ idlwave-complete-empty-string-as-lower-case) (not idlwave-completion-force-default-case)) (setq list (mapcar (lambda (x) - (if (listp x) + (if (listp x) (setcar x (downcase (car x))) (setq x (downcase x))) x) @@ -6280,19 +6280,19 @@ (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" (- (point) 15) t) (goto-char (point-min)) - (re-search-forward + (re-search-forward "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) ;; Yank the full class specification (insert (match-string 2)) ;; Do the completion, using list gathered from `idlwave-routines' - (idlwave-complete-in-buffer - 'class 'class (idlwave-class-alist) nil + (idlwave-complete-in-buffer + 'class 'class (idlwave-class-alist) nil "Select a class" "class" '(lambda (list) ;; Push it to help-links if system help available (mapcar (lambda (x) (let* ((entry (idlwave-class-info x)) (link (nth 1 (assq 'link entry)))) - (if link (push (cons x link) + (if link (push (cons x link) idlwave-completion-help-links)) x)) list))))) @@ -6304,7 +6304,7 @@ ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. (if (or (null show-classes) ; don't want to see classes (null class-selector) ; not a method call - (and + (and (stringp class-selector) ; the class is already known (not super-classes))) ; no possibilities for inheritance ;; In these cases, we do not have to do anything @@ -6319,13 +6319,13 @@ (max (abs show-classes)) (lmax (if do-dots (apply 'max (mapcar 'length list)))) classes nclasses class-info space) - (mapcar + (mapcar (lambda (x) ;; get the classes (if (eq type 'class-tag) ;; Just one class for tags (setq classes - (list + (list (idlwave-class-or-superclass-with-tag class-selector x))) ;; Multiple classes for method or method-keyword (setq classes @@ -6334,7 +6334,7 @@ method-selector x type-selector) (idlwave-all-method-classes x type-selector))) (if inherit - (setq classes + (setq classes (delq nil (mapcar (lambda (x) (if (memq x inherit) x nil)) classes))))) @@ -6371,7 +6371,7 @@ (defun idlwave-attach-class-tag-classes (list) ;; Call idlwave-attach-classes with class structure tags (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) - + ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- @@ -6392,7 +6392,7 @@ ((= 1 (length list)) (setq rtn (car list))) ((featurep 'xemacs) - (if sort (setq list (sort list (lambda (a b) + (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) (setq menu (append (list title) @@ -6403,7 +6403,7 @@ (setq resp (get-popup-menu-response menu)) (funcall (event-function resp) (event-object resp))) (t - (if sort (setq list (sort list (lambda (a b) + (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) (setq menu (cons title (list @@ -6494,7 +6494,7 @@ (setq idlwave-before-completion-wconf (current-window-configuration))) (if (featurep 'xemacs) - (idlwave-display-completion-list-xemacs + (idlwave-display-completion-list-xemacs list) (idlwave-display-completion-list-emacs list)) @@ -6575,7 +6575,7 @@ (mapcar (lambda(x) (princ (nth 1 x)) (princ "\n")) - keys-alist)) + keys-alist)) (setq char (read-char))) (setq char (read-char))) (message nil) @@ -6695,7 +6695,7 @@ (defun idlwave-make-modified-completion-map-emacs (old-map) "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) - (substitute-key-definition + (substitute-key-definition 'choose-completion 'idlwave-choose-completion new-map) (substitute-key-definition 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) @@ -6721,8 +6721,8 @@ ;; ;; - Go again over the documentation how to write a completion ;; plugin. It is in self.el, but currently still very bad. -;; This could be in a separate file in the distribution, or -;; in an appendix for the manual. +;; This could be in a separate file in the distribution, or +;; in an appendix for the manual. (defvar idlwave-struct-skip "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" @@ -6761,7 +6761,7 @@ (beg (car borders)) (end (cdr borders)) (case-fold-search t)) - (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") + (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") end t))) (defun idlwave-struct-inherits () @@ -6776,7 +6776,7 @@ (goto-char beg) (save-restriction (narrow-to-region beg end) - (while (re-search-forward + (while (re-search-forward (concat "[{,]" ;leading comma/brace idlwave-struct-skip ; 4 groups "inherits" ; The INHERITS tag @@ -6826,9 +6826,9 @@ (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) "\\(\\)") "=" ws "\\({\\)" - (if name + (if name (if (stringp name) - (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") + (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") ;; Just a generic name (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) "")))) @@ -6839,7 +6839,7 @@ (goto-char (match-beginning 3)) (match-string-no-properties 5))))) -(defvar idlwave-class-info nil) +(defvar idlwave-class-info nil) (defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo (defvar idlwave-class-reset nil) ; to reset buffer-local classes @@ -6852,13 +6852,13 @@ (let (list entry) (if idlwave-class-info (if idlwave-class-reset - (setq + (setq idlwave-class-reset nil idlwave-class-info ; Remove any visited in a buffer - (delq nil (mapcar - (lambda (x) - (let ((filebuf - (idlwave-class-file-or-buffer + (delq nil (mapcar + (lambda (x) + (let ((filebuf + (idlwave-class-file-or-buffer (or (cdr (assq 'found-in x)) (car x))))) (if (cdr filebuf) nil @@ -6896,7 +6896,7 @@ (progn ;; For everything there (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) - (while (setq name + (while (setq name (idlwave-find-structure-definition nil t end-lim)) (funcall all-hook name))) (idlwave-find-structure-definition nil (or alt-class class)))))) @@ -6934,11 +6934,11 @@ (insert-file-contents file)) (save-excursion (goto-char 1) - (idlwave-find-class-definition class + (idlwave-find-class-definition class ;; Scan all of the structures found there (lambda (name) (let* ((this-class (idlwave-sintern-class name)) - (entry + (entry (list this-class (cons 'tags (idlwave-struct-tags)) (cons 'inherits (idlwave-struct-inherits))))) @@ -6963,7 +6963,7 @@ (condition-case err (apply 'append (mapcar 'idlwave-class-tags (cons class (idlwave-all-class-inherits class)))) - (error + (error (idlwave-class-tag-reset) (error "%s" (error-message-string err))))) @@ -7000,24 +7000,24 @@ all-inherits)))))) (defun idlwave-entry-keywords (entry &optional record-link) - "Return the flat entry keywords alist from routine-info entry. + "Return the flat entry keywords alist from routine-info entry. If RECORD-LINK is non-nil, the keyword text is copied and a text property indicating the link is added." (let (kwds) (mapcar - (lambda (key-list) + (lambda (key-list) (let ((file (car key-list))) (mapcar (lambda (key-cons) (let ((key (car key-cons)) (link (cdr key-cons))) (when (and record-link file) (setq key (copy-sequence key)) - (put-text-property + (put-text-property 0 (length key) - 'link - (concat - file - (if link + 'link + (concat + file + (if link (concat idlwave-html-link-sep (number-to-string link)))) key)) @@ -7030,13 +7030,13 @@ "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" (catch 'exit (mapc - (lambda (key-list) + (lambda (key-list) (let ((file (car key-list)) (kwd (assoc keyword (cdr key-list)))) (when kwd - (setq kwd (cons (car kwd) + (setq kwd (cons (car kwd) (if (and file (cdr kwd)) - (concat file + (concat file idlwave-html-link-sep (number-to-string (cdr kwd))) (cdr kwd)))) @@ -7074,14 +7074,14 @@ ;; Check if we need to update the "current" class (if (not (equal class-selector idlwave-current-tags-class)) (idlwave-prepare-class-tag-completion class-selector)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'idlwave-complete-class-structure-tag-help - (idlwave-sintern-routine + (idlwave-sintern-routine (concat class-selector "__define")) nil)) (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) (idlwave-complete-in-buffer - 'class-tag 'class-tag + 'class-tag 'class-tag idlwave-current-class-tags nil (format "Select a tag of class %s" class-selector) "class tag" @@ -7133,7 +7133,7 @@ (skip-chars-backward "[a-zA-Z0-9_$]") (equal (char-before) ?!)) (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) - (idlwave-complete-in-buffer 'sysvar 'sysvar + (idlwave-complete-in-buffer 'sysvar 'sysvar idlwave-system-variables-alist nil "Select a system variable" "system variable") @@ -7152,7 +7152,7 @@ (or tags (error "System variable !%s is not a structure" var)) (setq idlwave-completion-help-info (list 'idlwave-complete-sysvar-tag-help var)) - (idlwave-complete-in-buffer 'sysvartag 'sysvartag + (idlwave-complete-in-buffer 'sysvartag 'sysvartag tags nil "Select a system variable tag" "system variable tag") @@ -7179,8 +7179,8 @@ ((eq mode 'test) ; we can at least link the main (and (stringp word) entry main)) ((eq mode 'set) - (if entry - (setq link + (if entry + (setq link (if (setq target (cdr (assoc word tags))) (idlwave-substitute-link-target main target) main)))) ;; setting dynamic!!! @@ -7198,7 +7198,7 @@ ;; Fake help in the source buffer for class structure tags. ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. -(defvar name) +(defvar name) (defvar kwd) (defvar idlwave-help-do-class-struct-tag nil) (defun idlwave-complete-class-structure-tag-help (mode word) @@ -7207,13 +7207,13 @@ nil) ((eq mode 'set) (let (class-with found-in) - (when (setq class-with - (idlwave-class-or-superclass-with-tag + (when (setq class-with + (idlwave-class-or-superclass-with-tag idlwave-current-tags-class word)) - (if (assq (idlwave-sintern-class class-with) + (if (assq (idlwave-sintern-class class-with) idlwave-system-class-info) - (error "No help available for system class tags.")) + (error "No help available for system class tags")) (if (setq found-in (idlwave-class-found-in class-with)) (setq name (cons (concat found-in "__define") class-with)) (setq name (concat class-with "__define"))))) @@ -7224,7 +7224,7 @@ (defun idlwave-class-or-superclass-with-tag (class tag) "Find and return the CLASS or one of its superclass with the associated TAG, if any." - (let ((sclasses (cons class (cdr (assq 'all-inherits + (let ((sclasses (cons class (cdr (assq 'all-inherits (idlwave-class-info class))))) cl) (catch 'exit @@ -7233,7 +7233,7 @@ (let ((tags (idlwave-class-tags cl))) (while tags (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) - (throw 'exit cl)) + (throw 'exit cl)) (setq tags (cdr tags)))))))) @@ -7256,8 +7256,8 @@ (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) (setq tags (assq 'tags entry)) (if tags - (setcdr tags - (mapcar (lambda (x) + (setcdr tags + (mapcar (lambda (x) (cons (idlwave-sintern-sysvartag (car x) 'set) (cdr x))) (cdr tags))))))) @@ -7274,19 +7274,19 @@ text start) (setq start (match-end 0) var (match-string 1 text) - tags (if (match-end 3) + tags (if (match-end 3) (idlwave-split-string (match-string 3 text)))) ;; Maintain old links, if present (setq old-entry (assq (idlwave-sintern-sysvar var) old)) (setq link (assq 'link old-entry)) (setq idlwave-system-variables-alist - (cons (list var - (cons - 'tags - (mapcar (lambda (x) - (cons x - (cdr (assq - (idlwave-sintern-sysvartag x) + (cons (list var + (cons + 'tags + (mapcar (lambda (x) + (cons x + (cdr (assq + (idlwave-sintern-sysvartag x) (cdr (assq 'tags old-entry)))))) tags)) link) idlwave-system-variables-alist))) @@ -7308,9 +7308,9 @@ (defun idlwave-uniquify (list) (let ((ht (make-hash-table :size (length list) :test 'equal))) - (delq nil + (delq nil (mapcar (lambda (x) - (unless (gethash x ht) + (unless (gethash x ht) (puthash x t ht) x)) list)))) @@ -7338,11 +7338,11 @@ nil))) ;; Restore the pre-completion window configuration if this is safe. - - (if (or (eq verify 'force) ; force - (and + + (if (or (eq verify 'force) ; force + (and (get-buffer-window "*Completions*") ; visible - (idlwave-local-value 'idlwave-completion-p + (idlwave-local-value 'idlwave-completion-p "*Completions*") ; cib-buffer (eq (marker-buffer idlwave-completion-mark) (current-buffer)) ; buffer OK @@ -7440,7 +7440,7 @@ (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" resolve) (setq type (match-string 1 resolve) - class (if (match-beginning 2) + class (if (match-beginning 2) (match-string 3 resolve) nil) name (match-string 4 resolve))) @@ -7449,15 +7449,15 @@ (cond ((null class) - (idlwave-shell-send-command + (idlwave-shell-send-command (format "resolve_routine,'%s'%s" (downcase name) kwd) 'idlwave-update-routine-info nil t)) (t - (idlwave-shell-send-command + (idlwave-shell-send-command (format "resolve_routine,'%s__define'%s" (downcase class) kwd) - (list 'idlwave-shell-send-command - (format "resolve_routine,'%s__%s'%s" + (list 'idlwave-shell-send-command + (format "resolve_routine,'%s__%s'%s" (downcase class) (downcase name) kwd) '(idlwave-update-routine-info) nil t)))))) @@ -7474,19 +7474,19 @@ (this-buffer (equal arg '(4))) (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) (default (if module - (concat (idlwave-make-full-name + (concat (idlwave-make-full-name (nth 2 module) (car module)) (if (eq (nth 1 module) 'pro) "<p>" "<f>")) "none")) - (list + (list (idlwave-uniquify (delq nil - (mapcar (lambda (x) + (mapcar (lambda (x) (if (eq 'system (car-safe (nth 3 x))) ;; Take out system routines with no source. nil (list - (concat (idlwave-make-full-name + (concat (idlwave-make-full-name (nth 2 x) (car x)) (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) (if this-buffer @@ -7515,10 +7515,10 @@ (t t))) (idlwave-do-find-module name type class nil this-buffer))) -(defun idlwave-do-find-module (name type class +(defun idlwave-do-find-module (name type class &optional force-source this-buffer) (let ((name1 (idlwave-make-full-name class name)) - source buf1 entry + source buf1 entry (buf (current-buffer)) (pos (point)) file name2) @@ -7528,11 +7528,11 @@ name2 (if (nth 2 entry) (idlwave-make-full-name (nth 2 entry) name) name1)) - (if source + (if source (setq file (idlwave-routine-source-file source))) (unless file ; Try to find it on the path. - (setq file - (idlwave-expand-lib-file-name + (setq file + (idlwave-expand-lib-file-name (if class (format "%s__define.pro" (downcase class)) (format "%s.pro" (downcase name)))))) @@ -7540,14 +7540,14 @@ ((or (null name) (equal name "")) (error "Abort")) ((eq (car source) 'system) - (error "Source code for system routine %s is not available" + (error "Source code for system routine %s is not available" name2)) ((or (not file) (not (file-regular-p file))) (error "Source code for routine %s is not available" name2)) (t (when (not this-buffer) - (setq buf1 + (setq buf1 (idlwave-find-file-noselect file 'find)) (pop-to-buffer buf1 t)) (goto-char (point-max)) @@ -7557,7 +7557,7 @@ (cond ((eq type 'fun) "function") ((eq type 'pro) "pro") (t "\\(pro\\|function\\)")) - "\\>[ \t]+" + "\\>[ \t]+" (regexp-quote (downcase name2)) "[^a-zA-Z0-9_$]") nil t) @@ -7594,17 +7594,17 @@ (cond ((and (eq cw 'procedure) (not (equal this-word ""))) - (setq this-word (idlwave-sintern-routine-or-method + (setq this-word (idlwave-sintern-routine-or-method this-word (nth 2 (nth 3 where)))) (list this-word 'pro - (idlwave-determine-class + (idlwave-determine-class (cons this-word (cdr (nth 3 where))) 'pro))) - ((and (eq cw 'function) + ((and (eq cw 'function) (not (equal this-word "")) (or (eq next-char ?\() ; exclude arrays, vars. (looking-at "[a-zA-Z0-9_]*[ \t]*("))) - (setq this-word (idlwave-sintern-routine-or-method + (setq this-word (idlwave-sintern-routine-or-method this-word (nth 2 (nth 3 where)))) (list this-word 'fun (idlwave-determine-class @@ -7641,7 +7641,7 @@ class))) (defun idlwave-fix-module-if-obj_new (module) - "Check if MODULE points to obj_new. + "Check if MODULE points to obj_new. If yes, and if the cursor is in the keyword region, change to the appropriate Init method." (let* ((name (car module)) @@ -7681,30 +7681,30 @@ string) (setq class (idlwave-sintern-class (match-string 1 string))) (setq idlwave-current-obj_new-class class) - (setq keywords - (append keywords + (setq keywords + (append keywords (idlwave-entry-keywords (idlwave-rinfo-assq (idlwave-sintern-method "INIT") 'fun class (idlwave-routines)) 'do-link)))))) - + ;; If the class is `t', combine all keywords of all methods NAME (when (eq class t) (mapc (lambda (entry) (and (nth 2 entry) ; non-nil class (eq (nth 1 entry) type) ; correct type - (setq keywords - (append keywords + (setq keywords + (append keywords (idlwave-entry-keywords entry 'do-link))))) (idlwave-all-assq name (idlwave-routines))) (setq keywords (idlwave-uniquify keywords))) - + ;; If we have inheritance, add all keywords from superclasses, if ;; the user indicated that method in `idlwave-keyword-class-inheritance' - (when (and + (when (and super-classes idlwave-keyword-class-inheritance (stringp class) @@ -7724,7 +7724,7 @@ (mapcar (lambda (k) (add-to-list 'keywords k)) (idlwave-entry-keywords entry 'do-link)))) (setq keywords (idlwave-uniquify keywords))) - + ;; Return the final list keywords)) @@ -7749,14 +7749,14 @@ (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) (completion-ignore-case t) candidates) - (cond ((assq kwd kwd-alist) + (cond ((assq kwd kwd-alist) kwd) ((setq candidates (all-completions kwd kwd-alist)) (if (= (length candidates) 1) (car candidates) candidates)) ((and entry extra) - ;; Inheritance may cause this keyword to be correct + ;; Inheritance may cause this keyword to be correct keyword) (entry ;; We do know the function, which does not have the keyword. @@ -7768,13 +7768,13 @@ (defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) (defvar idlwave-rinfo-map (make-sparse-keymap)) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [button2] [mouse-2]) 'idlwave-mouse-active-rinfo) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) 'idlwave-mouse-active-rinfo-shift) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) 'idlwave-mouse-active-rinfo-right) (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) @@ -7800,7 +7800,7 @@ (let* ((initial-class (or initial-class class)) (entry (or (idlwave-best-rinfo-assq name type class (idlwave-routines)) - (idlwave-rinfo-assq name type class + (idlwave-rinfo-assq name type class idlwave-unresolved-routines))) (name (or (car entry) name)) (class (or (nth 2 entry) class)) @@ -7825,7 +7825,7 @@ (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (face 'idlwave-help-link-face) beg props win cnt total) - ;; Fix keywords, but don't add chained super-classes, since these + ;; Fix keywords, but don't add chained super-classes, since these ;; are shown separately for that super-class (setq keywords (idlwave-fix-keywords name type class keywords)) (cond @@ -7867,7 +7867,7 @@ km-prop idlwave-rinfo-mouse-map 'help-echo help-echo-use 'data (cons 'usage data))) - (if html-file (setq props (append (list 'face face 'link html-file) + (if html-file (setq props (append (list 'face face 'link html-file) props))) (insert "Usage: ") (setq beg (point)) @@ -7876,14 +7876,14 @@ (format calling-seq name name name name)) "\n") (add-text-properties beg (point) props) - + (insert "Keywords:") (if (null keywords) (insert " No keywords accepted.") (setq col 9) (mapcar (lambda (x) - (if (>= (+ col 1 (length (car x))) + (if (>= (+ col 1 (length (car x))) (window-width)) (progn (insert "\n ") @@ -7901,7 +7901,7 @@ (add-text-properties beg (point) props) (setq col (+ col 1 (length (car x))))) keywords)) - + (setq cnt 1 total (length all)) ;; Here entry is (key file (list of type-conses)) (while (setq entry (pop all)) @@ -7914,7 +7914,7 @@ (cdr (car (nth 2 entry)))) 'data (cons 'source data))) (idlwave-insert-source-location - (format "\n%-8s %s" + (format "\n%-8s %s" (if (equal cnt 1) (if (> total 1) "Sources:" "Source:") "") @@ -7923,7 +7923,7 @@ (incf cnt) (when (and all (> cnt idlwave-rinfo-max-source-lines)) ;; No more source lines, please - (insert (format + (insert (format "\n Source information truncated to %d entries." idlwave-rinfo-max-source-lines)) (setq all nil))) @@ -7937,7 +7937,7 @@ (unwind-protect (progn (select-window win) - (enlarge-window (- (/ (frame-height) 2) + (enlarge-window (- (/ (frame-height) 2) (window-height))) (shrink-window-if-larger-than-buffer)) (select-window ww))))))))) @@ -7974,9 +7974,9 @@ ((and (not file) shell-flag) (insert "Unresolved")) - ((null file) + ((null file) (insert "ERROR")) - + ((idlwave-syslib-p file) (if (string-match "obsolete" (file-name-directory file)) (insert "Obsolete ") @@ -7990,7 +7990,7 @@ ;; Old special syntax: a matching regexp ((setq special (idlwave-special-lib-test file)) (insert (format "%-10s" special))) - + ;; Catch-all with file ((idlwave-lib-p file) (insert "Library ")) @@ -8005,7 +8005,7 @@ (if shell-flag "S" "-") (if buffer-flag "B" "-") "] "))) - (when (> ndupl 1) + (when (> ndupl 1) (setq beg (point)) (insert (format "(%dx) " ndupl)) (add-text-properties beg (point) (list 'face 'bold))) @@ -8029,7 +8029,7 @@ alist nil))) rtn) (t nil)))) - + (defun idlwave-mouse-active-rinfo-right (ev) (interactive "e") (idlwave-mouse-active-rinfo ev 'right)) @@ -8062,9 +8062,9 @@ (cond ((eq id 'class) ; Switch class being displayed (if (window-live-p bufwin) (select-window bufwin)) - (idlwave-display-calling-sequence + (idlwave-display-calling-sequence (idlwave-sintern-method name) - type (idlwave-sintern-class word) + type (idlwave-sintern-class word) initial-class)) ((eq id 'usage) ; Online help on this routine (idlwave-online-help link name type class)) @@ -8105,9 +8105,9 @@ (setq bwin (get-buffer-window buffer))) (if (eq (preceding-char) ?/) (insert keyword) - (unless (save-excursion + (unless (save-excursion (re-search-backward - "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" + "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" (min (- (point) 100) (point-min)) t)) (insert ", ")) (if shift (insert "/")) @@ -8159,7 +8159,7 @@ command can be used to detect possible name clashes during this process." (idlwave-routines) ; Make sure everything is loaded. (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) - (or (y-or-n-p + (or (y-or-n-p "You don't have any user or library catalogs. Continue anyway? ") (error "Abort"))) (let* ((routines (append idlwave-system-routines @@ -8172,7 +8172,7 @@ (keymap (make-sparse-keymap)) (props (list 'mouse-face 'highlight km-prop keymap - 'help-echo "Mouse2: Find source")) + 'help-echo "Mouse2: Find source")) (nroutines (length (or special-routines routines))) (step (/ nroutines 99)) (n 0) @@ -8196,13 +8196,13 @@ (message "Sorting routines...done") (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) - (lambda (ev) + (lambda (ev) (interactive "e") (mouse-set-point ev) (apply 'idlwave-do-find-module (get-text-property (point) 'find-args)))) (define-key keymap [(return)] - (lambda () + (lambda () (interactive) (apply 'idlwave-do-find-module (get-text-property (point) 'find-args)))) @@ -8230,13 +8230,13 @@ (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) (incf cnt) (insert (format "\n%s%s" - (idlwave-make-full-name (nth 2 routine) + (idlwave-make-full-name (nth 2 routine) (car routine)) (if (eq (nth 1 routine) 'fun) "()" ""))) (while (setq twin (pop dtwins)) (setq props1 (append (list 'find-args - (list (nth 0 routine) - (nth 1 routine) + (list (nth 0 routine) + (nth 1 routine) (nth 2 routine))) props)) (idlwave-insert-source-location "\n - " twin props1)))) @@ -8259,7 +8259,7 @@ (or (not (stringp sfile)) (not (string-match "\\S-" sfile)))) (setq stype 'unresolved)) - (princ (format " %-10s %s\n" + (princ (format " %-10s %s\n" stype (if sfile sfile "No source code available"))))) @@ -8278,20 +8278,20 @@ (eq type (nth 1 candidate)) (eq class (nth 2 candidate))) (push candidate twins))) - (if (setq candidate (idlwave-rinfo-assq name type class + (if (setq candidate (idlwave-rinfo-assq name type class idlwave-unresolved-routines)) (push candidate twins)) (cons entry (nreverse twins)))) (defun idlwave-study-twins (entries) - "Return dangerous twins of first entry in ENTRIES. + "Return dangerous twins of first entry in ENTRIES. Dangerous twins are routines with same name, but in different files on the load path. If a file is in the system library and has an entry in the `idlwave-system-routines' list, we omit the latter as non-dangerous because many IDL routines are implemented as library routines, and may have been scanned." (let* ((entry (car entries)) - (name (car entry)) ; + (name (car entry)) ; (type (nth 1 entry)) ; Must be bound for (class (nth 2 entry)) ; idlwave-routine-twin-compare (cnt 0) @@ -8309,23 +8309,23 @@ (t 'unresolved))) ;; Check for an entry in the system library - (if (and file + (if (and file (not syslibp) (idlwave-syslib-p file)) (setq syslibp t)) - + ;; If there's more than one matching entry for the same file, just ;; append the type-cons to the type list. (if (setq entry (assoc key alist)) (push type-cons (nth 2 entry)) (push (list key file (list type-cons)) alist))) - + (setq alist (nreverse alist)) - + (when syslibp ;; File is in system *library* - remove any 'system entry (setq alist (delq (assq 'system alist) alist))) - + ;; If 'system remains and we've scanned the syslib, it's a builtin ;; (rather than a !DIR/lib/.pro file bundled as source). (when (and (idlwave-syslib-scanned-p) @@ -8362,7 +8362,7 @@ ((not (eq type (nth 1 b))) ;; Type decides (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) - (t + (t ;; A and B are twins - so the decision is more complicated. ;; Call twin-compare with the proper arguments. (idlwave-routine-entry-compare-twins a b))))) @@ -8414,7 +8414,7 @@ (tpath-alist (idlwave-true-path-alist)) (apathp (and (stringp akey) (assoc (file-name-directory akey) tpath-alist))) - (bpathp (and (stringp bkey) + (bpathp (and (stringp bkey) (assoc (file-name-directory bkey) tpath-alist))) ;; How early on search path? High number means early since we ;; measure the tail of the path list @@ -8450,7 +8450,7 @@ (t nil)))) ; Default (defun idlwave-routine-source-file (source) - (if (nth 2 source) + (if (nth 2 source) (expand-file-name (nth 1 source) (nth 2 source)) (nth 1 source))) @@ -8540,7 +8540,7 @@ (forward-sexp 2) (forward-sexp -1) (let ((begin (point))) - (re-search-forward + (re-search-forward "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") (if (fboundp 'buffer-substring-no-properties) (buffer-substring-no-properties begin (point)) @@ -8580,12 +8580,12 @@ (start-process "idldeclient" nil idlwave-shell-explicit-file-name "-c" "-e" (buffer-file-name) "&")) - + (defun idlwave-launch-idlhelp () "Start the IDLhelp application." (interactive) (start-process "idlhelp" nil idlwave-help-application)) - + ;; Menus - using easymenu.el (defvar idlwave-mode-menu-def `("IDLWAVE" @@ -8672,7 +8672,7 @@ ("Customize" ["Browse IDLWAVE Group" idlwave-customize t] "--" - ["Build Full Customize Menu" idlwave-create-customize-menu + ["Build Full Customize Menu" idlwave-create-customize-menu (fboundp 'customize-menu-create)]) ("Documentation" ["Describe Mode" describe-mode t] @@ -8689,22 +8689,22 @@ '("Debug" ["Start IDL shell" idlwave-shell t] ["Save and .RUN buffer" idlwave-shell-save-and-run - (and (boundp 'idlwave-shell-automatic-start) + (and (boundp 'idlwave-shell-automatic-start) idlwave-shell-automatic-start)])) (if (or (featurep 'easymenu) (load "easymenu" t)) (progn - (easy-menu-define idlwave-mode-menu idlwave-mode-map - "IDL and WAVE CL editing menu" + (easy-menu-define idlwave-mode-menu idlwave-mode-map + "IDL and WAVE CL editing menu" idlwave-mode-menu-def) - (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map - "IDL and WAVE CL editing menu" + (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map + "IDL and WAVE CL editing menu" idlwave-mode-debug-menu-def))) (defun idlwave-customize () "Call the customize function with idlwave as argument." (interactive) - ;; Try to load the code for the shell, so that we can customize it + ;; Try to load the code for the shell, so that we can customize it ;; as well. (or (featurep 'idlw-shell) (load "idlw-shell" t)) @@ -8715,11 +8715,11 @@ (interactive) (if (fboundp 'customize-menu-create) (progn - ;; Try to load the code for the shell, so that we can customize it + ;; Try to load the code for the shell, so that we can customize it ;; as well. (or (featurep 'idlw-shell) (load "idlw-shell" t)) - (easy-menu-change + (easy-menu-change '("IDLWAVE") "Customize" `(["Browse IDLWAVE group" idlwave-customize t] "--" @@ -8767,7 +8767,7 @@ (let ((table (symbol-value 'idlwave-mode-abbrev-table)) abbrevs str rpl func fmt (len-str 0) (len-rpl 0)) - (mapatoms + (mapatoms (lambda (sym) (if (symbol-value sym) (progn @@ -8793,7 +8793,7 @@ (with-output-to-temp-buffer "*Help*" (if arg (progn - (princ "Abbreviations and Actions in IDLWAVE-Mode\n") + (princ "Abbreviations and Actions in IDLWAVE-Mode\n") (princ "=========================================\n\n") (princ (format fmt "KEY" "REPLACE" "HOOK")) (princ (format fmt "---" "-------" "----")))
--- a/lisp/progmodes/ld-script.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/ld-script.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; ld-script.el --- GNU linker script editing mode for Emacs -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2005 Free Software Foundation, Inc. ;; Author: Masatake YAMATO<jet@gyve.org> ;; Keywords: languages, faces @@ -34,11 +34,13 @@ :prefix "ld-script-" :group 'languages) -(defvar ld-script-location-counter-face 'ld-script-location-counter-face) -(defface ld-script-location-counter-face +(defvar ld-script-location-counter-face 'ld-script-location-counter) +(defface ld-script-location-counter '((t (:weight bold :inherit font-lock-builtin-face))) "Face for location counter in GNU ld script." :group 'ld-script) +;; backward-compatibility alias +(put 'ld-script-location-counter-face 'face-alias 'ld-script-location-counter) ;; Syntax rules (defvar ld-script-mode-syntax-table
--- a/lisp/progmodes/make-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/make-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -99,30 +99,32 @@ :group 'tools :prefix "makefile-") -(defface makefile-space-face +(defface makefile-space '((((class color)) (:background "hotpink")) (t (:reverse-video t))) "Face to use for highlighting leading spaces in Font-Lock mode." :group 'faces :group 'makefile) +(put 'makefile-space-face 'face-alias 'makefile-space) -(defface makefile-targets-face +(defface makefile-targets ;; This needs to go along both with foreground and background colors (i.e. shell) - '((t (:underline t))) + '((t (:inherit font-lock-function-name-face))) "Face to use for additionally highlighting rule targets in Font-Lock mode." :group 'faces :group 'makefile :version "22.1") -(defface makefile-shell-face - '((((class color) (min-colors 88) (background light)) (:background "seashell1")) - (((class color) (min-colors 88) (background dark)) (:background "seashell4"))) +(defface makefile-shell + () + ;;'((((class color) (min-colors 88) (background light)) (:background "seashell1")) + ;; (((class color) (min-colors 88) (background dark)) (:background "seashell4"))) "Face to use for additionally highlighting Shell commands in Font-Lock mode." :group 'faces :group 'makefile :version "22.1") -(defface makefile-makepp-perl-face +(defface makefile-makepp-perl '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book (((class color) (background dark)) (:background "DarkBlue")) (t (:reverse-video t))) @@ -302,8 +304,8 @@ "Regex for filenames that will NOT be included in the target list.") (if (fboundp 'facemenu-unlisted-faces) - (add-to-list 'facemenu-unlisted-faces 'makefile-space-face)) -(defvar makefile-space-face 'makefile-space-face + (add-to-list 'facemenu-unlisted-faces 'makefile-space)) +(defvar makefile-space 'makefile-space "Face to use for highlighting leading spaces in Font-Lock mode.") ;; These lists were inspired by the old solution. But they are silly, because @@ -348,14 +350,14 @@ (,makefile-macroassign-regex (1 font-lock-variable-name-face) ;; This is for after != - (2 'makefile-shell-face prepend t) + (2 'makefile-shell prepend t) ;; This is for after normal assignment (3 'font-lock-string-face prepend t)) ;; Rule actions. (makefile-match-action (1 font-lock-type-face) - (2 'makefile-shell-face prepend) + (2 'makefile-shell prepend) ;; Only makepp has builtin commands. (3 font-lock-builtin-face prepend t)) @@ -367,7 +369,7 @@ ("[^$]\\$\\([@%<?^+*_]\\|[a-zA-Z0-9]\\>\\)" 1 font-lock-constant-face prepend) ("[^$]\\(\\$[@%*]\\)" - 1 'makefile-targets-face prepend) + 1 'makefile-targets append) ;; Fontify conditionals and includes. (,(concat "^\\(?: [ \t]*\\)?" @@ -382,22 +384,22 @@ ,@(if space '(;; Highlight lines that contain just whitespace. ;; They can cause trouble, especially if they start with a tab. - ("^[ \t]+$" . makefile-space-face) + ("^[ \t]+$" . makefile-space) ;; Highlight shell comments that Make treats as commands, ;; since these can fool people. - ("^\t+#" 0 makefile-space-face t) + ("^\t+#" 0 makefile-space t) ;; Highlight spaces that precede tabs. ;; They can make a tab fail to be effective. - ("^\\( +\\)\t" 1 makefile-space-face))) + ("^\\( +\\)\t" 1 makefile-space))) ,@font-lock-keywords ;; Do dependencies. (makefile-match-dependency - (1 'makefile-targets-face prepend) - (3 'makefile-shell-face prepend t)))) + (1 'makefile-targets prepend) + (3 'makefile-shell prepend t)))) (defconst makefile-font-lock-keywords (makefile-make-font-lock-keywords @@ -419,7 +421,7 @@ "^\\(?: [ \t]*\\)?if\\(n\\)\\(?:def\\|eq\\)\\>" '("[^$]\\(\\$[({][@%*][DF][})]\\)" - 1 'makefile-targets-face prepend) + 1 'makefile-targets append) ;; $(function ...) ${function ...} '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)" @@ -428,7 +430,7 @@ ;; $(shell ...) ${shell ...} '("[^$]\\$\\([({]\\)shell[ \t]+" makefile-match-function-end nil nil - (1 'makefile-shell-face prepend t)))) + (1 'makefile-shell prepend t)))) (defconst makefile-makepp-font-lock-keywords (makefile-make-font-lock-keywords @@ -438,7 +440,7 @@ "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>" '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)" - 1 'makefile-targets-face prepend) + 1 'makefile-targets append) ;; Colon modifier keywords. '("\\(:\\s *\\)\\(build_c\\(?:ache\\|heck\\)\\|env\\(?:ironment\\)?\\|foreach\\|signature\\|scanner\\|quickscan\\|smartscan\\)\\>\\([^:\n]*\\)" @@ -453,32 +455,32 @@ ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}} '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+" makefile-match-function-end nil nil - (1 'makefile-shell-face prepend t)) + (1 'makefile-shell prepend t)) ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}} '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+" makefile-match-function-end nil nil - (1 'makefile-makepp-perl-face prepend t)) + (1 'makefile-makepp-perl prepend t)) '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+" makefile-match-function-end nil nil - (1 'makefile-makepp-perl-face t t)) + (1 'makefile-makepp-perl t t)) ;; Can we unify these with (if (match-end 1) 'prepend t)? - '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face prepend) - '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face t) + '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl prepend) + '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl t) ;; Perl block single- or multiline, as statement or rule action. ;; Don't know why the initial newline in 2nd variant of group 2 doesn't get skipped. '("\\<make\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" - (1 'makefile-makepp-perl-face prepend t) - (2 'makefile-makepp-perl-face prepend t)) + (1 'makefile-makepp-perl prepend t) + (2 'makefile-makepp-perl prepend t)) '("\\<\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" - (1 'makefile-makepp-perl-face t t) - (2 'makefile-makepp-perl-face t t)) + (1 'makefile-makepp-perl t t) + (2 'makefile-makepp-perl t t)) ;; Statement style perl block. '("perl[-_]begin\\s *\\(?:\\s #.*\\)?\n\\(\\(?:.*\n\\)+?\\)\\s *perl[-_]end\\>" - 1 'makefile-makepp-perl-face t))) + 1 'makefile-makepp-perl t))) (defconst makefile-bsdmake-font-lock-keywords (makefile-make-font-lock-keywords @@ -911,6 +913,8 @@ (backward-char)) (get-text-property (point) 'face) (beginning-of-line) + (if (> (point) (+ (point-min) 2)) + (eq (char-before (1- (point))) ?\\)) (if (looking-at makefile-dependency-regex) (throw 'found t)))) (goto-char pt) @@ -1700,6 +1704,8 @@ (forward-char) (or (eq (char-after) ?=) (get-text-property (1- (point)) 'face) + (if (> (line-beginning-position) (+ (point-min) 2)) + (eq (char-before (line-end-position 0)) ?\\)) (when (save-excursion (beginning-of-line) (looking-at makefile-dependency-regex))
--- a/lisp/progmodes/octave-inf.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/octave-inf.el Wed Jun 15 23:32:15 2005 +0000 @@ -129,7 +129,7 @@ Entry to this mode successively runs the hooks `comint-mode-hook' and `inferior-octave-mode-hook'." (interactive) - (comint-mode) + (delay-mode-hooks (comint-mode)) (setq comint-prompt-regexp inferior-octave-prompt major-mode 'inferior-octave-mode mode-name "Inferior Octave"
--- a/lisp/progmodes/sh-script.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/sh-script.el Wed Jun 15 23:32:15 2005 +0000 @@ -792,7 +792,7 @@ ;; Font-Lock support -(defface sh-heredoc-face +(defface sh-heredoc '((((min-colors 88) (class color) (background dark)) (:foreground "yellow1" :weight bold)) @@ -806,7 +806,9 @@ (:weight bold))) "Face to show a here-document" :group 'sh-indentation) -(defvar sh-heredoc-face 'sh-heredoc-face) +;; backward-compatibility alias +(put 'sh-heredoc-face 'face-alias 'sh-heredoc) +(defvar sh-heredoc-face 'sh-heredoc) (defface sh-escaped-newline '((t :inherit font-lock-string-face)) "Face used for (non-escaped) backslash at end of a line in Shell-script mode."
--- a/lisp/progmodes/sql.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/sql.el Wed Jun 15 23:32:15 2005 +0000 @@ -2328,7 +2328,7 @@ \(setq comint-output-filter-functions \(function (lambda (STR) (comint-show-output))))" - (comint-mode) + (delay-mode-hooks (comint-mode)) ;; Get the `sql-product' for this interactive session. (set (make-local-variable 'sql-product) (or sql-interactive-product
--- a/lisp/progmodes/vhdl-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/vhdl-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -1379,11 +1379,11 @@ (defcustom vhdl-highlight-keywords t "*Non-nil means highlight VHDL keywords and other standardized words. The following faces are used: - `font-lock-keyword-face' : keywords - `font-lock-type-face' : standardized types - `vhdl-font-lock-attribute-face': standardized attributes - `vhdl-font-lock-enumvalue-face': standardized enumeration values - `vhdl-font-lock-function-face' : standardized function and package names + `font-lock-keyword-face' : keywords + `font-lock-type' : standardized types + `vhdl-attribute' : standardized attributes + `vhdl-enumvalue' : standardized enumeration values + `vhdl-function' : standardized function and package names NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." @@ -1398,7 +1398,7 @@ `font-lock-function-name-face' : names in declarations of units, subprograms, components, as well as labels of VHDL constructs `font-lock-type-face' : names in type/nature declarations - `vhdl-font-lock-attribute-face': names in attribute declarations + `vhdl-attribute' : names in attribute declarations `font-lock-variable-name-face' : names in declarations of signals, variables, constants, subprogram parameters, generics, and ports @@ -1426,7 +1426,7 @@ "*Non-nil means highlight forbidden words. The reserved words specified in option `vhdl-forbidden-words' or having the syntax specified in option `vhdl-forbidden-syntax' are highlighted in a -warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to +warning color (face `vhdl-reserved-word') to indicate not to use them. NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu @@ -1440,7 +1440,7 @@ (defcustom vhdl-highlight-verilog-keywords nil "*Non-nil means highlight Verilog keywords as reserved words. Verilog keywords are highlighted in a warning color (face -`vhdl-font-lock-reserved-words-face') to indicate not to use them. +`vhdl-reserved-word') to indicate not to use them. NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." @@ -1454,7 +1454,7 @@ "*Non-nil means background-highlight code excluded from translation. That is, all code between \"-- pragma translate_off\" and \"-- pragma translate_on\" is highlighted using a different background color -\(face `vhdl-font-lock-translate-off-face'). +\(face `vhdl-translate-off'). Note: this might slow down on-the-fly fontification (and thus editing). NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu @@ -1501,7 +1501,7 @@ \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using common substrings or name suffices. For each entry, a new face is generated with the specified colors and name -\"vhdl-font-lock-\" + name + \"-face\". +\"vhdl-\" + name. NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\"). All other changes require restarting Emacs." @@ -12484,7 +12484,7 @@ (list (concat "^\\s-*attribute\\s-+\\(\\w+\\)") - 1 'vhdl-font-lock-attribute-face) + 1 'vhdl-attribute) ;; highlight type/nature name in (sub)type/(sub)nature declarations (list @@ -12542,40 +12542,39 @@ (defconst vhdl-font-lock-keywords-5 ;; background highlight translate-off regions - '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) + '((vhdl-match-translate-off (0 vhdl-translate-off-face append))) "For consideration as a value of `vhdl-font-lock-keywords'. This does background highlighting of translate-off regions.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font and color definitions -(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face +(defvar vhdl-prompt-face 'vhdl-prompt "Face name to use for prompts.") -(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face +(defvar vhdl-attribute-face 'vhdl-attribute "Face name to use for standardized attributes.") -(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face +(defvar vhdl-enumvalue-face 'vhdl-enumvalue "Face name to use for standardized enumeration values.") -(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face +(defvar vhdl-function-face 'vhdl-function "Face name to use for standardized functions and packages.") -(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face +(defvar vhdl-directive-face 'vhdl-directive "Face name to use for directives.") -(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face +(defvar vhdl-reserved-words-face 'vhdl-reserved-words "Face name to use for additional reserved words.") -(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face +(defvar vhdl-translate-off-face 'vhdl-translate-off "Face name to use for translate-off regions.") ;; face names to use for words with special syntax. (let ((syntax-alist vhdl-special-syntax-alist) name) (while syntax-alist - (setq name (vhdl-function-name - "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) + (setq name (vhdl-function-name "vhdl" (nth 0 (car syntax-alist)))) (eval `(defvar ,name ',name ,(concat "Face name to use for " (nth 0 (car syntax-alist)) "."))) @@ -12599,8 +12598,8 @@ (custom-add-to-group 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) -(defface vhdl-font-lock-prompt-face - '((((min-colors 88) (class color) (background light)) +(defface vhdl-prompt + '((((min-colors 88) (class color) (background light)) (:foreground "Red1" :bold t)) (((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Pink" :bold t)) @@ -12608,62 +12607,75 @@ "Font lock mode face used to highlight prompts." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-attribute-face +;; backward-compatibility alias +(put 'vhdl-font-lock-prompt-face 'face-alias 'vhdl-prompt) + +(defface vhdl-attribute '((((class color) (background light)) (:foreground "Orchid")) (((class color) (background dark)) (:foreground "LightSteelBlue")) (t (:italic t :bold t))) "Font lock mode face used to highlight standardized attributes." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-enumvalue-face +;; backward-compatibility alias +(put 'vhdl-font-lock-attribute-face 'face-alias 'vhdl-attribute) + +(defface vhdl-enumvalue '((((class color) (background light)) (:foreground "SaddleBrown")) (((class color) (background dark)) (:foreground "BurlyWood")) (t (:italic t :bold t))) "Font lock mode face used to highlight standardized enumeration values." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-function-face +;; backward-compatibility alias +(put 'vhdl-font-lock-enumvalue-face 'face-alias 'vhdl-enumvalue) + +(defface vhdl-function '((((class color) (background light)) (:foreground "Cyan4")) (((class color) (background dark)) (:foreground "Orchid1")) (t (:italic t :bold t))) "Font lock mode face used to highlight standardized functions and packages." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-directive-face +;; backward-compatibility alias +(put 'vhdl-font-lock-function-face 'face-alias 'vhdl-function) + +(defface vhdl-directive '((((class color) (background light)) (:foreground "CadetBlue")) (((class color) (background dark)) (:foreground "Aquamarine")) (t (:italic t :bold t))) "Font lock mode face used to highlight directives." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-reserved-words-face +;; backward-compatibility alias +(put 'vhdl-font-lock-directive-face 'face-alias 'vhdl-directive) + +(defface vhdl-reserved-word '((((class color) (background light)) (:foreground "Orange" :bold t)) - (((min-colors 88) (class color) (background dark)) + (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1" :bold t)) (((class color) (background dark)) (:foreground "Yellow" :bold t)) (t ())) "Font lock mode face used to highlight additional reserved words." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) - -(defface vhdl-font-lock-translate-off-face +;; backward-compatibility alias +(put 'vhdl-font-lock-reserved-words-face 'face-alias 'vhdl-reserved-word) + +(defface vhdl-translate-off '((((class color) (background light)) (:background "LightGray")) (((class color) (background dark)) (:background "DimGray")) (t ())) "Font lock mode face used to background highlight translate-off regions." :group 'vhdl-highlight-faces :group 'font-lock-highlighting-faces) +;; backward-compatibility alias +(put 'vhdl-font-lock-translate-off-face 'face-alias 'vhdl-translate-off) ;; font lock mode faces used to highlight words with special syntax. (let ((syntax-alist vhdl-special-syntax-alist)) (while syntax-alist - (eval `(defface ,(vhdl-function-name - "vhdl-font-lock" (caar syntax-alist) "face") + (eval `(defface ,(vhdl-function-name "vhdl" (caar syntax-alist)) '((((class color) (background light)) (:foreground ,(nth 2 (car syntax-alist)))) (((class color) (background dark)) @@ -12684,20 +12696,19 @@ (setq vhdl-font-lock-keywords-0 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" vhdl-template-prompt-syntax ">\\)") - 2 'vhdl-font-lock-prompt-face t) + 2 'vhdl-prompt t) (list (concat "--\\s-*" vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") - 2 'vhdl-font-lock-directive-face t))) + 2 'vhdl-directive t))) ;; highlight keywords and standardized types, attributes, enumeration ;; values, and subprograms (setq vhdl-font-lock-keywords-1 (list - (list (concat "'" vhdl-attributes-regexp) - 1 'vhdl-font-lock-attribute-face) + (list (concat "'" vhdl-attributes-regexp) 1 'vhdl-attribute) (list vhdl-types-regexp 1 'font-lock-type-face) - (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) - (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) - (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) + (list vhdl-functions-regexp 1 'vhdl-function) + (list vhdl-packages-regexp 1 'vhdl-function) + (list vhdl-enum-values-regexp 1 'vhdl-enumvalue) (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) ;; highlight words with special syntax. (setq vhdl-font-lock-keywords-3 @@ -12708,14 +12719,13 @@ (cons (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>") (vhdl-function-name - "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) + "vhdl" (nth 0 (car syntax-alist)))) keywords)) (setq syntax-alist (cdr syntax-alist))) keywords)) ;; highlight additional reserved words (setq vhdl-font-lock-keywords-4 - (list (list vhdl-reserved-words-regexp 1 - 'vhdl-font-lock-reserved-words-face))) + (list (list vhdl-reserved-words-regexp 1 'vhdl-reserved-word))) ;; highlight everything together (setq vhdl-font-lock-keywords (append @@ -12753,18 +12763,12 @@ (unless (or (not vhdl-print-customize-faces) ps-print-color-p) (set (make-local-variable 'ps-bold-faces) - '(font-lock-keyword-face - font-lock-type-face - vhdl-font-lock-attribute-face - vhdl-font-lock-enumvalue-face - vhdl-font-lock-directive-face)) + '(font-lock-keyword-face font-lock-type-face + vhdl-attribute vhdl-enumvalue vhdl-directive)) (set (make-local-variable 'ps-italic-faces) '(font-lock-comment-face - font-lock-function-name-face - font-lock-type-face - vhdl-font-lock-attribute-face - vhdl-font-lock-enumvalue-face - vhdl-font-lock-directive-face)) + font-lock-function-name-face font-lock-type-face + vhdl-attribute vhdl-enumvalue vhdl-directive)) (set (make-local-variable 'ps-underlined-faces) '(font-lock-string-face)) (setq ps-always-build-face-reference t)) @@ -13973,7 +13977,7 @@ 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) (nth 1 ent-entry) 'vhdl-speedbar-find-file (cons (nth 2 ent-entry) (nth 3 ent-entry)) - 'vhdl-speedbar-entity-face depth) + 'vhdl-speedbar-entity depth) (unless (nth 2 ent-entry) (end-of-line 0) (insert "!") (forward-char 1)) (unless (member (nth 0 ent-entry) ent-inst-list) @@ -13987,7 +13991,7 @@ 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) (nth 1 conf-entry) 'vhdl-speedbar-find-file (cons (nth 2 conf-entry) (nth 3 conf-entry)) - 'vhdl-speedbar-configuration-face depth) + 'vhdl-speedbar-configuration depth) (setq conf-alist (cdr conf-alist))) ;; insert packages (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) @@ -14178,7 +14182,7 @@ (cons token (nth 0 arch-entry)) (nth 1 arch-entry) 'vhdl-speedbar-find-file (cons (nth 2 arch-entry) (nth 3 arch-entry)) - 'vhdl-speedbar-architecture-face (1+ indent)) + 'vhdl-speedbar-architecture (1+ indent)) (setq arch-alist (cdr arch-alist))) ;; insert instantiations (when inst-alist @@ -14361,7 +14365,7 @@ (cons token (nth 0 comp-entry)) (nth 1 comp-entry) 'vhdl-speedbar-find-file (cons (nth 2 comp-entry) (nth 3 comp-entry)) - 'vhdl-speedbar-entity-face (1+ indent)) + 'vhdl-speedbar-entity (1+ indent)) (setq comp-alist (cdr comp-alist))) ;; insert subprograms (when func-alist @@ -14477,43 +14481,43 @@ (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-entity-face) + speedbar-last-selected-file 'vhdl-speedbar-entity) (vhdl-speedbar-update-units "{.} " (nth 1 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-architecture-face) + speedbar-last-selected-file 'vhdl-speedbar-architecture) (vhdl-speedbar-update-units "\\[.\\] " (nth 3 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-configuration-face) + speedbar-last-selected-file 'vhdl-speedbar-configuration) (vhdl-speedbar-update-units "[]>] " (nth 4 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-package-face) + speedbar-last-selected-file 'vhdl-speedbar-package) (vhdl-speedbar-update-units "\\[.\\].+(" '("body") - speedbar-last-selected-file 'vhdl-speedbar-package-face) + speedbar-last-selected-file 'vhdl-speedbar-package) (vhdl-speedbar-update-units "> " (nth 6 file-entry) - speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) + speedbar-last-selected-file 'vhdl-speedbar-instantiation)) ;; highlight current units (let* ((file-entry (aget file-alist file-name t))) (setq pos (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) - file-name 'vhdl-speedbar-entity-selected-face pos) + file-name 'vhdl-speedbar-entity-selected pos) pos (vhdl-speedbar-update-units "{.} " (nth 1 file-entry) - file-name 'vhdl-speedbar-architecture-selected-face pos) + file-name 'vhdl-speedbar-architecture-selected pos) pos (vhdl-speedbar-update-units "\\[.\\] " (nth 3 file-entry) - file-name 'vhdl-speedbar-configuration-selected-face pos) + file-name 'vhdl-speedbar-configuration-selected pos) pos (vhdl-speedbar-update-units "[]>] " (nth 4 file-entry) - file-name 'vhdl-speedbar-package-selected-face pos) + file-name 'vhdl-speedbar-package-selected pos) pos (vhdl-speedbar-update-units "\\[.\\].+(" '("body") - file-name 'vhdl-speedbar-package-selected-face pos) + file-name 'vhdl-speedbar-package-selected pos) pos (vhdl-speedbar-update-units "> " (nth 6 file-entry) - file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) + file-name 'vhdl-speedbar-instantiation-selected pos)))))) ;; move speedbar so the first highlighted unit is visible (when (and pos (not no-position)) (goto-char pos) @@ -14564,21 +14568,21 @@ (insert "(top)") (insert inst-name) (speedbar-make-button - start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-instantiation 'speedbar-highlight-face 'vhdl-speedbar-find-file inst-file-marker)) (insert delimiter) (when ent-name (setq start (point)) (insert ent-name) (speedbar-make-button - start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-entity 'speedbar-highlight-face 'vhdl-speedbar-find-file ent-file-marker) (when arch-name (insert " (") (setq start (point)) (insert arch-name) (speedbar-make-button - start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-architecture 'speedbar-highlight-face 'vhdl-speedbar-find-file arch-file-marker) (insert ")")) (when conf-name @@ -14586,14 +14590,14 @@ (setq start (point)) (insert conf-name) (speedbar-make-button - start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-configuration 'speedbar-highlight-face 'vhdl-speedbar-find-file conf-file-marker) (insert ")"))) (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) (setq start (point)) (insert " (" lib-name ")") (put-text-property (+ 2 start) (1- (point)) 'face - 'vhdl-speedbar-library-face)) + 'vhdl-speedbar-library)) (insert-char ?\n 1) (put-text-property visible-start (point) 'invisible nil))) @@ -14617,7 +14621,7 @@ (setq start (point)) (insert pack-name) (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-package 'speedbar-highlight-face 'vhdl-speedbar-find-file pack-file-marker) (unless (car pack-file-marker) (insert "!")) @@ -14626,7 +14630,7 @@ (setq start (point)) (insert "body") (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-package 'speedbar-highlight-face 'vhdl-speedbar-find-file body-file-marker) (insert ")")) (insert-char ?\n 1) @@ -14650,12 +14654,12 @@ (setq start (point)) (insert pack-name) (speedbar-make-button - start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-package 'speedbar-highlight-face 'vhdl-speedbar-find-file pack-file-marker) (setq start (point)) (insert " (" lib-name ")") (put-text-property (+ 2 start) (1- (point)) 'face - 'vhdl-speedbar-library-face) + 'vhdl-speedbar-library) (insert-char ?\n 1) (put-text-property visible-start (point) 'invisible nil))) @@ -14678,14 +14682,14 @@ (setq start (point)) (insert func-name) (speedbar-make-button - start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-subprogram 'speedbar-highlight-face 'vhdl-speedbar-find-file func-file-marker) (when (car func-body-file-marker) (insert " (") (setq start (point)) (insert "body") (speedbar-make-button - start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face + start (point) 'vhdl-speedbar-subprogram 'speedbar-highlight-face 'vhdl-speedbar-find-file func-body-file-marker) (insert ")")) (insert-char ?\n 1) @@ -14773,22 +14777,22 @@ (message "%s \"%s\" in \"%s\"" ;; design unit kind - (cond ((or (eq face 'vhdl-speedbar-entity-face) - (eq face 'vhdl-speedbar-entity-selected-face)) + (cond ((or (eq face 'vhdl-speedbar-entity) + (eq face 'vhdl-speedbar-entity-selected)) (if (equal (match-string 2) ">") "Component" "Entity")) - ((or (eq face 'vhdl-speedbar-architecture-face) - (eq face 'vhdl-speedbar-architecture-selected-face)) + ((or (eq face 'vhdl-speedbar-architecture) + (eq face 'vhdl-speedbar-architecture-selected)) "Architecture") - ((or (eq face 'vhdl-speedbar-configuration-face) - (eq face 'vhdl-speedbar-configuration-selected-face)) + ((or (eq face 'vhdl-speedbar-configuration) + (eq face 'vhdl-speedbar-configuration-selected)) "Configuration") - ((or (eq face 'vhdl-speedbar-package-face) - (eq face 'vhdl-speedbar-package-selected-face)) + ((or (eq face 'vhdl-speedbar-package) + (eq face 'vhdl-speedbar-package-selected)) "Package") - ((or (eq face 'vhdl-speedbar-instantiation-face) - (eq face 'vhdl-speedbar-instantiation-selected-face)) + ((or (eq face 'vhdl-speedbar-instantiation) + (eq face 'vhdl-speedbar-instantiation-selected)) "Instantiation") - ((eq face 'vhdl-speedbar-subprogram-face) + ((eq face 'vhdl-speedbar-subprogram) "Subprogram") (t "")) ;; design unit name @@ -14924,7 +14928,7 @@ "Place the entity/component under the cursor as component." (interactive) (if (not (vhdl-speedbar-check-unit 'entity)) - (error "ERROR: No entity/component under cursor.") + (error "ERROR: No entity/component under cursor") (vhdl-speedbar-port-copy) (if (fboundp 'speedbar-select-attached-frame) (speedbar-select-attached-frame) @@ -14964,11 +14968,11 @@ (speedbar-position-cursor-on-line) (cond ((eq design-unit 'entity) (memq (get-text-property (match-end 0) 'face) - '(vhdl-speedbar-entity-face - vhdl-speedbar-entity-selected-face))) + '(vhdl-speedbar-entity + vhdl-speedbar-entity-selected))) ((eq design-unit 'subprogram) (eq (get-text-property (match-end 0) 'face) - 'vhdl-speedbar-subprogram-face)) + 'vhdl-speedbar-subprogram)) (t nil)))) (defun vhdl-speedbar-set-depth (depth) @@ -14979,82 +14983,106 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Fontification -(defface vhdl-speedbar-entity-face +(defface vhdl-speedbar-entity '((((class color) (background light)) (:foreground "ForestGreen")) (((class color) (background dark)) (:foreground "PaleGreen"))) "Face used for displaying entity names." :group 'speedbar-faces) - -(defface vhdl-speedbar-architecture-face +;; backward-compatibility alias +(put 'vhdl-speedbar-entity-face 'face-alias 'vhdl-speedbar-entity) + +(defface vhdl-speedbar-architecture '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) (((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue"))) "Face used for displaying architecture names." :group 'speedbar-faces) - -(defface vhdl-speedbar-configuration-face +;; backward-compatibility alias +(put 'vhdl-speedbar-architecture-face 'face-alias 'vhdl-speedbar-architecture) + +(defface vhdl-speedbar-configuration '((((class color) (background light)) (:foreground "DarkGoldenrod")) (((class color) (background dark)) (:foreground "Salmon"))) "Face used for displaying configuration names." :group 'speedbar-faces) - -(defface vhdl-speedbar-package-face +;; backward-compatibility alias +(put 'vhdl-speedbar-configuration-face 'face-alias 'vhdl-speedbar-configuration) + +(defface vhdl-speedbar-package '((((class color) (background light)) (:foreground "Grey50")) (((class color) (background dark)) (:foreground "Grey80"))) "Face used for displaying package names." :group 'speedbar-faces) - -(defface vhdl-speedbar-library-face +;; backward-compatibility alias +(put 'vhdl-speedbar-package-face 'face-alias 'vhdl-speedbar-package) + +(defface vhdl-speedbar-library '((((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Orchid1"))) "Face used for displaying library names." :group 'speedbar-faces) - -(defface vhdl-speedbar-instantiation-face +;; backward-compatibility alias +(put 'vhdl-speedbar-library-face 'face-alias 'vhdl-speedbar-library) + +(defface vhdl-speedbar-instantiation '((((class color) (background light)) (:foreground "Brown")) (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) (((class color) (background dark)) (:foreground "Yellow"))) "Face used for displaying instantiation names." :group 'speedbar-faces) - -(defface vhdl-speedbar-subprogram-face +;; backward-compatibility alias +(put 'vhdl-speedbar-instantiation-face 'face-alias 'vhdl-speedbar-instantiation) + +(defface vhdl-speedbar-subprogram '((((class color) (background light)) (:foreground "Orchid4")) (((class color) (background dark)) (:foreground "BurlyWood2"))) "Face used for displaying subprogram names." :group 'speedbar-faces) - -(defface vhdl-speedbar-entity-selected-face +;; backward-compatibility alias +(put 'vhdl-speedbar-subprogram-face 'face-alias 'vhdl-speedbar-subprogram) + +(defface vhdl-speedbar-entity-selected '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) "Face used for displaying entity names." :group 'speedbar-faces) - -(defface vhdl-speedbar-architecture-selected-face +;; backward-compatibility alias +(put 'vhdl-speedbar-entity-selected-face 'face-alias 'vhdl-speedbar-entity-selected) + +(defface vhdl-speedbar-architecture-selected '((((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t)) (((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t)) (((class color) (background light)) (:foreground "Blue" :underline t)) (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) "Face used for displaying architecture names." :group 'speedbar-faces) - -(defface vhdl-speedbar-configuration-selected-face +;; backward-compatibility alias +(put 'vhdl-speedbar-architecture-selected-face 'face-alias 'vhdl-speedbar-architecture-selected) + +(defface vhdl-speedbar-configuration-selected '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) (((class color) (background dark)) (:foreground "Salmon" :underline t))) "Face used for displaying configuration names." :group 'speedbar-faces) - -(defface vhdl-speedbar-package-selected-face +;; backward-compatibility alias +(put 'vhdl-speedbar-configuration-selected-face 'face-alias 'vhdl-speedbar-configuration-selected) + +(defface vhdl-speedbar-package-selected '((((class color) (background light)) (:foreground "Grey50" :underline t)) (((class color) (background dark)) (:foreground "Grey80" :underline t))) "Face used for displaying package names." :group 'speedbar-faces) - -(defface vhdl-speedbar-instantiation-selected-face +;; backward-compatibility alias +(put 'vhdl-speedbar-package-selected-face 'face-alias 'vhdl-speedbar-package-selected) + +(defface vhdl-speedbar-instantiation-selected '((((class color) (background light)) (:foreground "Brown" :underline t)) (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1" :underline t)) (((class color) (background dark)) (:foreground "Yellow" :underline t))) "Face used for displaying instantiation names." :group 'speedbar-faces) +;; backward-compatibility alias +(put 'vhdl-speedbar-instantiation-selected-face 'face-alias 'vhdl-speedbar-instantiation-selected) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialization
--- a/lisp/progmodes/which-func.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/progmodes/which-func.el Wed Jun 15 23:32:15 2005 +0000 @@ -113,17 +113,40 @@ map) "Keymap to display on mode line which-func.") -(defface which-func-face - '((t (:inherit font-lock-function-name-face))) - "Face used to highlight mode line function names. -Defaults to `font-lock-function-name-face' if font-lock is loaded." +(defface which-func + ;; Whether `font-lock-function-name-face' is an appropriate face to + ;; inherit depends on the mode-line face; define several variants based + ;; on the default mode-line face. + '(;; The default mode-line face on a high-color display is a relatively + ;; light color ("grey75"), and only the light-background variant of + ;; `font-lock-function-name-face' is visible against it. + (((class color) (min-colors 88) (background light)) + :inherit font-lock-function-name-face) + ;; The default mode-line face on other display types is inverse-video; + ;; it seems that only in the dark-background case is + ;; `font-lock-function-name-face' visible against it. + (((class grayscale mono) (background dark)) + :inherit font-lock-function-name-face) + (((class color) (background light)) + :inherit font-lock-function-name-face) + ;; If none of the above cases, use an explicit color chosen to contrast + ;; well with the default mode-line face. + (((class color) (min-colors 88) (background dark)) + :foreground "Blue1") + (((background dark)) + :foreground "Blue1") + (t + :foreground "LightSkyBlue")) + "Face used to highlight mode line function names." :group 'which-func) +;; backward-compatibility alias +(put 'which-func-face 'face-alias 'which-func) (defcustom which-func-format `("[" (:propertize which-func-current local-map ,which-func-keymap - face which-func-face + face which-func ;;mouse-face highlight ; currently not evaluated :-( help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end") "]")
--- a/lisp/recentf.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/recentf.el Wed Jun 15 23:32:15 2005 +0000 @@ -923,9 +923,11 @@ \\{recentf-dialog-mode-map}" (interactive) + (kill-all-local-variables) (setq major-mode 'recentf-dialog-mode) (setq mode-name "recentf-dialog") - (use-local-map recentf-dialog-mode-map)) + (use-local-map recentf-dialog-mode-map) + (run-mode-hooks 'recentf-dialog-mode-hook)) ;;; Hooks ;; @@ -1002,13 +1004,13 @@ (get-buffer-create (format "*%s - Edit list*" recentf-menu-title)) (switch-to-buffer (current-buffer)) ;; Cleanup buffer - (kill-all-local-variables) (let ((inhibit-read-only t) (ol (overlay-lists))) (erase-buffer) ;; Delete all the overlays. (mapc 'delete-overlay (car ol)) (mapc 'delete-overlay (cdr ol))) + (recentf-dialog-mode) (setq recentf-edit-selected-items nil) ;; Insert the dialog header (widget-insert @@ -1045,7 +1047,6 @@ 'push-button :notify 'recentf-cancel-dialog "Cancel") - (recentf-dialog-mode) (widget-setup) (goto-char (point-min)))) @@ -1101,13 +1102,13 @@ (with-current-buffer (get-buffer-create buffer-name) (switch-to-buffer (current-buffer)) ;; Cleanup buffer - (kill-all-local-variables) (let ((inhibit-read-only t) (ol (overlay-lists))) (erase-buffer) ;; Delete all the overlays. (mapc 'delete-overlay (car ol)) (mapc 'delete-overlay (cdr ol))) + (recentf-dialog-mode) ;; Insert the dialog header (widget-insert "Click on a file to open it. ") (widget-insert "Click on Cancel or type \"q\" to quit.\n\n" ) @@ -1123,7 +1124,6 @@ 'push-button :notify 'recentf-cancel-dialog "Cancel") - (recentf-dialog-mode) (widget-setup) (goto-char (point-min))))
--- a/lisp/ruler-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ruler-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; ruler-mode.el --- display a ruler in the header line -;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -70,26 +70,26 @@ ;; ;; The following faces are customizable: ;; -;; - `ruler-mode-default-face' the ruler default face. -;; - `ruler-mode-fill-column-face' the face used to highlight the +;; - `ruler-mode-default' the ruler default face. +;; - `ruler-mode-fill-column' the face used to highlight the ;; `fill-column' character. -;; - `ruler-mode-comment-column-face' the face used to highlight the +;; - `ruler-mode-comment-column' the face used to highlight the ;; `comment-column' character. -;; - `ruler-mode-goal-column-face' the face used to highlight the +;; - `ruler-mode-goal-column' the face used to highlight the ;; `goal-column' character. -;; - `ruler-mode-current-column-face' the face used to highlight the +;; - `ruler-mode-current-column' the face used to highlight the ;; `current-column' character. -;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop +;; - `ruler-mode-tab-stop' the face used to highlight tab stop ;; characters. -;; - `ruler-mode-margins-face' the face used to highlight graduations +;; - `ruler-mode-margins' the face used to highlight graduations ;; in the `window-margins' areas. -;; - `ruler-mode-fringes-face' the face used to highlight graduations +;; - `ruler-mode-fringes' the face used to highlight graduations ;; in the `window-fringes' areas. -;; - `ruler-mode-column-number-face' the face used to highlight the +;; - `ruler-mode-column-number' the face used to highlight the ;; numbered graduations. ;; -;; `ruler-mode-default-face' inherits from the built-in `default' face. -;; All `ruler-mode' faces inherit from `ruler-mode-default-face'. +;; `ruler-mode-default' inherits from the built-in `default' face. +;; All `ruler-mode' faces inherit from `ruler-mode-default'. ;; ;; WARNING: To keep ruler graduations aligned on text columns it is ;; important to use the same font family and size for ruler and text @@ -204,7 +204,7 @@ :group 'ruler-mode :type 'boolean) -(defface ruler-mode-default-face +(defface ruler-mode-default '((((type tty)) (:inherit default :background "grey64" @@ -220,83 +220,103 @@ ))) "Default face used by the ruler." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-default-face 'face-alias 'ruler-mode-default) -(defface ruler-mode-pad-face +(defface ruler-mode-pad '((((type tty)) - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :background "grey50" )) (t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :background "grey64" ))) "Face used to pad inactive ruler areas." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-pad-face 'face-alias 'ruler-mode-pad) -(defface ruler-mode-margins-face +(defface ruler-mode-margins '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "white" ))) "Face used to highlight margin areas." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-margins-face 'face-alias 'ruler-mode-margins) -(defface ruler-mode-fringes-face +(defface ruler-mode-fringes '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "green" ))) "Face used to highlight fringes areas." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-fringes-face 'face-alias 'ruler-mode-fringes) -(defface ruler-mode-column-number-face +(defface ruler-mode-column-number '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "black" ))) "Face used to highlight number graduations." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-column-number-face 'face-alias 'ruler-mode-column-number) -(defface ruler-mode-fill-column-face +(defface ruler-mode-fill-column '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "red" ))) "Face used to highlight the fill column character." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-fill-column-face 'face-alias 'ruler-mode-fill-column) -(defface ruler-mode-comment-column-face +(defface ruler-mode-comment-column '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "red" ))) "Face used to highlight the comment column character." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-comment-column-face 'face-alias 'ruler-mode-comment-column) -(defface ruler-mode-goal-column-face +(defface ruler-mode-goal-column '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "red" ))) "Face used to highlight the goal column character." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-goal-column-face 'face-alias 'ruler-mode-goal-column) -(defface ruler-mode-tab-stop-face +(defface ruler-mode-tab-stop '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :foreground "steelblue" ))) "Face used to highlight tab stop characters." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-tab-stop-face 'face-alias 'ruler-mode-tab-stop) -(defface ruler-mode-current-column-face +(defface ruler-mode-current-column '((t - (:inherit ruler-mode-default-face + (:inherit ruler-mode-default :weight bold :foreground "yellow" ))) "Face used to highlight the `current-column' character." :group 'ruler-mode) +;; backward-compatibility alias +(put 'ruler-mode-current-column-face 'face-alias 'ruler-mode-current-column) (defsubst ruler-mode-full-window-width () @@ -418,7 +438,7 @@ (message "Goal column set to %d (click on %s again to unset it)" newc (propertize (char-to-string ruler-mode-goal-column-char) - 'face 'ruler-mode-goal-column-face)) + 'face 'ruler-mode-goal-column)) nil) ;; Don't start dragging. ) (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration @@ -628,34 +648,34 @@ ;; Setup the scrollbar, fringes, and margins areas. (lf (ruler-mode-space 'left-fringe - 'face 'ruler-mode-fringes-face + 'face 'ruler-mode-fringes 'help-echo (format ruler-mode-fringe-help-echo "Left" (or (car f) 0)))) (rf (ruler-mode-space 'right-fringe - 'face 'ruler-mode-fringes-face + 'face 'ruler-mode-fringes 'help-echo (format ruler-mode-fringe-help-echo "Right" (or (cadr f) 0)))) (lm (ruler-mode-space 'left-margin - 'face 'ruler-mode-margins-face + 'face 'ruler-mode-margins 'help-echo (format ruler-mode-margin-help-echo "Left" (or (car m) 0)))) (rm (ruler-mode-space 'right-margin - 'face 'ruler-mode-margins-face + 'face 'ruler-mode-margins 'help-echo (format ruler-mode-margin-help-echo "Right" (or (cdr m) 0)))) (sb (ruler-mode-space 'scroll-bar - 'face 'ruler-mode-pad-face)) + 'face 'ruler-mode-pad)) ;; Remember the scrollbar vertical type. (sbvt (car (window-current-scroll-bars))) ;; Create an "clean" ruler. (ruler (propertize (make-string w ruler-mode-basic-graduation-char) - 'face 'ruler-mode-default-face + 'face 'ruler-mode-default 'local-map ruler-mode-map 'help-echo (cond (ruler-mode-show-tab-stops @@ -674,7 +694,7 @@ m (length c) k i) (put-text-property - i (1+ i) 'face 'ruler-mode-column-number-face + i (1+ i) 'face 'ruler-mode-column-number ruler) (while (and (> m 0) (>= k 0)) (aset ruler k (aref c (setq m (1- m)))) @@ -688,13 +708,13 @@ ((= j (current-column)) (aset ruler i ruler-mode-current-column-char) (put-text-property - i (1+ i) 'face 'ruler-mode-current-column-face + i (1+ i) 'face 'ruler-mode-current-column ruler)) ;; Show the `goal-column' marker. ((and goal-column (= j goal-column)) (aset ruler i ruler-mode-goal-column-char) (put-text-property - i (1+ i) 'face 'ruler-mode-goal-column-face + i (1+ i) 'face 'ruler-mode-goal-column ruler) (put-text-property i (1+ i) 'mouse-face 'mode-line-highlight @@ -706,7 +726,7 @@ ((= j comment-column) (aset ruler i ruler-mode-comment-column-char) (put-text-property - i (1+ i) 'face 'ruler-mode-comment-column-face + i (1+ i) 'face 'ruler-mode-comment-column ruler) (put-text-property i (1+ i) 'mouse-face 'mode-line-highlight @@ -718,7 +738,7 @@ ((= j fill-column) (aset ruler i ruler-mode-fill-column-char) (put-text-property - i (1+ i) 'face 'ruler-mode-fill-column-face + i (1+ i) 'face 'ruler-mode-fill-column ruler) (put-text-property i (1+ i) 'mouse-face 'mode-line-highlight @@ -730,7 +750,7 @@ ((and ruler-mode-show-tab-stops (member j tab-stop-list)) (aset ruler i ruler-mode-tab-stop-char) (put-text-property - i (1+ i) 'face 'ruler-mode-tab-stop-face + i (1+ i) 'face 'ruler-mode-tab-stop ruler))) (setq i (1+ i) j (1+ j)))
--- a/lisp/ses.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/ses.el Wed Jun 15 23:32:15 2005 +0000 @@ -1361,7 +1361,7 @@ (ses-set-parameter 'ses--file-format 2) (message "Upgrading from SES-1 file format"))) (or (= ses--file-format 2) - (error "This file needs a newer version of the SES library code.")) + (error "This file needs a newer version of the SES library code")) (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols)) ;;Initialize cell array (setq ses--cells (make-vector ses--numrows nil))
--- a/lisp/skeleton.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/skeleton.el Wed Jun 15 23:32:15 2005 +0000 @@ -50,7 +50,7 @@ (defvar skeleton-autowrap t - "Controls wrapping behaviour of functions created with `define-skeleton'. + "Controls wrapping behavior of functions created with `define-skeleton'. When the region is visible (due to `transient-mark-mode' or marking a region with the mouse) and this is non-nil and the function was called without an explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
--- a/lisp/smerge-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/smerge-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -75,7 +75,7 @@ :group 'smerge :type 'boolean) -(defface smerge-mine-face +(defface smerge-mine '((((min-colors 88) (background light)) (:foreground "blue1")) (((background light)) @@ -86,18 +86,22 @@ (:foreground "cyan"))) "Face for your code." :group 'smerge) -(defvar smerge-mine-face 'smerge-mine-face) +;; backward-compatibility alias +(put 'smerge-mine-face 'face-alias 'smerge-mine) +(defvar smerge-mine-face 'smerge-mine) -(defface smerge-other-face +(defface smerge-other '((((background light)) (:foreground "darkgreen")) (((background dark)) (:foreground "lightgreen"))) "Face for the other code." :group 'smerge) -(defvar smerge-other-face 'smerge-other-face) +;; backward-compatibility alias +(put 'smerge-other-face 'face-alias 'smerge-other) +(defvar smerge-other-face 'smerge-other) -(defface smerge-base-face +(defface smerge-base '((((min-colors 88) (background light)) (:foreground "red1")) (((background light)) @@ -106,16 +110,20 @@ (:foreground "orange"))) "Face for the base code." :group 'smerge) -(defvar smerge-base-face 'smerge-base-face) +;; backward-compatibility alias +(put 'smerge-base-face 'face-alias 'smerge-base) +(defvar smerge-base-face 'smerge-base) -(defface smerge-markers-face +(defface smerge-markers '((((background light)) (:background "grey85")) (((background dark)) (:background "grey30"))) "Face for the conflict markers." :group 'smerge) -(defvar smerge-markers-face 'smerge-markers-face) +;; backward-compatibility alias +(put 'smerge-markers-face 'face-alias 'smerge-markers) +(defvar smerge-markers-face 'smerge-markers) (easy-mmode-defmap smerge-basic-map `(("n" . smerge-next)
--- a/lisp/strokes.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/strokes.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; strokes.el --- control Emacs through mouse strokes -;; Copyright (C) 1997, 2000, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000, 2002, 2005 Free Software Foundation, Inc. ;; Author: David Bakhash <cadet@alum.mit.edu> ;; Maintainer: FSF @@ -1418,10 +1418,12 @@ ;; This is the stuff that will eventually be used for composing letters in ;; any language, compression, decompression, graphics, editing, etc. -(defface strokes-char-face '((t (:background "lightgray"))) +(defface strokes-char '((t (:background "lightgray"))) "Face for strokes characters." :version "21.1" :group 'strokes) +;; backward-compatibility alias +(put 'strokes-char-face 'face-alias 'strokes-char) (put 'strokes 'char-table-extra-slots 0) (defconst strokes-char-table (make-char-table 'strokes) ; @@ -1695,7 +1697,7 @@ (delete-char 1) (add-text-properties start (point) (list 'type 'stroke-string - 'face 'strokes-char-face + 'face 'strokes-char 'stroke-glyph glyph 'display nil)))) (message "Encoding strokes in %s...done" buffer)))))
--- a/lisp/subr.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/subr.el Wed Jun 15 23:32:15 2005 +0000 @@ -957,6 +957,39 @@ (append (symbol-value list-var) (list element)) (cons element (symbol-value list-var)))))) + +(defun add-to-ordered-list (list-var element &optional order) + "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. +The test for presence of ELEMENT is done with `equal'. + +The resulting list is reordered so that the elements are in the +order given by each element's numeric list order. +Elements without a numeric list order are placed at the end of +the list. + +If the third optional argument ORDER is non-nil, set the +element's list order to the given value. + +The list order for each element is stored in LIST-VAR's +`list-order' property. + +The return value is the new value of LIST-VAR." + (let ((ordering (get list-var 'list-order))) + (unless ordering + (put list-var 'list-order + (setq ordering (make-hash-table :weakness 'key :test 'eq)))) + (when order + (puthash element order ordering)) + (add-to-list list-var element) + (set list-var (sort (symbol-value list-var) + (lambda (a b) + (let ((oa (gethash a ordering)) + (ob (gethash b ordering))) + (cond + ((not oa) nil) + ((not ob) t) + (t (< oa ob))))))))) + ;;; Load history @@ -1561,7 +1594,7 @@ `yank-excluded-properties'. Otherwise just like (insert STRING). If STRING has a non-nil `yank-handler' property on the first character, -the normal insert behaviour is modified in various ways. The value of +the normal insert behavior is modified in various ways. The value of the yank-handler property must be a list with one to five elements with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). When FUNCTION is present and non-nil, it is called instead of `insert' @@ -1923,6 +1956,7 @@ The result of the `dynamic-completion-table' form is a function that can be used as the ALIST argument to `try-completion' and `all-completion'. See Info node `(elisp)Programmed Completion'." + (declare (debug (lambda-expr))) (let ((win (make-symbol "window")) (string (make-symbol "string")) (predicate (make-symbol "predicate")) @@ -1944,12 +1978,29 @@ If completion is requested in the minibuffer, FUN will be called in the buffer from which the minibuffer was entered. The return value of `lazy-completion-table' must be used to initialize the value of VAR." + (declare (debug (symbol lambda-expr def-body))) (let ((str (make-symbol "string"))) `(dynamic-completion-table (lambda (,str) (unless (listp ,var) - (setq ,var (funcall ',fun ,@args))) + (setq ,var (,fun ,@args))) ,var)))) + +(defmacro complete-in-turn (a b) + "Create a completion table that first tries completion in A and then in B. +A and B should not be costly (or side-effecting) expressions." + (declare (debug (def-form def-form))) + `(lambda (string predicate mode) + (cond + ((eq mode t) + (or (all-completions string ,a predicate) + (all-completions string ,b predicate))) + ((eq mode nil) + (or (try-completion string ,a predicate) + (try-completion string ,b predicate))) + (t + (or (test-completion string ,a predicate) + (test-completion string ,b predicate)))))) ;;; Matching and substitution
--- a/lisp/tempo.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/tempo.el Wed Jun 15 23:32:15 2005 +0000 @@ -125,7 +125,7 @@ "*Automatically insert current region when there is a `r' in the template If this variable is nil, `r' elements will be treated just like `p' elements, unless the template function is given a prefix (or a non-nil -argument). If this variable is non-nil, the behaviour is reversed. +argument). If this variable is non-nil, the behavior is reversed. In Transient Mark mode, this option is unused." :type 'boolean
--- a/lisp/term.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/term.el Wed Jun 15 23:32:15 2005 +0000 @@ -597,7 +597,7 @@ "Function to actually send to PROCESS the STRING submitted by user. Usually this is just 'term-simple-send, but if your mode needs to massage the input string, this is your hook. This is called from -the user command term-send-input. term-simple-send just sends +the user command term-send-input. `term-simple-send' just sends the string plus a newline.") (defcustom term-eol-on-send t @@ -888,7 +888,7 @@ (while (< i 128) (define-key map (make-string 1 i) 'term-send-raw) ;; Avoid O and [. They are used in escape sequences for various keys. - (unless (or (eq i ?O) (eq i 91)) + (unless (or (eq i ?O) (eq i 91)) (define-key esc-map (make-string 1 i) 'term-send-raw-meta)) (setq i (1+ i))) (define-key map "\e" esc-map) @@ -939,11 +939,11 @@ (make-display-table))) i) ;; avoid changing the display table for ^J - (setq i 0) + (setq i 0) (while (< i 10) (aset dt i (vector i)) (setq i (1+ i))) - (setq i 11) + (setq i 11) (while (< i 32) (aset dt i (vector i)) (setq i (1+ i))) @@ -981,7 +981,7 @@ If you accidentally suspend your process, use \\[term-continue-subjob] to continue it. -This mode can be customised to create specific modes for running +This mode can be customized to create specific modes for running particular subprocesses. This can be done by setting the hooks `term-input-filter-functions', `term-input-filter', `term-input-sender' and `term-get-old-input' to appropriate functions, @@ -1271,7 +1271,7 @@ (defun term-check-proc (buffer) "True if there is a process associated w/buffer BUFFER, and it is alive (status RUN or STOP). BUFFER can be either a buffer or the -name of one" +name of one." (let ((proc (get-buffer-process buffer))) (and proc (memq (process-status proc) '(run stop))))) @@ -2086,7 +2086,7 @@ (defun term-simple-send (proc string) "Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, -set the hook TERM-INPUT-SENDER." +set the hook `term-input-sender'." (term-send-string proc string) (term-send-string proc "\n")) @@ -2178,7 +2178,7 @@ If your process is choking on big inputs, try lowering the value.") (defun term-send-string (proc str) - "Send PROCESS the contents of STRING as input. + "Send to PROC the contents of STR as input. This is equivalent to process-send-string, except that long input strings are broken up into chunks of size term-input-chunk-size. Processes are given a chance to output between chunks. This can help prevent processes @@ -2193,9 +2193,9 @@ (setq i next-i))))) (defun term-send-region (proc start end) - "Sends to PROC the region delimited by START and END. + "Send to PROC the region delimited by START and END. This is a replacement for process-send-region that tries to keep -your process from hanging on long inputs. See term-send-string." +your process from hanging on long inputs. See `term-send-string'." (term-send-string proc (buffer-substring start end))) @@ -2425,7 +2425,7 @@ ;;; This is pretty stupid about strings. It decides we're in a string ;;; if there's a quote on both sides of point on the current line. (defun term-extract-string () - "Returns string around POINT that starts the current line or nil." + "Return string around `point' that starts the current line or nil." (save-excursion (let* ((point (point)) (bol (progn (beginning-of-line) (point))) @@ -2599,7 +2599,7 @@ (defun term-adjust-current-row-cache (delta) (when term-current-row - (setq term-current-row + (setq term-current-row (max 0 (+ term-current-row delta))))) (defun term-terminal-pos () @@ -2779,11 +2779,11 @@ ;; In insert if the if the current line ;; has become too long it needs to be ;; chopped off. - (when term-insert-mode + (when term-insert-mode (setq pos (point)) (end-of-line) (when (> (current-column) term-width) - (delete-region (- (point) (- (current-column) term-width)) + (delete-region (- (point) (- (current-column) term-width)) (point))) (goto-char pos))) (setq term-current-column nil) @@ -2802,15 +2802,15 @@ (setq count (term-current-column)) ;; The line cannot exceed term-width. TAB at ;; the end of a line should not cause wrapping. - (setq count (min term-width + (setq count (min term-width (+ count 8 (- (mod count 8))))) (if (> term-width count) (progn - (term-move-columns + (term-move-columns (- count (term-current-column))) (setq term-current-column count)) (when (> term-width (term-current-column)) - (term-move-columns + (term-move-columns (1- (- term-width (term-current-column))))) (when (= term-width (term-current-column)) (term-move-columns -1)))) @@ -2901,7 +2901,7 @@ (term-goto (car term-saved-cursor) (cdr term-saved-cursor))) (setq term-terminal-state 0)) - ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) + ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) ;; This is used by the "clear" program. (setq term-terminal-state 0) (term-reset-terminal)) @@ -3033,7 +3033,7 @@ (setq term-current-row (1- term-height)))))) ;;; Reset the terminal, delete all the content and set the face to the -;;; default one. +;;; default one. (defun term-reset-terminal () (erase-buffer) (setq term-current-row 0) @@ -3187,7 +3187,7 @@ ((or (eq char ?H) ; cursor motion (terminfo: cup) ;; (eq char ?f) ; xterm seems to handle this sequence too, not ;; needed for now - ) + ) (if (<= term-terminal-parameter 0) (setq term-terminal-parameter 1)) (if (<= term-terminal-previous-parameter 0) @@ -3208,8 +3208,8 @@ (term-down (max 1 term-terminal-parameter) t)) ;; \E[C - cursor right (terminfo: cuf) ((eq char ?C) - (term-move-columns - (max 1 + (term-move-columns + (max 1 (if (>= (+ term-terminal-parameter (term-current-column)) term-width) (- term-width (term-current-column) 1) term-terminal-parameter)))) @@ -3250,7 +3250,7 @@ )) ;;; Modified to allow ansi coloring -mm - ;; \E[m - Set/reset modes, set bg/fg + ;; \E[m - Set/reset modes, set bg/fg ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) ((eq char ?m) (when (= term-terminal-more-parameters 1) @@ -3295,7 +3295,7 @@ (not (and (= term-scroll-start 0) (= term-scroll-end term-height))))) (term-move-columns (- (term-current-column))) - (term-goto + (term-goto term-scroll-start (term-current-column))) ;; (defun term-switch-to-alternate-sub-buffer (set) @@ -3844,7 +3844,7 @@ (defun term-word (word-chars) - "Return the word of WORD-CHARS at point, or nil if non is found. + "Return the word of WORD-CHARS at point, or nil if none is found. Word constituents are considered to be those in WORD-CHARS, which is like the inside of a \"[...]\" (see `skip-chars-forward')." (save-excursion @@ -3861,7 +3861,7 @@ (defun term-match-partial-filename () - "Return the filename at point, or nil if non is found. + "Return the filename at point, or nil if none is found. Environment variables are substituted. See `term-word'." (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-"))) (and filename (substitute-in-file-name filename))))
--- a/lisp/term/x-win.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/term/x-win.el Wed Jun 15 23:32:15 2005 +0000 @@ -2184,6 +2184,11 @@ ctext utf8))))) +;; Get a selection value of type TYPE by calling x-get-selection with +;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'. +;; The return value is already decoded. If x-get-selection causes an +;; error, this function return nil. + (defun x-selection-value (type) (let (text) (cond ((null x-select-request-type) @@ -2444,10 +2449,7 @@ (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive) - (let ((clipboard-text - (condition-case nil - (x-get-selection 'CLIPBOARD) - (error nil))) + (let ((clipboard-text (x-selection-value 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text))
--- a/lisp/terminal.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/terminal.el Wed Jun 15 23:32:15 2005 +0000 @@ -1089,7 +1089,7 @@ `Meta' characters may not currently be sent through the terminal emulator. -Here is a list of some of the variables which control the behaviour +Here is a list of some of the variables which control the behavior of the emulator -- see their documentation for more information: terminal-escape-char, terminal-scrolling, terminal-more-processing, terminal-redisplay-interval.
--- a/lisp/textmodes/bibtex.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/bibtex.el Wed Jun 15 23:32:15 2005 +0000 @@ -4277,9 +4277,11 @@ (bibtex-move-outside-of-entry) (indent-to-column bibtex-entry-offset) (insert "@Preamble" - (bibtex-entry-left-delimiter)) + (bibtex-entry-left-delimiter) + (bibtex-field-left-delimiter)) (let ((endpos (point))) (insert (bibtex-entry-right-delimiter) + (bibtex-field-right-delimiter) "\n") (goto-char endpos)))
--- a/lisp/textmodes/fill.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/fill.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,7 +1,7 @@ ;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- -;; Copyright (C) 1985,86,92,94,95,96,97,1999,2001,02,03,2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, +;; 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp @@ -115,7 +115,7 @@ (defcustom adaptive-fill-function nil "*Function to call to choose a fill prefix for a paragraph, or nil. -This function is used when `adaptive-fill-regexp' does not match." +nil means the function has not determined the fill prefix." :type '(choice (const nil) function) :group 'fill) @@ -205,6 +205,16 @@ (unless (zerop cmp) (substring s1 0 cmp))))) +(defun fill-match-adaptive-prefix () + (let ((str (or + (and adaptive-fill-function (funcall adaptive-fill-function)) + (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) + (match-string-no-properties 0))))) + (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) + ;; Death to insanely long prefixes. + nil + str))) + (defun fill-context-prefix (from to &optional first-line-regexp) "Compute a fill prefix from the text between FROM and TO. This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' @@ -218,55 +228,45 @@ (if (eolp) (forward-line 1)) ;; Move to the second line unless there is just one. (move-to-left-margin) - (let ((firstline (point)) - first-line-prefix + (let (first-line-prefix ;; Non-nil if we are on the second line. - second-line-prefix - start) - (setq start (point)) + second-line-prefix) (setq first-line-prefix ;; We don't need to consider `paragraph-start' here since it ;; will be explicitly checked later on. ;; Also setting first-line-prefix to nil prevents ;; second-line-prefix from being used. - (cond ;; ((looking-at paragraph-start) nil) - ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) - (match-string-no-properties 0)) - (adaptive-fill-function (funcall adaptive-fill-function)))) + ;; ((looking-at paragraph-start) nil) + (fill-match-adaptive-prefix)) (forward-line 1) (if (< (point) to) - (progn - (move-to-left-margin) - (setq start (point)) - (setq second-line-prefix - (cond ((looking-at paragraph-start) nil) ;Can it happen ? -stef - ((and adaptive-fill-regexp - (looking-at adaptive-fill-regexp)) - (buffer-substring-no-properties start (match-end 0))) - (adaptive-fill-function - (funcall adaptive-fill-function)))) - ;; If we get a fill prefix from the second line, - ;; make sure it or something compatible is on the first line too. - (when second-line-prefix - (unless first-line-prefix (setq first-line-prefix "")) - ;; If the non-whitespace chars match the first line, - ;; just use it (this subsumes the 2 checks used previously). - ;; Used when first line is `/* ...' and second-line is - ;; ` * ...'. - (let ((tmp second-line-prefix) - (re "\\`")) - (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) - (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) - (setq tmp (substring tmp (match-end 0)))) - ;; (assert (string-match "\\`[ \t]*\\'" tmp)) + (progn + (move-to-left-margin) + (setq second-line-prefix + (cond ((looking-at paragraph-start) nil) ;Can it happen? -Stef + (t (fill-match-adaptive-prefix)))) + ;; If we get a fill prefix from the second line, + ;; make sure it or something compatible is on the first line too. + (when second-line-prefix + (unless first-line-prefix (setq first-line-prefix "")) + ;; If the non-whitespace chars match the first line, + ;; just use it (this subsumes the 2 checks used previously). + ;; Used when first line is `/* ...' and second-line is + ;; ` * ...'. + (let ((tmp second-line-prefix) + (re "\\`")) + (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) + (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) + (setq tmp (substring tmp (match-end 0)))) + ;; (assert (string-match "\\`[ \t]*\\'" tmp)) - (if (string-match re first-line-prefix) - second-line-prefix + (if (string-match re first-line-prefix) + second-line-prefix - ;; Use the longest common substring of both prefixes, - ;; if there is one. - (fill-common-string-prefix first-line-prefix - second-line-prefix))))) + ;; Use the longest common substring of both prefixes, + ;; if there is one. + (fill-common-string-prefix first-line-prefix + second-line-prefix))))) ;; If we get a fill prefix from a one-line paragraph, ;; maybe change it to whitespace, ;; and check that it isn't a paragraph starter. @@ -333,7 +333,7 @@ Can be customized with the variables `fill-nobreak-predicate' and `fill-nobreak-invisible'." (or - (and fill-nobreak-invisible (line-move-invisible (point))) + (and fill-nobreak-invisible (line-move-invisible-p (point))) (unless (bolp) (or ;; Don't break after a period followed by just one space. @@ -1128,8 +1128,6 @@ ncols ; new indent point or offset (nspaces 0) ; number of spaces between words ; in line (not space characters) - fracspace ; fractional amount of space to be - ; added between each words (curr-fracspace 0) ; current fractional space amount count) (end-of-line) @@ -1338,7 +1336,7 @@ (forward-line 1)))) (narrow-to-region (point) max) ;; Loop over paragraphs. - (while (let ((here (point))) + (while (progn ;; Skip over all paragraph-separating lines ;; so as to not include them in any paragraph. (while (and (not (eobp)) @@ -1446,5 +1444,5 @@ "") string)) -;;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d +;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d ;;; fill.el ends here
--- a/lisp/textmodes/flyspell.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/flyspell.el Wed Jun 15 23:32:15 2005 +0000 @@ -94,7 +94,7 @@ "*The maximum distance for finding duplicates of unrecognized words. This applies to the feature that when a word is not found in the dictionary, if the same spelling occurs elsewhere in the buffer, -Flyspell uses a different face (`flyspell-duplicate-face') to highlight it. +Flyspell uses a different face (`flyspell-duplicate') to highlight it. This variable specifies how far to search to find such a duplicate. -1 means no limit (search the whole buffer). 0 means do not search for duplicate unrecognized spellings." @@ -172,7 +172,7 @@ "*List of functions to be called when incorrect words are encountered. Each function is given three arguments: the beginning and the end of the incorrect region. The third is either the symbol 'doublon' or the list -of possible corrections as returned by 'ispell-parse-output'. +of possible corrections as returned by `ispell-parse-output'. If any of the functions return non-Nil, the word is not highlighted as incorrect." @@ -444,18 +444,22 @@ ;*---------------------------------------------------------------------*/ ;* Highlighting */ ;*---------------------------------------------------------------------*/ -(defface flyspell-incorrect-face +(defface flyspell-incorrect '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) (t (:bold t))) "Face used for marking a misspelled word in Flyspell." :group 'flyspell) +;; backward-compatibility alias +(put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect) -(defface flyspell-duplicate-face +(defface flyspell-duplicate '((((class color)) (:foreground "Gold3" :bold t :underline t)) (t (:bold t))) "Face used for marking a misspelled word that appears twice in the buffer. See also `flyspell-duplicate-distance'." :group 'flyspell) +;; backward-compatibility alias +(put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate) (defvar flyspell-overlay nil) @@ -540,7 +544,7 @@ ;*---------------------------------------------------------------------*/ (defun flyspell-mode-on () "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." - (setq ispell-highlight-face 'flyspell-incorrect-face) + (setq ispell-highlight-face 'flyspell-incorrect) ;; local dictionaries setup (or ispell-local-dictionary ispell-dictionary (if flyspell-default-dictionary @@ -978,7 +982,7 @@ (setq r p) (goto-char p)))) r))) - + ;*---------------------------------------------------------------------*/ ;* flyspell-word-search-forward ... */ ;*---------------------------------------------------------------------*/ @@ -992,7 +996,7 @@ (setq r p) (goto-char (1+ p))))) r))) - + ;*---------------------------------------------------------------------*/ ;* flyspell-word ... */ ;*---------------------------------------------------------------------*/ @@ -1022,7 +1026,7 @@ flyspell-mark-duplications-flag (save-excursion (goto-char (1- start)) - (let ((p (flyspell-word-search-backward + (let ((p (flyspell-word-search-backward word (- start (1+ (- end start)))))) (and p (/= p (1- start)))))) @@ -1122,7 +1126,7 @@ (flyspell-notify-misspell start end word poss)) nil)))) ;; return to original location - (goto-char cursor-location) + (goto-char cursor-location) (if ispell-quit (setq ispell-quit nil)) res)))))))) @@ -1570,7 +1574,7 @@ (overlay-put flyspell-overlay flyspell-overlay-keymap-property-name flyspell-mouse-map)) - (when (eq face 'flyspell-incorrect-face) + (when (eq face 'flyspell-incorrect) (and (stringp flyspell-before-incorrect-word-string) (overlay-put flyspell-overlay 'before-string flyspell-before-incorrect-word-string)) @@ -1610,7 +1614,7 @@ ;; now we can use a new overlay (setq flyspell-overlay (make-flyspell-overlay - beg end 'flyspell-incorrect-face 'highlight))))))) + beg end 'flyspell-incorrect 'highlight))))))) ;*---------------------------------------------------------------------*/ ;* flyspell-highlight-duplicate-region ... */ @@ -1636,7 +1640,7 @@ ;; now we can use a new overlay (setq flyspell-overlay (make-flyspell-overlay beg end - 'flyspell-duplicate-face + 'flyspell-duplicate 'highlight))))))) ;*---------------------------------------------------------------------*/ @@ -1698,8 +1702,7 @@ (let ((num (car pos))) (put-text-property num (+ num (length flyspell-auto-correct-word)) - 'face - 'flyspell-incorrect-face + 'face 'flyspell-incorrect string)) (setq pos (cdr pos))) (if (fboundp 'display-message) @@ -1836,7 +1839,7 @@ (defun flyspell-auto-correct-previous-hook () "Hook to track successive calls to `flyspell-auto-correct-previous-word'. Sets `flyspell-auto-correct-previous-pos' to nil" - (interactive) + (interactive) (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) (unless (eq this-command (function flyspell-auto-correct-previous-word)) (setq flyspell-auto-correct-previous-pos nil))) @@ -1844,7 +1847,7 @@ ;*---------------------------------------------------------------------*/ ;* flyspell-auto-correct-previous-word ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-auto-correct-previous-word (position) +(defun flyspell-auto-correct-previous-word (position) "*Auto correct the first mispelled word that occurs before point. But don't look beyond what's visible on the screen." (interactive "d") @@ -1860,29 +1863,29 @@ (narrow-to-region top bot) (overlay-recenter (point)) - (add-hook 'pre-command-hook + (add-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t t) (unless flyspell-auto-correct-previous-pos ;; only reset if a new overlay exists (setq flyspell-auto-correct-previous-pos nil) - + (let ((overlay-list (overlays-in (point-min) position)) (new-overlay 'dummy-value)) - + ;; search for previous (new) flyspell overlay (while (and new-overlay (or (not (flyspell-overlay-p new-overlay)) ;; check if its face has changed - (not (eq (get-char-property - (overlay-start new-overlay) 'face) - 'flyspell-incorrect-face)))) + (not (eq (get-char-property + (overlay-start new-overlay) 'face) + 'flyspell-incorrect)))) (setq new-overlay (car-safe overlay-list)) (setq overlay-list (cdr-safe overlay-list))) - + ;; if nothing new exits new-overlay should be nil (if new-overlay ;; the length of the word may change so go to the start - (setq flyspell-auto-correct-previous-pos + (setq flyspell-auto-correct-previous-pos (overlay-start new-overlay))))) (when flyspell-auto-correct-previous-pos @@ -2131,9 +2134,9 @@ and return t. The third arg POSS is either the symbol 'doublon' or a list of -possible corrections as returned by 'ispell-parse-output'. +possible corrections as returned by `ispell-parse-output'. -This function is meant to be added to 'flyspell-incorrect-hook'." +This function is meant to be added to `flyspell-incorrect-hook'." (when (consp poss) (catch 'done (let ((str (buffer-substring beg end)) @@ -2161,9 +2164,9 @@ and return t. The third arg POSS is either the symbol 'doublon' or a list of -possible corrections as returned by 'ispell-parse-output'. +possible corrections as returned by `ispell-parse-output'. -This function is meant to be added to 'flyspell-incorrect-hook'." +This function is meant to be added to `flyspell-incorrect-hook'." (when (consp poss) (catch 'done (let ((str (buffer-substring beg end))
--- a/lisp/textmodes/ispell.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/ispell.el Wed Jun 15 23:32:15 2005 +0000 @@ -942,7 +942,7 @@ '(menu-item "Automatic spell checking (Flyspell)" flyspell-mode :help "Check spelling while you edit the text" - :button (:toggle . flyspell-mode))) + :button (:toggle . (bound-and-true-p flyspell-mode)))) (define-key ispell-menu-map [ispell-complete-word] '(menu-item "Complete Word" ispell-complete-word :help "Complete word at cursor using dictionary"))
--- a/lisp/textmodes/org.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/org.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,11 +1,11 @@ -;; org.el --- Outline-based notes management and organizer +;;; org.el --- Outline-based notes management and organizer ;; Carstens outline-mode for keeping track of everything. ;; Copyright (c) 2004, 2005 Free Software Foundation ;; ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 3.10 +;; Version: 3.11 ;; ;; This file is part of GNU Emacs. ;; @@ -80,6 +80,17 @@ ;; ;; Changes: ;; ------- +;; Version 3.11 +;; - Links inserted with C-c C-l are now by default enclosed in angle +;; brackets. See the new variable `org-link-format'. +;; - ">" terminates a link, this is a way to have several links in a line. +;; - Archiving of finished tasks. +;; - C-<up>/<down> bindings removed, to allow access to paragraph commands. +;; - Compatibility with CUA-mode (see variable `org-CUA-compatible'). +;; - Compatibility problems with viper-mode fixed. +;; - Improved html export of tables. +;; - Various clean-up changes. +;; ;; Version 3.10 ;; - Using `define-derived-mode' to derive `org-mode' from `outline-mode'. ;; @@ -157,7 +168,7 @@ ;;; Customization variables -(defvar org-version "3.10" +(defvar org-version "3.11" "The version number of the file org.el.") (defun org-version () (interactive) @@ -183,6 +194,44 @@ :tag "Org Startup" :group 'org) +(defcustom org-CUA-compatible nil + "Non-nil means use alternative key bindings for S-<cursor movement>. +Org-mode used S-<cursor movement> for changing timestamps and priorities. +S-<cursor movement> is also used for example by `CUA-mode' to select text. +If you want to use Org-mode together with `CUA-mode', Org-mode needs to use +alternative bindings. Setting this variable to t will replace the following +keys both in Org-mode and in the Org-agenda buffer. + +S-RET -> C-S-RET +S-up -> M-p +S-down -> M-n +S-left -> M-- +S-right -> M-+ + +If you do not like the alternative keys, take a look at the variable +`org-disputed-keys'. + +This option is only relevant at load-time of Org-mode. Changing it requires +a restart of Emacs to become effective." + :group 'org-startup + :type 'boolean) + +(defvar org-disputed-keys + '((S-up [(shift up)] [(meta ?p)]) + (S-down [(shift down)] [(meta ?n)]) + (S-left [(shift left)] [(meta ?-)]) + (S-right [(shift right)] [(meta ?+)]) + (S-return [(shift return)] [(control shift return)])) + "Keys for which Org-mode and other modes compete. +This is an alist, cars are symbols for lookup, 1st element is the default key, +second element will be used when `org-CUA-compatible' is t.") + +(defun org-key (key) + "Select a key according to `org-CUA-compatible'." + (nth (if org-CUA-compatible 2 1) + (or (assq key org-disputed-keys) + (error "Invalid Key %s in `org-key'" key)))) + (defcustom org-startup-folded t "Non-nil means, entering Org-mode will switch to OVERVIEW. This can also be configured on a per-file basis by adding one of @@ -382,26 +431,21 @@ If the file does not specify a category, then file's base name is used instead.") -(defun org-run-mode-hooks (&rest hooks) - "Call `run-mode-hooks' if it is available; otherwise call `run-hooks'." - (if (fboundp 'run-mode-hooks) - (apply 'run-mode-hooks hooks) - (apply 'run-hooks hooks))) - (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." (when (eq major-mode 'org-mode) (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"))) + '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" + "STARTUP" "ARCHIVE"))) (splitre "[ \t]+") - kwds int key value cat) + kwds int key value cat arch) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward re nil t) (setq key (match-string 1) value (match-string 2)) - (cond + (cond ((equal key "CATEGORY") (if (string-match "[ \t]+$" value) (setq value (replace-match "" t t value))) @@ -425,17 +469,23 @@ l var val) (while (setq l (assoc (pop opts) set)) (setq var (nth 1 l) val (nth 2 l)) - (set (make-local-variable var) val))))) + (set (make-local-variable var) val)))) + ((equal key "ARCHIVE") + (string-match " *$" value) + (setq arch (replace-match "" t t value)) + (remove-text-properties 0 (length arch) + '(face t fontified t) arch))) ))) (and cat (set (make-local-variable 'org-category) cat)) (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) + (and arch (set (make-local-variable 'org-archive-location) arch)) (and int (set (make-local-variable 'org-todo-interpretation) int))) ;; Compute the regular expressions and other local variables (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) org-todo-kwd-max-priority (1- (length org-todo-keywords)) org-ds-keyword-length (+ 2 (max (length org-deadline-string) (length org-scheduled-string))) - org-done-string + org-done-string (nth (1- (length org-todo-keywords)) org-todo-keywords) org-todo-regexp (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords @@ -469,6 +519,11 @@ :tag "Org Time" :group 'org) +(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") + "Formats for `format-time-string' which are used for time stamps. +It is not recommended to change this constant.") + + (defcustom org-deadline-warning-days 30 "No. of days before expiration during which a deadline becomes active. This variable governs the display in the org file." @@ -510,7 +565,7 @@ (defcustom org-select-agenda-window t "Non-nil means, after creating an agenda, move cursor into Agenda window. -When nil, cursor will remain in the current window." +When nil, cursor will remain in the current window." :group 'org-agenda :type 'boolean) @@ -546,7 +601,7 @@ When nil, date-less entries will only be shown if `org-agenda' is called with a prefix argument. When non-nil, the TODO entries will be listed at the top of the agenda, before -the entries for specific days." +the entries for specific days." :group 'org-agenda :type 'boolean) @@ -591,7 +646,7 @@ Leaving out `category-keep' would mean that items will be sorted across categories by priority." :group 'org-agenda - :type '(repeat + :type '(repeat (choice (const time-up) (const time-down) @@ -667,14 +722,26 @@ :group 'org-agenda :type 'boolean) -(defcustom org-agenda-time-grid +(defcustom org-agenda-time-grid '((daily today require-timed) "----------------" (800 1000 1200 1400 1600 1800 2000)) - "FIXME: document" + "The settings for time grid for agenda display. +This is a list of three items. The first item is again a list. It contains +symbols specifying conditions when the grid should be displayed: + + daily if the agenda shows a single day + weekly if the agenda shows an entire week + today show grid on current date, independent of daily/weekly display + require-timed show grid only if at least on item has a time specification + +The second item is a string which will be places behing the grid time. + +The third item is a list of integers, indicating the times that should have +a grid line." :group 'org-agenda - :type + :type '(list (set :greedy t :tag "Grid Display Options" (const :tag "Show grid in single day agenda display" daily) @@ -756,10 +823,6 @@ (const :tag "Everywhere except in headlines" t) )) -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - (defcustom org-show-following-heading t "Non-nil means, show heading following match in `org-occur'. When doing an `org-occur' it is useful to show the headline which @@ -770,12 +833,73 @@ :group 'org-structure :type 'boolean) +(defcustom org-archive-location "%s_archive::" + "The location where subtrees should be archived. +This string consists of two parts, separated by a double-colon. + +The first part is a file name - when omitted, archiving happens in the same +file. %s will be replaced by the current file name (without directory part). +Archiving to a different file is useful to keep archived entries from +contributing to the Org-mode Agenda. + +The part after the double colon is a headline. The archived entries will be +filed under that headline. When omitted, the subtrees are simply filed away +at the end of the file, as top-level entries. + +Here are a few examples: +\"%s_archive::\" + If the current file is Projects.org, archive in file + Projects.org_archive, as top-level trees. This is the default. + +\"::* Archived Tasks\" + Archive in the current file, under the top-level headline + \"* Archived Tasks\". + +\"~/org/archive.org::\" + Archive in file ~/org/archive.org (absolute path), as top-level trees. + +\"basement::** Finished Tasks\" + Archive in file ./basement (relative path), as level 3 trees + below the level 2 heading \"** Finished Tasks\". + +You may set this option on a per-file basis by adding to the buffer a +line like + +#+ARCHIVE: basement::** Finished Tasks" + :group 'org-structure + :type 'string) + +(defcustom org-archive-mark-done t + "Non-nil means, mark archived entries as DONE." + :group 'org-structure + :type 'boolean) + +(defcustom org-archive-stamp-time t + "Non-nil means, add a time stamp to archived entries. +The time stamp will be added directly after the TODO state keyword in the +first line, so it is probably best to use this in combinations with +`org-archive-mark-done'." + :group 'org-structure + :type 'boolean) (defgroup org-link nil "Options concerning links in Org-mode." :tag "Org Link" :group 'org) +(defcustom org-link-format "<%s>" + "Default format for linkes in the buffer. +This is a format string for printf, %s will be replaced by the link text. +If you want to make sure that your link is always properly terminated, +include angle brackets into this format, like \"<%s>\". Some people also +recommend an additional URL: prefix, so the format would be \"<URL:%s>\"." + :group 'org-link + :type '(choice + (const :tag "\"%s\" (e.g. http://www.there.com)" "%s") + (const :tag "\"<%s>\" (e.g. <http://www.there.com>)" "<%s>") + (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") + (string :tag "Other" :value "<%s>"))) + (defcustom org-allow-space-in-links t "Non-nil means, file names in links may contain space characters. When nil, it becomes possible to put several links into a line. @@ -1314,7 +1438,7 @@ :tag "Org Faces" :group 'org) -(defface org-level-1-face ;; font-lock-function-name-face +(defface org-level-1 ;; font-lock-function-name-face '((((type tty) (class color)) (:foreground "blue" :weight bold)) (((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) @@ -1322,7 +1446,7 @@ "Face used for level 1 headlines." :group 'org-faces) -(defface org-level-2-face ;; font-lock-variable-name-face +(defface org-level-2 ;; 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")) @@ -1330,7 +1454,7 @@ "Face used for level 2 headlines." :group 'org-faces) -(defface org-level-3-face ;; font-lock-keyword-face +(defface org-level-3 ;; font-lock-keyword-face '((((type tty) (class color)) (:foreground "cyan" :weight bold)) (((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) @@ -1338,7 +1462,7 @@ "Face used for level 3 headlines." :group 'org-faces) -(defface org-level-4-face ;; font-lock-comment-face +(defface org-level-4 ;; font-lock-comment-face '((((type tty pc) (class color) (background light)) (:foreground "red")) (((type tty pc) (class color) (background dark)) (:foreground "red1")) (((class color) (background light)) (:foreground "Firebrick")) @@ -1347,7 +1471,7 @@ "Face used for level 4 headlines." :group 'org-faces) -(defface org-level-5-face ;; font-lock-type-face +(defface org-level-5 ;; font-lock-type-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "ForestGreen")) (((class color) (background dark)) (:foreground "PaleGreen")) @@ -1355,7 +1479,7 @@ "Face used for level 5 headlines." :group 'org-faces) -(defface org-level-6-face ;; font-lock-constant-face +(defface org-level-6 ;; font-lock-constant-face '((((type tty) (class color)) (:foreground "magenta")) (((class color) (background light)) (:foreground "CadetBlue")) (((class color) (background dark)) (:foreground "Aquamarine")) @@ -1363,7 +1487,7 @@ "Face used for level 6 headlines." :group 'org-faces) -(defface org-level-7-face ;; font-lock-builtin-face +(defface org-level-7 ;; font-lock-builtin-face '((((type tty) (class color)) (:foreground "blue" :weight light)) (((class color) (background light)) (:foreground "Orchid")) (((class color) (background dark)) (:foreground "LightSteelBlue")) @@ -1371,7 +1495,7 @@ "Face used for level 7 headlines." :group 'org-faces) -(defface org-level-8-face ;; font-lock-string-face +(defface org-level-8 ;; font-lock-string-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "RosyBrown")) (((class color) (background dark)) (:foreground "LightSalmon")) @@ -1379,7 +1503,7 @@ "Face used for level 8 headlines." :group 'org-faces) -(defface org-warning-face ;; font-lock-warning-face +(defface org-warning ;; font-lock-warning-face '((((type tty) (class color)) (:foreground "red")) (((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Red1" :bold t)) @@ -1392,11 +1516,11 @@ "Non-nil means, change the face of a headline if it is marked DONE. Normally, only the TODO/DONE keyword indicates the state of a headline. When this is non-nil, the headline after the keyword is set to the -`org-headline-done-face' as an additional indication." +`org-headline-done' as an additional indication." :group 'org-faces :type 'boolean) -(defface org-headline-done-face ;; font-lock-string-face +(defface org-headline-done ;; font-lock-string-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "RosyBrown")) (((class color) (background dark)) (:foreground "LightSalmon")) @@ -1407,7 +1531,7 @@ ;; Inheritance does not yet work for xemacs. So we just copy... -(defface org-deadline-announce-face +(defface org-deadline-announce '((((type tty) (class color)) (:foreground "blue" :weight bold)) (((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) @@ -1415,7 +1539,7 @@ "Face for upcoming deadlines." :group 'org-faces) -(defface org-scheduled-today-face +(defface org-scheduled-today '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "DarkGreen")) (((class color) (background dark)) (:foreground "PaleGreen")) @@ -1423,7 +1547,7 @@ "Face for items scheduled for a certain day." :group 'org-faces) -(defface org-scheduled-previously-face +(defface org-scheduled-previously '((((type tty pc) (class color) (background light)) (:foreground "red")) (((type tty pc) (class color) (background dark)) (:foreground "red1")) (((class color) (background light)) (:foreground "Firebrick")) @@ -1432,7 +1556,7 @@ "Face for items scheduled previously, and not yet done." :group 'org-faces) -(defface org-link-face +(defface org-link '((((type tty) (class color)) (:foreground "cyan" :weight bold)) (((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) @@ -1440,7 +1564,7 @@ "Face for links." :group 'org-faces) -(defface org-done-face ;; font-lock-type-face +(defface org-done ;; font-lock-type-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "ForestGreen" :bold t)) (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) @@ -1448,7 +1572,7 @@ "Face used for DONE." :group 'org-faces) -(defface org-table-face ;; font-lock-function-name-face +(defface org-table ;; font-lock-function-name-face '((((type tty) (class color)) (:foreground "blue" :weight bold)) (((class color) (background light)) (:foreground "Blue")) (((class color) (background dark)) (:foreground "LightSkyBlue")) @@ -1456,7 +1580,7 @@ "Face used for tables." :group 'org-faces) -(defface org-time-grid-face ;; font-lock-variable-name-face +(defface org-time-grid ;; 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")) @@ -1466,14 +1590,14 @@ (defvar org-level-faces '( - org-level-1-face - org-level-2-face - org-level-3-face - org-level-4-face - org-level-5-face - org-level-6-face - org-level-7-face - org-level-8-face + org-level-1 + org-level-2 + org-level-3 + org-level-4 + org-level-5 + org-level-6 + org-level-7 + org-level-8 )) (defvar org-n-levels (length org-level-faces)) @@ -1539,7 +1663,7 @@ ;;;###autoload (define-derived-mode org-mode outline-mode "Org" - "Outline-based notes management and organizer, alias + "Outline-based notes management and organizer, alias \"Carstens outline-mode for keeping track of everything.\" Org-mode develops organizational tasks around a NOTES file which @@ -1568,6 +1692,9 @@ (make-local-hook 'before-change-functions) ;; needed for XEmacs (add-hook 'before-change-functions 'org-before-change-function nil 'local) + ;; Paragraph regular expressions + (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$") + (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)") ;; Inhibit auto-fill for headers, tables and fixed-width lines. (set (make-local-variable 'auto-fill-inhibit-regexp) (concat "\\*" @@ -1577,6 +1704,7 @@ (if org-enable-table-editor "|" "") (if org-enable-fixed-width-editor ":" "") "]")))) + (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) (if (and org-insert-mode-line-in-empty-file (interactive-p) (= (point-min) (point-max))) @@ -1591,25 +1719,38 @@ (let ((this-command 'org-cycle) (last-command 'org-cycle)) (org-cycle '(4)) (org-cycle '(4)))))))) +(defun org-fill-paragraph (&optional justify) + "Re-align a table, pass through to fill-paragraph if no table." + (save-excursion + (beginning-of-line 1) + (looking-at "\\s-*\\(|\\|\\+-+\\)"))) + ;;; Font-Lock stuff (defvar org-mouse-map (make-sparse-keymap)) -(define-key org-mouse-map +(define-key org-mouse-map (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) (define-key org-mouse-map (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) (require 'font-lock) -(defconst org-non-link-chars "\t\n\r|") +(defconst org-non-link-chars "\t\n\r|<>\000") (defconst org-link-regexp (if org-allow-space-in-links (concat - "\\(https?\\|ftp\\|mailto|\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^" org-non-link-chars "]+[^ " org-non-link-chars "]\\)") + "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^" org-non-link-chars "]+[^ " org-non-link-chars "]\\)") (concat "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ " org-non-link-chars "]+\\)") ) "Regular expression for matching links.") +(defconst org-link-maybe-angles-regexp + (concat "<?\\(" org-link-regexp "\\)>?") + "Matches a link and optionally surrounding angle brackets.") +(defconst org-protected-link-regexp + (concat "\000" org-link-regexp "\000") + "Matches a link and optionally surrounding angle brackets.") + (defconst org-ts-lengths (cons (length (format-time-string (car org-time-stamp-formats))) (length (format-time-string (cdr org-time-stamp-formats)))) @@ -1654,37 +1795,37 @@ (defun org-set-font-lock-defaults () (let ((org-font-lock-extra-keywords (list - '(org-activate-links (0 'org-link-face)) - '(org-activate-dates (0 'org-link-face)) + '(org-activate-links (0 'org-link)) + '(org-activate-dates (0 'org-link)) (list (concat "^\\*+[ \t]*" org-not-done-regexp) - '(1 'org-warning-face t)) - (list (concat "\\[#[A-Z]\\]") '(0 'org-warning-face t)) - (list (concat "\\<" org-deadline-string) '(0 'org-warning-face t)) - (list (concat "\\<" org-scheduled-string) '(0 'org-warning-face t)) + '(1 'org-warning t)) + (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) + (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) + (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'bold)) - ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" + ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'italic)) - ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" + ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'underline)) - '("\\<FIXME\\>" (0 'org-warning-face t)) + '("\\<FIXME\\>" (0 'org-warning t)) (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") - '(1 'org-warning-face t)) + '(1 'org-warning t)) '("^#.*" (0 'font-lock-comment-face t)) (if org-fontify-done-headline (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") - '(1 'org-done-face t) '(2 'org-headline-done-face t)) + '(1 'org-done t) '(2 'org-headline-done t)) (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") - '(1 'org-done-face t))) + '(1 'org-done t))) '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" - (1 'org-table-face t)) - '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) + (1 'org-table t)) + '("^[ \t]*\\(:.*\\)" (1 'org-table t))))) (set (make-local-variable 'org-font-lock-keywords) (append (if org-noutline-p ; FIXME: I am not sure if eval will work ; on XEmacs if noutline is ever ported '((eval . (list "^\\(\\*+\\).*" - 0 '(nth + 0 '(nth (% (- (match-end 1) (match-beginning 1) 1) org-n-levels) org-level-faces) @@ -1698,7 +1839,7 @@ (set (make-local-variable 'font-lock-defaults) '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) - + (defun org-unfontify-region (beg end &optional maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) @@ -1889,12 +2030,12 @@ (let ((cmds '(isearch-forward isearch-backward)) cmd) (while (setq cmd (pop cmds)) (substitute-key-definition cmd cmd org-goto-map global-map))) -(define-key org-goto-map [(return)] 'org-goto-ret) +(define-key org-goto-map "\C-m" 'org-goto-ret) (define-key org-goto-map [(left)] 'org-goto-left) (define-key org-goto-map [(right)] 'org-goto-right) (define-key org-goto-map [(?q)] 'org-goto-quit) (define-key org-goto-map [(control ?g)] 'org-goto-quit) -(define-key org-goto-map [(tab)] 'org-cycle) +(define-key org-goto-map "\C-i" 'org-cycle) (define-key org-goto-map [(down)] 'outline-next-visible-heading) (define-key org-goto-map [(up)] 'outline-previous-visible-heading) (define-key org-goto-map "n" 'outline-next-visible-heading) @@ -2098,7 +2239,7 @@ (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) (up-head (make-string (1- level) ?*))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover.")) + (if (= level 1) (error "Cannot promote to level 0. UNDO to recover")) (replace-match up-head nil t) (if org-adapt-indentation (org-fixup-indentation "^ " "" "^ ?\\S-")))) @@ -2279,15 +2420,21 @@ (- (match-end 0) (match-beginning 0))) (t nil))) (previous-level (save-excursion - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0)) - 1))) + (condition-case nil + (progn + (outline-previous-visible-heading 1) + (if (looking-at re) + (- (match-end 0) (match-beginning 0)) + 1)) + (error 1)))) (next-level (save-excursion - (outline-next-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0)) - 1))) + (condition-case nil + (progn + (outline-next-visible-heading 1) + (if (looking-at re) + (- (match-end 0) (match-beginning 0)) + 1)) + (error 1)))) (new-level (or force-level (max previous-level next-level))) (shift (if (or (= old-level -1) (= new-level -1) @@ -2346,6 +2493,102 @@ (throw 'exit nil))) t)))) +(defun org-archive-subtree () + "Move the current subtree to the archive. +The archive can be a certain top-level heading in the current file, or in +a different file. The tree will be moved to that location, the subtree +heading be marked DONE, and the current time will be added." + (interactive) + ;; Save all relevant TODO keyword-relatex variables + (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler + (tr-org-todo-keywords org-todo-keywords) + (tr-org-todo-interpretation org-todo-interpretation) + (tr-org-done-string org-done-string) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (this-buffer (current-buffer)) + file heading buffer level newfile-p) + (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) + (progn + (setq file (format (match-string 1 org-archive-location) + (file-name-nondirectory (buffer-file-name))) + heading (match-string 2 org-archive-location))) + (error "Invalid `org-archive-location'")) + (if (> (length file) 0) + (setq newfile-p (not (file-exists-p file)) + buffer (find-file-noselect file)) + (setq buffer (current-buffer))) + (unless buffer + (error "Cannot access file \"%s\"" file)) + (if (and (> (length heading) 0) + (string-match "^\\*+" heading)) + (setq level (match-end 0)) + (setq heading nil level 0)) + (save-excursion + (org-copy-subtree) ; We first only copy, in case something goes wrong + (set-buffer buffer) + ;; Enforce org-mode for the archive buffer + (if (not (eq major-mode 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t)) + (call-interactively 'org-mode))) + (when newfile-p + (goto-char (point-max)) + (insert (format "\nArchived entries from file %s\n\n" + (buffer-file-name this-buffer)))) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords tr-org-todo-keywords) + (org-todo-interpretation tr-org-todo-interpretation) + (org-done-string tr-org-done-string) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp)) + (goto-char (point-min)) + (if heading + (progn + (if (re-search-forward + (concat "\\(^\\|\r\\)" + (regexp-quote heading) "[ \t]*\\($\\|\r\\)") + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "\n" heading "\n") + (end-of-line 0)) + ;; Make the heading visible, and the following as well + (let ((org-show-following-heading t)) (org-show-hierarchy-above)) + (if (re-search-forward + (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") + nil t) + (progn (goto-char (match-beginning 0)) (insert "\n") + (beginning-of-line 0)) + (goto-char (point-max)) (insert "\n"))) + (goto-char (point-max)) (insert "\n")) + ;; Paste + (org-paste-subtree (1+ level)) + ;; Mark the entry as done, i.e. set to last work in org-todo-keywords + (if org-archive-mark-done + (org-todo (length org-todo-keywords))) + ;; Move cursor to right after the TODO keyword + (when org-archive-stamp-time + (beginning-of-line 1) + (looking-at org-todo-line-regexp) + (goto-char (or (match-end 2) (match-beginning 3))) + (insert "(" (format-time-string (cdr org-time-stamp-formats) + (current-time)) + ")")) + ;; Save the buffer, if it is not the same buffer. + (if (not (eq this-buffer buffer)) (save-buffer)))) + ;; Here we are back in the original buffer. Everything seems to have + ;; worked. So now cut the tree and finish up. + (org-cut-subtree) + (if (looking-at "[ \t]*$") (kill-line)) + (message "Subtree archived %s" + (if (eq this-buffer buffer) + (concat "under heading: " heading) + (concat "in file: " (abbreviate-file-name file)))))) + ;;; Completion (defun org-complete (&optional arg) @@ -2374,11 +2617,11 @@ (table (cond (opt (setq type :opt) - (mapcar (lambda (x) + (mapcar (lambda (x) (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) (cons (match-string 2 x) (match-string 1 x))) (org-split-string (org-get-current-options) "\n"))) - (texp + (texp (setq type :tex) org-html-entities) ((string-match "\\`\\*+[ \t]*\\'" @@ -2388,7 +2631,7 @@ (t (progn (ispell-complete-word arg) (throw 'exit nil))))) (completion (try-completion pattern table))) (cond ((eq completion t) - (if (equal type :opt) + (if (equal type :opt) (insert (substring (cdr (assoc (upcase pattern) table)) (length pattern))))) ((null completion) @@ -2396,7 +2639,7 @@ (ding)) ((not (string= pattern completion)) (delete-region beg end) - (if (string-match " +$" completion) + (if (string-match " +$" completion) (setq completion (replace-match "" t t completion))) (insert completion) (if (get-buffer-window "*Completions*") @@ -2633,9 +2876,9 @@ (save-match-data (if (not (string-match org-priority-regexp s)) (* 1000 (- org-lowest-priority org-default-priority)) - (* 1000 (- org-lowest-priority + (* 1000 (- org-lowest-priority (string-to-char (match-string 2 s))))))) - + ;;; Timestamps (defvar org-last-changed-timestamp nil) @@ -2667,7 +2910,7 @@ (setq time (let ((this-command this-command)) (org-read-date arg 'totime))) (and (org-at-timestamp-p) (replace-match - (setq org-last-changed-timestamp + (setq org-last-changed-timestamp (format-time-string fmt time)) t t)) (message "Timestamp updated")) @@ -2697,8 +2940,8 @@ While prompting, a calendar is popped up - you can also select the date with the mouse (button 1). The calendar shows a period of three -month. To scroll it to other months, use the keys `>' and `<'. -If you don't like the calendar, turn it off with +month. To scroll it to other months, use the keys `>' and `<'. +If you don't like the calendar, turn it off with \(setq org-popup-calendar-for-date-prompt nil). With optional argument TO-TIME, the date will immediately be converted @@ -2712,7 +2955,7 @@ ;; Default time is either today, or, when entering a range, ;; the range start. (if (save-excursion - (re-search-backward + (re-search-backward (concat org-ts-regexp "--\\=") (- (point) 20) t)) (apply @@ -2823,7 +3066,7 @@ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq ans1 (format-time-string "%Y-%m-%d" time))) (if (active-minibuffer-window) (exit-minibuffer)))) - + (defun org-check-deadlines (ndays) "Check if there are any deadlines due or past due. A deadline is considered due if it happens within `org-deadline-warning-days' @@ -2863,7 +3106,7 @@ (goto-char (point-at-bol)) (re-search-forward org-tr-regexp (point-at-eol) t)) (if (not (org-at-date-range-p)) - (error "Not at a time-stamp range, and none found in current line."))) + (error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) (ts2 (match-string 2)) (havetime (or (> (length ts1) 15) (> (length ts2) 15))) @@ -3096,6 +3339,7 @@ (defvar org-agenda-follow-mode nil) (defvar org-agenda-buffer-name "*Org Agenda*") (defvar org-agenda-redo-command nil) +(defvar org-agenda-mode-hook nil) ;;;###autoload (defun org-agenda-mode () @@ -3114,27 +3358,29 @@ (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) (add-hook 'pre-command-hook 'org-unhighlight nil 'local) (setq org-agenda-follow-mode nil) - (easy-menu-change + (easy-menu-change '("Agenda") "Agenda Files" (append - (list + (list ["Edit File List" (customize-variable 'org-agenda-files) t] "--") (mapcar 'org-file-menu-entry org-agenda-files))) (org-agenda-set-mode-name) - (org-run-mode-hooks 'org-agenda-mode-hook)) - -(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) -(define-key org-agenda-mode-map [(return)] 'org-agenda-switch-to) -(define-key org-agenda-mode-map " " 'org-agenda-show) + (apply + (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) + org-agenda-mode-hook)) + +(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto) +(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to) +(define-key org-agenda-mode-map " " 'org-agenda-show) (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) -(define-key org-agenda-mode-map "o" 'delete-other-windows) -(define-key org-agenda-mode-map "l" 'org-agenda-recenter) -(define-key org-agenda-mode-map "t" 'org-agenda-todo) -(define-key org-agenda-mode-map "." 'org-agenda-goto-today) -(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view) -(define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later) -(define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) +(define-key org-agenda-mode-map "o" 'delete-other-windows) +(define-key org-agenda-mode-map "l" 'org-agenda-recenter) +(define-key org-agenda-mode-map "t" 'org-agenda-todo) +(define-key org-agenda-mode-map "." 'org-agenda-goto-today) +(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view) +(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later) +(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) (let ((l '(1 2 3 4 5 6 7 8 9 0))) @@ -3168,15 +3414,15 @@ (define-key org-agenda-mode-map "H" 'org-agenda-holidays) (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) -(define-key org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) -(define-key org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) +(define-key org-agenda-mode-map (org-key 'S-up) 'org-agenda-priority-up) +(define-key org-agenda-mode-map (org-key 'S-down) 'org-agenda-priority-down) (define-key org-agenda-mode-map [(right)] 'org-agenda-later) (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) "Local keymap for agenda entries from Org-mode.") -(define-key org-agenda-keymap +(define-key org-agenda-keymap (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) (define-key org-agenda-keymap (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) @@ -3188,7 +3434,7 @@ ["Show" org-agenda-show t] ["Go To (other window)" org-agenda-goto t] ["Go To (one window)" org-agenda-switch-to t] - ["Follow Mode" org-agenda-follow-mode + ["Follow Mode" org-agenda-follow-mode :style toggle :selected org-agenda-follow-mode :active t] "--" ["Cycle TODO" org-agenda-todo t] @@ -3306,7 +3552,7 @@ (org-respect-restriction t) (past t) s e rtn d) - (setq org-agenda-redo-command + (setq org-agenda-redo-command (list 'progn (list 'switch-to-buffer-other-window (current-buffer)) (list 'org-timeline include-all))) @@ -3315,7 +3561,7 @@ (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (switch-to-buffer-other-window + (switch-to-buffer-other-window (get-buffer-create org-agenda-buffer-name)) (setq buffer-read-only nil) (erase-buffer) @@ -3330,7 +3576,7 @@ (setq date (calendar-gregorian-from-absolute d)) (setq s (point)) (if dotodo - (setq rtn (org-agenda-get-day-entries + (setq rtn (org-agenda-get-day-entries entry date :todo :timestamp)) (setq rtn (org-agenda-get-day-entries entry date :timestamp))) (if (or rtn (equal d today)) @@ -3340,7 +3586,7 @@ (calendar-month-name (extract-calendar-month date)) " " (number-to-string (extract-calendar-year date)) "\n") (put-text-property s (1- (point)) 'face - 'org-link-face) + 'org-link) (if (equal d today) (put-text-property s (1- (point)) 'org-today t)) (insert (org-finalize-agenda-entries rtn) "\n") @@ -3386,7 +3632,7 @@ (day-numbers (list start)) (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)) ;; Make the list of days (setq ndays (or ndays org-agenda-ndays) @@ -3398,7 +3644,7 @@ (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) (progn (delete-other-windows) - (switch-to-buffer-other-window + (switch-to-buffer-other-window (get-buffer-create org-agenda-buffer-name)))) (setq buffer-read-only nil) (erase-buffer) @@ -3416,10 +3662,10 @@ rtn (org-agenda-get-day-entries file date :todo)) (setq rtnall (append rtnall rtn)))) - (when rtnall + (when rtnall (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") (add-text-properties (point-min) (1- (point)) - (list 'face 'org-link-face)) + (list 'face 'org-link)) (insert (org-finalize-agenda-entries rtnall) "\n"))) (while (setq d (pop day-numbers)) (setq date (calendar-gregorian-from-absolute d) @@ -3449,13 +3695,13 @@ (calendar-month-name (extract-calendar-month date)) (extract-calendar-year date))) (put-text-property s (1- (point)) 'face - 'org-link-face) - (if rtnall (insert + 'org-link) + (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)) (setq buffer-read-only t) (if org-fit-agenda-window @@ -3545,7 +3791,7 @@ (error "Not allowed")) (setq org-agenda-ndays (if (equal org-agenda-ndays 1) 7 1)) - (org-agenda include-all-loc + (org-agenda include-all-loc (or (get-text-property (point) 'day) starting-day)) (org-agenda-set-mode-name) @@ -3560,7 +3806,7 @@ (if (not (re-search-forward "^\\S-" nil t arg)) (progn (backward-char 1) - (error "No next date after this line in this buffer."))) + (error "No next date after this line in this buffer"))) (goto-char (match-beginning 0))) (defun org-agenda-previous-date-line (&optional arg) @@ -3568,7 +3814,7 @@ (interactive "p") (beginning-of-line 1) (if (not (re-search-backward "^\\S-" nil t arg)) - (error "No previous date before this line in this buffer."))) + (error "No previous date before this line in this buffer"))) ;; Initialize the highlight (defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1)) @@ -3634,7 +3880,7 @@ "Get the (Emacs Calendar) diary entries for DATE." (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") (diary-display-hook '(fancy-diary-display)) - (list-diary-entries-hook + (list-diary-entries-hook (cons 'org-diary-default-entry list-diary-entries-hook)) entries (org-disable-diary t)) @@ -3658,12 +3904,12 @@ (kill-buffer fancy-diary-buffer))) (when entries (setq entries (org-split-string entries "\n")) - (setq entries - (mapcar + (setq entries + (mapcar (lambda (x) (setq x (org-format-agenda-item "" x "Diary" 'time)) ;; Extend the text properties to the beginning of the line - (add-text-properties + (add-text-properties 0 (length x) (text-properties-at (1- (length x)) x) x) @@ -3704,7 +3950,7 @@ 0 (length string) (list 'mouse-face 'highlight 'keymap org-agenda-keymap - 'help-echo + 'help-echo (format "mouse-2 or RET jump to diary file %s" (abbreviate-file-name (buffer-file-name))) @@ -3726,7 +3972,7 @@ These are the files which are being checked for agenda entries. Optional argument FILE means, use this file instead of the current. It is possible (but not recommended) to add this function to the -`org-mode-hook'." +`org-mode-hook'." (interactive) (catch 'exit (let* ((file (or file (buffer-file-name) @@ -3741,7 +3987,7 @@ org-agenda-files)))) (if (not present) (progn - (setq org-agenda-files + (setq org-agenda-files (cons afile org-agenda-files)) ;; Make sure custom.el does not end up with Org-mode (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) @@ -3758,7 +4004,7 @@ (let* ((file (or file (buffer-file-name))) (true-file (file-truename file)) (afile (abbreviate-file-name file)) - (files (delq nil (mapcar + (files (delq nil (mapcar (lambda (x) (if (equal true-file (file-truename x)) @@ -3843,7 +4089,7 @@ The function expects the lisp variables `entry' and `date' to be provided by the caller, because this is how the calendar works. Don't use this -function from a program - use `org-agenda-get-day-entries' instead." +function from a program - use `org-agenda-get-day-entries' instead." (org-agenda-maybe-reset-markers) (org-compile-agenda-prefix-format org-agenda-prefix-format) (setq args (or args '(:deadline :scheduled :timestamp))) @@ -3885,7 +4131,7 @@ (if (org-region-active-p) ;; Respect a region to restrict search (narrow-to-region (region-beginning) (region-end))) - ;; If we work for the calendar or many files, + ;; If we work for the calendar or many files, ;; get rid of any restriction (widen)) ;; The way we repeatedly append to `results' makes it O(n^2) :-( @@ -3936,7 +4182,7 @@ (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil - 'done-face 'org-done-face + 'done-face 'org-done 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -3951,7 +4197,7 @@ (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (point-at-bol)) txt (org-format-agenda-item "" (match-string 1)) - priority + priority (+ (org-get-priority txt) (if org-todo-kwd-priority-p (- org-todo-kwd-max-priority -2 @@ -4023,18 +4269,18 @@ (if deadlinep (add-text-properties 0 (length txt) - (list 'face - (if donep 'org-done-face 'org-warning-face) - 'undone-face 'org-warning-face - 'done-face 'org-done-face + (list 'face + (if donep 'org-done 'org-warning) + 'undone-face 'org-warning + 'done-face 'org-done 'priority (+ 100 priority)) txt) (if scheduledp (add-text-properties 0 (length txt) - (list 'face 'org-scheduled-today-face - 'undone-face 'org-scheduled-today-face - 'done-face 'org-done-face + (list 'face 'org-scheduled-today + 'undone-face 'org-scheduled-today + 'done-face 'org-done priority (+ 99 priority)) txt) (add-text-properties @@ -4083,19 +4329,19 @@ (setq txt org-agenda-no-heading-message)) (when txt (add-text-properties - 0 (length txt) - (append + 0 (length txt) + (append (list 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- 10 diff) (org-get-priority txt)) - 'face (cond ((<= diff 0) 'org-warning-face) - ((<= diff 5) 'org-scheduled-previously-face) + 'face (cond ((<= diff 0) 'org-warning) + ((<= diff 5) 'org-scheduled-previously) (t nil)) 'undone-face (cond - ((<= diff 0) 'org-warning-face) - ((<= diff 5) 'org-scheduled-previously-face) + ((<= diff 0) 'org-warning) + ((<= diff 5) 'org-scheduled-previously) (t nil)) - 'done-face 'org-done-face) + 'done-face 'org-done) props) txt) (push txt ee))))) @@ -4103,9 +4349,9 @@ (defun org-agenda-get-scheduled () "Return the scheduled information for agenda display." - (let* ((props (list 'face 'org-scheduled-previously-face - 'undone-face 'org-scheduled-previously-face - 'done-face 'org-done-face + (let* ((props (list 'face 'org-scheduled-previously + 'undone-face 'org-scheduled-previously + 'done-face 'org-done 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -4176,7 +4422,7 @@ (setq hdmarker (org-agenda-new-marker (match-end 1))) (goto-char (match-end 1)) (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item + (setq txt (org-format-agenda-item (format (if (= d1 d2) "" "(%d/%d): ") (1+ (- d0 d1)) (1+ (- d2 d1))) (match-string 1) nil (if (= d0 d1) timestr)))) @@ -4258,7 +4504,7 @@ (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. @@ -4271,7 +4517,7 @@ ;; 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) @@ -4283,7 +4529,7 @@ 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) @@ -4314,12 +4560,12 @@ (while (setq time (pop gridtimes)) (unless (and remove (member time have)) (setq time (int-to-string time)) - (push (org-format-agenda-item + (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)))) + (put-text-property + 1 (length (car new)) 'face 'org-time-grid (car new)))) (if (member 'time-up org-agenda-sorting-strategy) (append new list) (append list new))))) @@ -4357,7 +4603,7 @@ The optional STRING argument forces conversion into a 5 character wide string HH:MM." (save-match-data - (when + (when (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) @@ -4405,6 +4651,7 @@ (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." + ;; The following variables will be used when the form is evaluated. (let* ((time-up (org-cmp-time a b)) (time-down (if time-up (- time-up) nil)) (priority-up (org-cmp-priority a b)) @@ -4412,7 +4659,7 @@ (category-up (org-cmp-category a b)) (category-down (if category-up (- category-up) nil)) (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? - (cdr (assoc + (cdr (assoc (eval (cons 'or org-agenda-sorting-strategy)) '((-1 . t) (1 . nil) (nil . nil)))))) @@ -4427,7 +4674,7 @@ (defun org-agenda-goto (&optional highlight) "Go to the Org-mode file which contains the item at point." (interactive) - (let* ((marker (or (get-text-property (point) 'org-marker) + (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) @@ -4444,7 +4691,7 @@ (defun org-agenda-switch-to () "Go to the Org-mode file which contains the item at point." (interactive) - (let* ((marker (or (get-text-property (point) 'org-marker) + (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) @@ -4491,7 +4738,7 @@ (org-agenda-error))) (defun org-agenda-error () - (error "Command not allowed in this line.")) + (error "Command not allowed in this line")) (defvar org-last-heading-marker (make-marker) "Marker pointing to the headline that last changed its TODO state @@ -4558,7 +4805,7 @@ (beginning-of-line 1) (add-text-properties (point-at-bol) (point-at-eol) props) (if fixface - (add-text-properties + (add-text-properties (point-at-bol) (point-at-eol) (list 'face (if org-last-todo-state-is-todo @@ -4655,7 +4902,7 @@ All the standard commands work: block, weekly etc" (interactive) (require 'diary-lib) - (let* ((char (progn + (let* ((char (progn (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") (read-char-exclusive))) (cmd (cdr (assoc char @@ -4685,7 +4932,7 @@ (progn (fset 'calendar-cursor-to-date (lambda (&optional error) - (calendar-gregorian-from-absolute + (calendar-gregorian-from-absolute (get-text-property point 'day)))) (call-interactively cmd)) (fset 'calendar-cursor-to-date oldf))))) @@ -4708,7 +4955,7 @@ (progn (fset 'calendar-cursor-to-date (lambda (&optional error) - (calendar-gregorian-from-absolute + (calendar-gregorian-from-absolute (get-text-property point 'day)))) (call-interactively cmd)) (fset 'calendar-cursor-to-date oldf)))) @@ -4758,7 +5005,7 @@ (unless day (error "Don't know which date to convert")) (setq date (calendar-gregorian-from-absolute day)) - (setq s (concat + (setq s (concat "Gregorian: " (calendar-date-string date) "\n" "ISO: " (calendar-iso-date-string date) "\n" "Day of Yr: " (calendar-day-of-year-string date) "\n" @@ -4805,7 +5052,8 @@ (let (type path line (pos (point))) (save-excursion (skip-chars-backward - (if org-allow-space-in-links "^\t\n\r" "^ \t\n\r")) + (concat (if org-allow-space-in-links "^" "^ ") + org-non-link-chars)) (if (re-search-forward org-link-regexp (save-excursion @@ -4816,7 +5064,7 @@ (setq type (match-string 1) path (match-string 2))) (unless path - (error "No link found.")) + (error "No link found")) ;; Remove any trailing spaces in path (if (string-match " +\\'" path) (setq path (replace-match "" t t path))) @@ -4870,6 +5118,10 @@ ((string= type "shell") (let ((cmd path)) + (while (string-match "@{" cmd) + (setq cmd (replace-match "<" t t cmd))) + (while (string-match "@}" cmd) + (setq cmd (replace-match ">" t t cmd))) (if (or (not org-confirm-shell-links) (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) (shell-command cmd) @@ -4965,7 +5217,7 @@ (widen) (goto-char (point-max)) (if (re-search-backward - (concat "^Message-ID:\\s-+" (regexp-quote + (concat "^Message-ID:\\s-+" (regexp-quote (or article ""))) nil t) (rmail-what-message)))))) @@ -5001,7 +5253,7 @@ (cdr (assoc t apps))))) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) - (setq cmd (format cmd file)) + (setq cmd (format cmd (concat "\"" file "\""))) (save-window-excursion (shell-command (concat cmd " & &")))) ((or (stringp cmd) @@ -5047,10 +5299,12 @@ (cond ((eq major-mode 'bbdb-mode) - (setq link (concat "bbdb:" - (or (bbdb-record-name (bbdb-current-record)) - (bbdb-record-company (bbdb-current-record)))))) - + (setq cpltxt (concat + "bbdb:" + (or (bbdb-record-name (bbdb-current-record)) + (bbdb-record-company (bbdb-current-record)))) + link (org-make-link cpltxt))) + ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) (setq link @@ -5076,8 +5330,9 @@ folder) (setq folder (replace-match "" t t folder))) (setq cpltxt (concat author " on: " subject)) - (setq link (concat cpltxt "\n " "vm:" folder - "#" message-id))))) + (setq link (concat cpltxt "\n " + (org-make-link + "vm:" folder "#" message-id)))))) ((eq major-mode 'wl-summary-mode) (let* ((msgnum (wl-summary-message-number)) @@ -5088,8 +5343,10 @@ (author (wl-summary-line-from)) ; FIXME: how to get author name? (subject "???")) ; FIXME: How to get subject of email? (setq cpltxt (concat author " on: " subject)) - (setq link (concat cpltxt "\n " "wl:" wl-summary-buffer-folder-name - "#" message-id)))) + (setq link (concat cpltxt "\n " + (org-make-link + "wl:" wl-summary-buffer-folder-name + "#" message-id))))) ((eq major-mode 'rmail-mode) (save-excursion @@ -5100,8 +5357,9 @@ (author (mail-fetch-field "from")) (subject (mail-fetch-field "subject"))) (setq cpltxt (concat author " on: " subject)) - (setq link (concat cpltxt "\n " "rmail:" folder - "#" message-id)))))) + (setq link (concat cpltxt "\n " + (org-make-link + "rmail:" folder "#" message-id))))))) ((eq major-mode 'gnus-group-mode) (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus @@ -5109,11 +5367,12 @@ ((fboundp 'gnus-group-name) (gnus-group-name)) (t "???")))) - (setq link (concat - (if (org-xor arg org-usenet-links-prefer-google) - "http://groups.google.com/groups?group=" - "gnus:") - group)))) + (setq cpltxt (concat + (if (org-xor arg org-usenet-links-prefer-google) + "http://groups.google.com/groups?group=" + "gnus:") + group) + link (org-make-link cpltxt)))) ((memq major-mode '(gnus-summary-mode gnus-article-mode)) (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) @@ -5132,27 +5391,34 @@ cpltxt "\n " (format "http://groups.google.com/groups?as_umsgid=%s" (org-fixup-message-id-for-http message-id)))) - (setq link (concat cpltxt "\n" "gnus:" group - "#" (number-to-string article)))))) + (setq link (concat cpltxt "\n" + (org-make-link + "gnus:" group + "#" (number-to-string article))))))) ((eq major-mode 'w3-mode) - (setq link (url-view-url t))) + (setq cpltxt (url-view-url t) + link (org-make-link cpltxt))) ((eq major-mode 'w3m-mode) - (setq link w3m-current-url)) + (setq cpltxt w3m-current-url + link (org-make-link cpltxt))) ((buffer-file-name) ;; Just link to this file here. - (setq link (concat "file:" - (abbreviate-file-name (buffer-file-name)))) + (setq cpltxt (concat "file:" + (abbreviate-file-name (buffer-file-name)))) ;; Add the line number? (if (org-xor org-line-numbers-in-file-links arg) - (setq link - (concat link - ":" (int-to-string + (setq cpltxt + (concat cpltxt + ":" (int-to-string (+ (if (bolp) 1 0) (count-lines - (point-min) (point)))))))) + (point-min) (point))))))) + (setq link (org-make-link cpltxt))) + ((interactive-p) (error "Cannot link to a buffer which is not visiting a file")) + (t (setq link nil))) (if (and (interactive-p) link) @@ -5162,6 +5428,10 @@ (message "Stored: %s" (or cpltxt link))) link))) +(defun org-make-link (&rest strings) + "Concatenate STRINGS, format resulting string with `org-link-format'." + (format org-link-format (apply 'concat strings))) + (defun org-xor (a b) "Exclusive or." (if a (not b) b)) @@ -5206,7 +5476,8 @@ Completion can be used to select a link previously stored with `org-store-link'. When the empty string is entered (i.e. if you just press RET at the prompt), the link defaults to the most recently -stored link. +stored link. As SPC triggers completion in the minibuffer, you need to +use M-SPC or C-q SPC to force the insertion of a space character. With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be selected using completion. The path to the file will be relative to @@ -5230,15 +5501,20 @@ (let ((pwd (file-name-as-directory (expand-file-name ".")))) (cond ((equal complete-file '(16)) - (insert "file:" (abbreviate-file-name (expand-file-name link)))) + (insert + (org-make-link + "file:" (abbreviate-file-name (expand-file-name link))))) ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") (expand-file-name link)) - (insert "file:" (match-string 1 (expand-file-name link)))) - (t (insert "file:" link)))) + (insert + (org-make-link + "file:" (match-string 1 (expand-file-name link))))) + (t (insert (org-make-link "file:" link))))) (setq linktxt (cdr (assoc link org-stored-links))) (if (not org-keep-stored-link-after-insertion) (setq org-stored-links (delq (assoc link org-stored-links) org-stored-links))) + (if (not linktxt) (setq link (org-make-link link))) (let ((lines (org-split-string (or linktxt link) "\n"))) (insert (car lines)) (setq matched (string-match org-link-regexp (car lines))) @@ -5305,7 +5581,7 @@ also indented so that it starts in the same column as the headline \(i.e. after the stars). -See also the variable `org-reverse-note-order'." +See also the variable `org-reverse-note-order'." (catch 'quit (let* ((txt (buffer-substring (point-min) (point-max))) (fastp current-prefix-arg) @@ -5795,7 +6071,7 @@ non-empty field above. With argument N, use the Nth non-empty field. If the current field is not empty, it is copied down to the next row, and the cursor is moved with it. Therefore, repeating this command causes the -column to be filled row-by-row. +column to be filled row-by-row. If the variable `org-table-copy-increment' is non-nil and the field is an integer, it will be incremented while copying." (interactive "p") @@ -5886,7 +6162,7 @@ (defun org-table-goto-column (n &optional on-delim force) "Move the cursor to the Nth column in the current table line. With optional argument ON-DELIM, stop with point before the left delimiter -of the field. +of the field. If there are less than N fields, just go to after the last delimiter. However, when FORCE is non-nil, create new columns if necessary." (let ((pos (point-at-eol))) @@ -5906,7 +6182,8 @@ (if (looking-at " ") (forward-char 1)))))) (defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table." + "Return t if the cursor is inside an org-type table. +If TABLE-TYPE is non-nil, also chack for table.el-type tables." (if org-enable-table-editor (save-excursion (beginning-of-line 1) @@ -6086,7 +6363,7 @@ (if (not (org-at-table-p)) (progn (goto-char pos) - (error "Cannot move row further."))) + (error "Cannot move row further"))) (goto-char pos) (beginning-of-line 1) (setq pos (point)) @@ -6173,7 +6450,7 @@ (goto-char beg) (org-table-check-inside-data-field) (setq l01 (count-lines (point-min) (point)) - c01 (org-table-current-column)) + c01 (org-table-current-column)) (goto-char end) (org-table-check-inside-data-field) (setq l02 (count-lines (point-min) (point)) @@ -6194,7 +6471,7 @@ (setq l1 (1+ l1))))) (setq org-table-clip (nreverse region)) (if cut (org-table-align)))) - + (defun org-table-paste-rectangle () "Paste a rectangular region into a table. The upper right corner ends up in the current field. All involved fields @@ -6305,7 +6582,7 @@ (+ (length org-table-clip) arg) arg) (length org-table-clip))) - (setq org-table-clip + (setq org-table-clip (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") nil nlines))) (goto-char beg) @@ -6360,7 +6637,7 @@ (setq ll (org-do-wrap words w))) ll)) (t (error "Cannot wrap this"))))) - + (defun org-do-wrap (words width) "Create lines of maximum width WIDTH (in characters) from word list WORDS." @@ -6685,28 +6962,32 @@ ;;;###autoload (defun orgtbl-mode (&optional arg) - "The `org-mode' table editor as a minor mode for use in other modes." - (interactive) - (setq orgtbl-mode - (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) - (if orgtbl-mode - (progn - (set (make-local-variable (quote org-table-may-need-update)) t) - (make-local-hook (quote before-change-functions)) - (add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) - auto-fill-inhibit-regexp) - (set (make-local-variable 'auto-fill-inhibit-regexp) - (if auto-fill-inhibit-regexp - (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) - "[ \t]*|")) - (easy-menu-add orgtbl-mode-menu) - (run-hooks 'orgtbl-mode-hook)) - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (remove-hook 'before-change-functions 'org-before-change-function t) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all))) + "The `org-mode' table editor as a minor mode for use in other modes." + (interactive) + (if (eq major-mode 'org-mode) + ;; Exit without error, in case some hook functions calls this + ;; by accident in org-mode. + (message "Orgtbl-mode is not useful in org-mode, command ignored") + (setq orgtbl-mode + (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) + (if orgtbl-mode + (progn + (set (make-local-variable (quote org-table-may-need-update)) t) + (make-local-hook (quote before-change-functions)) + (add-hook 'before-change-functions 'org-before-change-function + nil 'local) + (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) + auto-fill-inhibit-regexp) + (set (make-local-variable 'auto-fill-inhibit-regexp) + (if auto-fill-inhibit-regexp + (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) + "[ \t]*|")) + (easy-menu-add orgtbl-mode-menu) + (run-hooks 'orgtbl-mode-hook)) + (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) + (remove-hook 'before-change-functions 'org-before-change-function t) + (easy-menu-remove orgtbl-mode-menu) + (force-mode-line-update 'all)))) ;; Install it as a minor mode. (put 'orgtbl-mode :included t) @@ -6715,7 +6996,9 @@ (defun orgtbl-make-binding (fun &rest keys) "Create a function for binding in the table minor mode." - (list 'lambda '(arg) '(interactive "p") + (list 'lambda '(arg) + (concat "Run `" (symbol-name fun) "' or the default binding.") + '(interactive "p") (list 'if '(org-at-table-p) (list 'call-interactively (list 'quote fun)) @@ -6734,29 +7017,30 @@ ;; Keybindings for the minor mode (let ((bindings - '(([(meta shift left)] org-table-delete-column) - ([(meta left)] org-table-move-column-left) - ([(meta right)] org-table-move-column-right) - ([(meta shift right)] org-table-insert-column) - ([(meta shift up)] org-table-kill-row) - ([(meta shift down)] org-table-insert-row) - ([(meta up)] org-table-move-row-up) - ([(meta down)] org-table-move-row-down) - ("\C-c\C-w" org-table-cut-region) - ("\C-c\M-w" org-table-copy-region) - ("\C-c\C-y" org-table-paste-rectangle) - ("\C-c-" org-table-insert-hline) - ([(shift tab)] org-table-previous-field) - ("\C-c\C-c" org-table-align) - ([(return)] org-table-next-row) - ([(shift return)] org-table-copy-down) - ([(meta return)] org-table-wrap-region) - ("\C-c\C-q" org-table-wrap-region) - ("\C-c?" org-table-current-column) - ("\C-c " org-table-blank-field) - ("\C-c+" org-table-sum) - ("\C-c|" org-table-toggle-vline-visibility) - ("\C-c=" org-table-eval-formula))) + (list + '([(meta shift left)] org-table-delete-column) + '([(meta left)] org-table-move-column-left) + '([(meta right)] org-table-move-column-right) + '([(meta shift right)] org-table-insert-column) + '([(meta shift up)] org-table-kill-row) + '([(meta shift down)] org-table-insert-row) + '([(meta up)] org-table-move-row-up) + '([(meta down)] org-table-move-row-down) + '("\C-c\C-w" org-table-cut-region) + '("\C-c\M-w" org-table-copy-region) + '("\C-c\C-y" org-table-paste-rectangle) + '("\C-c-" org-table-insert-hline) + '([(shift tab)] org-table-previous-field) + '("\C-c\C-c" org-table-align) + '("\C-m" org-table-next-row) + (list (org-key 'S-return) 'org-table-copy-down) + '([(meta return)] org-table-wrap-region) + '("\C-c\C-q" org-table-wrap-region) + '("\C-c?" org-table-current-column) + '("\C-c " org-table-blank-field) + '("\C-c+" org-table-sum) + '("\C-c|" org-table-toggle-vline-visibility) + '("\C-c=" org-table-eval-formula))) elt key fun cmd) (while (setq elt (pop bindings)) (setq key (car elt) @@ -6765,20 +7049,12 @@ (define-key orgtbl-mode-map key cmd))) ;; Special treatment needed for TAB and RET -;(define-key orgtbl-mode-map [(return)] -; (orgtbl-make-binding 'org-table-next-row [(return)] "\C-m")) -;(define-key orgtbl-mode-map "\C-m" -; (orgtbl-make-binding 'org-table-next-row "\C-m" [(return)])) -;(define-key orgtbl-mode-map [(tab)] -; (orgtbl-make-binding 'org-table-next-field [(tab)] "\C-i")) -;(define-key orgtbl-mode-map "\C-i" -; (orgtbl-make-binding 'org-table-next-field "\C-i" [(tab)])) - -(define-key orgtbl-mode-map [(return)] + +(define-key orgtbl-mode-map [(return)] (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) -(define-key orgtbl-mode-map "\C-m" +(define-key orgtbl-mode-map "\C-m" (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) -(define-key orgtbl-mode-map [(tab)] +(define-key orgtbl-mode-map [(tab)] (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) (define-key orgtbl-mode-map "\C-i" (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) @@ -6888,7 +7164,7 @@ ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) "--" ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Sum Column/Rectangle" org-table-sum + ["Sum Column/Rectangle" org-table-sum :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] )) @@ -7400,9 +7676,10 @@ (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) ".txt")) (buffer (find-file-noselect filename)) - (ore (concat + (ore (concat (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP" + '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" + "STARTUP" "ARCHIVE" "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) (if org-noutline-p "\\(\n\\|$\\)" ""))) s e) @@ -7457,6 +7734,7 @@ #+SEQ_TODO: %s #+TYP_TODO: %s #+STARTUP: %s %s +#+ARCHIVE: %s " (buffer-name) (user-full-name) user-mail-address org-export-default-language org-export-headline-levels @@ -7479,6 +7757,7 @@ (cdr (assoc org-startup-folded '((nil . "nofold")(t . "fold")(content . "content")))) (if org-startup-with-deadline-check "dlcheck" "nodlcheck") + org-archive-location )) (defun org-insert-export-options-template () @@ -7575,6 +7854,7 @@ (text nil) (lang-words nil) (head-count 0) cnt + (start 0) table-open type table-buffer table-orig-buffer ) @@ -7628,7 +7908,7 @@ ;; This is a headline (progn (setq level (- (match-end 1) (match-beginning 1)) - txt (save-match-data + txt (save-match-data (org-html-expand (match-string 3 line))) todo @@ -7672,8 +7952,15 @@ )) (setq head-count 0) (org-init-section-numbers) - (while (setq line (pop lines) origline line) + ;; Protect the links + (setq start 0) + (while (string-match org-link-maybe-angles-regexp line start) + (setq start (match-end 0)) + (setq line (replace-match + (concat "\000" (match-string 1 line) "\000") + t t line))) + ;; replace "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") (setq line (org-html-expand line)) @@ -7691,27 +7978,34 @@ (not (string-match "^[ \t]+\\(:.*\\)" (car lines)))) "<br>\n" "\n")))) - - (when (string-match org-link-regexp line) + (setq start 0) + (while (string-match org-protected-link-regexp line start) + (setq start (- (match-end 0) 2)) (setq type (match-string 1 line)) (cond ((member type '("http" "https" "ftp" "mailto" "news")) ;; standard URL (setq line (replace-match - "<a href=\"\\1:\\2\"><\\1:\\2></a>" +; "<a href=\"\\1:\\2\"><\\1:\\2></a>" + "<a href=\"\\1:\\2\">\\1:\\2</a>" nil nil line))) ((string= type "file") ;; FILE link - (let* ((filename (match-string 2 line)) + (abs-p (file-name-absolute-p filename)) + (thefile (if abs-p (expand-file-name filename) filename)) + (thefile (save-match-data + (if (string-match ":[0-9]+$" thefile) + (replace-match "" t t thefile) + thefile))) (file-is-image-p (save-match-data - (string-match (org-image-file-name-regexp) filename)))) + (string-match (org-image-file-name-regexp) thefile)))) (setq line (replace-match (if (and org-export-html-inline-images file-is-image-p) - "<img src=\"\\2\"/>" - "<a href=\"\\2\">\\1:\\2</a>") + (concat "<img src=\"" thefile "\"/>") + (concat "<a href=\"" thefile "\">\\1:\\2</a>")) nil nil line)))) ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) @@ -7809,20 +8103,15 @@ (let ((head (and org-export-highlight-first-table-line (delq nil (mapcar (lambda (x) (string-match "^[ \t]*|-" x)) - lines)))) - lastline line fields html empty) + (cdr lines))))) + line fields html) (setq html (concat org-export-html-table-tag "\n")) - (while (setq lastline line - line (pop lines)) - (setq empty " ") + (while (setq line (pop lines)) (catch 'next-line (if (string-match "^[ \t]*|-" line) - (if lastline - ;; A hline: simulate an empty table row instead. - (setq line (org-fake-empty-table-line lastline) - head nil - empty "") - ;; Ignore this line + (progn + (setq head nil) ;; head ends here, first time around + ;; ignore this line (throw 'next-line t))) ;; Break the line into fields (setq fields (org-split-string line "[ \t]*|[ \t]*")) @@ -7830,7 +8119,6 @@ html "<tr>" (mapconcat (lambda (x) - (if (equal x "") (setq x empty)) (if head (concat "<th>" x "</th>") (concat "<td valign=\"top\">" x "</td>"))) @@ -7903,7 +8191,7 @@ (insert (mapconcat 'identity lines "\n")) (goto-char (point-min)) (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table.")) + (error "Error processing table")) (table-recognize-table) (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) (table-generate-source 'html " org-tmp2 ") @@ -7919,9 +8207,9 @@ (r (if m (substring string m) ""))) ;; convert < to < and > to > (while (string-match "<" s) - (setq s (replace-match "<" nil nil s))) + (setq s (replace-match "<" t t s))) (while (string-match ">" s) - (setq s (replace-match ">" nil nil s))) + (setq s (replace-match ">" t t s))) (if org-export-html-expand (while (string-match "@<\\([^&]*\\)>" s) (setq s (replace-match "<\\1>" nil nil s)))) @@ -8130,7 +8418,6 @@ ;; i k @ expendable from outline-mode ;; 0123456789 ! $%^& * ()_{} " ~`' free -(define-key org-mode-map [(tab)] 'org-cycle) (define-key org-mode-map "\C-i" 'org-cycle) (define-key org-mode-map [(meta tab)] 'org-complete) (define-key org-mode-map "\M-\C-i" 'org-complete) @@ -8148,6 +8435,7 @@ (define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-special) (define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-special) (define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-special) +(define-key org-mode-map "\C-c$" 'org-archive-subtree) (define-key org-mode-map "\C-c\C-j" 'org-goto) (define-key org-mode-map "\C-c\C-t" 'org-todo) (define-key org-mode-map "\C-c\C-s" 'org-schedule) @@ -8170,21 +8458,19 @@ (define-key org-mode-map "\C-c[" 'org-add-file) (define-key org-mode-map "\C-c]" 'org-remove-file) (define-key org-mode-map "\C-c\C-r" 'org-timeline) -(define-key org-mode-map [(shift up)] 'org-shiftup) -(define-key org-mode-map [(shift down)] 'org-shiftdown) -(define-key org-mode-map [(shift left)] 'org-timestamp-down-day) -(define-key org-mode-map [(shift right)] 'org-timestamp-up-day) +(define-key org-mode-map (org-key 'S-up) 'org-shiftup) +(define-key org-mode-map (org-key 'S-down) 'org-shiftdown) +(define-key org-mode-map (org-key 'S-left) 'org-timestamp-down-day) +(define-key org-mode-map (org-key 'S-right) 'org-timestamp-up-day) (define-key org-mode-map "\C-c-" 'org-table-insert-hline) ;; The following line is e.g. necessary for German keyboards under Suse Linux (unless org-xemacs-p (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) (define-key org-mode-map [(shift tab)] 'org-shifttab) (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) -(define-key org-mode-map [(return)] 'org-return) -(define-key org-mode-map [(shift return)] 'org-table-copy-down) +(define-key org-mode-map "\C-m" 'org-return) +(define-key org-mode-map (org-key 'S-return) 'org-table-copy-down) (define-key org-mode-map [(meta return)] 'org-meta-return) -(define-key org-mode-map [(control up)] 'org-move-line-up) -(define-key org-mode-map [(control down)] 'org-move-line-down) (define-key org-mode-map "\C-c?" 'org-table-current-column) (define-key org-mode-map "\C-c " 'org-table-blank-field) (define-key org-mode-map "\C-c+" 'org-table-sum) @@ -8203,15 +8489,12 @@ (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) (define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) - -;; FIXME: Do we really need to save match data in these commands? -;; I would like to remove it in order to minimize impact. -;; Self-insert already does not preserve it. How much resources used by this??? - (defsubst org-table-p () (if (and (eq major-mode 'org-mode) font-lock-mode) - (eq (get-text-property (point) 'face) 'org-table-face) - (save-match-data (org-at-table-p)))) + (eq (get-text-property (point) 'face) 'org-table) + ;; (save-match-data (org-at-table-p)))) ; FIXME: OK to not use this? + (org-at-table-p))) + (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. @@ -8283,7 +8566,7 @@ (defun org-shiftcursor-error () "Throw an error because Shift-Cursor command was applied in wrong context." - (error "This command is only active in tables and on headlines.")) + (error "This command is only active in tables and on headlines")) (defun org-shifttab () "Call `(org-cycle t)' or `org-table-previous-field'." @@ -8414,7 +8697,7 @@ (if (y-or-n-p "Convert inactive region to table? ") (org-table-convert-region (region-beginning) (region-end) arg) (error "Abort"))) - (t (error "No table at point, and no region to make one."))))) + (t (error "No table at point, and no region to make one"))))) (defun org-return () "Call `org-table-next-row' or `newline'." @@ -8473,7 +8756,9 @@ ["Promote Heading" org-metaleft (not (org-at-table-p))] ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]) + ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] + "--" + ["Archive Subtree" org-archive-subtree t]) "--" ("TODO Lists" ["TODO/DONE/-" org-todo t] @@ -8537,7 +8822,7 @@ ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) "--" ["Which Column?" org-table-current-column (org-at-table-p)] - ["Sum Column/Rectangle" org-table-sum + ["Sum Column/Rectangle" org-table-sum (or (org-at-table-p) (org-region-active-p))] ["Eval Formula" org-table-eval-formula (org-at-table-p)] "--" @@ -8580,10 +8865,10 @@ (Info-goto-node (format "(org)%s" (or node "")))) (defun org-install-agenda-files-menu () - (easy-menu-change + (easy-menu-change '("Org") "File List for Agenda" (append - (list + (list ["Edit File List" (customize-variable 'org-agenda-files) t] ["Add Current File to List" org-add-file t] ["Remove Current File from List" org-remove-file t] @@ -8698,7 +8983,7 @@ ;; Functions needed for compatibility with old outline.el ;; The following functions capture almost the entire compatibility code -;; between the different versions of outline-mode. The only other place +;; between the different versions of outline-mode. The only other place ;; where this is important are the font-lock-keywords. Search for ;; `org-noutline-p' to find it. @@ -8738,11 +9023,11 @@ (outline-back-to-heading invisible-ok) (if (looking-at outline-regexp) t - (if (re-search-backward (concat (if invisible-ok "[\r\n]" "^") + (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") outline-regexp) nil t) (if invisible-ok - (progn (forward-char 1) + (progn (goto-char (match-end 1)) (looking-at outline-regexp))) (error "Before first heading"))))) @@ -8763,7 +9048,7 @@ This function considers both visible and invisible heading lines. With argument, move up ARG levels." (if org-noutline-p - (if (fboundp 'outline-up-heading-all) + (if (fboundp 'outline-up-heading-all) (outline-up-heading-all arg) ; emacs 21 version of outline.el (outline-up-heading arg t)) ; emacs 22 version of outline.el (org-back-to-heading t) @@ -8819,8 +9104,8 @@ (defun org-show-subtree () "Show everything after this heading at deeper levels." - (outline-flag-region - (point) + (outline-flag-region + (point) (save-excursion (outline-end-of-subtree) (outline-next-heading) (point)) (if org-noutline-p nil ?\n))) @@ -8831,7 +9116,7 @@ (interactive) (save-excursion (org-back-to-heading t) - (outline-flag-region + (outline-flag-region (1- (point)) (save-excursion (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) @@ -8864,6 +9149,4 @@ (run-hooks 'org-load-hook) ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd - ;;; org.el ends here -
--- a/lisp/textmodes/reftex-toc.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/reftex-toc.el Wed Jun 15 23:32:15 2005 +0000 @@ -149,7 +149,7 @@ (frame-parameter (selected-frame) 'unsplittable))) offset toc-window) - (if (setq toc-window (get-buffer-window + (if (setq toc-window (get-buffer-window "*toc*" (if reuse 'visible))) (select-window toc-window) @@ -165,7 +165,7 @@ (split-window-horizontally (floor (* (window-width) reftex-toc-split-windows-fraction))) - (split-window-vertically + (split-window-vertically (floor (* (window-height) reftex-toc-split-windows-fraction))))) @@ -210,11 +210,11 @@ reftex-toc-include-context nil ; counter nil ; commented - here-I-am + here-I-am "" ; xr-prefix t ; a toc buffer )) - + (run-hooks 'reftex-display-copied-context-hook) (message "Building *toc* buffer...done.") (setq buffer-read-only t)) @@ -226,7 +226,7 @@ t reftex-toc-include-index-entries reftex-toc-include-file-boundaries) - (reftex-last-assoc-before-elt + (reftex-last-assoc-before-elt 'toc here-I-am (symbol-value reftex-docstruct-symbol)))) (put 'reftex-toc :reftex-line 3) @@ -251,7 +251,7 @@ (not (get-text-property (point) 'intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 - (or (previous-single-property-change + (or (previous-single-property-change (min (point-max) (1+ (point))) :data) (point-min)) (or (next-single-property-change (point) :data) @@ -298,16 +298,16 @@ (window-height)))))) (defun reftex-toc-dframe-p (&optional frame error) - ;; Check if FRAME is the dedicated TOC frame. + ;; Check if FRAME is the dedicated TOC frame. ;; If yes, and ERROR is non-nil, throw an error. (setq frame (or frame (selected-frame))) - (let ((res (equal + (let ((res (equal (if (fboundp 'frame-property) (frame-property frame 'name) (frame-parameter frame 'name)) "RefTeX TOC Frame"))) (if (and res error) - (error "This frame is view-only. Use `C-c =' to create toc window for commands.")) + (error "This frame is view-only. Use `C-c =' to create toc window for commands")) res)) (defun reftex-toc-show-help () @@ -327,7 +327,7 @@ (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) (setq reftex-callback-fwd t) (or (eobp) (forward-char 1)) - (goto-char (or (next-single-property-change (point) :data) + (goto-char (or (next-single-property-change (point) :data) (point)))) (defun reftex-toc-previous (&optional arg) "Move to previous selectable item." @@ -364,7 +364,7 @@ With prefix ARG, prompt for a label type and include only labels of that specific type." (interactive "P") - (setq reftex-toc-include-labels + (setq reftex-toc-include-labels (if arg (reftex-query-label-type) (not reftex-toc-include-labels))) (reftex-toc-revert)) @@ -468,7 +468,7 @@ (defun reftex-toc-rescan (&rest ignore) "Regenerate the *toc* buffer by reparsing file of section at point." (interactive) - (if (and reftex-enable-partial-scans + (if (and reftex-enable-partial-scans (null current-prefix-arg)) (let* ((data (get-text-property (point) :data)) (what (car data)) @@ -502,7 +502,7 @@ (defun reftex-toc-revert (&rest ignore) "Regenerate the *toc* from the internal lists." (interactive) - (let ((unsplittable + (let ((unsplittable (if (fboundp 'frame-property) (frame-property (selected-frame) 'unsplittable) (frame-parameter (selected-frame) 'unsplittable))) @@ -589,7 +589,7 @@ (goto-char start-pos) (setq sections (reftex-toc-extract-section-number (car entries))) (if (> (setq nsec (length entries)) 1) - (setq sections + (setq sections (concat sections "-" (reftex-toc-extract-section-number (nth (1- nsec) entries))))) @@ -614,7 +614,7 @@ (save-window-excursion (reftex-toc-Rescan)) (reftex-toc-restore-region start-line mark-line) - (message "%d section%s %smoted" + (message "%d section%s %smoted" nsec (if (= 1 nsec) "" "s") pro-or-de) nil)) (if msg (progn (ding) (message msg))))) @@ -667,7 +667,7 @@ (beginning-of-line 1) (if (looking-at reftex-section-regexp) (setq name (reftex-match-string 2)) - (error "Something is wrong! Contact maintainer!"))) + (error "Something is wrong! Contact maintainer!"))) ;; Section has changed, request scan and loading ;; We use a variable to delay until after the safe-exc. ;; because otherwise we loose the region. @@ -776,7 +776,7 @@ (error "This is not a label entry.")) (setq newlabel (read-string (format "Rename label \"%s\" to:" label))) (if (assoc newlabel (symbol-value reftex-docstruct-symbol)) - (if (not (y-or-n-p + (if (not (y-or-n-p (format "Label '%s' exists. Use anyway? " label))) (error "Abort"))) (save-excursion @@ -786,7 +786,7 @@ (reftex-query-replace-document (concat "{" (regexp-quote label) "}") (format "{%s}" newlabel)) - (error t)))) + (error t)))) (reftex-toc-rescan))) @@ -805,9 +805,9 @@ show-window show-buffer match) (unless toc (error "Don't know which toc line to visit")) - + (cond - + ((eq (car toc) 'toc) ;; a toc entry (setq match (reftex-toc-find-section toc no-revisit))) @@ -823,7 +823,7 @@ (file (nth 1 toc))) (if (or (not no-revisit) (reftex-get-buffer-visiting file)) (progn - (switch-to-buffer-other-window + (switch-to-buffer-other-window (reftex-get-file-buffer-force file nil)) (goto-char (if (eq where 'bof) (point-min) (point-max)))) (message reftex-no-follow-message) nil)))) @@ -876,8 +876,8 @@ (looking-at (reftex-make-desperate-section-regexp literal)) (looking-at (concat "\\\\" (regexp-quote - (car - (rassq level + (car + (rassq level reftex-section-levels-all))) "[[{]?")))) ((or (not no-revisit) @@ -1047,7 +1047,7 @@ (define-key reftex-toc-map (vector (list key)) 'digit-argument)) (define-key reftex-toc-map "-" 'negative-argument) -(easy-menu-define +(easy-menu-define reftex-toc-menu reftex-toc-map "Menu for Table of Contents buffer" '("TOC" @@ -1080,7 +1080,7 @@ ["Context" reftex-toc-toggle-context :style toggle :selected reftex-toc-include-context] "--" - ["Follow Mode" reftex-toc-toggle-follow :style toggle + ["Follow Mode" reftex-toc-toggle-follow :style toggle :selected reftex-toc-follow-mode] ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle :selected reftex-toc-auto-recenter-timer]
--- a/lisp/textmodes/reftex.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/reftex.el Wed Jun 15 23:32:15 2005 +0000 @@ -26,7 +26,7 @@ ;;--------------------------------------------------------------------------- ;; ;;; Commentary: -;; +;; ;; RefTeX is a minor mode with distinct support for \ref, \label, \cite, ;; and \index commands in (multi-file) LaTeX documents. ;; - A table of contents provides easy access to any part of a document. @@ -71,7 +71,7 @@ ;; ;; Introduction ;; ************ -;; +;; ;; RefTeX is a specialized package for support of labels, references, ;; citations, and the index in LaTeX. RefTeX wraps itself round 4 LaTeX ;; macros: `\label', `\ref', `\cite', and `\index'. Using these macros @@ -80,13 +80,13 @@ ;; time-consuming tasks almost entirely. It also provides functions to ;; display the structure of a document and to move around in this ;; structure quickly. -;; +;; ;; *Note Imprint::, for information about who to contact for help, bug ;; reports or suggestions. -;; +;; ;; Environment ;; =========== -;; +;; ;; RefTeX needs to access all files which are part of a multifile ;; document, and the BibTeX database files requested by the ;; `\bibliography' command. To find these files, RefTeX will require a @@ -95,26 +95,26 @@ ;; which are also used by RefTeX. However, on some systems these ;; variables do not contain the full search path. If RefTeX does not work ;; for you because it cannot find some files, read *Note Finding Files::. -;; +;; ;; Entering RefTeX Mode ;; ==================== -;; +;; ;; To turn RefTeX Mode on and off in a particular buffer, use `M-x ;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the ;; following lines to your `.emacs' file: -;; +;; ;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode ;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode -;; +;; ;; RefTeX in a Nutshell ;; ==================== -;; +;; ;; 1. Table of Contents ;; Typing `C-c =' (`reftex-toc') will show a table of contents of the ;; document. This buffer can display sections, labels and index ;; entries defined in the document. From the buffer, you can jump ;; quickly to every part of your document. Press `?' to get help. -;; +;; ;; 2. Labels and References ;; RefTeX helps to create unique labels and to find the correct key ;; for references quickly. It distinguishes labels for different @@ -122,7 +122,7 @@ ;; others), and can be configured to recognize any additional labeled ;; environments you have defined yourself (variable ;; `reftex-label-alist'). -;; +;; ;; * Creating Labels ;; Type `C-c (' (`reftex-label') to insert a label at point. ;; RefTeX will either @@ -131,17 +131,17 @@ ;; tables) or ;; - insert a simple label made of a prefix and a number (all ;; other environments) -;; +;; ;; Which labels are created how is configurable with the variable ;; `reftex-insert-label-flags'. -;; +;; ;; * Referencing Labels ;; To make a reference, type `C-c )' (`reftex-reference'). This ;; shows an outline of the document with all labels of a certain ;; type (figure, equation,...) and some label context. ;; Selecting a label inserts a `\ref{LABEL}' macro into the ;; original buffer. -;; +;; ;; 3. Citations ;; Typing `C-c [' (`reftex-citation') will let you specify a regular ;; expression to search in current BibTeX database files (as @@ -150,7 +150,7 @@ ;; sorted. The selected article is referenced as `\cite{KEY}' (see ;; the variable `reftex-cite-format' if you want to insert different ;; macros). -;; +;; ;; 4. Index Support ;; RefTeX helps to enter index entries. It also compiles all entries ;; into an alphabetically sorted `*Index*' buffer which you can use @@ -158,25 +158,25 @@ ;; index macros and can be configured to recognize any additional ;; macros you have defined (`reftex-index-macros'). Multiple indices ;; are supported. -;; +;; ;; * Creating Index Entries ;; To index the current selection or the word at point, type ;; `C-c /' (`reftex-index-selection-or-word'). The default macro ;; `reftex-index-default-macro' will be used. For a more ;; complex entry type `C-c <' (`reftex-index'), select any of ;; the index macros and enter the arguments with completion. -;; +;; ;; * The Index Phrases File (Delayed Indexing) ;; Type `C-c \' (`reftex-index-phrase-selection-or-word') to add ;; the current word or selection to a special _index phrase ;; file_. RefTeX can later search the document for occurrences ;; of these phrases and let you interactively index the matches. -;; +;; ;; * Displaying and Editing the Index ;; To display the compiled index in a special buffer, type `C-c ;; >' (`reftex-display-index'). From that buffer you can check ;; and edit all entries. -;; +;; ;; 5. Viewing Cross-References ;; When point is on the KEY argument of a cross-referencing macro ;; (`\label', `\ref', `\cite', `\bibitem', `\index', and variations) @@ -186,14 +186,14 @@ ;; When the enclosing macro is `\cite' or `\ref' and no other message ;; occupies the echo area, information about the citation or label ;; will automatically be displayed in the echo area. -;; +;; ;; 6. Multifile Documents ;; Multifile Documents are fully supported. The included files must ;; have a file variable `TeX-master' or `tex-main-file' pointing to ;; the master file. RefTeX provides cross-referencing information ;; from all parts of the document, and across document borders ;; (`xr.sty'). -;; +;; ;; 7. Document Parsing ;; RefTeX needs to parse the document in order to find labels and ;; other information. It does it automatically once and updates its @@ -202,23 +202,23 @@ ;; with a raw `C-u' prefix, or press the `r' key in the label ;; selection buffer, the table of contents buffer, or the index ;; buffer. -;; +;; ;; 8. AUCTeX ;; If your major LaTeX mode is AUCTeX, RefTeX can cooperate with it ;; (see variable `reftex-plug-into-AUCTeX'). AUCTeX contains style ;; files which trigger appropriate settings in RefTeX, so that for ;; many of the popular LaTeX packages no additional customizations ;; will be necessary. -;; +;; ;; 9. Useful Settings ;; To make RefTeX faster for large documents, try these: ;; (setq reftex-enable-partial-scans t) ;; (setq reftex-save-parse-info t) ;; (setq reftex-use-multiple-selection-buffers t) -;; +;; ;; To integrate with AUCTeX, use ;; (setq reftex-plug-into-AUCTeX t) -;; +;; ;; To make your own LaTeX macro definitions known to RefTeX, ;; customize the variables ;; `reftex-label-alist' (for label macros/environments) @@ -228,7 +228,7 @@ ;; `reftex-index-default-macro' (to set the default macro) ;; If you have a large number of macros defined, you may want to write ;; an AUCTeX style file to support them with both AUCTeX and RefTeX. -;; +;; ;; 10. Where Next? ;; Go ahead and use RefTeX. Use its menus until you have picked up ;; the key bindings. For an overview of what you can do in each of @@ -237,7 +237,7 @@ ;; The first part of the manual explains in a tutorial way how to use ;; and customize RefTeX. The second part is a command and variable ;; reference. -;; +;; ;;--------------------------------------------------------------------------- ;; ;; AUTHOR @@ -319,7 +319,7 @@ (setq reftex-syntax-table (copy-syntax-table)) (modify-syntax-entry ?\( "." reftex-syntax-table) (modify-syntax-entry ?\) "." reftex-syntax-table)) - + (unless reftex-syntax-table-for-bib (setq reftex-syntax-table-for-bib (copy-syntax-table reftex-syntax-table)) @@ -395,7 +395,7 @@ (setq reftex-syntax-table (copy-syntax-table (syntax-table))) (modify-syntax-entry ?\( "." reftex-syntax-table) (modify-syntax-entry ?\) "." reftex-syntax-table) - + (setq reftex-syntax-table-for-bib (copy-syntax-table reftex-syntax-table)) (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) @@ -536,7 +536,7 @@ ((master (cond ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism. - (condition-case nil + (condition-case nil (TeX-master-file t) (error (buffer-file-name)))) ((fboundp 'tex-main-file) (tex-main-file)) ; Emacs LaTeX mode @@ -737,14 +737,14 @@ ;; A list of all variables in the cache. ;; The cache is used to save the compiled versions of some variables. -(defconst reftex-cache-variables +(defconst reftex-cache-variables '(reftex-memory ;; This MUST ALWAYS be the first! - + ;; Outline reftex-section-levels-all ;; Labels - reftex-env-or-mac-alist + reftex-env-or-mac-alist reftex-special-env-parsers reftex-macros-with-labels reftex-label-mac-list @@ -761,7 +761,7 @@ reftex-index-macro-alist reftex-macros-with-index reftex-query-index-macro-prompt - reftex-query-index-macro-help + reftex-query-index-macro-help reftex-key-to-index-macro-alist ;; Regular expressions @@ -806,7 +806,7 @@ (t (reftex-compile-variables))))) (defun reftex-reset-mode () - "Reset RefTeX Mode. + "Reset RefTeX Mode. This will re-compile the configuration information and remove all current scanning information and the parse file to enforce a rescan on next use." @@ -857,12 +857,12 @@ (defun reftex-erase-all-selection-and-index-buffers () ;; Remove all selection buffers associated with current document. - (mapcar + (mapcar (lambda (type) (reftex-erase-buffer (reftex-make-selection-buffer-name type))) reftex-typekey-list) ;; Kill all index buffers - (mapcar + (mapcar (lambda (tag) (reftex-kill-buffer (reftex-make-index-buffer-name tag))) (cdr (assoc 'index-tags (symbol-value reftex-docstruct-symbol))))) @@ -878,7 +878,7 @@ ;; Record that we have done this, and what we have used. (setq reftex-tables-dirty nil) - (setq reftex-memory + (setq reftex-memory (list reftex-label-alist (get reftex-docstruct-symbol 'reftex-section-levels) (get reftex-docstruct-symbol 'reftex-label-alist-style) @@ -897,7 +897,7 @@ '(nil))) (all-index (reftex-uniquify-by-car (reftex-splice-symbols-into-list - (append reftex-index-macros + (append reftex-index-macros (get reftex-docstruct-symbol 'reftex-index-macros-style) '(default)) @@ -908,7 +908,7 @@ macro verify repeat nindex tag key toc-level toc-levels) (setq reftex-words-to-typekey-alist nil - reftex-prefix-to-typekey-alist + reftex-prefix-to-typekey-alist '(("sec:" . "s") ("cha:" . "s") ("chap:" . "s")) reftex-typekey-list nil reftex-typekey-to-format-alist nil @@ -964,7 +964,7 @@ ((symbolp env-or-mac) ;; A special parser function (unless (fboundp env-or-mac) - (message "Warning: %s does not seem to be a valid function" + (message "Warning: %s does not seem to be a valid function" env-or-mac)) (setq nargs nil nlabel nil opt-args nil) (add-to-list 'reftex-special-env-parsers env-or-mac) @@ -992,8 +992,8 @@ (push (cons string toc-level) toc-levels)))))))) ;; Translate some special context cases (when (assq context reftex-default-context-regexps) - (setq context - (format + (setq context + (format (cdr (assq context reftex-default-context-regexps)) (regexp-quote env-or-mac)))) ;; See if this is the first format for this typekey @@ -1026,7 +1026,7 @@ (nreverse reftex-typekey-to-prefix-alist)) ;; Prepare the typekey query prompt and help string. - (setq qh-list + (setq qh-list (sort qh-list (lambda (x1 x2) (string< (downcase (car x1)) (downcase (car x2)))))) @@ -1037,7 +1037,7 @@ "]")) ;; In the help string, we need to wrap lines... (setq reftex-type-query-help - (concat + (concat "SELECT A LABEL TYPE:\n--------------------\n" (mapconcat (lambda(x) @@ -1057,7 +1057,7 @@ ;; which allow for some chars from the ref format to be in the buffer. ;; These characters will be seen and removed. (setq reftex-words-to-typekey-alist - (mapcar + (mapcar (lambda (x) (setq word (car x) typekey (cdr x) @@ -1110,18 +1110,18 @@ (setq reftex-key-to-index-macro-alist (sort reftex-key-to-index-macro-alist (lambda (a b) (< (downcase (car a)) (downcase (car b)))))) - (setq reftex-query-index-macro-prompt + (setq reftex-query-index-macro-prompt (concat "Index macro: [" (mapconcat (lambda (x) (char-to-string (car x))) reftex-key-to-index-macro-alist "") "]")) (setq i 0 reftex-query-index-macro-help - (concat + (concat "SELECT A MACRO:\n---------------\n" (mapconcat (lambda(x) - (format "[%c] %-20.20s%s" (car x) (nth 1 x) + (format "[%c] %-20.20s%s" (car x) (nth 1 x) (if (= 0 (mod (incf i) 3)) "\n" ""))) reftex-key-to-index-macro-alist ""))) @@ -1135,11 +1135,11 @@ (let* ( ; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because - ;;; because match number are hard coded + ;;; because match number are hard coded (label-re "\\\\label{\\([^}]*\\)}") - (include-re (concat wbol + (include-re (concat wbol "\\\\\\(" - (mapconcat 'identity + (mapconcat 'identity reftex-include-file-commands "\\|") "\\)[{ \t]+\\([^} \t\n\r]+\\)")) (section-re @@ -1193,7 +1193,7 @@ reftex-macros-with-labels macros-with-labels reftex-find-index-entry-regexp-format find-index-re-format reftex-find-label-regexp-format find-label-re-format - reftex-find-label-regexp-format2 + reftex-find-label-regexp-format2 "\\([]} \t\n\r]\\)\\([[{]\\)\\(%s\\)[]}]") (message "Compiling label environment definitions...done"))) (put reftex-docstruct-symbol 'reftex-cache @@ -1232,7 +1232,7 @@ ;; Error out in a buffer without a file. (if (and reftex-mode (not (buffer-file-name))) - (error "RefTeX works only in buffers visiting a file.")) + (error "RefTeX works only in buffers visiting a file")) ;; Make sure we have the symbols tied (if (eq reftex-docstruct-symbol nil) @@ -1270,7 +1270,7 @@ (and (symbolp reftex-docstruct-symbol) (symbol-value reftex-docstruct-symbol) t)) - + (defun reftex-silence-toc-markers (list n) ;; Set all toc markers in the first N entries in list to nil (while (and list (> (decf n) -1)) @@ -1287,7 +1287,7 @@ (master (reftex-TeX-master-file)) (enable-local-variables nil) (file (if (string-match "\\.[a-zA-Z]+\\'" master) - (concat (substring master 0 (match-beginning 0)) + (concat (substring master 0 (match-beginning 0)) reftex-parse-file-extension) (concat master reftex-parse-file-extension)))) (cond @@ -1366,7 +1366,7 @@ ;; Check if the master is the same: when moving a document, this will see it. (let* ((real-master (reftex-TeX-master-file)) - (parsed-master + (parsed-master (nth 1 (assq 'bof (symbol-value reftex-docstruct-symbol))))) (unless (string= (file-truename real-master) (file-truename parsed-master)) (message "Master file name in load file is different: %s versus %s" @@ -1386,7 +1386,7 @@ (defun reftex-select-external-document (xr-alist xr-index) ;; Return index of an external document. (let* ((len (length xr-alist)) (highest (1- (+ ?0 len))) - (prompt (format "[%c-%c] Select TAB: Read prefix with completion" + (prompt (format "[%c-%c] Select TAB: Read prefix with completion" ?0 highest)) key prefix) (cond @@ -1397,7 +1397,7 @@ (- 1 xr-index)) (t (save-excursion - (let* ((length (apply 'max (mapcar + (let* ((length (apply 'max (mapcar (lambda(x) (length (car x))) xr-alist))) (fmt (format " [%%c] %%-%ds %%s\n" length)) (n (1- ?0))) @@ -1407,7 +1407,7 @@ (concat "SELECT EXTERNAL DOCUMENT\n------------------------\n" (mapconcat - (lambda (x) + (lambda (x) (format fmt (incf n) (or (car x) "") (abbreviate-file-name (cdr x)))) xr-alist "")) @@ -1431,7 +1431,7 @@ (let* ((rec-values (if reftex-search-unrecursed-path-first '(nil t) '(t))) (extensions (cdr (assoc type reftex-file-extensions))) (def-ext (car extensions)) - (ext-re (concat "\\(" + (ext-re (concat "\\(" (mapconcat 'regexp-quote extensions "\\|") "\\)\\'")) (files (if (string-match ext-re file) @@ -1440,8 +1440,8 @@ path old-path file1) (cond ((file-name-absolute-p file) - (setq file1 - (or + (setq file1 + (or (and (car files) (file-regular-p (car files)) (car files)) (and (cdr files) (file-regular-p (cdr files)) (cdr files))))) ((and reftex-use-external-file-finders @@ -1456,10 +1456,10 @@ (setq old-path path path (cons master-dir path) file1 (or (and (car files) - (reftex-find-file-on-path + (reftex-find-file-on-path (car files) path master-dir)) (and (cdr files) - (reftex-find-file-on-path + (reftex-find-file-on-path (cdr files) path master-dir)))))))) (cond (file1 file1) (die (error "No such file: %s" file) nil) @@ -1504,7 +1504,7 @@ (reftex-uniquify (reftex-parse-colon-path (mapconcat - (lambda(x) + (lambda(x) (if (string-match "^!" x) (apply 'reftex-process-string (split-string (substring x 1))) @@ -1513,7 +1513,7 @@ ;; (cdr (assoc type reftex-path-environment)) ;; However, historically we have separate options for the ;; environment variables, so we have to do this: - (symbol-value (intern (concat "reftex-" type + (symbol-value (intern (concat "reftex-" type "path-environment-variables"))) path-separator)))) (put pathvar 'status 'split) @@ -1539,11 +1539,11 @@ ;; or: Relative recursive path elements need to be expanded ;; relative to new default directory (message "Expanding search path to find %s file: %s ..." type file) - (put pathvar 'recursive-path + (put pathvar 'recursive-path (reftex-expand-path (symbol-value pathvar) master-dir)) (put pathvar 'master-dir master-dir) (get pathvar 'recursive-path)) - (t + (t ;; Recursive path computed earlier is still OK. (get pathvar 'recursive-path))) ;; The simple path was requested @@ -1572,7 +1572,7 @@ ;; Trailing ! or !! will be converted into `//' (emTeX convention) (mapcar (lambda (dir) - (if (string-match "\\(//+\\|/*!+\\)\\'" dir) + (if (string-match "\\(//+\\|/*!+\\)\\'" dir) (setq dir (replace-match "//" t t dir))) (file-name-as-directory dir)) (delete "" (split-string path (concat path-separator "+"))))) @@ -1601,7 +1601,7 @@ (when (file-directory-p dir) (setq files (nreverse (directory-files dir t "[^.]"))) (while (setq file (pop files)) - (if (file-directory-p file) + (if (file-directory-p file) (push (file-name-as-directory file) path))) (push dir path1))) path1)) @@ -1664,7 +1664,7 @@ "Show the table of contents for the current document." t) (autoload 'reftex-toc-recenter "reftex-toc" "Display the TOC window and highlight line corresponding to current position." t) -(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" +(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "Toggle automatic recentering of TOC window." t) ;;; ========================================================================= @@ -1883,7 +1883,7 @@ (while list (if (funcall predicate (car list)) (push (if completion - (list (nth nth (car list))) + (list (nth nth (car list))) (nth nth (car list))) rtn)) (setq list (cdr list))) @@ -1919,7 +1919,7 @@ ;; If POS is given, calculate distances relative to it. ;; Return nil if there is no match. (let ((pos (point)) - (dist (or max-length (length regexp))) + (dist (or max-length (length regexp))) match1 match2 match) (goto-char (min (+ pos dist) (point-max))) (when (re-search-backward regexp nil t) @@ -2005,10 +2005,10 @@ ((and scroll (equal char ?\C-? )) (condition-case nil (scroll-down) (error nil)) (message prompt)) - (t (message "") + (t (message "") (throw 'exit char))) (setq char (read-char-exclusive))))))) - + (defun reftex-make-regexp-allow-for-ctrl-m (string) ;; convert STRING into a regexp, allowing ^M for \n and vice versa @@ -2206,10 +2206,10 @@ ;; Restrict number of words (if (> (length words) nwords) (setcdr (nthcdr (1- nwords) words) nil)) - + ;; First, try to use all words (setq string (mapconcat 'identity words sep)) - + ;; Abbreviate words if enforced by user settings or string length (if (or (eq t abbrev) (and abbrev @@ -2301,7 +2301,7 @@ (font-lock-set-defaults-1) (reftex-select-font-lock-fontify-region (point-min) (point-max)))) (t - ;; Oops? + ;; Oops? (message "Sorry: cannot refontify RefTeX Select buffer.")))) (rename-buffer oldname)))) @@ -2350,7 +2350,7 @@ ;; Initialize the overlays (aset reftex-highlight-overlays 0 (reftex-make-overlay 1 1)) -(reftex-overlay-put (aref reftex-highlight-overlays 0) +(reftex-overlay-put (aref reftex-highlight-overlays 0) 'face 'highlight) (aset reftex-highlight-overlays 1 (reftex-make-overlay 1 1)) (reftex-overlay-put (aref reftex-highlight-overlays 1) @@ -2375,7 +2375,7 @@ ;;; ========================================================================= ;;; -;;; Keybindings +;;; Keybindings ;; The default bindings in the mode map. (loop for x in @@ -2395,10 +2395,10 @@ ;; Bind `reftex-mouse-view-crossref' only when the key is still free (if (featurep 'xemacs) (unless (key-binding [(shift button2)]) - (define-key reftex-mode-map [(shift button2)] + (define-key reftex-mode-map [(shift button2)] 'reftex-mouse-view-crossref)) (unless (key-binding [(shift mouse-2)]) - (define-key reftex-mode-map [(shift mouse-2)] + (define-key reftex-mode-map [(shift mouse-2)] 'reftex-mouse-view-crossref))) ;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map @@ -2502,7 +2502,7 @@ ("Reference Style" ["Default" (setq reftex-vref-is-default nil reftex-fref-is-default nil) - :style radio :selected (not (or reftex-vref-is-default + :style radio :selected (not (or reftex-vref-is-default reftex-fref-is-default))] ["Varioref" (setq reftex-vref-is-default t reftex-fref-is-default nil) @@ -2537,7 +2537,7 @@ (list 'reftex-add-index-macros (list 'list (list 'quote (car x)))) :style 'radio :selected (list 'memq (list 'quote (car x)) - (list 'get 'reftex-docstruct-symbol + (list 'get 'reftex-docstruct-symbol (list 'quote 'reftex-index-macros-style))))) reftex-index-macros-builtin)) "--" @@ -2546,7 +2546,7 @@ ("Customize" ["Browse RefTeX Group" reftex-customize t] "--" - ["Build Full Customize Menu" reftex-create-customize-menu + ["Build Full Customize Menu" reftex-create-customize-menu (fboundp 'customize-menu-create)]) ("Documentation" ["Info" reftex-info t] @@ -2562,7 +2562,7 @@ (interactive) (if (fboundp 'customize-menu-create) (progn - (easy-menu-change + (easy-menu-change '("Ref") "Customize" `(["Browse RefTeX group" reftex-customize t] "--" @@ -2600,7 +2600,7 @@ ;;; That's it! ---------------------------------------------------------------- (setq reftex-tables-dirty t) ; in case this file is evaluated by hand -(provide 'reftex) +(provide 'reftex) ;;;============================================================================
--- a/lisp/textmodes/sgml-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/sgml-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -246,11 +246,13 @@ "Regular expression that matches a non-empty start tag. Any terminating `>' or `/' is not matched.") -(defface sgml-namespace-face +(defface sgml-namespace '((t (:inherit font-lock-builtin-face))) "`sgml-mode' face used to highlight the namespace part of identifiers." :group 'sgml) -(defvar sgml-namespace-face 'sgml-namespace-face) +;; backward-compatibility alias +(put 'sgml-namespace-face 'face-alias 'sgml-namespace) +(defvar sgml-namespace-face 'sgml-namespace) ;; internal (defconst sgml-font-lock-keywords-1
--- a/lisp/textmodes/table.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/table.el Wed Jun 15 23:32:15 2005 +0000 @@ -682,7 +682,7 @@ :tag "Table Command Prefix" :group 'table) -(defface table-cell-face +(defface table-cell '((((min-colors 88) (class color)) (:foreground "gray90" :background "blue1")) (((class color)) @@ -691,6 +691,8 @@ "*Face used for table cell contents." :tag "Cell Face" :group 'table) +;; backward-compatibility alias +(put 'table-cell-face 'face-alias 'table-cell) (defcustom table-cell-horizontal-chars "-=" "*Characters that may be used for table cell's horizontal border line." @@ -5264,7 +5266,7 @@ (defun table--put-cell-face-property (beg end &optional object) "Put cell face property." - (put-text-property beg end 'face 'table-cell-face object)) + (put-text-property beg end 'face 'table-cell object)) (defun table--put-cell-keymap-property (beg end &optional object) "Put cell keymap property." @@ -5303,8 +5305,8 @@ (defun table--update-cell-face () "Update cell face according to the current mode." (if (featurep 'xemacs) - (set-face-property 'table-cell-face 'underline table-fixed-width-mode) - (set-face-inverse-video-p 'table-cell-face table-fixed-width-mode))) + (set-face-property 'table-cell 'underline table-fixed-width-mode) + (set-face-inverse-video-p 'table-cell table-fixed-width-mode))) (table--update-cell-face)
--- a/lisp/textmodes/tex-mode.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/tex-mode.el Wed Jun 15 23:32:15 2005 +0000 @@ -650,17 +650,22 @@ "Face used for subscripts." :group 'tex) -(defface tex-math-face +(defface tex-math '((t :inherit font-lock-string-face)) "Face used to highlight TeX math expressions." :group 'tex) -(defvar tex-math-face 'tex-math-face) -(defface tex-verbatim-face +;; backward-compatibility alias +(put 'tex-math-face 'face-alias 'tex-math) +(defvar tex-math-face 'tex-math) + +(defface tex-verbatim ;; '((t :inherit font-lock-string-face)) '((t :family "courier")) "Face used to highlight TeX verbatim environments." :group 'tex) -(defvar tex-verbatim-face 'tex-verbatim-face) +;; backward-compatibility alias +(put 'tex-verbatim-face 'face-alias 'tex-verbatim) +(defvar tex-verbatim-face 'tex-verbatim) ;; Use string syntax but math face for $...$. (defun tex-font-lock-syntactic-face-function (state) @@ -1101,7 +1106,7 @@ inserts \" characters." (interactive "*P") (if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\)) - (eq (get-text-property (point) 'face) 'tex-verbatim-face) + (eq (get-text-property (point) 'face) tex-verbatim-face) (save-excursion (backward-char (length tex-open-quote)) (when (or (looking-at (regexp-quote tex-open-quote))
--- a/lisp/textmodes/texinfo.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/textmodes/texinfo.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,7 +1,7 @@ ;;; texinfo.el --- major mode for editing Texinfo files ;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997, -;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. +;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Date: [See date below for texinfo-version] @@ -343,11 +343,13 @@ "Regexp for environment-like Texinfo list commands. Subexpression 1 is what goes into the corresponding `@end' statement.") -(defface texinfo-heading-face +(defface texinfo-heading '((t (:inherit font-lock-function-name-face))) "Face used for section headings in `texinfo-mode'." :group 'texinfo) -(defvar texinfo-heading-face 'texinfo-heading-face) +;; backward-compatibility alias +(put 'texinfo-heading-face 'face-alias 'texinfo-heading) +(defvar texinfo-heading-face 'texinfo-heading) (defvar texinfo-font-lock-keywords `(;; All but the first had an OVERRIDE of t.
--- a/lisp/thumbs.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/thumbs.el Wed Jun 15 23:32:15 2005 +0000 @@ -77,13 +77,13 @@ (defcustom thumbs-per-line 5 "*Number of thumbnails per line to show in directory." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-thumbsdir-max-size 50000000 "Max size for thumbnails directory. When it reaches that size (in bytes), a warning is sent." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-conversion-program @@ -104,13 +104,13 @@ (defcustom thumbs-relief 5 "*Size of button-like border around thumbnails." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-margin 2 "*Size of the margin around thumbnails. This is where you see the cursor." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-thumbsdir-auto-clean t @@ -122,7 +122,7 @@ (defcustom thumbs-image-resizing-step 10 "Step by which to resize image." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-temp-dir temporary-file-directory @@ -172,17 +172,21 @@ (1+ thumbs-gensym-counter)))))) (make-symbol (format "%s%d" pfix num)))))) +(defsubst thumbs-temp-dir () + (file-name-as-directory (expand-file-name thumbs-temp-dir))) + (defun thumbs-temp-file () "Return a unique temporary filename for an image." (format "%s%s-%s.jpg" - (expand-file-name thumbs-temp-dir) + (thumbs-temp-dir) thumbs-temp-prefix (thumbs-gensym "T"))) (defun thumbs-thumbsdir () "Return the current thumbnails directory (from `thumbs-thumbsdir'). Create the thumbnails directory if it does not exist." - (let ((thumbs-thumbsdir (expand-file-name thumbs-thumbsdir))) + (let ((thumbs-thumbsdir (file-name-as-directory + (expand-file-name thumbs-thumbsdir)))) (unless (file-directory-p thumbs-thumbsdir) (make-directory thumbs-thumbsdir) (message "Creating thumbnails directory")) @@ -267,7 +271,7 @@ (condition-case nil (apply 'delete-file (directory-files - thumbs-temp-dir t + (thumbs-temp-dir) t thumbs-temp-prefix)) (error nil)) (let ((buffer-read-only nil) @@ -306,7 +310,7 @@ "Return a thumbnail name for the image IMG." (convert-standard-filename (let ((filename (expand-file-name img))) - (format "%s/%08x-%s.jpg" + (format "%s%08x-%s.jpg" (thumbs-thumbsdir) (sxhash filename) (subst-char-in-string @@ -637,7 +641,7 @@ ;; cleaning of old temp file (mapc 'delete-file (directory-files - thumbs-temp-dir + (thumbs-temp-dir) t thumbs-temp-prefix)) (let ((buffer-read-only nil)
--- a/lisp/time.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/time.el Wed Jun 15 23:32:15 2005 +0000 @@ -127,8 +127,8 @@ (defcustom display-time-mail-face nil "Face to use for `display-time-mail-string'. If `display-time-use-mail-icon' is non-nil, the image's -background colour is the background of this face. Set this to -make the mail indicator stand out on a colour display." +background color is the background of this face. Set this to +make the mail indicator stand out on a color display." :group 'faces :group 'display-time :version "22.1"
--- a/lisp/tooltip.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/tooltip.el Wed Jun 15 23:32:15 2005 +0000 @@ -113,6 +113,17 @@ "Face for tooltips." :group 'tooltip) +(defcustom tooltip-use-echo-area nil + "Use the echo area instead of tooltip frames for help and GUD tooltips." + :type 'boolean + :tag "Use echo area" + :group 'tooltip) + +(make-obsolete-variable 'tooltip-use-echo-area +"To display help tooltips in the echo area turn tooltip-mode off. +To display GUD tooltips in the echo area turn gud-tooltip-mode on and set +gud-tooltip-echo-area to t." "22.1") + ;;; Variables that are not customizable. @@ -169,7 +180,7 @@ (remove-hook 'pre-command-hook 'tooltip-hide)) (remove-hook 'tooltip-hook 'tooltip-help-tips)) (setq show-help-function - (if tooltip-mode 'tooltip-show-help-function nil))) + (if tooltip-mode 'tooltip-show-help nil))) ;;; Timeout for tooltip display @@ -314,9 +325,9 @@ ;;; Tooltip help. (defvar tooltip-help-message nil - "The last help message received via `tooltip-show-help-function'.") + "The last help message received via `tooltip-show-help'.") -(defun tooltip-show-help-function (msg) +(defun tooltip-show-help (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." (let ((previous-help tooltip-help-message)) @@ -341,7 +352,7 @@ the timer with ID `tooltip-timeout-id' fires. Value is non-nil if this function handled the tip." (when (stringp tooltip-help-message) - (tooltip-show tooltip-help-message) + (tooltip-show tooltip-help-message tooltip-use-echo-area) t)) (provide 'tooltip)
--- a/lisp/tree-widget.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/tree-widget.el Wed Jun 15 23:32:15 2005 +0000 @@ -1,6 +1,6 @@ ;;; tree-widget.el --- Tree widget -;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -174,7 +174,7 @@ ;;; Image support ;; -(eval-when-compile ;; GNU Emacs/XEmacs compatibility stuff +(eval-and-compile ;; GNU Emacs/XEmacs compatibility stuff (cond ;; XEmacs ((featurep 'xemacs) @@ -469,21 +469,6 @@ 'widget-type) property)) -(defsubst tree-widget-super-format-handler (widget escape) - "Call WIDGET's inherited format handler to process ESCAPE character." - (let ((handler (tree-widget-get-super widget :format-handler))) - (and handler (funcall handler widget escape)))) - -(defun tree-widget-format-handler (widget escape) - "For WIDGET, signal that the %p format template is obsolete. -Call WIDGET's inherited format handler to process other ESCAPE -characters." - (if (eq escape ?p) - (message "The %%p format template is obsolete and ignored") - (tree-widget-super-format-handler widget escape))) -(make-obsolete 'tree-widget-format-handler - 'tree-widget-super-format-handler) - (defsubst tree-widget-node (widget) "Return the tree WIDGET :node value. If not found setup a default 'item' widget." @@ -630,26 +615,35 @@ (let* ((widget-image-enable (tree-widget-use-image-p)) ; Emacs (widget-glyph-enable widget-image-enable) ; XEmacs (node (tree-widget-node tree)) + (flags (widget-get tree :tree-widget--guide-flags)) + (indent (widget-get tree :indent)) children buttons) + (and indent + (null flags) + (save-restriction + (widen) + (or (bolp) + (and (eq (char-before) ?<) + (save-excursion + (backward-char) (bolp))))) + (insert-char ?\ indent)) (if (widget-get tree :open) ;;;; Unfolded node. - (let* ((args (widget-get tree :args)) - (dynargs (widget-get tree :dynargs)) - (flags (widget-get tree :tree-widget--guide-flags)) - (rflags (reverse flags)) - (guide (tree-widget-guide tree)) - (noguide (tree-widget-no-guide tree)) - (endguide (tree-widget-end-guide tree)) - (handle (tree-widget-handle tree)) - (nohandle (tree-widget-no-handle tree)) - ;; Lookup for images and set widgets' tag-glyphs here, - ;; to allow to dynamically change the image theme. - (guidi (tree-widget-find-image "guide")) - (noguidi (tree-widget-find-image "no-guide")) - (endguidi (tree-widget-find-image "end-guide")) - (handli (tree-widget-find-image "handle")) - (nohandli (tree-widget-find-image "no-handle")) - child) + (let ((args (widget-get tree :args)) + (dynargs (widget-get tree :dynargs)) + (guide (tree-widget-guide tree)) + (noguide (tree-widget-no-guide tree)) + (endguide (tree-widget-end-guide tree)) + (handle (tree-widget-handle tree)) + (nohandle (tree-widget-no-handle tree)) + ;; Lookup for images and set widgets' tag-glyphs here, + ;; to allow to dynamically change the image theme. + (guidi (tree-widget-find-image "guide")) + (noguidi (tree-widget-find-image "no-guide")) + (endguidi (tree-widget-find-image "end-guide")) + (handli (tree-widget-find-image "handle")) + (nohandli (tree-widget-find-image "no-handle")) + child) (when dynargs ;; Request the definition of dynamic children (setq dynargs (funcall dynargs tree)) @@ -671,8 +665,9 @@ (while args (setq child (car args) args (cdr args)) + (and indent (insert-char ?\ indent)) ;; Insert guide lines elements - (dolist (f rflags) + (dolist (f (reverse flags)) (widget-create-child-and-convert tree (if f guide noguide) :tag-glyph (if f guidi noguidi))
--- a/lisp/url/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,27 @@ +2005-06-14 Juanma Barranquero <lekktu@gmail.com> + + * url-history.el (url-completion-function): Follow error + conventions. + +2005-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-file.el (url-file, url-file-asynch-callback): with-current-buffer. + +2005-06-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-dav.el: Remove most autoload cookies. + Don't hook into the url-file-handler since it currently breaks all + non-HTTP URLs. + + * url-handlers.el (vc-registered): Explicitly disable VC for URL files. + + * url.el (url-retrieve-synchronously): Don't exit precipitously when + fetching a file via ange-ftp. + +2005-06-10 Juanma Barranquero <lekktu@gmail.com> + + * url-cookie.el (url-cookie-multiple-line): Fix spelling in docstring. + 2005-05-19 Juanma Barranquero <lekktu@gmail.com> * url-cookie.el (url-cookie-multiple-line):
--- a/lisp/url/url-cookie.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url-cookie.el Wed Jun 15 23:32:15 2005 +0000 @@ -73,7 +73,7 @@ (defvar url-cookie-storage nil "Where cookies are stored.") (defvar url-cookie-secure-storage nil "Where secure cookies are stored.") -(defcustom url-cookie-file nil "*Where cookies are stored on disk." +(defcustom url-cookie-file nil "*Where cookies are stored on disk." :type '(choice (const :tag "Default" :value nil) file) :group 'url-file :group 'url-cookie) @@ -86,7 +86,7 @@ (defcustom url-cookie-multiple-line nil "*If nil, HTTP requests put all cookies for the server on one line. Some web servers, such as http://www.hotmail.com/, only accept cookies -when they are on one line. This is broken behaviour, but just try +when they are on one line. This is broken behavior, but just try telling Microsoft that." :type 'boolean :group 'url-cookie)
--- a/lisp/url/url-dav.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url-dav.el Wed Jun 15 23:32:15 2005 +0000 @@ -457,7 +457,6 @@ "</" (symbol-name tag) ">\n")))) (url-dav-process-response (url-retrieve-synchronously url) url))) -;;;###autoload (defun url-dav-get-properties (url &optional attributes depth namespaces) "Return properties for URL, up to DEPTH levels deep. @@ -487,7 +486,6 @@ to other users when the DAV:lockdiscovery property is requested, so make sure you are comfortable with it leaking to the outside world.") -;;;###autoload (defun url-dav-lock-resource (url exclusive &optional depth) "Request a lock on URL. If EXCLUSIVE is non-nil, get an exclusive lock. Optional 3rd argument DEPTH says how deep the lock should go, default is 0 @@ -528,7 +526,6 @@ (push (list url child-status) failures))) (cons successes failures))) -;;;###autoload (defun url-dav-active-locks (url &optional depth) "Return an assoc list of all active locks on URL." (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth)) @@ -563,7 +560,6 @@ results))) results)) -;;;###autoload (defun url-dav-unlock-resource (url lock-token) "Release the lock on URL represented by LOCK-TOKEN. Returns t iff the lock was successfully released." @@ -624,7 +620,6 @@ (autoload 'url-http-head-file-attributes "url-http") -;;;###autoload (defun url-dav-file-attributes (url &optional id-format) (let ((properties (cdar (url-dav-get-properties url))) (attributes nil)) @@ -680,7 +675,6 @@ (setq attributes (url-http-head-file-attributes url id-format))) attributes)) -;;;###autoload (defun url-dav-save-resource (url obj &optional content-type lock-token) "Save OBJ as URL using WebDAV. URL must be a fully qualified URL. @@ -736,7 +730,6 @@ (concat "(<" ,lock-token ">)")))))))) -;;;###autoload (defun url-dav-delete-directory (url &optional recursive lock-token) "Delete the WebDAV collection URL. If optional second argument RECURSIVE is non-nil, then delete all @@ -761,7 +754,6 @@ props)) nil) -;;;###autoload (defun url-dav-delete-file (url &optional lock-token) "Delete file named URL." (let ((props nil) @@ -781,7 +773,6 @@ props)) nil) -;;;###autoload (defun url-dav-directory-files (url &optional full match nosort files-only) "Return a list of names of files in DIRECTORY. There are three optional arguments: @@ -828,13 +819,11 @@ files (sort files 'string-lessp)))) -;;;###autoload (defun url-dav-file-directory-p (url) "Return t if URL names an existing DAV collection." (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype))))) (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection))) -;;;###autoload (defun url-dav-make-directory (url &optional parents) "Create the directory DIR and any nonexistent parent dirs." (declare (special url-http-response-status)) @@ -864,7 +853,6 @@ (kill-buffer buffer))) result)) -;;;###autoload (defun url-dav-rename-file (oldname newname &optional overwrite) (if (not (and (string-match url-handler-regexp oldname) (string-match url-handler-regexp newname))) @@ -905,13 +893,11 @@ props) t)) -;;;###autoload (defun url-dav-file-name-all-completions (file url) "Return a list of all completions of file name FILE in directory DIRECTORY. These are all file names in directory DIRECTORY which begin with FILE." (url-dav-directory-files url nil (concat "^" file ".*"))) -;;;###autoload (defun url-dav-file-name-completion (file url) "Complete file name FILE in directory DIRECTORY. Returns the longest string @@ -951,15 +937,18 @@ (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op)))) (mapcar 'url-dav-register-handler - '(file-name-all-completions - file-name-completion - rename-file - make-directory - file-directory-p - directory-files - delete-file - delete-directory - file-attributes)) + ;; These handlers are disabled because they incorrectly presume that + ;; the URL specifies an HTTP location and thus break FTP URLs. + '(;; file-name-all-completions + ;; file-name-completion + ;; rename-file + ;; make-directory + ;; file-directory-p + ;; directory-files + ;; delete-file + ;; delete-directory + ;; file-attributes + )) ;;; Version Control backend cruft
--- a/lisp/url/url-file.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url-file.el Wed Jun 15 23:32:15 2005 +0000 @@ -73,8 +73,7 @@ func args args efs)) (let ((size (nth 7 (file-attributes name)))) - (save-excursion - (set-buffer buff) + (with-current-buffer buff (goto-char (point-max)) (if (/= -1 size) (insert (format "Content-length: %d\n" size))) @@ -177,9 +176,8 @@ (if (file-directory-p filename) ;; A directory is done the same whether we are local or remote (url-find-file-dired filename) - (save-excursion - (setq buffer (generate-new-buffer " *url-file*")) - (set-buffer buffer) + (with-current-buffer + (setq buffer (generate-new-buffer " *url-file*")) (mm-disable-multibyte) (setq url-current-object url) (insert "Content-type: " (or content-type "application/octet-stream") "\n")
--- a/lisp/url/url-handlers.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url-handlers.el Wed Jun 15 23:32:15 2005 +0000 @@ -155,6 +155,9 @@ ;; These are operations that we do not support yet (DAV!!!) (put 'file-writable-p 'url-file-handlers 'ignore) (put 'file-symlink-p 'url-file-handlers 'ignore) +;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v +;; files and such since we can't do anything clever with them anyway. +(put 'vc-registered 'url-file-handlers 'ignore) (defun url-handler-expand-file-name (file &optional base) (if (file-name-absolute-p file)
--- a/lisp/url/url-history.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url-history.el Wed Jun 15 23:32:15 2005 +0000 @@ -84,7 +84,7 @@ (defun url-history-setup-save-timer () "Reset the history list timer." (interactive) - (ignore-errors + (ignore-errors (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer)) ((fboundp 'delete-itimer) (delete-itimer url-history-timer)))) (setq url-history-timer nil) @@ -192,7 +192,7 @@ (gethash string url-history-hash-table) t)) (t - (error "url-completion-function very confused.")))) + (error "url-completion-function very confused")))) (provide 'url-history)
--- a/lisp/url/url.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/url/url.el Wed Jun 15 23:32:15 2005 +0000 @@ -170,17 +170,26 @@ (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) (setq retrieval-done t asynch-buffer (current-buffer))))) - (let ((proc (and asynch-buffer (get-buffer-process asynch-buffer)))) - (if (null proc) - ;; We do not need to do anything, it was a mailto or something - ;; similar that takes processing completely outside of the URL - ;; package. - nil + (if (null asynch-buffer) + ;; We do not need to do anything, it was a mailto or something + ;; similar that takes processing completely outside of the URL + ;; package. + nil + (let ((proc (get-buffer-process asynch-buffer))) + ;; If the access method was synchronous, `retrieval-done' should + ;; hopefully already be set to t. If it is nil, and `proc' is also + ;; nil, it implies that the async process is not running in + ;; asynch-buffer. This happens e.g. for FTP files. In such a case + ;; url-file.el should probably set something like a `url-process' + ;; buffer-local variable so we can find the exact process that we + ;; should be waiting for. In the mean time, we'll just wait for any + ;; process output. (while (not retrieval-done) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) - (if (memq (process-status proc) '(closed exit signal failed)) + (if (and proc (memq (process-status proc) + '(closed exit signal failed))) ;; FIXME: It's not clear whether url-retrieve's callback is ;; guaranteed to be called or not. It seems that url-http ;; decides sometimes consciously not to call it, so it's not @@ -193,7 +202,7 @@ ;; interrupt it before it got a chance to handle process input. ;; `sleep-for' was tried but it lead to other forms of ;; hanging. --Stef - (unless (accept-process-output proc) + (unless (or (accept-process-output proc) (null proc)) ;; accept-process-output returned nil, maybe because the process ;; exited (and may have been replaced with another). (setq proc (get-buffer-process asynch-buffer)))))) @@ -201,9 +210,9 @@ (defun url-mm-callback (&rest ignored) (let ((handle (mm-dissect-buffer t))) - (save-excursion - (url-mark-buffer-as-dead (current-buffer)) - (set-buffer (generate-new-buffer (url-recreate-url url-current-object))) + (url-mark-buffer-as-dead (current-buffer)) + (with-current-buffer + (generate-new-buffer (url-recreate-url url-current-object)) (if (eq (mm-display-part handle) 'external) (progn (set-process-sentinel
--- a/lisp/vc-arch.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/vc-arch.el Wed Jun 15 23:32:15 2005 +0000 @@ -178,7 +178,7 @@ (defun vc-arch-root (file) "Return the root directory of a Arch project, if any." (or (vc-file-getprop file 'arch-root) - (vc-file-setprop + (vc-file-setprop ;; Check the =tagging-method, in case someone naively manually ;; creates a {arch} directory somewhere. file 'arch-root (vc-find-root file "{arch}/=tagging-method")))) @@ -357,7 +357,7 @@ (defun vc-arch-checkout-model (file) 'implicit) (defun vc-arch-checkin (file rev comment) - (if rev (error "Committing to a specific revision is unsupported.")) + (if rev (error "Committing to a specific revision is unsupported")) (let ((summary (file-relative-name file (vc-arch-root file)))) ;; Extract a summary from the comment. (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) @@ -376,7 +376,7 @@ ;; so we can diff with the current file. (setq newvers nil)) (if newvers - (error "Diffing specific revisions not implemented.") + (error "Diffing specific revisions not implemented") (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) ;; Run the command from the root dir. (default-directory (vc-arch-root file))
--- a/lisp/vc.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/vc.el Wed Jun 15 23:32:15 2005 +0000 @@ -3043,12 +3043,12 @@ ;;;###autoload (defun vc-annotate (prefix &optional revision display-mode) - "Display the edit history of the current file using colours. + "Display the edit history of the current file using colors. This command creates a buffer that shows, for each line of the current -file, when it was last edited and by whom. Additionally, colours are +file, when it was last edited and by whom. Additionally, colors are used to show the age of each line--blue means oldest, red means -youngest, and intermediate colours indicate intermediate ages. By +youngest, and intermediate colors indicate intermediate ages. By default, the time scale stretches back one year into the past; everything that is older than that is shown in blue.
--- a/lisp/vcursor.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/vcursor.el Wed Jun 15 23:32:15 2005 +0000 @@ -1116,7 +1116,7 @@ "Copy up to ARGth line after virtual cursor position. With no argument, copy to the end of the current line. -Behaviour with regard to newlines is similar (but not identical) to +Behavior with regard to newlines is similar (but not identical) to `kill-line'; the main difference is that whitespace at the end of the line is treated like ordinary characters."
--- a/lisp/whitespace.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/whitespace.el Wed Jun 15 23:32:15 2005 +0000 @@ -307,8 +307,8 @@ :group 'whitespace) (defcustom whitespace-display-spaces-in-color t - "Display the bogus whitespaces by coloring them with -`whitespace-highlight-face'." + "Display the bogus whitespaces by coloring them with the face +`whitespace-highlight'." :type 'boolean :group 'whitespace) @@ -318,18 +318,20 @@ :group 'whitespace :group 'faces) -(defface whitespace-highlight-face '((((class color) (background light)) - (:background "green1")) - (((class color) (background dark)) - (:background "sea green")) - (((class grayscale mono) - (background light)) - (:background "black")) - (((class grayscale mono) - (background dark)) - (:background "white"))) +(defface whitespace-highlight '((((class color) (background light)) + (:background "green1")) + (((class color) (background dark)) + (:background "sea green")) + (((class grayscale mono) + (background light)) + (:background "black")) + (((class grayscale mono) + (background dark)) + (:background "white"))) "Face used for highlighting the bogus whitespaces that exist in the buffer." :group 'whitespace-faces) +;; backward-compatibility alias +(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight) (if (not (assoc 'whitespace-mode minor-mode-alist)) (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) @@ -734,7 +736,7 @@ (if whitespace-display-spaces-in-color (let ((ol (whitespace-make-overlay b e))) (push ol whitespace-highlighted-space) - (whitespace-overlay-put ol 'face 'whitespace-highlight-face)))) + (whitespace-overlay-put ol 'face 'whitespace-highlight)))) ;; (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space)) (defun whitespace-unhighlight-the-space()
--- a/lisp/wid-edit.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/wid-edit.el Wed Jun 15 23:32:15 2005 +0000 @@ -89,28 +89,32 @@ :group 'widgets :group 'faces) -(defvar widget-documentation-face 'widget-documentation-face +(defvar widget-documentation-face 'widget-documentation "Face used for documentation strings in widgets. This exists as a variable so it can be set locally in certain buffers.") -(defface widget-documentation-face '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) +(defface widget-documentation '((((class color) + (background dark)) + (:foreground "lime green")) + (((class color) + (background light)) + (:foreground "dark green")) + (t nil)) "Face used for documentation text." :group 'widget-documentation :group 'widget-faces) - -(defvar widget-button-face 'widget-button-face +;; backward compatibility alias +(put 'widget-documentation-face 'face-alias 'widget-documentation) + +(defvar widget-button-face 'widget-button "Face used for buttons in widgets. This exists as a variable so it can be set locally in certain buffers.") -(defface widget-button-face '((t (:weight bold))) +(defface widget-button '((t (:weight bold))) "Face used for widget buttons." :group 'widget-faces) +;; backward compatibility alias +(put 'widget-button-face 'face-alias 'widget-button) (defcustom widget-mouse-face 'highlight "Face used for widget buttons when the mouse is above them." @@ -120,33 +124,37 @@ ;; TTY gets special definitions here and in the next defface, because ;; the gray colors defined for other displays cause black text on a black ;; background, at least on light-background TTYs. -(defface widget-field-face '((((type tty)) - :background "yellow3" - :foreground "black") - (((class grayscale color) - (background light)) - :background "gray85") - (((class grayscale color) - (background dark)) - :background "dim gray") - (t - :slant italic)) +(defface widget-field '((((type tty)) + :background "yellow3" + :foreground "black") + (((class grayscale color) + (background light)) + :background "gray85") + (((class grayscale color) + (background dark)) + :background "dim gray") + (t + :slant italic)) "Face used for editable fields." :group 'widget-faces) - -(defface widget-single-line-field-face '((((type tty)) - :background "green3" - :foreground "black") - (((class grayscale color) - (background light)) - :background "gray85") - (((class grayscale color) - (background dark)) - :background "dim gray") - (t - :slant italic)) +;; backward-compatibility alias +(put 'widget-field-face 'face-alias 'widget-field) + +(defface widget-single-line-field '((((type tty)) + :background "green3" + :foreground "black") + (((class grayscale color) + (background light)) + :background "gray85") + (((class grayscale color) + (background dark)) + :background "dim gray") + (t + :slant italic)) "Face used for editable fields spanning only a single line." :group 'widget-faces) +;; backward-compatibility alias +(put 'widget-single-line-field-face 'face-alias 'widget-single-line-field) ;;; This causes display-table to be loaded, and not usefully. ;;;(defvar widget-single-line-display-table @@ -325,7 +333,7 @@ (insert-and-inherit " "))) (setq to (point))) (let ((keymap (widget-get widget :keymap)) - (face (or (widget-get widget :value-face) 'widget-field-face)) + (face (or (widget-get widget :value-face) 'widget-field)) (help-echo (widget-get widget :help-echo)) (follow-link (widget-get widget :follow-link)) (rear-sticky @@ -433,24 +441,26 @@ (prog1 (progn ,@form) (goto-char (point-max)))))) -(defface widget-inactive-face '((((class grayscale color) - (background dark)) - (:foreground "light gray")) - (((class grayscale color) - (background light)) - (:foreground "dim gray")) - (t - (:slant italic))) +(defface widget-inactive '((((class grayscale color) + (background dark)) + (:foreground "light gray")) + (((class grayscale color) + (background light)) + (:foreground "dim gray")) + (t + (:slant italic))) "Face used for inactive widgets." :group 'widget-faces) +;; backward-compatibility alias +(put 'widget-inactive-face 'face-alias 'widget-inactive) (defun widget-specify-inactive (widget from to) "Make WIDGET inactive for user modifications." (unless (widget-get widget :inactive) (let ((overlay (make-overlay from to nil t nil))) - (overlay-put overlay 'face 'widget-inactive-face) + (overlay-put overlay 'face 'widget-inactive) ;; This is disabled, as it makes the mouse cursor change shape. - ;; (overlay-put overlay 'mouse-face 'widget-inactive-face) + ;; (overlay-put overlay 'mouse-face 'widget-inactive) (overlay-put overlay 'evaporate t) (overlay-put overlay 'priority 100) (overlay-put overlay 'modification-hooks '(widget-overlay-inactive)) @@ -633,7 +643,7 @@ ;; Oh well. nil))) -(defvar widget-button-pressed-face 'widget-button-pressed-face +(defvar widget-button-pressed-face 'widget-button-pressed "Face used for pressed buttons in widgets. This exists as a variable so it can be set locally in certain buffers.") @@ -882,7 +892,7 @@ (call-interactively (lookup-key widget-global-map (this-command-keys)))))) -(defface widget-button-pressed-face +(defface widget-button-pressed '((((min-colors 88) (class color)) (:foreground "red1")) (((class color)) @@ -891,6 +901,8 @@ (:weight bold :underline t))) "Face used for pressed buttons." :group 'widget-faces) +;; backward-compatibility alias +(put 'widget-button-pressed-face 'face-alias 'widget-button-pressed) (defun widget-button-click (event) "Invoke the button that the mouse is pointing at." @@ -2990,7 +3002,7 @@ :match 'widget-regexp-match :validate 'widget-regexp-validate ;; Doesn't work well with terminating newline. - ;; :value-face 'widget-single-line-field-face + ;; :value-face 'widget-single-line-field :tag "Regexp") (defun widget-regexp-match (widget value) @@ -3016,7 +3028,7 @@ :prompt-value 'widget-file-prompt-value :format "%{%t%}: %v" ;; Doesn't work well with terminating newline. - ;; :value-face 'widget-single-line-field-face + ;; :value-face 'widget-single-line-field :tag "File") (defun widget-file-complete ()
--- a/lisp/window.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/window.el Wed Jun 15 23:32:15 2005 +0000 @@ -31,7 +31,7 @@ (defvar window-size-fixed nil "*Non-nil in a buffer means windows displaying the buffer are fixed-size. -If the value is`height', then only the window's height is fixed. +If the value is `height', then only the window's height is fixed. If the value is `width', then only the window's width is fixed. Any other non-nil value fixes both the width and the height. Emacs won't change the size of any window displaying that buffer, @@ -92,9 +92,9 @@ (defun window-current-scroll-bars (&optional window) "Return the current scroll-bar settings in window WINDOW. -Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the +Value is a cons (VERTICAL . HORIZONTAL) where VERTICAL specifies the current location of the vertical scroll-bars (left, right, or nil), -and HORISONTAL specifies the current location of the horisontal scroll +and HORIZONTAL specifies the current location of the horizontal scroll bars (top, bottom, or nil)." (let ((vert (nth 2 (window-scroll-bars window))) (hor nil)) @@ -542,7 +542,7 @@ Do not shrink to less than `window-min-height' lines. 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 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." (interactive) (when (null window)
--- a/lisp/woman.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/woman.el Wed Jun 15 23:32:15 2005 +0000 @@ -823,13 +823,13 @@ (defcustom woman-bold-headings t "*If non-nil then embolden section and subsection headings. Default is t. -Heading emboldening is NOT standard `man' behaviour." +Heading emboldening is NOT standard `man' behavior." :type 'boolean :group 'woman-formatting) (defcustom woman-ignore t "*If non-nil then unrecognised requests etc. are ignored. Default is t. -This gives the standard ?roff behaviour. If nil then they are left in +This gives the standard ?roff behavior. If nil then they are left in the buffer, which may aid debugging." :type 'boolean :group 'woman-formatting) @@ -875,49 +875,56 @@ ;; This is overkill! Troff uses just italic; Nroff uses just underline. ;; You should probably select either italic or underline as you prefer, but ;; not both, although italic and underline work together perfectly well! -(defface woman-italic-face - `((((min-colors 88) (background light)) +(defface woman-italic + `((((min-colors 88) (background light)) (:slant italic :underline t :foreground "red1")) (((background light)) (:slant italic :underline t :foreground "red")) (((background dark)) (:slant italic :underline t))) "Face for italic font in man pages." :group 'woman-faces) - -(defface woman-bold-face +;; backward-compatibility alias +(put 'woman-italic-face 'face-alias 'woman-italic) + +(defface woman-bold '((((min-colors 88) (background light)) (:weight bold :foreground "blue1")) (((background light)) (:weight bold :foreground "blue")) (((background dark)) (:weight bold :foreground "green2"))) "Face for bold font in man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-bold-face 'face-alias 'woman-bold) ;; Brown is a good compromise: it is distinguishable from the default ;; but not enough so to make font errors look terrible. (Files that use ;; non-standard fonts seem to do so badly or in idiosyncratic ways!) -(defface woman-unknown-face +(defface woman-unknown '((((background light)) (:foreground "brown")) (((min-colors 88) (background dark)) (:foreground "cyan1")) (((background dark)) (:foreground "cyan"))) "Face for all unknown fonts in man pages." :group 'woman-faces) - -(defface woman-addition-face +;; backward-compatibility alias +(put 'woman-unknown-face 'face-alias 'woman-unknown) + +(defface woman-addition '((t (:foreground "orange"))) "Face for all WoMan additions to man pages." :group 'woman-faces) +;; backward-compatibility alias +(put 'woman-addition-face 'face-alias 'woman-addition) (defun woman-default-faces () - "Set foreground colours of italic and bold faces to their default values." + "Set foreground colors of italic and bold faces to their default values." (interactive) - (face-spec-set 'woman-italic-face - (face-user-default-spec 'woman-italic-face)) - (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face))) + (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) + (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) (defun woman-monochrome-faces () - "Set foreground colours of italic and bold faces to that of the default face. + "Set foreground colors of italic and bold faces to that of the default face. This is usually either black or white." (interactive) - (set-face-foreground 'woman-italic-face 'unspecified) - (set-face-foreground 'woman-bold-face 'unspecified)) + (set-face-foreground 'woman-italic 'unspecified) + (set-face-foreground 'woman-bold 'unspecified)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Experimental font support, initially only for MS-Windows. @@ -938,7 +945,7 @@ symbol-fonts)) (when woman-font-support - (make-face 'woman-symbol-face) + (make-face 'woman-symbol) ;; Set the symbol font only if `woman-use-symbol-font' is true, to ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! @@ -1028,18 +1035,6 @@ "Set `woman-nospace' to nil." (setq woman-nospace nil)) -(defconst woman-mode-line-format - ;; This is essentially the Man-mode format with page numbers removed - ;; and line numbers added. (Online documents do not have pages, but - ;; they do have lines!) - '("-" mode-line-mule-info mode-line-modified - mode-line-frame-identification mode-line-buffer-identification - " " global-mode-string - " %[(WoMan" mode-line-process minor-mode-alist ")%]--" - (line-number-mode "L%l--") - (-3 . "%p") "-%-") - "Mode line format for WoMan buffer.") - (defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *" ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named ;; "`" and CGI.man uses a macro named "''"! @@ -1673,24 +1668,24 @@ (goto-char (point-min)) (while (search-forward "__\b\b" nil t) (backward-delete-char 4) - (woman-set-face (point) (1+ (point)) 'woman-italic-face)) + (woman-set-face (point) (1+ (point)) 'woman-italic)) (goto-char (point-min)) (while (search-forward "\b\b__" nil t) (backward-delete-char 4) - (woman-set-face (1- (point)) (point) 'woman-italic-face)))) + (woman-set-face (1- (point)) (point) 'woman-italic)))) ;; Interpret overprinting to indicate bold face: (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t) (woman-delete-match 2) - (woman-set-face (1- (point)) (point) 'woman-bold-face)) + (woman-set-face (1- (point)) (point) 'woman-bold)) ;; Interpret underlining to indicate italic face: ;; (Must be AFTER emboldening to interpret bold _ correctly!) (goto-char (point-min)) (while (search-forward "_" nil t) (delete-char -2) - (woman-set-face (point) (1+ (point)) 'woman-italic-face)) + (woman-set-face (point) (1+ (point)) 'woman-italic)) ;; Leave any other uninterpreted ^H's in the buffer for now! (They ;; might indicate composite special characters, which could be @@ -1703,7 +1698,7 @@ (goto-char (point-min)) (forward-line) (while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t) - (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold-face)))) + (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold)))) ) (defun woman-insert-file-contents (filename compressed) @@ -1738,15 +1733,10 @@ (defvar woman-mode-map nil "Keymap for woman mode.") -(if woman-mode-map - () - ;; Set up the keymap, mostly inherited from Man-mode-map. Normally - ;; button-buffer-map is used as a parent keymap, but we can't have two - ;; parents, so we just copy it. - (setq woman-mode-map (copy-keymap button-buffer-map)) +(unless woman-mode-map + (setq woman-mode-map (make-sparse-keymap)) (set-keymap-parent woman-mode-map Man-mode-map) - ;; Above two lines were - ;; (setq woman-mode-map (cons 'keymap Man-mode-map)) + (define-key woman-mode-map "R" 'woman-reformat-last-file) (define-key woman-mode-map "w" 'woman) (define-key woman-mode-map "\en" 'WoMan-next-manpage) @@ -1834,6 +1824,8 @@ (setq woman-emulation value) (woman-reformat-last-file)) +(put 'woman-mode 'mode-class 'special) + (defun woman-mode () "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs @@ -1851,34 +1843,33 @@ (fset 'Man-unindent 'ignore) (fset 'Man-goto-page 'ignore) (unwind-protect - (progn - (set (make-local-variable 'Man-mode-map) woman-mode-map) - ;; Install Man mode: - (Man-mode) - ;; Reset inappropriate definitions: - (setq mode-line-format woman-mode-line-format) - (put 'Man-mode 'mode-class 'special)) + (delay-mode-hooks (Man-mode)) ;; Restore the status quo: (fset 'Man-build-page-list Man-build-page-list) (fset 'Man-strip-page-headers Man-strip-page-headers) (fset 'Man-unindent Man-unindent) - (fset 'Man-goto-page Man-goto-page) - ) - ;; Imenu support: - (set (make-local-variable 'imenu-generic-expression) - ;; `make-local-variable' in case imenu not yet loaded! - woman-imenu-generic-expression) - (set (make-local-variable 'imenu-space-replacement) " ") - ;; For reformat ... - ;; necessary when reformatting a file in its old buffer: - (setq imenu--last-menubar-index-alist nil) - ;; necessary to avoid re-installing the same imenu: - (setq woman-imenu-done nil) - (if woman-imenu (woman-imenu)) - (setq buffer-read-only nil) - (Man-highlight-references) - (setq buffer-read-only t) - (set-buffer-modified-p nil))) + (fset 'Man-goto-page Man-goto-page))) + (setq major-mode 'woman-mode + mode-name "WoMan") + ;; Don't show page numbers like Man-mode does. (Online documents do + ;; not have pages) + (kill-local-variable 'mode-line-buffer-identification) + (use-local-map woman-mode-map) + ;; Imenu support: + (set (make-local-variable 'imenu-generic-expression) + ;; `make-local-variable' in case imenu not yet loaded! + woman-imenu-generic-expression) + (set (make-local-variable 'imenu-space-replacement) " ") + ;; For reformat ... + ;; necessary when reformatting a file in its old buffer: + (setq imenu--last-menubar-index-alist nil) + ;; necessary to avoid re-installing the same imenu: + (setq woman-imenu-done nil) + (if woman-imenu (woman-imenu)) + (let (buffer-read-only) + (Man-highlight-references)) + (set-buffer-modified-p nil) + (run-mode-hooks 'woman-mode-hook)) (defun woman-imenu (&optional redraw) "Add a \"Contents\" menu to the menubar. @@ -1955,7 +1946,7 @@ (around Man-getpage-in-background-advice (topic) activate) "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. Otherwise use Man and record start of formatting time." - (if (and (eq mode-line-format woman-mode-line-format) + (if (and (eq major-mode 'woman-mode) (not (eq (caar command-history) 'man))) (WoMan-getpage-in-background topic) ;; Initiates man processing @@ -2204,11 +2195,11 @@ ;; Prepare non-underlined versions of underlined faces: (woman-non-underline-faces) - ;; Set font of `woman-symbol-face' to `woman-symbol-font' if + ;; Set font of `woman-symbol' face to `woman-symbol-font' if ;; `woman-symbol-font' is well defined. (and woman-use-symbol-font (stringp woman-symbol-font) - (set-face-font 'woman-symbol-face woman-symbol-font + (set-face-font 'woman-symbol woman-symbol-font (and (frame-live-p woman-frame) woman-frame))) ;; Set syntax and display tables: @@ -2293,8 +2284,7 @@ "^" "_"))) (cond (first (replace-match repl nil t) - (put-text-property (1- (point)) (point) - 'face 'woman-addition-face) + (put-text-property (1- (point)) (point) 'face 'woman-addition) (WoMan-warn "Initial vertical motion escape \\%s simulated" esc) (WoMan-log @@ -2919,8 +2909,7 @@ Set NEWTEXT in face FACE if specified." (woman-delete-match 0) (insert-before-markers newtext) - (if face (put-text-property (1- (point)) (point) - 'face 'woman-symbol-face)) + (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol)) t) (defun woman-special-characters (to) @@ -2938,7 +2927,7 @@ ;; Need symbol font: (if woman-use-symbol-font (woman-replace-match (nth 2 replacement) - 'woman-symbol-face)) + 'woman-symbol)) ;; Need extended font: (if woman-use-extended-font (woman-replace-match (nth 2 replacement)))))) @@ -2963,7 +2952,7 @@ (while (< i 256) (insert (format "\\%03o " i) (string i) " " (string i)) (put-text-property (1- (point)) (point) - 'face 'woman-symbol-face) + 'face 'woman-symbol) (insert " ") (setq i (1+ i)) (when (= i 128) (setq i 160) (insert "\n")) @@ -3231,12 +3220,12 @@ (defconst woman-font-alist '(("R" . default) - ("I" . woman-italic-face) - ("B" . woman-bold-face) + ("I" . woman-italic) + ("B" . woman-bold) ("P" . previous) ("1" . default) - ("2" . woman-italic-face) - ("3" . woman-bold-face) ; used in bash.1 + ("2" . woman-italic) + ("3" . woman-bold) ; used in bash.1 ) "Alist of ?roff font indicators and woman font variables and names.") @@ -3284,9 +3273,9 @@ (WoMan-warn "Unknown font %s." fontstring) ;; Output this message once only per call ... (setq font-alist - (cons (cons fontstring 'woman-unknown-face) + (cons (cons fontstring 'woman-unknown) font-alist)) - 'woman-unknown-face) + 'woman-unknown) ))) ;; Delete font control line or escape sequence: (cond (beg (delete-region beg (point)) @@ -3747,7 +3736,7 @@ )) ;; Embolden heading (point is at end of heading): (woman-set-face - (save-excursion (beginning-of-line) (point)) (point) 'woman-bold-face) + (save-excursion (beginning-of-line) (point)) (point) 'woman-bold) (forward-line) (delete-blank-lines) (setq woman-left-margin woman-default-indent) @@ -3767,7 +3756,7 @@ ;; Optionally embolden heading (point is at beginning of heading): (if woman-bold-headings (woman-set-face - (point) (save-excursion (end-of-line) (point)) 'woman-bold-face)) + (point) (save-excursion (end-of-line) (point)) 'woman-bold)) (forward-line) (setq woman-left-margin woman-default-indent woman-nofill nil) ; fill output lines
--- a/lisp/xml.el Thu Jun 09 07:36:24 2005 +0000 +++ b/lisp/xml.el Wed Jun 15 23:32:15 2005 +0000 @@ -211,6 +211,35 @@ (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) ;;[67] Reference ::= EntityRef | CharRef (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) +;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" + (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|" + "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)")) +;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default] +;; | 'IDREF' [VC: IDREF] +;; | 'IDREFS' [VC: IDREF] +;; | 'ENTITY' [VC: Entity Name] +;; | 'ENTITIES' [VC: Entity Name] +;; | 'NMTOKEN' [VC: Name Token] +;; | 'NMTOKENS' [VC: Name Token] + (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)") +;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re + "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)")) +;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens] + (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re + "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*" + whitespace ")\\)")) +;;[57] EnumeratedType ::= NotationType | Enumeration + (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)")) +;;[54] AttType ::= StringType | TokenizedType | EnumeratedType +;;[55] StringType ::= 'CDATA' + (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)")) +;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) + (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)")) +;;[53] AttDef ::= S Name S AttType S DefaultDecl + (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re + whitespace "*" xml-att-type-re + whitespace "*" xml-default-decl-re "\\)")) ;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' ;; | "'" ([^%&'] | PEReference | Reference)* "'" (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re @@ -580,7 +609,7 @@ (error "XML: Bad DTD") (forward-char) ;; Parse the rest of the DTD - ;; Fixme: Deal with ATTLIST, NOTATION, PIs. + ;; Fixme: Deal with NOTATION, PIs. (while (not (looking-at "\\s-*\\]")) (skip-syntax-forward " ") (cond @@ -616,16 +645,24 @@ ;; Store the element in the DTD (push (list element type) dtd) (goto-char end-pos)) + + ;; Translation of rule [52] of XML specifications + ((looking-at (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re + "\\)[ \t\n\r]*\\(" xml-att-def-re + "\\)*[ \t\n\r]*>")) + + ;; We don't do anything with ATTLIST currently + (goto-char (match-end 0))) + ((looking-at "<!--") (search-forward "-->")) ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re "\\)[ \t\n\r]*\\(" xml-entity-value-re "\\)[ \t\n\r]*>")) - (let ((name (buffer-substring (nth 2 (match-data)) - (nth 3 (match-data)))) - (value (buffer-substring (+ (nth 4 (match-data)) 1) - (- (nth 5 (match-data)) 1)))) - (goto-char (nth 1 (match-data))) + (let ((name (match-string 1)) + (value (substring (match-string 2) 1 + (- (length (match-string 2)) 1)))) + (goto-char (match-end 0)) (setq xml-entity-alist (append xml-entity-alist (list (cons name @@ -644,11 +681,10 @@ "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'" "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)" "[ \t\n\r]*>"))) - (let ((name (buffer-substring (nth 2 (match-data)) - (nth 3 (match-data)))) - (file (buffer-substring (+ (nth 4 (match-data)) 1) - (- (nth 5 (match-data)) 1)))) - (goto-char (nth 1 (match-data))) + (let ((name (match-string 1)) + (file (substring (match-string 2) 1 + (- (length (match-string 2)) 1)))) + (goto-char (match-end 0)) (setq xml-entity-alist (append xml-entity-alist (list (cons name (with-temp-buffer @@ -677,7 +713,7 @@ (when xml-validating-parser (error "XML: (Validity) Invalid DTD item")))))) (if (looking-at "\\s-*]>") - (goto-char (nth 1 (match-data))))) + (goto-char (match-end 0)))) (nreverse dtd))) (defun xml-parse-elem-type (string)
--- a/lispref/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,82 @@ +2005-06-15 Kim F. Storm <storm@cua.dk> + + * searching.texi (Entire Match Data): Rephrase warnings about + evaporate arg to match-data and set-match-data. + +2005-06-14 Luc Teirlinck <teirllm@auburn.edu> + + * elisp.texi (Top): Update detailed menu. + + * edebug.texi (Edebug): Update menu. + (Instrumenting): Update xrefs. + (Edebug Execution Modes): Correct xref. + (Jumping): Clarify description of `h' command. + Eliminate redundant @ref. + (Breaks): New node. + (Breakpoints): is now a subsubsection. + (Global Break Condition): Mention `C-x X X'. + (Edebug Views): Clarify `v' and `p'. Mention `C-x X w'. + (Trace Buffer): Clarify STRING arg of `edebug-tracing'. + (Edebug Display Update): Correct pxref. + (Edebug and Macros): New node. + (Instrumenting Macro Calls): Is now a subsubsection. + Neither arg of `def-edebug-spec' is evaluated. + (Instrumenting Macro Calls): Mention `edebug-eval-macro-args'. + (Specification Examples): Fix typo. + +2005-06-14 Lute Kamstra <lute@gnu.org> + + * debugging.texi (Function Debugging): Primitives can break on + entry too. + +2005-06-14 Kim F. Storm <storm@cua.dk> + + * variables.texi (Setting Variables): Add add-to-ordered-list. + +2005-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.texi (Parsing Expressions): Document aux functions and vars of + syntax-ppss: syntax-ppss-flush-cache and syntax-begin-function. + +2005-06-13 Lute Kamstra <lute@gnu.org> + + * text.texi (Special Properties): Fix cross reference. + +2005-06-11 Luc Teirlinck <teirllm@auburn.edu> + + * debugging.texi (Function Debugging): Delete mention of empty + string argument to `cancel-debug-on-entry'. Delete inaccurate + description of the return value of that command. + +2005-06-11 Alan Mackenzie <acm@muc.de> + + * text.texi (Adaptive Fill): Amplify the description of + fill-context-prefix. + +2005-06-10 Luc Teirlinck <teirllm@auburn.edu> + + * syntax.texi (Parsing Exprssions): Fix Texinfo error. + +2005-06-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.texi (Parsing Expressions): Document syntax-ppss. + +2005-06-10 Luc Teirlinck <teirllm@auburn.edu> + + * debugging.texi (Error Debugging): Minor rewording. + (Function Debugging): FUNCTION-NAME arg to `cancel-debug-on-entry' + is optional. + +2005-06-10 Lute Kamstra <lute@gnu.org> + + * elisp.texi: Use EMACSVER to refer to the current version of Emacs. + (Top): Give it a title. Correct version number. Give the + detailed node listing a more prominent header. + * intro.texi: Don't set VERSION here a second time. + Mention Emacs's version too. + * anti.texi (Antinews): Use EMACSVER to refer to the current + version of Emacs. + 2005-06-09 Kim F. Storm <storm@cua.dk> * searching.texi (Entire Match Data): Explain new `reseat' argument to @@ -78,8 +157,8 @@ 2005-05-21 Eli Zaretskii <eliz@gnu.org> - * files.texi (Locating Files): New subsection. Describe - locate-file and executable-find. + * files.texi (Locating Files): New subsection. + Describe locate-file and executable-find. 2005-05-21 Kevin Ryde <user42@zip.com.au> @@ -94,8 +173,8 @@ (Major Mode Conventions): Refer to `Auto Major Mode' in more appropriate place. (Derived Modes): Small clarifications. - (Minor Mode Conventions, Keymaps and Minor Modes): Replace - references to nodes with references to anchors. + (Minor Mode Conventions, Keymaps and Minor Modes): + Replace references to nodes with references to anchors. (Mode Line Data): Warn that `(:eval FORM)' should not load any files. Clarify description of lists whose first element is an integer. (Mode Line Variables): Add anchor. @@ -247,10 +326,10 @@ (Font Lock Basics): Say that font-lock-defaults is buffer-local when set and that some parts are optional. Add cross references. (Search-based Fontification): Say how to specify font-lock-keywords. - Add cross references. Add font-lock-multiline to index. Move - font-lock-keywords-case-fold-search here from node "Other Font + Add cross references. Add font-lock-multiline to index. + Move font-lock-keywords-case-fold-search here from node "Other Font Lock Variables". Document font-lock-add-keywords and - font-lock-remove-keywords + font-lock-remove-keywords. (Other Font Lock Variables): Move font-lock-keywords-only, font-lock-syntax-table, font-lock-beginning-of-syntax-function, and font-lock-syntactic-face-function to node "Syntactic Font @@ -265,8 +344,8 @@ and font-lock-syntactic-face-function here from node "Other Font Lock Variables". Move font-lock-syntactic-keywords to "Setting Syntax Properties". Add cross references. - (Setting Syntax Properties): New node. Move - font-lock-syntactic-keywords here from "Syntactic Font Lock". + (Setting Syntax Properties): New node. + Move font-lock-syntactic-keywords here from "Syntactic Font Lock". * syntax.texi (Syntax Properties): Add cross reference. * hooks.texi (Standard Hooks): Add Font-Lock hooks. @@ -325,7 +404,7 @@ 2005-04-19 Kevin Ryde <user42@zip.com.au> - * streams.texi (Output Functions): Fix xref. + * streams.texi (Output Functions): Fix xref. * strings.texi (String Conversion): Fix xref. 2005-04-19 Kim F. Storm <storm@cua.dk> @@ -419,8 +498,8 @@ * markers.texi (The Mark): Document temporary Transient Mark mode. - * minibuf.texi (Reading File Names): Document - read-file-name-completion-ignore-case. + * minibuf.texi (Reading File Names): + Document read-file-name-completion-ignore-case. * positions.texi (Screen Lines): Document nil for width argument to compute-motion. @@ -440,11 +519,10 @@ (Managing Overlays): Document remove-overlays. (Standard Faces): Document escape-glyph face. - * minibuf.texi (Reading File Names): Document - read-file-name-function. - - * modes.texi (Other Font Lock Variables): Document - font-lock-lines-before. + * minibuf.texi (Reading File Names): Document read-file-name-function. + + * modes.texi (Other Font Lock Variables): + Document font-lock-lines-before. * positions.texi (Skipping Characters): skip-chars-forward allows character classes. @@ -498,18 +576,18 @@ (Progress): Clarify. (Invisible Text): Explain that main loop moves point out. (Selective Display): Say "hidden", not "invisible". - (Managing Overlays): Moved up. Describe relation to Undo here. + (Managing Overlays): Move up. Describe relation to Undo here. (Overlay Properties): Clarify intro. (Finding Overlays): Explain return values when nothing found. (Width): truncate-string-to-width has added arg. (Displaying Faces): Clarify and update mode line face handling. (Face Functions): Minor cleanup. - (Conditional Display): Merged into Other Display Specs. + (Conditional Display): Merge into Other Display Specs. (Pixel Specification, Other Display Specs): Minor cleanups. (Images, Image Descriptors): Minor cleanups. (GIF Images): Patents have expired. (Showing Images): Explain default text for insert-image. - (Manipulating Button Types): Merged into Manipulating Buttons. + (Manipulating Button Types): Merge into Manipulating Buttons. (Making Buttons): Explain return values. (Button Buffer Commands): Add xref. (Inverse Video): Update mode-line-inverse-video. @@ -869,8 +947,8 @@ * commands.texi (Misc Events): Describe the help-echo event. * text.texi (Special Properties) <help-echo>: Use `pos' - consistently in description of the help-echo property. Use - @code{nil} instead of @var{nil}. + consistently in description of the help-echo property. + Use @code{nil} instead of @var{nil}. * display.texi (Overlay Properties): Fix the index entry for help-echo overlay property.
--- a/lispref/Makefile.in Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/Makefile.in Wed Jun 15 23:32:15 2005 +0000 @@ -124,7 +124,7 @@ maintainer-clean: clean rm -f elisp.dvi elisp.oaux - cd $(infodir); rm -f elisp elisp-[1-9] elisp-[1-9][0-9] + cd $(infodir); rm -f elisp elisp-[1-9] elisp-[1-9][0-9] dist: $(infodir)/elisp elisp.dvi -rm -rf temp
--- a/lispref/anti.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/anti.texi Wed Jun 15 23:32:15 2005 +0000 @@ -10,7 +10,8 @@ For those users who live backwards in time, here is information about downgrading to Emacs version 21.4. We hope you will enjoy the greater -simplicity that results from the absence of many Emacs 22 features. +simplicity that results from the absence of many Emacs @value{EMACSVER} +features. @section Old Lisp Features in Emacs 21
--- a/lispref/debugging.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/debugging.texi Wed Jun 15 23:32:15 2005 +0000 @@ -118,8 +118,8 @@ @end defopt @defopt eval-expression-debug-on-error -If you set this variable to a non-@code{nil} value, then -@code{debug-on-error} will be set to @code{t} when evaluating with the +If this variable has a non-@code{nil} value, then +@code{debug-on-error} is set to @code{t} when evaluating with the command @code{eval-expression}. If @code{eval-expression-debug-on-error} is @code{nil}, then the value of @code{debug-on-error} is not changed. @xref{Lisp Eval,, Evaluating @@ -210,15 +210,19 @@ function, and then step through its caller. @deffn Command debug-on-entry function-name -This function requests @var{function-name} to invoke the debugger each time -it is called. It works by inserting the form @code{(debug 'debug)} into -the function definition as the first form. +This function requests @var{function-name} to invoke the debugger each +time it is called. It works by inserting the form +@code{(implement-debug-on-entry)} into the function definition as the +first form. -Any function defined as Lisp code may be set to break on entry, -regardless of whether it is interpreted code or compiled code. If the -function is a command, it will enter the debugger when called from Lisp -and when called interactively (after the reading of the arguments). You -can't debug primitive functions (i.e., those written in C) this way. +Any function or macro defined as Lisp code may be set to break on +entry, regardless of whether it is interpreted code or compiled code. +If the function is a command, it will enter the debugger when called +from Lisp and when called interactively (after the reading of the +arguments). You can also set debug-on-entry for primitive functions +(i.e., those written in C) this way, but it only takes effect when the +primitive is called from Lisp code. Debug-on-entry is not allowed for +special forms. When @code{debug-on-entry} is called interactively, it prompts for @var{function-name} in the minibuffer. If the function is already set @@ -267,16 +271,13 @@ @end example @end deffn -@deffn Command cancel-debug-on-entry function-name +@deffn Command cancel-debug-on-entry &optional function-name This function undoes the effect of @code{debug-on-entry} on @var{function-name}. When called interactively, it prompts for @var{function-name} in the minibuffer. If @var{function-name} is -@code{nil} or the empty string, it cancels break-on-entry for all -functions. - +omitted or @code{nil}, it cancels break-on-entry for all functions. Calling @code{cancel-debug-on-entry} does nothing to a function which is -not currently set up to break on entry. It always returns -@var{function-name}. +not currently set up to break on entry. @end deffn @node Explicit Debug
--- a/lispref/edebug.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/edebug.texi Wed Jun 15 23:32:15 2005 +0000 @@ -65,7 +65,7 @@ * Modes: Edebug Execution Modes. Execution modes, stopping more or less often. * Jumping:: Commands to jump to a specified place. * Misc: Edebug Misc. Miscellaneous commands. -* Breakpoints:: Setting breakpoints to make the program stop. +* Breaks:: Setting breakpoints to make the program stop. * Trapping Errors:: Trapping errors with Edebug. * Views: Edebug Views. Views inside and outside of Edebug. * Eval: Edebug Eval. Evaluating expressions within Edebug. @@ -75,7 +75,7 @@ * Trace Buffer:: How to produce trace output in a buffer. * Coverage Testing:: How to test evaluation coverage. * The Outside Context:: Data that Edebug saves and restores. -* Instrumenting Macro Calls:: Specifying how to handle macro calls. +* Edebug and Macros:: Specifying how to handle macro calls. * Options: Edebug Options. Option variables for customizing Edebug. @end menu @@ -203,13 +203,13 @@ @code{interactive} forms with an expression argument, anonymous lambda expressions, and other defining forms. However, Edebug cannot determine on its own what a user-defined macro will do with the arguments of a -macro call, so you must provide that information; see @ref{Instrumenting -Macro Calls}, for details. +macro call, so you must provide that information; see @ref{Edebug and +Macros}, for details. When Edebug is about to instrument code for the first time in a session, it runs the hook @code{edebug-setup-hook}, then sets it to @code{nil}. You can use this to load Edebug specifications -(@pxref{Instrumenting Macro Calls}) associated with a package you are +(@pxref{Edebug and Macros}) associated with a package you are using, but only when you use Edebug. @findex eval-expression @r{(Edebug)} @@ -253,7 +253,7 @@ @item n Next: stop at the next stop point encountered after an expression (@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in -@ref{Edebug Misc}. +@ref{Jumping}. @item t Trace: pause (normally one second) at each Edebug stop point @@ -341,9 +341,8 @@ Step into the function or macro called by the form after point. @end table -The @kbd{h} command proceeds to the stop point near the current location -of point, using a temporary breakpoint. See @ref{Breakpoints}, for more -information about breakpoints. +The @kbd{h} command proceeds to the stop point at or after the current +location of point, using a temporary breakpoint. The @kbd{f} command runs the program forward over one expression. More precisely, it sets a temporary breakpoint at the position that @@ -427,14 +426,23 @@ with @kbd{q} or abort one recursive edit level with @kbd{C-]}. You can display a backtrace of all the pending evaluations with @kbd{d}. -@node Breakpoints -@subsection Breakpoints +@node Breaks +@subsection Breaks -@cindex breakpoints Edebug's step mode stops execution when the next stop point is reached. There are three other ways to stop Edebug execution once it has started: breakpoints, the global break condition, and source breakpoints. +@menu +* Breakpoints:: Breakpoints at stop points. +* Global Break Condition:: Breaking on an event. +* Source Breakpoints:: Embedding breakpoints in source code. +@end menu + +@node Breakpoints +@subsubsection Breakpoints + +@cindex breakpoints While using Edebug, you can specify @dfn{breakpoints} in the program you are testing: these are places where execution should stop. You can set a breakpoint at any stop point, as defined in @ref{Using Edebug}. For @@ -494,12 +502,6 @@ breakpoints. This command does not continue execution---it just moves point in the buffer. -@menu -* Global Break Condition:: Breaking on an event. -* Source Breakpoints:: Embedding breakpoints in source code. -@end menu - - @node Global Break Condition @subsubsection Global Break Condition @@ -515,7 +517,9 @@ @findex edebug-set-global-break-condition The condition expression is stored in @code{edebug-global-break-condition}. You can specify a new expression -using the @kbd{X} command (@code{edebug-set-global-break-condition}). +using the @kbd{X} command from the source code buffer while Edebug is +active, or using @kbd{C-x X X} from any buffer at any time, as long as +Edebug is loaded (@code{edebug-set-global-break-condition}). The global break condition is the simplest way to find where in your code some event occurs, but it makes code run much more slowly. So you @@ -582,13 +586,14 @@ @table @kbd @item v -Temporarily view the outside window configuration -(@code{edebug-view-outside}). +View the outside window configuration (@code{edebug-view-outside}). +Type @kbd{C-x X w} to return to Edebug. @item p -Temporarily display the outside current buffer with point at its outside -position (@code{edebug-bounce-point}). With a prefix argument @var{n}, -pause for @var{n} seconds instead. +Temporarily display the outside current buffer with point at its +outside position (@code{edebug-bounce-point}), pausing for one second +before returning to Edebug. With a prefix argument @var{n}, pause for +@var{n} seconds instead. @item w Move point back to the current stop point in the source code buffer @@ -610,8 +615,12 @@ You can view the outside window configuration with @kbd{v} or just bounce to the point in the current buffer with @kbd{p}, even if -it is not normally displayed. After moving point, you may wish to jump -back to the stop point with @kbd{w} from a source code buffer. +it is not normally displayed. + + After moving point, you may wish to jump back to the stop point. +You can do that with @kbd{w} from a source code buffer. You can jump +back to the stop point in the source code buffer from any buffer using +@kbd{C-x X w}. Each time you use @kbd{W} to turn saving @emph{off}, Edebug forgets the saved outside window configuration---so that even if you turn saving @@ -838,8 +847,9 @@ @defmac edebug-tracing string body@dots{} This macro requests additional trace information around the execution of the @var{body} forms. The argument @var{string} specifies text -to put in the trace buffer. All the arguments are evaluated, and -@code{edebug-tracing} returns the value of the last form in @var{body}. +to put in the trace buffer, after the @samp{@{} or @samp{@}}. All +the arguments are evaluated, and @code{edebug-tracing} returns the +value of the last form in @var{body}. @end defmac @defun edebug-trace format-string &rest format-args @@ -990,7 +1000,7 @@ @item @cindex window configuration (Edebug) The outside window configuration is saved and restored if -@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Display Update}). +@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}). The window configuration is not restored on error or quit, but the outside selected window @emph{is} reselected even on error or quit in @@ -1061,8 +1071,21 @@ @code{edebug-continue-kbd-macro}. @end itemize +@node Edebug and Macros +@subsection Edebug and Macros + +To make Edebug properly instrument expressions that call macros, some +extra care is needed. This subsection explains the details. + +@menu +* Instrumenting Macro Calls:: The basic problem. +* Specification List:: How to specify complex patterns of evaluation. +* Backtracking:: What Edebug does when matching fails. +* Specification Examples:: To help understand specifications. +@end menu + @node Instrumenting Macro Calls -@subsection Instrumenting Macro Calls +@subsubsection Instrumenting Macro Calls When Edebug instruments an expression that calls a Lisp macro, it needs additional information about the macro to do the job properly. This is @@ -1101,7 +1124,7 @@ @deffn Macro def-edebug-spec macro specification Specify which expressions of a call to macro @var{macro} are forms to be evaluated. @var{specification} should be the edebug specification. -It is not evaluated. +Neither argument is evaluated. The @var{macro} argument can actually be any symbol, not just a macro name. @@ -1128,12 +1151,12 @@ described in the following sections. @end table -@menu -* Specification List:: How to specify complex patterns of evaluation. -* Backtracking:: What Edebug does when matching fails. -* Specification Examples:: To help understand specifications. -@end menu - +@vindex edebug-eval-macro-args +If a macro has no Edebug specification, neither through a @code{debug} +declaration nor through a @code{def-edebug-spec} call, the variable +@code{edebug-eval-macro-args} comes into play. If it is @code{nil}, +the default, none of the arguments is instrumented for evaluation. +If it is non-@code{nil}, all arguments are instrumented. @node Specification List @subsubsection Specification List @@ -1406,7 +1429,7 @@ Edebug uses the following specifications for @code{defun} and @code{defmacro} and the associated argument list and @code{interactive} specifications. It is necessary to handle interactive forms specially -since an expression argument it is actually evaluated outside of the +since an expression argument is actually evaluated outside of the function body. @smallexample
--- a/lispref/elisp.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/elisp.texi Wed Jun 15 23:32:15 2005 +0000 @@ -4,8 +4,10 @@ @settitle GNU Emacs Lisp Reference Manual @c %**end of header -@c Versino of the manual. -@set VERSION 2.9 +@c Version of the manual and of Emacs. +@c Please remember to update the edition number in README as well. +@set VERSION 2.9 +@set EMACSVER 22.0.50 @dircategory Emacs @direntry @@ -26,9 +28,7 @@ @ifnottex This Info file contains edition @value{VERSION} of the GNU Emacs Lisp -Reference Manual, corresponding to Emacs version 22.1. -@c Please REMEMBER to update edition number in *four* places in this file -@c and also in *one* place in intro.texi and *one* in README. +Reference Manual, corresponding to Emacs version @value{EMACSVER}. Published by the Free Software Foundation 59 Temple Place, Suite 330 @@ -52,9 +52,7 @@ @titlepage @title GNU Emacs Lisp Reference Manual -@subtitle For Emacs Version 22 -@c The edition number appears in several places in this file -@c and also in the file intro.texi. +@subtitle For Emacs Version @value{EMACSVER} @subtitle Revision @value{VERSION}, January 2002 @author by Bil Lewis, Dan LaLiberte, Richard Stallman @@ -66,7 +64,7 @@ @sp 2 Edition @value{VERSION} @* -Revised for Emacs Version 22.1,@* +Revised for Emacs Version @value{EMACSVER},@* January 2002.@* @sp 2 ISBN 1-882114-73-6 @@ -92,11 +90,12 @@ @end titlepage @page +@ifnottex @node Top, Introduction, (dir), (dir) +@top Emacs Lisp -@ifnottex This Info file contains edition @value{VERSION} of the GNU Emacs Lisp -Reference Manual, corresponding to GNU Emacs version 22.1. +Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}. @end ifnottex @menu @@ -156,7 +155,7 @@ Appendices -* Antinews:: Info for users downgrading to Emacs 20. +* Antinews:: Info for users downgrading to Emacs 21. * GNU Free Documentation License:: The license for this documentation * GPL:: Conditions for copying and changing GNU Emacs. * Tips:: Advice and coding conventions for Emacs Lisp. @@ -171,9 +170,10 @@ * Index:: Index including concepts, functions, variables, and other terms. -* New Symbols:: New functions and variables in Emacs 22. +* New Symbols:: New functions and variables in Emacs @value{EMACSVER}. - --- The Detailed Node Listing --- +Detailed Node Listing +--------------------- Here are other nodes that are inferiors of those already listed, mentioned here so you can get to them in one step: @@ -514,7 +514,7 @@ * Edebug Execution Modes:: Execution modes, stopping more or less often. * Jumping:: Commands to jump to a specified place. * Edebug Misc:: Miscellaneous commands. -* Breakpoints:: Setting breakpoints to make the program stop. +* Breaks:: Setting breakpoints to make the program stop. * Trapping Errors:: Trapping errors with Edebug. * Edebug Views:: Views inside and outside of Edebug. * Edebug Eval:: Evaluating expressions within Edebug. @@ -524,7 +524,7 @@ * Trace Buffer:: How to produce trace output in a buffer. * Coverage Testing:: How to test evaluation coverage. * The Outside Context:: Data that Edebug saves and restores. -* Instrumenting Macro Calls:: Specifying how to handle macro calls. +* Edebug and Macros:: Specifying how to handle macro calls. * Edebug Options:: Option variables for customizing Edebug. Debugging Invalid Lisp Syntax
--- a/lispref/intro.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/intro.texi Wed Jun 15 23:32:15 2005 +0000 @@ -5,9 +5,6 @@ @c See the file elisp.texi for copying conditions. @setfilename ../info/intro -@c Versino of the manual. -@set VERSION 2.9 - @node Introduction, Lisp Data Types, Top, Top @comment node-name, next, previous, up @chapter Introduction @@ -38,7 +35,8 @@ chapters describe features that are peculiar to Emacs Lisp or relate specifically to editing. - This is edition @value{VERSION}. + This is edition @value{VERSION} of the GNU Emacs Lisp Reference +Manual, corresponding to Emacs version @value{EMACSVER}. @menu * Caveats:: Flaws and a request for help.
--- a/lispref/searching.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/searching.texi Wed Jun 15 23:32:15 2005 +0000 @@ -1531,8 +1531,9 @@ the markers are put back on the free list. @strong{Warning:} When @code{evaporate} is specified for @var{reseat}, -no other references to the markers on the @var{reuse} list; otherwise, -Emacs may crash during the next garbage collection. +you must ensure that no other references to the markers on the +@var{reuse} list exists; otherwise, Emacs may crash during the next +garbage collection. As always, there must be no possibility of intervening searches between the call to a search function and the call to @code{match-data} that is @@ -1563,8 +1564,9 @@ the markers are put back on the free list. @strong{Warning:} When @code{evaporate} is specified for @var{reseat}, -no other references to the markers on the @var{match-list} list; otherwise, -Emacs may crash during the next garbage collection. +you must ensure that no other references to the markers on the +@var{match-list} list exists; otherwise, Emacs may crash during the +next garbage collection. @findex store-match-data @code{store-match-data} is a semi-obsolete alias for @code{set-match-data}.
--- a/lispref/syntax.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/syntax.texi Wed Jun 15 23:32:15 2005 +0000 @@ -256,7 +256,7 @@ @deffn {Syntax class} @w{inherit} This syntax class does not specify a particular syntax. It says to look in the standard syntax table to find the syntax of this character. The -designator for this syntax code is @samp{@@}. +designator for this syntax class is @samp{@@}. @end deffn @deffn {Syntax class} @w{generic comment delimiter} @@ -385,7 +385,7 @@ @samp{p} identifies an additional ``prefix character'' for Lisp syntax. These characters are treated as whitespace when they appear between expressions. When they appear within an expression, they are handled -according to their usual syntax codes. +according to their usual syntax classes. The function @code{backward-prefix-chars} moves back over these characters, as well as over characters whose primary syntax class is @@ -566,7 +566,7 @@ @defun skip-syntax-forward syntaxes &optional limit This function moves point forward across characters having syntax -classes mentioned in @var{syntaxes} (a string of syntax code +classes mentioned in @var{syntaxes} (a string of syntax class characters). It stops when it encounters the end of the buffer, or position @var{limit} (if specified), or a character it is not supposed to skip. @@ -730,6 +730,36 @@ that have nested parentheses. @end defun +@defun syntax-ppss &optional pos +This function returns the state that the parser would have at position +@var{pos}, if it were started with a default start state at the +beginning of the buffer. Thus, it is equivalent to +@code{(parse-partial-sexp (point-min) @var{pos})}, except that +@code{syntax-ppss} uses a cache to speed up the computation. Also, +the 2nd value (previous complete subexpression) and 6th value (minimum +parenthesis depth) of the returned state are not meaningful. +@end defun + +@defun syntax-ppss-flush-cache beg +This function flushes the cache used by @code{syntax-ppss}, starting at +position @var{beg}. + +When @code{syntax-ppss} is called, it automatically hooks itself +to @code{before-change-functions} to keep its cache consistent. +But this can fail if @code{syntax-ppss} is called while +@code{before-change-functions} is temporarily let-bound, or if the +buffer is modified without obeying the hook, such as when using +@code{inhibit-modification-hooks}. For this reason, it is sometimes +necessary to flush the cache manually. +@end defun + +@defvar syntax-begin-function +If this is non-nil, it should be a function that moves to an earlier +buffer position where the parser state is equivalent to @code{nil}, +i.e., a position outside of any comment, string, or parenthesis. +@code{syntax-ppss} uses it to supplement its cache. +@end defvar + @defun scan-lists from count depth This function scans forward @var{count} balanced parenthetical groupings from position @var{from}. It returns the position where the scan stops. @@ -779,7 +809,7 @@ @end defopt @vindex parse-sexp-lookup-properties -The behaviour of @code{parse-partial-sexp} is also affected by +The behavior of @code{parse-partial-sexp} is also affected by @code{parse-sexp-lookup-properties} (@pxref{Syntax Properties}). You can use @code{forward-comment} to move forward or backward over
--- a/lispref/text.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/lispref/text.texi Wed Jun 15 23:32:15 2005 +0000 @@ -1667,8 +1667,12 @@ @section Adaptive Fill Mode @cindex Adaptive Fill mode - Adaptive Fill mode chooses a fill prefix automatically from the text -in each paragraph being filled. + When @dfn{Adaptive Fill Mode} is enabled, Emacs determines the fill +prefix automatically from the text in each paragraph being filled +rather than using a predetermined value. During filling, this fill +prefix gets inserted at the start of the second and subsequent lines +of the paragraph as described in @ref{Filling}, and in @ref{Auto +Filling}. @defopt adaptive-fill-mode Adaptive Fill mode is enabled when this variable is non-@code{nil}. @@ -1677,38 +1681,80 @@ @defun fill-context-prefix from to This function implements the heart of Adaptive Fill mode; it chooses a -fill prefix based on the text between @var{from} and @var{to}. It does -this by looking at the first two lines of the paragraph, based on the -variables described below. +fill prefix based on the text between @var{from} and @var{to}, +typically the start and end of a paragraph. It does this by looking +at the first two lines of the paragraph, based on the variables +described below. @c The optional argument first-line-regexp is not documented @c because it exists for internal purposes and might be eliminated @c in the future. + +Usually, this function returns the fill prefix, a string. However, +before doing this, the function makes a final check (not specially +mentioned in the following) that a line starting with this prefix +wouldn't look like the start of a paragraph. Should this happen, the +function signals the anomaly by returning @code{nil} instead. + +In detail, @code{fill-context-prefix} does this: + +@enumerate +@item +It takes a candidate for the fill prefix from the first line---it +tries first the function in @code{adaptive-fill-function} (if any), +then the regular expression @code{adaptive-fill-regexp} (see below). +The first non-@code{nil} result of these, or the empty string if +they're both @code{nil}, becomes the first line's candidate. +@item +If the paragraph has as yet only one line, the function tests the +validity of the prefix candidate just found. The function then +returns the candidate if it's valid, or a string of spaces otherwise. +(see the description of @code{adaptive-fill-first-line-regexp} below). +@item +When the paragraph already has two lines, the function next looks for +a prefix candidate on the second line, in just the same way it did for +the first line. If it doesn't find one, it returns @code{nil}. +@item +The function now compares the two candidate prefixes heuristically: if +the non-whitespace characters in the line 2 candidate occur in the +same order in the line 1 candidate, the function returns the line 2 +candidate. Otherwise, it returns the largest initial substring which +is common to both candidates (which might be the empty string). +@end enumerate @end defun @defopt adaptive-fill-regexp -This variable holds a regular expression to control Adaptive Fill mode. Adaptive Fill mode matches this regular expression against the text starting after the left margin whitespace (if any) on a line; the characters it matches are that line's candidate for the fill prefix. + +The default value of this variable is +@w{@samp{"[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"}}. This +matches a number enclosed in parentheses or followed by a period, +or certain punctuation characters, or any sequence of these +intermingled with whitespace. In particular, it matches a sequence of +whitespace, possibly empty. @end defopt @defopt adaptive-fill-first-line-regexp -In a one-line paragraph, if the candidate fill prefix matches this -regular expression, or if it matches @code{comment-start-skip}, then it -is used---otherwise, spaces amounting to the same width are used -instead. - -However, the fill prefix is never taken from a one-line paragraph -if it would act as a paragraph starter on subsequent lines. +Used only in one-line paragraphs, this regular expression acts as an +additional check of the validity of the one available candidate fill +prefix: the candidate must match this regular expression, or match +@code{comment-start-skip}. If it doesn't, @code{fill-context-prefix} +replaces the candidate with a string of spaces ``of the same width'' +as it. + +The default value of this variable is @w{@samp{"\\`[ \t]*\\'"}}, which +matches only a string of whitespace. The effect of this default is to +force the fill prefixes found in one-line paragraphs always to be pure +whitespace. @end defopt @defopt adaptive-fill-function You can specify more complex ways of choosing a fill prefix automatically by setting this variable to a function. The function is -called when @code{adaptive-fill-regexp} does not match, with point after -the left margin of a line, and it should return the appropriate fill -prefix based on that line. If it returns @code{nil}, that means it sees -no fill prefix in that line. +called with point after the left margin (if any) of a line, and it +must preserve point. It should return either ``that line's'' fill +prefix or @code{nil}, meaning it has failed to determine a prefix. @end defopt @node Auto Filling @@ -3078,8 +3124,8 @@ @item pointer @kindex pointer @r{(text property)} This specifies a specific pointer shape when the mouse pointer is over -this text or image. See the variable @var{void-area-text-pointer} -for possible pointer shapes. +this text or image. @xref{Pointer Shape}, for possible pointer +shapes. @item line-spacing @kindex line-spacing @r{(text property)}
--- a/man/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/man/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,17 @@ +2005-06-13 Carsten Dominik <dominik@science.uva.nl> + + * org.texi: Version 3.11 + +2005-06-12 Jay Belanger <belanger@truman.edu> + + * calc.texi (Getting Started): Remove extra menu item. + +2005-06-10 Lute Kamstra <lute@gnu.org> + + * emacs.texi (Top): Correct version number. + * anti.texi (Antinews): Correct version number. Use EMACSVER to + refer to the current version of Emacs. + 2005-06-08 Luc Teirlinck <teirllm@auburn.edu> * files.texi (Log Buffer): Document when there can be more than
--- a/man/anti.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/man/anti.texi Wed Jun 15 23:32:15 2005 +0000 @@ -3,11 +3,12 @@ @c See file emacs.texi for copying conditions. @node Antinews, Mac OS, X Resources, Top -@appendix Emacs 22.1 Antinews +@appendix Emacs 21 Antinews For those users who live backwards in time, here is information about downgrading to Emacs version 21.4. We hope you will enjoy the greater -simplicity that results from the absence of many Emacs 22 features. +simplicity that results from the absence of many Emacs @value{EMACSVER} +features. @itemize @bullet
--- a/man/calc.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/man/calc.texi Wed Jun 15 23:32:15 2005 +0000 @@ -585,7 +585,6 @@ * Notations Used in This Manual:: * Demonstration of Calc:: * Using Calc:: -* Demonstration of Calc:: * History and Acknowledgements:: @end menu
--- a/man/emacs.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/man/emacs.texi Wed Jun 15 23:32:15 2005 +0000 @@ -121,7 +121,7 @@ * GNU Free Documentation License:: The license for this documentation. * Intro:: An introduction to Emacs concepts. * Glossary:: The glossary. -* Antinews:: Information about Emacs version 20. +* Antinews:: Information about Emacs version 21. * Mac OS:: Using Emacs in the Mac. * MS-DOS:: Using Emacs on MS-DOS (otherwise known as "MS-DOG"). * Manifesto:: What's GNU? Gnu's Not Unix!
--- a/man/org.texi Thu Jun 09 07:36:24 2005 +0000 +++ b/man/org.texi Wed Jun 15 23:32:15 2005 +0000 @@ -4,8 +4,8 @@ @setfilename ../info/org @settitle Org Mode Manual -@set VERSION 3.10 -@set DATE May 2005 +@set VERSION 3.11 +@set DATE June 2005 @dircategory Emacs @direntry @@ -103,6 +103,7 @@ * Visibility cycling:: Show ad hide, much simplified * Motion:: Jumping to other headlines * Structure editing:: Changing sequence and level of headlines +* Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context Tables @@ -158,8 +159,8 @@ * Customization:: Adapting Org-mode to your taste * FAQ:: Frequently asked questions * Interaction:: Other Emacs packages +* Bugs:: Things which do not work perfectly * Acknowledgments:: These people provided feedback and more -* Bugs:: Things which do not work perfectly @end detailmenu @end menu @@ -303,6 +304,7 @@ * Visibility cycling:: Show ad hide, much simplified * Motion:: Jumping to other headlines * Structure editing:: Changing sequence and level of headlines +* Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context @end menu @@ -426,7 +428,7 @@ visible. @end table -@node Structure editing, Sparse trees, Motion, Document Structure +@node Structure editing, Archiving, Motion, Document Structure @section Structure editing @cindex structure editing @cindex headline, promotion and demotion @@ -487,7 +489,30 @@ inside a table (@pxref{Tables}), the Meta-Cursor keys have different functionality. -@node Sparse trees, , Structure editing, Document Structure +@node Archiving, Sparse trees, Structure editing, Document Structure +@section Archiving +@cindex archiving + +When an project represented by a (sub)tree is finished, you may want +to move the tree to an Archive place, either in the same file under a +special top-level heading, or even to a different file. +@table @kbd +@kindex @kbd{C-c $} +@item @kbd{C-c $} +Archive the subtree starting at the cursor position to the location +given by @code{org-archive-location}. +@end table + +@cindex archive locations +The default archive is a file in the same directory as the current +file, with the name derived by appending @file{_archive} to the +current file name. For information and examples on how to change +this, see the documentation string of the variable +@code{org-archive-location}. If you are also using the Org-mode +agenda, archiving to a different file is a good way to keep archived +trees from contributing agenda items. + +@node Sparse trees, , Archiving, Document Structure @section Sparse trees @cindex sparse trees @cindex trees, sparse @@ -702,7 +727,8 @@ When not empty, copy current field down to next row and move cursor along with it. Depending on the variable @code{org-table-copy-increment}, integer field values will be -incremented during copy. +incremented during copy. This key is also used by CUA-mode +(@pxref{Interaction}). @cindex formula, in tables @cindex calculations, in tables @@ -807,33 +833,35 @@ @cindex SHELL links Org-mode supports links to files, websites, usenet and email messages; -and BBDB database entries. Links are just plain-text URL-like locators. -The following list shows examples for each link type. +and BBDB database entries. Links are just plain-text URL-like +locators, optionally enclosed by angular brackets. The following list +shows examples for each link type. @example -http://www.astro.uva.nl/~dominik @r{on the web} -file:/home/dominik/images/jupiter.jpg @r{file, absolute path} -file:papers/last.pdf @r{file, relative path} -file:~/code/main.c:255 @r{file, with line number} -news:comp.emacs @r{Usenet link} -mailto:adent@@galaxy.net @r{Mail link} -vm:folder @r{VM folder link} -vm:folder#id @r{VM message link} -vm://myself@@some.where.org/folder#id @r{VM on remote machine} -wl:folder @r{WANDERLUST folder link} -wl:folder#id @r{WANDERLUST message link} -rmail:folder @r{RMAIL folder link} -rmail:folder#id @r{RMAIL message link} -gnus:group @r{GNUS group link} -gnus:group#id @r{GNUS article link} -bbdb:Richard Stallman @r{BBDB link} -shell:ls *.org @r{A shell command} +<http://www.astro.uva.nl/~dominik> @r{on the web} +<file:/home/dominik/images/jupiter.jpg> @r{file, absolute path} +<file:papers/last.pdf> @r{file, relative path} +<file:~/code/main.c:255> @r{file, with line number} +<news:comp.emacs> @r{Usenet link} +<mailto:adent@@galaxy.net> @r{Mail link} +<vm:folder> @r{VM folder link} +<vm:folder#id> @r{VM message link} +<vm://myself@@some.where.org/folder#id> @r{VM on remote machine} +<wl:folder> @r{WANDERLUST folder link} +<wl:folder#id> @r{WANDERLUST message link} +<rmail:folder> @r{RMAIL folder link} +<rmail:folder#id> @r{RMAIL message link} +<gnus:group> @r{GNUS group link} +<gnus:group#id> @r{GNUS article link} +<bbdb:Richard Stallman> @r{BBDB link} +<shell:ls *.org>@footnote{Note that @samp{<} and @samp{>} cannot be part of a link, and therefore of a shell command. If you need redirection, use @@@{ and @@@} instead.} @r{A shell command} @end example -A link may contain space characters and is terminated by the end of -the line or, in tables, by the end of the table field. Therefore, -outside of tables there can be only one link per line (but see the -variable @code{org-allow-space-in-links}). +A link may contain space characters and is terminated by @samp{>} or by +the end of a line. In tables, the end of a table field also terminates +a link. Angle brackets around a link are not required, but are +recommended to avoid problems with punctuation and other text following +the link. See also the variable @code{org-allow-space-in-links}. @cindex storing links @table @kbd @@ -854,10 +882,11 @@ buffer. You can just type a link, using one of the link type prefixes mentioned in the examples above. Through completion, all links stored during the current session can be accessed. When called with prefix -arg, you can use file name completion to enter a file link. Note that -you don't have to use this command to insert a link. Links in -Org-mode are plain text, and you can type or paste them straight into -the buffer. +arg, you can use file name completion to enter a file link. The link +will be formatted as given in the variable @code{org-link-format} and +inserted into the buffer. Note that you don't have to use this +command to insert a link. Links in Org-mode are plain text, and you +can type or paste them straight into the buffer. @cindex inserting links @kindex C-c C-o @@ -930,9 +959,11 @@ Or use prefix arg to specify level manually. @end multitable -So the fastest way to store the note is to press @kbd{C-c C-c @key{RET} -@key{RET}} to append it to the default file. But with little extra -effort, you can push it directly to the correct location. +So a fast way to store the note is to press @kbd{C-c C-c @key{RET} +@key{RET}} to append it to the default file. Even shorter would be +@kbd{C-u C-c C-c}, which does the same without even showing the tree. +But with little extra effort, you can push it directly to the correct +location. Before inserting the text into a tree, the function ensures that the text has a headline, i.e. a first line that starts with a @samp{*}. @@ -1140,6 +1171,8 @@ @itemx S-@key{down} Increase/decrease priority of current item. Note that these keys are also used to modify time stamps (@pxref{Creating timestamps}). +Furthermore, these keys is also used by CUA-mode +(@pxref{Interaction}). @end table @@ -1267,7 +1300,8 @@ @kindex S-@key{right} @item S-@key{left} @itemx S-@key{right} -Change date at cursor by one day. +Change date at cursor by one day. These key bindings conflict with +CUA-mode (@pxref{Interaction}). @kindex S-@key{up} @kindex S-@key{down} @@ -1275,8 +1309,10 @@ @itemx S-@key{down} Change the item under the cursor in a timestamp. The cursor can be on a year, month, day, hour or minute. Note that if the cursor is not at -a time stamp, these same keys modify the priority of an item -(@pxref{Priorities}). +a time stamp, these same keys modify the priority of an item. +(@pxref{Priorities}). These key bindings conflict with CUA-mode +(@pxref{Interaction}). + @kindex C-c C-y @cindex evaluate time range @@ -1872,7 +1908,8 @@ @cindex tables, export to HTML @item -Tables are transformed into HTML tables. +Tables are transformed into HTML tables. Data fields before the first +horizontal separator line will be formatted as table header fields. @cindex fixed width @item @@ -1960,8 +1997,8 @@ * Customization:: Adapting Org-mode to your taste * FAQ:: Frequently asked questions * Interaction:: Other Emacs packages +* Bugs:: Things which do not work perfectly * Acknowledgments:: These people provided feedback and more -* Bugs:: Things which do not work perfectly @end menu @node Completion, Customization, Miscellaneous, Miscellaneous @@ -2024,9 +2061,7 @@ In GNU Emacs, you may use @emph{indirect buffers} which do exactly this. See the documentation on the command @code{make-indirect-buffer}. In XEmacs, this is currently not -possible because of the different outline implementation., which visit -the same file, but have separate settings, also for outline -visibility. +possible because of the different outline implementation. @item @b{Is there an easy way to insert links to web locations?}@* @cindex URL, paste into buffer @@ -2060,12 +2095,17 @@ 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. +@item @b{Org-mode takes over the S-cursor keys. I also want to use +CUA-mode, is there a way to fix this conflict?}@* +Yes, see @ref{Interaction} + @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 To insert an empty table template, just type @samp{|-} and use @key{TAB}. The default size can be changed with the variable -@code{org-table-default-size}. +@code{org-table-default-size}. However, just starting to type the +first line is usually much easier. @item @b{When I am in the last column of a table and just above a horizontal line in the table, pressing TAB creates a new table line @@ -2082,7 +2122,7 @@ @end enumerate -@node Interaction, Acknowledgments, FAQ, Miscellaneous +@node Interaction, Bugs, FAQ, Miscellaneous @section Interaction with other packages @cindex packages, interaction with other @cindex @file{planner.el} @@ -2106,11 +2146,64 @@ @cindex @file{table.el} @item @file{table.el} by Takaaki Ota Org mode cooperates with table.el, see @ref{table.el}. +@cindex @file{CUA.el} +@item @file{CUA.el} by Kim. F. Storm +Keybindings in Org-mode conflict with the @kbd{S-<cursor>} keys +used by CUA-mode (as well as pc-select-mode and s-region-mode) to +select and extend the region. If you want to use one of these +packages along with Org-mode, configure the variable +@code{org-CUA-compatible}. When set, Org-mode will move the folowing +keybindings in org-mode files, and in the agenda buffer (but not +during date selection). +@example +S-UP -> M-p S-DOWN -> M-n +S-LEFT -> M-- S-RIGHT -> M-+ +S-RET -> C-S-RET +@end example +Yes, these are unfortunately more difficult to remember. If you want +to have other replacement keys, look at the variable +@code{org-disputed-keys}. + @end table -@page @c FIXME +@node Bugs, Acknowledgments, Interaction, Miscellaneous +@section Bugs +@cindex bugs + +Here is a list of things which should work differently, but which I +have found too hard to fix. -@node Acknowledgments, Bugs, Interaction, Miscellaneous +@itemize @bullet +@item +If you call @code{fill-paragraph} (bound to @kbd{M-q}) in a table, the +filling is correctly disabled. However, if some text directly +(without an empty line in between) preceeds or follws a table, calling +@code{fill-paragraph} in that text will also fill the table like +normal text. Also, @code{fill-region} does bypass the +@code{fill-paragraph} code and will fill tables like normal text. +@item +When the application called by @kbd{C-c C-o} to open a file link fails +(for example because the application does not exits or refuses to open +the file), it does so silently. No error message is displayed. +@item +Under XEmacs, if Org-mode entries are included into the diary, it is +not possible to jump back from the diary to the org file. Apparently, +the text properties are lost when the fancy-diary-display is used. +However, from Org-mode's timeline and agenda buffers (created with +@kbd{C-c C-r} and @kbd{C-c a}), things do work correctly. +@item +Linux should also have a default viewer application, using mailcap. +Maybe we can use GNUS or VM mime code? Or dired's guessing commands? +Any hints (or even patches) are appreciated. +@item +When you write @samp{x = a /b/ c}, b will be exported in italics. +@item +The exporters work well, but could be made more efficient. +@end itemize + +@page + +@node Acknowledgments, , Bugs, Miscellaneous @section Acknowledgments @cindex acknowledgments @@ -2136,13 +2229,18 @@ Philip Rooke created the Org-mode reference card. He also helped with beta testing and contributed a number of very useful ideas. @item +Christian Schlauer proposed angular brackets around links, and some +other useful stuff. +@item +David Wainberg suggested to implement an archiving mechanism. +@item Linking to VM/BBDB/GNUS was inspired by Tom Shannon's @file{organizer-mode.el}. @item Scheduling TODO items was inspired by John Wiegley's @file{planner.el}. @item -Sacha Chua, the current maintainer of Planner suggested to take some -linking code from Planner, which I did (for RMAIL and Wanderlust). +Sacha Chua, the current maintainer of Planner, offered linking code +from Planner. I made use of the offer for links to RMAIL and Wanderlust. @item Oliver Oppitz sent several useful suggestions. @item @@ -2150,38 +2248,13 @@ to GNUS. @item Pavel Chalmoviansky reported bugs and suggested improvements related -to the agenda treatment of items with specifed time. +to the agenda treatment of items with specified time. @item Stefan Monnier provided a patch with lots of little fixes to keep the Emacs-Lisp compiler happy. -@end itemize - -@node Bugs, , Acknowledgments, Miscellaneous -@section Bugs -@cindex bugs - -Here is a list of things which should work differently, but which I -have found too hard to fix. - -@itemize @bullet -@item -When the application called by @kbd{C-c C-o} to open a file link fails -(for example because the application does not exits or refuses to open -the file), it does so silently. No error message is displayed. -@item -Under XEmacs, if Org-mode entries are included into the diary, it is -not possible to jump back from the diary to the org file. Apparently, -the text properties are lost when the fancy-diary-display is used. -However, from Org-mode's timeline and agenda buffers (created with -@kbd{C-c C-r} and @kbd{C-c a}), things do work correctly. -@item -Linux should also have a default viewer application, using mailcap. -Maybe we can use GNUS or VM mime code? Or dired's guessing commands? -Any hints (or even patches) are appreciated. -@item -When you write @samp{x = a /b/ c}, b will be exported in italics. -@item -The exporters work well, but could be made more efficient. +@item +Kai Grossjohann pointed out that a number of key bindings in Org-mode +conflict with other packages. @end itemize @node Index, Key Index, Miscellaneous, Top
--- a/nt/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/nt/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,35 @@ +2005-06-11 Eli Zaretskii <eliz@gnu.org> + + * configure.bat: If their fc.exe returns a meaningful exit status, + don't overwrite src/config.h and src/epaths.h with identical + copies. + + * INSTALL: Warn about using "cvs up -kb" if one intends to commit + changes. Add a pointer to another site with detailed configure + and build instructions. Suggest to look at config.log when + configure fails. Add MinGW Make 3.80 to the list of successful + combinations. + + * gmake.defs (ARCH_CFLAGS): Use $(MCPU_FLAG) instead of a literal + "-mcpu=i686". + + * configure.bat: Update copyright years. + Delete config.log before doing anything else. + Write additional diagnostics to config.log in case of failures to + compile test programs, including the failed test program itself. + Add a test for support of -mtune=pentium4 switch to GCC; if it is + supported, set up MCPU_FLAG variable on the various Makefiles to + use that switch during compilations. (This avoids GCC warning + about -mcpu being deprecated.) + +2005-06-10 Eli Zaretskii <eliz@gnu.org> + + * addsection.c (copy_executable_and_add_section): Pass non-zero + `verbose' arg to COPY_CHUNK only if DEBUG_DUMP is defined in the + environment. Print section names with %.8s. + (COPY_CHUNK): New 4th arg `verbose'; print diagnostic messages + only if non-zero. All callers changed. + 2005-06-05 Eli Zaretskii <eliz@gnu.org> * inc/sys/socket.h: Change arg 4 of sys_setsockopt to
--- a/nt/INSTALL Thu Jun 09 07:36:24 2005 +0000 +++ b/nt/INSTALL Wed Jun 15 23:32:15 2005 +0000 @@ -15,10 +15,20 @@ (.bat files, nmake.defs and makefile.w32-in) may need the line-ends fixing first. The easiest way to do this and avoid future conflicts is to run the following command in this (emacs/nt) directory: + cvs update -kb + + (WARNING: Do NOT use this suggestion if you have write access to the + Emacs CVS tree and intend to commit changes to CVS. This is because -kb + is sticky: it will be used in all future CVS operations on the files you + check out like this.) Alternatively, use programs that convert + end-of-line format, such as dos2unix and unix2dos available from + GnuWin32 or dtou and utod from the DJGPP project. + In addition to this file, you should also read INSTALL.CVS in the - parent directory, and make sure that you have a version of "touch.exe" - in your path, and that it will create files that do not yet exist. + parent directory, and make sure that you have a version of + "touch.exe" 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 later and nmake, or a Windows port of GCC 2.95 or later with MinGW @@ -51,6 +61,10 @@ http://www.emacswiki.org/cgi-bin/wiki/WThirtyTwoInstallationKit + and at this URL: + + http://ourcomments.org/Emacs/EmacsW32.html + 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 of sh.exe, the Cygwin port of Bash. Note that any version of make @@ -77,6 +91,7 @@ cygwin compiled make 3.78.1: fails[5] fails[2, 5] cygwin compiled make 3.79.1: fails[3, 5] fails[2?, 5] mingw32 compiled make 3.79.1: okay okay + mingw32 compiled make 3.80: okay unknown[6] Notes: @@ -88,6 +103,7 @@ [4] may fail on Windows 9X and Windows ME; if so, install Bash. [5] fails when building leim due to the use of cygwin style paths. May work if building emacs without leim. + [6] please report if you try this combination. * Configuring @@ -105,6 +121,12 @@ is running, when gcc support is being tested. These cannot be surpressed because of limitations in the Windows 9x command.com shell. + You are encouraged to look at the file config.log which shows details + for failed tests, after configure.bat finishes. Any unexplained failure + should be investigated and perhaps reported as a bug (see the section + about reporting bugs in the file README in this directory and in the + Emacs manual). + * Optional image library support In addition to its "native" image formats (pbm and xbm), Emacs can @@ -114,7 +136,11 @@ configure script is run. This can be setup using environment variables, or by specifying --cflags -I... options on the command-line to configure.bat. The configure script will report whether it was - able to detect the headers. + able to detect the headers. If the results of this testing appear to be + incorrect, please look for details in the file config.log: it will show + the failed test programs and compiler error messages that should explain + what is wrong. (Usually, any such failures happen because some headers + are missing due to bad packaging of the image support libraries.) To use the external image support, the DLLs implementing the functionality must be found when Emacs first needs them, either on the @@ -133,7 +159,9 @@ Binaries for the image libraries (among many others) can be found at the GnuWin32 project. These are built with MinGW, but they can be - used with both GCC/MinGW and MSVC builds of Emacs. + used with both GCC/MinGW and MSVC builds of Emacs. See the info on + http://ourcomments.org/Emacs/EmacsW32.html for more details about + installing image support libraries. * Building @@ -187,6 +215,12 @@ addsection.c relies on. Versions of w32api-xxx.zip from at least 1999-11-18 onwards are okay. + When in doubt about correctness of what configure did, look at the file + config.log, which shows all the failed test programs and compiler + messages associated with the failures. If that doesn't give a clue, + please report the problems, together with the relevant fragments from + config.log, as bugs. + If configure succeeds, but make fails, install the Cygwin port of Bash, even if the table above indicates that Emacs should be able to build without sh.exe. (Some versions of Windows shells are too dumb
--- a/nt/addsection.c Thu Jun 09 07:36:24 2005 +0000 +++ b/nt/addsection.c Wed Jun 15 23:32:15 2005 +0000 @@ -1,5 +1,5 @@ /* Add an uninitialized data section to an executable. - Copyright (C) 1999 Free Software Foundation, Inc. + Copyright (C) 1999, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -283,15 +283,19 @@ PIMAGE_SECTION_HEADER dst_section; DWORD offset; int i; + int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; -#define COPY_CHUNK(message, src, size) \ +#define COPY_CHUNK(message, src, size, verbose) \ do { \ unsigned char *s = (void *)(src); \ unsigned long count = (size); \ - printf ("%s\n", (message)); \ - printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ + if (verbose) \ + { \ + printf ("%s\n", (message)); \ + printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ + printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%08x Size in bytes.\n", count); \ + } \ memcpy (dst, s, count); \ dst += count; \ } while (0) @@ -321,13 +325,14 @@ dst = (unsigned char *) p_outfile->file_base; COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD) nt_header - (DWORD) dos_header); + (DWORD) nt_header - (DWORD) dos_header, be_verbose); dst_nt_header = (PIMAGE_NT_HEADERS) dst; COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD) section - (DWORD) nt_header); + (DWORD) section - (DWORD) nt_header, be_verbose); dst_section = (PIMAGE_SECTION_HEADER) dst; COPY_CHUNK ("Copying section table...", section, - nt_header->FileHeader.NumberOfSections * sizeof (*section)); + nt_header->FileHeader.NumberOfSections * sizeof (*section), + be_verbose); /* To improve the efficiency of demand loading, make the file alignment match the section alignment (VC++ 6.0 does this by @@ -351,7 +356,9 @@ for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) { char msg[100]; - sprintf (msg, "Copying raw data for %s...", section->Name); + /* Windows section names are fixed 8-char strings, only + zero-terminated if the name is shorter than 8 characters. */ + sprintf (msg, "Copying raw data for %.8s...", section->Name); /* Update the file-relative offset for this section's raw data (if it has any) in case things have been relocated; we will update @@ -362,7 +369,7 @@ /* Can always copy the original raw data. */ COPY_CHUNK (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), - section->SizeOfRawData); + section->SizeOfRawData, be_verbose); /* Round up the raw data size to the new alignment. */ dst_section->SizeOfRawData = @@ -402,7 +409,7 @@ COPY_CHUNK ("Copying remainder of executable...", OFFSET_TO_PTR (offset, p_infile), - p_infile->size - offset); + p_infile->size - offset, be_verbose); /* Final size for new image. */ p_outfile->size = DST_TO_OFFSET ();
--- a/nt/configure.bat Thu Jun 09 07:36:24 2005 +0000 +++ b/nt/configure.bat Wed Jun 15 23:32:15 2005 +0000 @@ -1,7 +1,8 @@ @echo off rem ---------------------------------------------------------------------- rem Configuration script for MS Windows 95/98/Me and NT/2000/XP -rem Copyright (C) 1999-2003 Free Software Foundation, Inc. +rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 +rem Free Software Foundation, Inc. rem This file is part of GNU Emacs. @@ -47,6 +48,8 @@ rem cygwin provides this? rem +if exist config.log del config.log + rem ---------------------------------------------------------------------- rem See if the environment is large enough. We need 43 (?) bytes. set $foo$=123456789_123456789_123456789_123456789_123 @@ -236,13 +239,17 @@ echo Checking whether gcc requires '-mno-cygwin'... echo #include "cygwin/version.h" >junk.c echo main(){} >>junk.c -gcc -c junk.c +echo gcc -c junk.c >>config.log +gcc -c junk.c >>config.log 2>&1 if not exist junk.o goto chkapi -gcc -mno-cygwin -c junk.c +echo gcc -mno-cygwin -c junk.c >>config.log +gcc -mno-cygwin -c junk.c >>config.log 2>&1 if exist junk.o set nocygwin=Y rm -f junk.c junk.o :chkapi +echo The failed program was: >>config.log +type junk.c >>config.log rem ---------------------------------------------------------------------- rem Older versions of the Windows API headers either don't have any of rem the IMAGE_xxx definitions (the headers that come with Cygwin b20.1 @@ -263,9 +270,13 @@ :chkapi2 echo on gcc %cf% -c junk.c -echo off +@echo off +@echo gcc %cf% -c junk.c >>config.log +gcc %cf% -c junk.c >>config.log 2>&1 set cf= if exist junk.o goto gccOk +echo The failed program was: >>config.log +type junk.c >>config.log :nocompiler echo. @@ -278,8 +289,23 @@ :gccOk set COMPILER=gcc +echo Using 'gcc' rm -f junk.c junk.o -echo Using 'gcc' +Rem It is not clear what GCC version began supporting -mtune +Rem and pentium4 on x86, so check this explicitly. +echo main(){} >junk.c +echo gcc -c -O2 -mtune=pentium4 junk.c >>config.log +gcc -c -O2 -mtune=pentium4 junk.c >>config.log 2>&1 +if not errorlevel 1 goto gccMtuneOk +echo The failed program was: >>config.log +type junk.c >>config.log +set mf=-mcpu=i686 +rm -f junk.c junk.o +goto compilercheckdone +:gccMtuneOk +echo GCC supports -mtune=pentium4 >>config.log +set mf=-mtune=pentium4 +rm -f junk.c junk.o goto compilercheckdone :clOk @@ -307,10 +333,13 @@ echo #include "png.h" >junk.c echo main (){} >>junk.c rem -o option is ignored with cl, but allows result to be consistent. -%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log if exist junk.obj goto havePng echo ...png.h not found, building without PNG support. +echo The failed program was: >>config.log +type junk.c >>config.log set HAVE_PNG= goto :pngDone @@ -327,10 +356,13 @@ echo #include "jconfig.h" >junk.c echo main (){} >>junk.c rem -o option is ignored with cl, but allows result to be consistent. -%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log if exist junk.obj goto haveJpeg echo ...jconfig.h not found, building without JPEG support. +echo The failed program was: >>config.log +type junk.c >>config.log set HAVE_JPEG= goto :jpegDone @@ -347,10 +379,13 @@ echo #include "gif_lib.h" >junk.c echo main (){} >>junk.c rem -o option is ignored with cl, but allows result to be consistent. -%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log if exist junk.obj goto haveGif echo ...gif_lib.h not found, building without GIF support. +echo The failed program was: >>config.log +type junk.c >>config.log set HAVE_GIF= goto :gifDone @@ -367,10 +402,13 @@ echo #include "tiffio.h" >junk.c echo main (){} >>junk.c rem -o option is ignored with cl, but allows result to be consistent. -%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log if exist junk.obj goto haveTiff echo ...tiffio.h not found, building without TIFF support. +echo The failed program was: >>config.log +type junk.c >>config.log set HAVE_TIFF= goto :tiffDone @@ -388,10 +426,13 @@ echo #include "X11/xpm.h" >>junk.c echo main (){} >>junk.c rem -o option is ignored with cl, but allows result to be consistent. -%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>junk.err +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log if exist junk.obj goto haveXpm echo ...X11/xpm.h not found, building without XPM support. +echo The failed program was: >>config.log +type junk.c >>config.log set HAVE_XPM= goto :xpmDone @@ -414,6 +455,7 @@ rem echo # Start of settings from configure.bat >config.settings echo COMPILER=%COMPILER%>>config.settings +if not "(%mf%)" == "()" echo MCPU_FLAG=%mf%>>config.settings if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings if (%noopt%) == (Y) echo NOOPT=1 >>config.settings if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings @@ -423,20 +465,34 @@ echo # End of settings from configure.bat>>config.settings echo. >>config.settings -copy config.nt ..\src\config.h -echo. >>..\src\config.h -echo /* Start of settings from configure.bat. */ >>..\src\config.h -if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>..\src\config.h -if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>..\src\config.h -if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>..\src\config.h -if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>..\src\config.h -if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>..\src\config.h -if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>..\src\config.h -if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>..\src\config.h -echo /* End of settings from configure.bat. */ >>..\src\config.h +copy config.nt config.tmp +echo. >>config.tmp +echo /* Start of settings from configure.bat. */ >>config.tmp +if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>config.tmp +if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>config.tmp +if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp +if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp +if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp +if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp +if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>config.tmp +echo /* End of settings from configure.bat. */ >>config.tmp +Rem See if fc.exe returns a meaningful exit status. If it does, we +Rem might as well avoid unnecessary overwriting of config.h and epaths.h, +Rem since this forces recompilation of every source file. +if exist foo.bar del foo.bar +fc /b foo.bar foo.bar >nul 2>&1 +if not errorlevel 2 goto doCopy +fc /b config.tmp ..\src\config.h >nul 2>&1 +if errorlevel 1 goto doCopy +fc /b paths.h ..\src\epaths.h >nul 2>&1 +if errorlevel 0 goto dontCopy +:doCopy +copy config.tmp ..\src\config.h copy paths.h ..\src\epaths.h +:dontCopy +if exist config.tmp del config.tmp copy /b config.settings+%MAKECMD%.defs+..\nt\makefile.w32-in ..\nt\makefile copy /b config.settings+%MAKECMD%.defs+..\lib-src\makefile.w32-in ..\lib-src\makefile copy /b config.settings+%MAKECMD%.defs+..\src\makefile.w32-in ..\src\makefile @@ -474,6 +530,7 @@ set usercflags= set userldflags= set mingwflag= +set mf= goto skipArchTag arch-tag: 300d20a4-1675-4e75-b615-7ce1a8c5376c
--- a/nt/gmake.defs Thu Jun 09 07:36:24 2005 +0000 +++ b/nt/gmake.defs Wed Jun 15 23:32:15 2005 +0000 @@ -253,7 +253,7 @@ ifdef NOOPT ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) else -ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) -mcpu=i686 -O2 \ +ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) $(MCPU_FLAG) -O2 \ # -fbuiltin \ # -finline-functions \ # -fomit-frame-pointer
--- a/src/ChangeLog Thu Jun 09 07:36:24 2005 +0000 +++ b/src/ChangeLog Wed Jun 15 23:32:15 2005 +0000 @@ -1,3 +1,130 @@ +2005-06-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (mac_compute_glyph_string_overhangs): Don't set + overhangs unless the given glyph type is noncomposite CHAR_GLYPH. + [USE_CARBON_EVENTS] (mac_convert_event_ref): Convert dead key down + events. + (XTread_socket): Don't pass keyboard events with the option + modifier to the system when Vmac_command_key_is_meta is nil or + Vmac_option_modifier is non-nil. + [USE_CARBON_EVENTS] (read_socket_inev): New variable. + [USE_CARBON_EVENTS] (init_command_handler): Fix argument. + [USE_CARBON_EVENTS] (mac_handle_mouse_event): New Carbon event + handler function. + (install_window_handler) [USE_CARBON_EVENTS]: Install it. + (XTread_socket) [USE_CARBON_EVENTS]: Move mouse wheel event + handler part to mac_handle_mouse_event. + +2005-06-14 Juanma Barranquero <lekktu@gmail.com> + + * eval.c (Fdefvaralias): Rename arguments SYMBOL and ALIASED to + NEW-ALIAS and BASE-VARIABLE, respectively. + +2005-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * xdisp.c (note_mode_line_or_margin_highlight): Lisp_Object/int mixup. + (get_phys_cursor_geometry, format_mode_line_unwind_data) + (get_line_height_property, x_produce_glyphs): Remove unused vars. + + * coding.c (run_pre_post_conversion_on_str): Remove unused var `buf'. + +2005-06-13 Eli Zaretskii <eliz@gnu.org> + + * w32term.c (x_use_underline_position_properties): New variable. + (x_draw_glyph_string): Remind in a comment to change doc string of + x-use-underline-position-properties if/when underline positioning + is implemented. + (syms_of_w32term): DEFVAR_BOOL x-use-underline-position-properties, + and initialize it to nil. + +2005-06-12 Jason Rumney <jasonr@gnu.org> + + * w32fns.c (NEWOPENFILENAME): New struct. + (Fx_file_dialog): Use it to trick the system into giving us up to + date dialogs on systems that are documented to support it. + Do not set OFN_FILEMUSTEXIST flag if looking for a directory. + +2005-06-12 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c (w32_abort): Use the MB_YESNO dialog instead of + MB_ABORTRETRYIGNORE. Never return, even if DebugBreak does. + +2005-06-11 Eli Zaretskii <eliz@gnu.org> + + * image.c (x_create_x_image_and_pixmap) [HAVE_NTGUI]: Cast 4th arg + to CreateDIBSection to avoid a compiler warning. + (pbm_load): Cast 3rd arg to IMAGE_BACKGROUND to avoid a compiler + warning. + (png_load): Cast return values of fn_png_create_read_struct and + fn_png_create_info_struct, to avoid compiler warnings on W32. + Cast 3rd arg to IMAGE_BACKGROUND and image_background_transparent + to avoid compiler warnings. + (jpeg_load): Cast return value of fn_jpeg_std_error to avoid a + compiler warning on W32. Cast 3rd arg to IMAGE_BACKGROUND to + avoid a compiler warning. + (tiff_load): Cast return values of fn_TIFFOpen and + fn_TIFFClientOpen to avoid compiler warning on W32. Cast 3rd arg + to IMAGE_BACKGROUND to avoid a compiler warning. + (gif_load): Cast return values of fn_DGifOpenFileName and + fn_DGifOpen to avoid compiler warnings on W32. Cast 3rd arg to + IMAGE_BACKGROUND to avoid a compiler warning. + (DrawText) [HAVE_NTGUI || MAC_OS]: If already defined, undef + before redefining. + + * w32bdf.c (create_offscreen_bitmap): Cast `bitsp' to `void **' in + the call to CreateDIBSection, to avoid a compiler warning. + +2005-06-11 Jason Rumney <jasonr@gnu.org> + + * w32fns.c (Fx_file_dialog): Unblock input before falling back to + minibuffer. + * macfns.c (Fx_file_dialog): Likewise. + +2005-06-10 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(TEMACS)): Depend on addsection.exe. + +2005-06-10 Juanma Barranquero <lekktu@gmail.com> + + * process.c (syms_of_process) [ADAPTIVE_READ_BUFFERING]: + * w32fns.c (syms_of_w32fns): Fix spellings. + +2005-06-10 Eli Zaretskii <eliz@gnu.org> + + * unexw32.c (COPY_CHUNK, COPY_PROC_CHUNK): Add a new argument + `verbose'; print diagnostic messages only if it is non-zero. + All callers changed to pass a zero value unless DEBUG_DUMP is defined + in the environment. + (copy_executable_and_dump_data): Print section names with %.8s. + +2005-06-10 Masatake YAMATO <jet@gyve.org> + + * xdisp.c (note_mode_line_or_margin_highlight): Call clear_mouse_face + when mouse_face is not given. + Remove unnecessary tabs. + +2005-06-09 Luc Teirlinck <teirllm@auburn.edu> + + * window.c (Fselect_window): Adapt call to Fselect_frame. + + * lisp.h: Update EXFUN of Fselect_frame. + + * keyboard.c (command_loop_1): Adapt call to Fselect_frame. + + * frame.c (Fhandle_switch_frame, Fselect_frame): Delete unused arg + no_enter. + (Fset_mouse_position, Fset_mouse_pixel_position, Ficonify_frame): + Adapt to above change. + +2005-06-10 Juanma Barranquero <lekktu@gmail.com> + + * fns.c (Fmemq, Fmaphash): Doc fixes. + +2005-06-09 Juanma Barranquero <lekktu@gmail.com> + + * xfaces.c (Fdisplay_supports_face_attributes_p): + Fix typo in docstring. + 2005-06-08 Steven Tamm <steventamm@mac.com> * unexmacosx.c (copy_data_segment): Copy __la_sym_ptr2 section @@ -40,8 +167,8 @@ 2005-06-07 Masatake YAMATO <jet@gyve.org> - * xdisp.c (note_mode_line_or_margin_highlight): Check - the overlapping of re-rendering area to avoid flickering. + * xdisp.c (note_mode_line_or_margin_highlight): + Check the overlapping of re-rendering area to avoid flickering. (note_mouse_highlight): Call clear_mouse_face if PART is not ON_MODE_LINE nor ON_HEADER_LINE. @@ -56,21 +183,21 @@ 2005-06-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> - * macmenu.c (menu_quit_handler, install_menu_quit_handler): New - functions for popping down menus on C-g. + * macmenu.c (menu_quit_handler, install_menu_quit_handler): + New functions for popping down menus on C-g. (set_frame_menubar, mac_menu_show): Call install_menu_quit_handler. * macterm.c: Make mac_quit_char_modifiers and mac_quit_char_keycode non-static. - * config.in: Added HAVE_CANCELMENUTRACKING + * config.in: Add HAVE_CANCELMENUTRACKING. 2005-06-06 Eli Zaretskii <eliz@gnu.org> - * w32heap.h (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_PTR): Remove - macros. - - * unexw32.c (RVA_TO_PTR): Moved here from w32heap.h. + * w32heap.h (OFFSET_TO_RVA, RVA_TO_OFFSET, RVA_TO_PTR): + Remove macros. + + * unexw32.c (RVA_TO_PTR): Move here from w32heap.h. * w32proc.c (RVA_TO_PTR): New macro. @@ -194,11 +321,11 @@ (format_mode_line_unwind_data, unwind_format_mode_line): New functions for unwind protection in mode line formatting. (x_consider_frame_title): Use them and new local var 'title_start' - to support nested calls to format-mode-line and redisplay. Set - mode_line_target to MODE_LINE_TITLE. + to support nested calls to format-mode-line and redisplay. + Set mode_line_target to MODE_LINE_TITLE. (Fformat_mode_line): Use them and new local var 'string_start' to - support nested calls to format-mode-line and redisplay. Set - mode_line_target to MODE_LINE_NOPROP or MODE_LINE_STRING. + support nested calls to format-mode-line and redisplay. + Set mode_line_target to MODE_LINE_NOPROP or MODE_LINE_STRING. Don't trim trailing dashes. (decode_mode_spec): Don't make infinite number of trailing dashes for MODE_LINE_NOPROP and MODE_LINE_STRING targets. @@ -12989,9 +13116,9 @@ * sound.c: Added a partial implementation of play-sound-internal for Microsoft Windows. Added various #ifdef / #else / #endif code blocks to separate the code that will compile under - Microsoft Windows from the code that is specific to Gnu/Linux. + Microsoft Windows from the code that is specific to GNU/Linux. Moved several blocks of code around to make this separation of code - into Windows compatible and Gnu/Linux compatible code blocks easier. + into Windows compatible and GNU/Linux compatible code blocks easier. * makefile.w32-in: Include sound.c and link with WinMM.lib.
--- a/src/eval.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/eval.c Wed Jun 15 23:32:15 2005 +0000 @@ -722,35 +722,36 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, - doc: /* Make SYMBOL a variable alias for symbol ALIASED. -Setting the value of SYMBOL will subsequently set the value of ALIASED, -and getting the value of SYMBOL will return the value ALIASED has. -Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. If it is -omitted or nil, SYMBOL gets the documentation string of ALIASED, or of the -variable at the end of the chain of aliases, if ALIASED is itself an alias. -The return value is ALIASED. */) - (symbol, aliased, docstring) - Lisp_Object symbol, aliased, docstring; + doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. +Setting the value of NEW-ALIAS will subsequently set the value of BASE-VARIABLE, + and getting the value of NEW-ALIAS will return the value BASE-VARIABLE has. +Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is + omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE, + or of the variable at the end of the chain of aliases, if BASE-VARIABLE is + itself an alias. +The return value is BASE-VARIABLE. */) + (new_alias, base_variable, docstring) + Lisp_Object new_alias, base_variable, docstring; { struct Lisp_Symbol *sym; - CHECK_SYMBOL (symbol); - CHECK_SYMBOL (aliased); - - if (SYMBOL_CONSTANT_P (symbol)) + CHECK_SYMBOL (new_alias); + CHECK_SYMBOL (base_variable); + + if (SYMBOL_CONSTANT_P (new_alias)) error ("Cannot make a constant an alias"); - sym = XSYMBOL (symbol); + sym = XSYMBOL (new_alias); sym->indirect_variable = 1; - sym->value = aliased; - sym->constant = SYMBOL_CONSTANT_P (aliased); - LOADHIST_ATTACH (symbol); + sym->value = base_variable; + sym->constant = SYMBOL_CONSTANT_P (base_variable); + LOADHIST_ATTACH (new_alias); if (!NILP (docstring)) - Fput (symbol, Qvariable_documentation, docstring); + Fput (new_alias, Qvariable_documentation, docstring); else - Fput (symbol, Qvariable_documentation, Qnil); - - return aliased; + Fput (new_alias, Qvariable_documentation, Qnil); + + return base_variable; }
--- a/src/fns.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/fns.c Wed Jun 15 23:32:15 2005 +0000 @@ -1390,7 +1390,7 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. -Comparison done with EQ. The value is actually the tail of LIST +Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. */) (elt, list) Lisp_Object elt, list; @@ -4845,7 +4845,7 @@ DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, doc: /* Call FUNCTION for all entries in hash table TABLE. -FUNCTION is called with 2 arguments KEY and VALUE. */) +FUNCTION is called with two arguments, KEY and VALUE. */) (function, table) Lisp_Object function, table; {
--- a/src/frame.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/frame.c Wed Jun 15 23:32:15 2005 +0000 @@ -729,7 +729,7 @@ return frame; } -DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 2, "e", +DEFUN ("select-frame", Fselect_frame, Sselect_frame, 1, 1, "e", doc: /* Select the frame FRAME. Subsequent editing commands apply to its selected window. The selection of FRAME lasts until the next time the user does @@ -740,14 +740,14 @@ focus. On a text-only terminal, the next redisplay will display FRAME. This function returns FRAME, or nil if FRAME has been deleted. */) - (frame, no_enter) - Lisp_Object frame, no_enter; + (frame) + Lisp_Object frame; { return do_switch_frame (frame, 1, 0); } -DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 2, "e", +DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e", doc: /* Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. A switch-frame event tells Emacs that the window manager has requested @@ -756,8 +756,8 @@ If EVENT is frame object, handle it as if it were a switch-frame event to that frame. */) - (event, no_enter) - Lisp_Object event, no_enter; + (event) + Lisp_Object event; { /* Preserve prefix arg that the command loop just cleared. */ current_kboard->Vprefix_arg = Vcurrent_prefix_arg; @@ -1530,7 +1530,7 @@ #if defined (MSDOS) && defined (HAVE_MOUSE) if (FRAME_MSDOS_P (XFRAME (frame))) { - Fselect_frame (frame, Qnil); + Fselect_frame (frame); mouse_moveto (XINT (x), XINT (y)); } #endif @@ -1562,7 +1562,7 @@ #if defined (MSDOS) && defined (HAVE_MOUSE) if (FRAME_MSDOS_P (XFRAME (frame))) { - Fselect_frame (frame, Qnil); + Fselect_frame (frame); mouse_moveto (XINT (x), XINT (y)); } #endif @@ -1684,7 +1684,7 @@ #if 0 /* This isn't logically necessary, and it can do GC. */ /* Don't let the frame remain selected. */ if (EQ (frame, selected_frame)) - Fhandle_switch_frame (next_frame (frame, Qt), Qnil); + Fhandle_switch_frame (next_frame (frame, Qt)); #endif /* Don't allow minibuf_window to remain on a deleted frame. */
--- a/src/image.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/image.c Wed Jun 15 23:32:15 2005 +0000 @@ -1972,7 +1972,8 @@ and store its handle in *pixmap. */ *pixmap = CreateDIBSection (hdc, &((*ximg)->info), (depth < 16) ? DIB_PAL_COLORS : DIB_RGB_COLORS, - &((*ximg)->data), NULL, 0); + /* casting avoids a GCC warning */ + (void **)&((*ximg)->data), NULL, 0); /* Realize display palette and garbage all frames. */ release_frame_dc (f, hdc); @@ -5517,7 +5518,8 @@ /* Maybe fill in the background field while we have ximg handy. */ if (NILP (image_spec_value (img->spec, QCbackground, NULL))) - IMAGE_BACKGROUND (img, f, ximg); + /* Casting avoids a GCC warning. */ + IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); /* Put the image into a pixmap. */ x_put_x_image (f, ximg, img->pixmap, width, height); @@ -5843,9 +5845,11 @@ tbr.bytes += sizeof (sig); } - /* Initialize read and info structs for PNG lib. */ - png_ptr = fn_png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL, - my_png_error, my_png_warning); + /* Initialize read and info structs for PNG lib. Casting return + value avoids a GCC warning on W32. */ + png_ptr = (png_structp)fn_png_create_read_struct (PNG_LIBPNG_VER_STRING, + NULL, my_png_error, + my_png_warning); if (!png_ptr) { if (fp) fclose (fp); @@ -5853,7 +5857,8 @@ return 0; } - info_ptr = fn_png_create_info_struct (png_ptr); + /* Casting return value avoids a GCC warning on W32. */ + info_ptr = (png_infop)fn_png_create_info_struct (png_ptr); if (!info_ptr) { fn_png_destroy_read_struct (&png_ptr, NULL, NULL); @@ -5862,7 +5867,8 @@ return 0; } - end_info = fn_png_create_info_struct (png_ptr); + /* Casting return value avoids a GCC warning on W32. */ + end_info = (png_infop)fn_png_create_info_struct (png_ptr); if (!end_info) { fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL); @@ -6135,8 +6141,9 @@ img->width = width; img->height = height; - /* Maybe fill in the background field while we have ximg handy. */ - IMAGE_BACKGROUND (img, f, ximg); + /* Maybe fill in the background field while we have ximg handy. + Casting avoids a GCC warning. */ + IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); /* Put the image into the pixmap, then free the X image and its buffer. */ x_put_x_image (f, ximg, img->pixmap, width, height); @@ -6145,9 +6152,9 @@ /* Same for the mask. */ if (mask_img) { - /* Fill in the background_transparent field while we have the mask - handy. */ - image_background_transparent (img, f, mask_img); + /* Fill in the background_transparent field while we have the + mask handy. Casting avoids a GCC warning. */ + image_background_transparent (img, f, (XImagePtr_or_DC)mask_img); x_put_x_image (f, mask_img, img->mask, img->width, img->height); x_destroy_x_image (mask_img); @@ -6494,8 +6501,9 @@ } /* Customize libjpeg's error handling to call my_error_exit when an - error is detected. This function will perform a longjmp. */ - cinfo.err = fn_jpeg_std_error (&mgr.pub); + error is detected. This function will perform a longjmp. + Casting return value avoids a GCC warning on W32. */ + cinfo.err = (struct jpeg_error_mgr *)fn_jpeg_std_error (&mgr.pub); mgr.pub.error_exit = my_error_exit; if ((rc = setjmp (mgr.setjmp_buffer)) != 0) @@ -6606,7 +6614,8 @@ /* Maybe fill in the background field while we have ximg handy. */ if (NILP (image_spec_value (img->spec, QCbackground, NULL))) - IMAGE_BACKGROUND (img, f, ximg); + /* Casting avoids a GCC warning. */ + IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); /* Put the image into the pixmap. */ x_put_x_image (f, ximg, img->pixmap, width, height); @@ -6932,8 +6941,9 @@ return 0; } - /* Try to open the image file. */ - tiff = fn_TIFFOpen (SDATA (file), "r"); + /* Try to open the image file. Casting return value avoids a + GCC warning on W32. */ + tiff = (TIFF *)fn_TIFFOpen (SDATA (file), "r"); if (tiff == NULL) { image_error ("Cannot open `%s'", file, Qnil); @@ -6948,14 +6958,15 @@ memsrc.len = SBYTES (specified_data); memsrc.index = 0; - tiff = fn_TIFFClientOpen ("memory_source", "r", &memsrc, - (TIFFReadWriteProc) tiff_read_from_memory, - (TIFFReadWriteProc) tiff_write_from_memory, - tiff_seek_in_memory, - tiff_close_memory, - tiff_size_of_memory, - tiff_mmap_memory, - tiff_unmap_memory); + /* Casting return value avoids a GCC warning on W32. */ + tiff = (TIFF *)fn_TIFFClientOpen ("memory_source", "r", &memsrc, + (TIFFReadWriteProc) tiff_read_from_memory, + (TIFFReadWriteProc) tiff_write_from_memory, + tiff_seek_in_memory, + tiff_close_memory, + tiff_size_of_memory, + tiff_mmap_memory, + tiff_unmap_memory); if (!tiff) { @@ -7018,7 +7029,8 @@ /* Maybe fill in the background field while we have ximg handy. */ if (NILP (image_spec_value (img->spec, QCbackground, NULL))) - IMAGE_BACKGROUND (img, f, ximg); + /* Casting avoids a GCC warning on W32. */ + IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); /* Put the image into the pixmap, then free the X image and its buffer. */ x_put_x_image (f, ximg, img->pixmap, width, height); @@ -7126,6 +7138,11 @@ #ifdef HAVE_GIF #if defined (HAVE_NTGUI) || defined (MAC_OS) +/* winuser.h might define DrawText to DrawTextA or DrawTextW. + Undefine before redefining to avoid a preprocessor warning. */ +#ifdef DrawText +#undef DrawText +#endif /* avoid conflict with QuickdrawText.h */ #define DrawText gif_DrawText #include <gif_lib.h> @@ -7239,8 +7256,9 @@ return 0; } - /* Open the GIF file. */ - gif = fn_DGifOpenFileName (SDATA (file)); + /* Open the GIF file. Casting return value avoids a GCC warning + on W32. */ + gif = (GifFileType *)fn_DGifOpenFileName (SDATA (file)); if (gif == NULL) { image_error ("Cannot open `%s'", file, Qnil); @@ -7256,7 +7274,8 @@ memsrc.len = SBYTES (specified_data); memsrc.index = 0; - gif = fn_DGifOpen(&memsrc, gif_read_from_memory); + /* Casting return value avoids a GCC warning on W32. */ + gif = (GifFileType *)fn_DGifOpen(&memsrc, gif_read_from_memory); if (!gif) { image_error ("Cannot open memory source `%s'", img->spec, Qnil); @@ -7390,7 +7409,8 @@ /* Maybe fill in the background field while we have ximg handy. */ if (NILP (image_spec_value (img->spec, QCbackground, NULL))) - IMAGE_BACKGROUND (img, f, ximg); + /* Casting avoids a GCC warning. */ + IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); /* Put the image into the pixmap, then free the X image and its buffer. */ x_put_x_image (f, ximg, img->pixmap, width, height); @@ -7400,7 +7420,7 @@ return 1; } -#else +#else /* !HAVE_GIF */ #ifdef MAC_OS static int
--- a/src/keyboard.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/keyboard.c Wed Jun 15 23:32:15 2005 +0000 @@ -1509,7 +1509,7 @@ Is this a good idea? */ if (FRAMEP (internal_last_event_frame) && !EQ (internal_last_event_frame, selected_frame)) - Fselect_frame (internal_last_event_frame, Qnil); + Fselect_frame (internal_last_event_frame); #endif /* If it has changed current-menubar from previous value, really recompute the menubar from the value. */
--- a/src/lisp.h Thu Jun 09 07:36:24 2005 +0000 +++ b/src/lisp.h Wed Jun 15 23:32:15 2005 +0000 @@ -2992,7 +2992,7 @@ extern Lisp_Object get_frame_param P_ ((struct frame *, Lisp_Object)); extern Lisp_Object frame_buffer_predicate P_ ((Lisp_Object)); EXFUN (Fframep, 1); -EXFUN (Fselect_frame, 2); +EXFUN (Fselect_frame, 1); EXFUN (Fselected_frame, 0); EXFUN (Fwindow_frame, 1); EXFUN (Fframe_root_window, 1);
--- a/src/macfns.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/macfns.c Wed Jun 15 23:32:15 2005 +0000 @@ -4375,14 +4375,15 @@ break; } NavDialogDispose(dialogRef); + UNBLOCK_INPUT; } else { + UNBLOCK_INPUT; /* Fall back on minibuffer if there was a problem */ file = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, dir, Qfile_name_history, default_filename, Qnil); } - UNBLOCK_INPUT; } UNGCPRO;
--- a/src/macterm.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/macterm.c Wed Jun 15 23:32:15 2005 +0000 @@ -2002,33 +2002,37 @@ mac_compute_glyph_string_overhangs (s) struct glyph_string *s; { - Rect r; - MacFontStruct *font = s->font; - - TextFont (font->mac_fontnum); - TextSize (font->mac_fontsize); - TextFace (font->mac_fontface); - - if (s->two_byte_p) - QDTextBounds (s->nchars * 2, (char *)s->char2b, &r); - else - { - int i; - char *buf = xmalloc (s->nchars); - - if (buf == NULL) - SetRect (&r, 0, 0, 0, 0); + if (s->cmp == NULL + && s->first_glyph->type == CHAR_GLYPH) + { + Rect r; + MacFontStruct *font = s->font; + + TextFont (font->mac_fontnum); + TextSize (font->mac_fontsize); + TextFace (font->mac_fontface); + + if (s->two_byte_p) + QDTextBounds (s->nchars * 2, (char *)s->char2b, &r); else { - for (i = 0; i < s->nchars; ++i) - buf[i] = s->char2b[i].byte2; - QDTextBounds (s->nchars, buf, &r); - xfree (buf); + int i; + char *buf = xmalloc (s->nchars); + + if (buf == NULL) + SetRect (&r, 0, 0, 0, 0); + else + { + for (i = 0; i < s->nchars; ++i) + buf[i] = s->char2b[i].byte2; + QDTextBounds (s->nchars, buf, &r); + xfree (buf); + } } - } - - s->right_overhang = r.right > s->width ? r.right - s->width : 0; - s->left_overhang = r.left < 0 ? -r.left : 0; + + s->right_overhang = r.right > s->width ? r.right - s->width : 0; + s->left_overhang = r.left < 0 ? -r.left : 0; + } } @@ -7495,6 +7499,11 @@ /* If Non-nil, the Mac "Control" key is passed on to the Mac Toolbox for processing before Emacs sees it. */ Lisp_Object Vmac_pass_control_to_system; + +/* Points to the variable `inev' in the function XTread_socket. It is + used for passing an input event to the function back from a Carbon + event handler. */ +static struct input_event *read_socket_inev = NULL; #endif /* Set in term/mac-win.el to indicate that event loop can now generate @@ -7627,45 +7636,79 @@ /* Normally, ConvertEventRefToEventRecord will correctly handle all events. However the click of the mouse wheel is not converted to a - mouseDown or mouseUp event. This calls ConvertEventRef, but then - checks to see if it is a mouse up or down carbon event that has not - been converted, and if so, converts it by hand (to be picked up in - the XTread_socket loop). */ + mouseDown or mouseUp event. Likewise for dead key down events. + This calls ConvertEventRef, but then checks to see if it is a mouse + up/down, or a dead key down carbon event that has not been + converted, and if so, converts it by hand (to be picked up in the + XTread_socket loop). */ static Boolean mac_convert_event_ref (EventRef eventRef, EventRecord *eventRec) { Boolean result = ConvertEventRefToEventRecord (eventRef, eventRec); - /* Do special case for mouse wheel button. */ - if (!result && GetEventClass (eventRef) == kEventClassMouse) - { - UInt32 kind = GetEventKind (eventRef); - if (kind == kEventMouseDown && !(eventRec->what == mouseDown)) + + if (result) + return result; + + switch (GetEventClass (eventRef)) + { + case kEventClassMouse: + switch (GetEventKind (eventRef)) { + case kEventMouseDown: eventRec->what = mouseDown; - result=1; + result = 1; + break; + + case kEventMouseUp: + eventRec->what = mouseUp; + result = 1; + break; + + default: + break; } - if (kind == kEventMouseUp && !(eventRec->what == mouseUp)) - { - eventRec->what = mouseUp; - result=1; - } - if (result) + + case kEventClassKeyboard: + switch (GetEventKind (eventRef)) { - /* Need where and when. */ - UInt32 mods; - GetEventParameter (eventRef, kEventParamMouseLocation, - typeQDPoint, NULL, sizeof (Point), - NULL, &eventRec->where); - /* Use two step process because new event modifiers are - 32-bit and old are 16-bit. Currently, only loss is - NumLock & Fn. */ - GetEventParameter (eventRef, kEventParamKeyModifiers, - typeUInt32, NULL, sizeof (UInt32), - NULL, &mods); - eventRec->modifiers = mods; - - eventRec->when = EventTimeToTicks (GetEventTime (eventRef)); + case kEventRawKeyDown: + { + unsigned char char_codes; + UInt32 key_code; + + eventRec->what = keyDown; + GetEventParameter (eventRef, kEventParamKeyMacCharCodes, typeChar, + NULL, sizeof (char), NULL, &char_codes); + GetEventParameter (eventRef, kEventParamKeyCode, typeUInt32, + NULL, sizeof (UInt32), NULL, &key_code); + eventRec->message = char_codes | ((key_code & 0xff) << 8); + result = 1; + } + break; + + default: + break; } - } + + default: + break; + } + + if (result) + { + /* Need where and when. */ + UInt32 mods; + + GetEventParameter (eventRef, kEventParamMouseLocation, typeQDPoint, + NULL, sizeof (Point), NULL, &eventRec->where); + /* Use two step process because new event modifiers are 32-bit + and old are 16-bit. Currently, only loss is NumLock & Fn. */ + GetEventParameter (eventRef, kEventParamKeyModifiers, typeUInt32, + NULL, sizeof (UInt32), NULL, &mods); + eventRec->modifiers = mods; + + eventRec->when = EventTimeToTicks (GetEventTime (eventRef)); + } + return result; } @@ -8235,8 +8278,7 @@ } static OSErr -init_command_handler (window) - WindowPtr window; +init_command_handler () { OSErr err = noErr; EventTypeSpec specs[] = {{kEventClassCommand, kEventCommandProcess}}; @@ -8321,6 +8363,68 @@ return eventNotHandledErr; } + +static pascal OSStatus +mac_handle_mouse_event (next_handler, event, data) + EventHandlerCallRef next_handler; + EventRef event; + void *data; +{ + OSStatus result; + + switch (GetEventKind (event)) + { + case kEventMouseWheelMoved: + { + WindowPtr wp; + struct frame *f; + EventMouseWheelAxis axis; + SInt32 delta; + Point point; + + result = CallNextEventHandler (next_handler, event); + if (result != eventNotHandledErr || read_socket_inev == NULL) + return result; + + GetEventParameter (event, kEventParamWindowRef, typeWindowRef, + NULL, sizeof (WindowRef), NULL, &wp); + f = mac_window_to_frame (wp); + if (f != mac_focus_frame (&one_mac_display_info)) + break; + + GetEventParameter (event, kEventParamMouseWheelAxis, + typeMouseWheelAxis, NULL, + sizeof (EventMouseWheelAxis), NULL, &axis); + if (axis != kEventMouseWheelAxisY) + break; + + GetEventParameter (event, kEventParamMouseWheelDelta, typeSInt32, + NULL, sizeof (SInt32), NULL, &delta); + GetEventParameter (event, kEventParamMouseLocation, typeQDPoint, + NULL, sizeof (Point), NULL, &point); + read_socket_inev->kind = WHEEL_EVENT; + read_socket_inev->code = 0; + read_socket_inev->modifiers = + (mac_event_to_emacs_modifiers (event) + | ((delta < 0) ? down_modifier : up_modifier)); + SetPortWindowPort (wp); + GlobalToLocal (&point); + XSETINT (read_socket_inev->x, point.h); + XSETINT (read_socket_inev->y, point.v); + XSETFRAME (read_socket_inev->frame_or_window, f); + read_socket_inev->timestamp = + EventTimeToTicks (GetEventTime (event)) * (1000/60); + + return noErr; + } + break; + + default: + break; + } + + return eventNotHandledErr; +} #endif /* USE_CARBON_EVENTS */ @@ -8330,16 +8434,24 @@ { OSErr err = noErr; #if USE_CARBON_EVENTS - EventTypeSpec specs[] = {{kEventClassWindow, kEventWindowUpdate}, - {kEventClassWindow, kEventWindowBoundsChanging}}; - static EventHandlerUPP handle_window_event_UPP = NULL; - - if (handle_window_event_UPP == NULL) - handle_window_event_UPP = NewEventHandlerUPP (mac_handle_window_event); - - err = InstallWindowEventHandler (window, handle_window_event_UPP, - GetEventTypeCount (specs), specs, - NULL, NULL); + EventTypeSpec specs_window[] = + {{kEventClassWindow, kEventWindowUpdate}, + {kEventClassWindow, kEventWindowBoundsChanging}}; + EventTypeSpec specs_mouse[] = {{kEventClassMouse, kEventMouseWheelMoved}}; + static EventHandlerUPP handle_window_eventUPP = NULL; + static EventHandlerUPP handle_mouse_eventUPP = NULL; + + if (handle_window_eventUPP == NULL) + handle_window_eventUPP = NewEventHandlerUPP (mac_handle_window_event); + if (handle_mouse_eventUPP == NULL) + handle_mouse_eventUPP = NewEventHandlerUPP (mac_handle_mouse_event); + err = InstallWindowEventHandler (window, handle_window_eventUPP, + GetEventTypeCount (specs_window), + specs_window, NULL, NULL); + if (err == noErr) + err = InstallWindowEventHandler (window, handle_mouse_eventUPP, + GetEventTypeCount (specs_mouse), + specs_mouse, NULL, NULL); #endif #if TARGET_API_MAC_CARBON if (mac_do_track_dragUPP == NULL) @@ -8891,68 +9003,19 @@ #if USE_CARBON_EVENTS /* Handle new events */ if (!mac_convert_event_ref (eventRef, &er)) - switch (GetEventClass (eventRef)) - { - case kEventClassWindow: - if (GetEventKind (eventRef) == kEventWindowBoundsChanged) - { - WindowPtr window_ptr; - GetEventParameter(eventRef, kEventParamDirectObject, - typeWindowRef, NULL, sizeof(WindowPtr), - NULL, &window_ptr); - f = mac_window_to_frame (window_ptr); - if (f && !f->async_iconified) - x_real_positions (f, &f->left_pos, &f->top_pos); - SendEventToEventTarget (eventRef, toolbox_dispatcher); - } - break; - case kEventClassMouse: - if (GetEventKind (eventRef) == kEventMouseWheelMoved) - { - SInt32 delta; - Point point; - struct frame *f = mac_focus_frame (dpyinfo); - WindowPtr window_ptr; - -#if 0 - if (dpyinfo->x_focus_frame == NULL) - { - /* Beep if wheel move occurs when all the frames - are invisible. */ - SysBeep(1); - break; - } -#endif - - GetEventParameter(eventRef, kEventParamMouseWheelDelta, - typeSInt32, NULL, sizeof (SInt32), - NULL, &delta); - GetEventParameter(eventRef, kEventParamMouseLocation, - typeQDPoint, NULL, sizeof (Point), - NULL, &point); - inev.kind = WHEEL_EVENT; - inev.code = 0; - inev.modifiers = (mac_event_to_emacs_modifiers (eventRef) - | ((delta < 0) ? down_modifier - : up_modifier)); - window_ptr = FRAME_MAC_WINDOW (f); - SetPortWindowPort (window_ptr); - GlobalToLocal (&point); - XSETINT (inev.x, point.h); - XSETINT (inev.y, point.v); - XSETFRAME (inev.frame_or_window, - mac_window_to_frame (window_ptr)); - inev.timestamp = EventTimeToTicks (GetEventTime (eventRef))*(1000/60); - } - else - SendEventToEventTarget (eventRef, toolbox_dispatcher); - - break; - - default: - /* Send the event to the appropriate receiver. */ - SendEventToEventTarget (eventRef, toolbox_dispatcher); - } + { + /* There used to be a handler for the kEventMouseWheelMoved + event here. But as of Mac OS X 10.4, this kind of event + is not directly posted to the main event queue by + two-finger scrolling on the trackpad. Instead, some + private event is posted and it is converted to a wheel + event by the default handler for the application target. + The converted one can be received by a Carbon event + handler installed on a window target. */ + read_socket_inev = &inev; + SendEventToEventTarget (eventRef, toolbox_dispatcher); + read_socket_inev = NULL; + } else #endif /* USE_CARBON_EVENTS */ switch (er.what) @@ -9388,7 +9451,10 @@ if ((!NILP (Vmac_pass_command_to_system) || !(er.modifiers & cmdKey)) && (!NILP (Vmac_pass_control_to_system) - || !(er.modifiers & controlKey))) + || !(er.modifiers & controlKey)) + && (!NILP (Vmac_command_key_is_meta) + && NILP (Vmac_option_modifier) + || !(er.modifiers & optionKey))) if (SendEventToEventTarget (eventRef, toolbox_dispatcher) != eventNotHandledErr) break;
--- a/src/makefile.w32-in Thu Jun 09 07:36:24 2005 +0000 +++ b/src/makefile.w32-in Wed Jun 15 23:32:15 2005 +0000 @@ -170,7 +170,8 @@ # (it is the preload heap size in MB). # temacs: $(BLD) $(TEMACS) -$(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) +$(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) \ + ../nt/$(BLD)/addsection.exe $(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS) "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20 echo $(OBJ0) > $(BLD)/buildobj.lst
--- a/src/process.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/process.c Wed Jun 15 23:32:15 2005 +0000 @@ -6822,7 +6822,7 @@ doc: /* If non-nil, improve receive buffering by delaying after short reads. On some systems, when Emacs reads the output from a subprocess, the output data is read in very small blocks, potentially resulting in very poor performance. -This behaviour can be remedied to some extent by setting this variable to a +This behavior can be remedied to some extent by setting this variable to a non-nil value, as it will automatically delay reading from such processes, to allowing them to produce more output before Emacs tries to read it. If the value is t, the delay is reset after each write to the process; any other
--- a/src/unexw32.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/unexw32.c Wed Jun 15 23:32:15 2005 +0000 @@ -1,5 +1,5 @@ /* unexec for GNU Emacs on Windows NT. - Copyright (C) 1994 Free Software Foundation, Inc. + Copyright (C) 1994, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -491,27 +491,34 @@ PIMAGE_SECTION_HEADER dst_section; DWORD offset; int i; + int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; -#define COPY_CHUNK(message, src, size) \ +#define COPY_CHUNK(message, src, size, verbose) \ do { \ unsigned char *s = (void *)(src); \ unsigned long count = (size); \ - printf ("%s\n", (message)); \ - printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ + if (verbose) \ + { \ + printf ("%s\n", (message)); \ + printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ + printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%08x Size in bytes.\n", count); \ + } \ memcpy (dst, s, count); \ dst += count; \ } while (0) -#define COPY_PROC_CHUNK(message, src, size) \ +#define COPY_PROC_CHUNK(message, src, size, verbose) \ do { \ unsigned char *s = (void *)(src); \ unsigned long count = (size); \ - printf ("%s\n", (message)); \ - printf ("\t0x%08x Address in process.\n", s); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ + if (verbose) \ + { \ + printf ("%s\n", (message)); \ + printf ("\t0x%08x Address in process.\n", s); \ + printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%08x Size in bytes.\n", count); \ + } \ memcpy (dst, s, count); \ dst += count; \ } while (0) @@ -542,13 +549,14 @@ dst = (unsigned char *) p_outfile->file_base; COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD) nt_header - (DWORD) dos_header); + (DWORD) nt_header - (DWORD) dos_header, be_verbose); dst_nt_header = (PIMAGE_NT_HEADERS) dst; COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD) section - (DWORD) nt_header); + (DWORD) section - (DWORD) nt_header, be_verbose); dst_section = (PIMAGE_SECTION_HEADER) dst; COPY_CHUNK ("Copying section table...", section, - nt_header->FileHeader.NumberOfSections * sizeof (*section)); + nt_header->FileHeader.NumberOfSections * sizeof (*section), + be_verbose); /* Align the first section's raw data area, and set the header size field accordingly. */ @@ -558,7 +566,9 @@ for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) { char msg[100]; - sprintf (msg, "Copying raw data for %s...", section->Name); + /* Windows section names are fixed 8-char strings, only + zero-terminated if the name is shorter than 8 characters. */ + sprintf (msg, "Copying raw data for %.8s...", section->Name); dst_save = dst; @@ -571,7 +581,7 @@ /* Can always copy the original raw data. */ COPY_CHUNK (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), - section->SizeOfRawData); + section->SizeOfRawData, be_verbose); /* Ensure alignment slop is zeroed. */ ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); @@ -580,7 +590,8 @@ { dst = dst_save + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (data_start), dst_section); - COPY_PROC_CHUNK ("Dumping initialized data...", data_start, data_size); + COPY_PROC_CHUNK ("Dumping initialized data...", + data_start, data_size, be_verbose); dst = dst_save + dst_section->SizeOfRawData; } if (section == bss_section) @@ -589,7 +600,8 @@ data size as necessary. */ dst = dst_save + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start), dst_section); - COPY_PROC_CHUNK ("Dumping bss data...", bss_start, bss_size); + COPY_PROC_CHUNK ("Dumping bss data...", bss_start, + bss_size, be_verbose); ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); /* Determine new size of raw data area. */ @@ -604,7 +616,8 @@ section's raw data size as necessary. */ dst = dst_save + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start_static), dst_section); - COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static, bss_size_static); + COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static, + bss_size_static, be_verbose); ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); /* Determine new size of raw data area. */ @@ -622,7 +635,8 @@ section's size to the appropriate size. */ dst = dst_save + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (heap_start), dst_section); - COPY_PROC_CHUNK ("Dumping heap...", heap_start, heap_size); + COPY_PROC_CHUNK ("Dumping heap...", heap_start, heap_size, + be_verbose); ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); /* Determine new size of raw data area. */ @@ -657,7 +671,7 @@ COPY_CHUNK ("Copying remainder of executable...", OFFSET_TO_PTR (offset, p_infile), - p_infile->size - offset); + p_infile->size - offset, be_verbose); /* Final size for new image. */ p_outfile->size = DST_TO_OFFSET ();
--- a/src/w32bdf.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/w32bdf.c Wed Jun 15 23:32:15 2005 +0000 @@ -604,7 +604,7 @@ info.c[1].rgbRed = info.c[1].rgbGreen = info.c[1].rgbBlue = 255; return CreateDIBSection(hdc, (LPBITMAPINFO)&info, - DIB_RGB_COLORS, bitsp, NULL, 0); + DIB_RGB_COLORS, (void **)bitsp, NULL, 0); } glyph_metric *
--- a/src/w32fns.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/w32fns.c Wed Jun 15 23:32:15 2005 +0000 @@ -7821,6 +7821,19 @@ return 0; } +/* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility) + we end up with the old file dialogs. Define a big enough struct for the + new dialog to trick GetOpenFileName into giving us the new dialogs on + Windows 2000 and XP. */ +typedef struct +{ + OPENFILENAME real_details; + void * pReserved; + DWORD dwReserved; + DWORD FlagsEx; +} NEWOPENFILENAME; + + DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. @@ -7869,39 +7882,58 @@ filename[0] = '\0'; { - OPENFILENAME file_details; - + NEWOPENFILENAME new_file_details; + BOOL file_opened = FALSE; + OPENFILENAME * file_details = &new_file_details.real_details; + /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); BLOCK_INPUT; - bzero (&file_details, sizeof (file_details)); - file_details.lStructSize = sizeof (file_details); - file_details.hwndOwner = FRAME_W32_WINDOW (f); + bzero (&new_file_details, sizeof (new_file_details)); + /* Apparently NT4 crashes if you give it an unexpected size. + I'm not sure about Windows 9x, so play it safe. */ + if (w32_major_version > 4 && w32_major_version < 95) + file_details->lStructSize = sizeof (new_file_details); + else + file_details->lStructSize = sizeof (file_details); + + file_details->hwndOwner = FRAME_W32_WINDOW (f); /* Undocumented Bug in Common File Dialog: If a filter is not specified, shell links are not resolved. */ - file_details.lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0"; - file_details.lpstrFile = filename; - file_details.nMaxFile = sizeof (filename); - file_details.lpstrInitialDir = init_dir; - file_details.lpstrTitle = SDATA (prompt); + file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0"; + file_details->lpstrFile = filename; + file_details->nMaxFile = sizeof (filename); + file_details->lpstrInitialDir = init_dir; + file_details->lpstrTitle = SDATA (prompt); if (! NILP (only_dir_p)) default_filter_index = 2; - file_details.nFilterIndex = default_filter_index; - - file_details.Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR + file_details->nFilterIndex = default_filter_index; + + file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR | OFN_EXPLORER | OFN_ENABLEHOOK); if (!NILP (mustmatch)) - file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST; - - file_details.lpfnHook = (LPOFNHOOKPROC) file_dialog_callback; - - if (GetOpenFileName (&file_details)) + { + /* Require that the path to the parent directory exists. */ + file_details->Flags |= OFN_PATHMUSTEXIST; + /* If we are looking for a file, require that it exists. */ + if (NILP (only_dir_p)) + file_details->Flags |= OFN_FILEMUSTEXIST; + } + + file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback; + + file_opened = GetOpenFileName (file_details); + + UNBLOCK_INPUT; + + if (file_opened) { dostounix_filename (filename); - if (file_details.nFilterIndex == 2) + + if (file_details->nFilterIndex == 2) { /* "Directories" selected - strip dummy file name. */ char * last = strrchr (filename, '/'); @@ -7919,7 +7951,6 @@ dir, mustmatch, dir, Qfile_name_history, default_filename, Qnil); - UNBLOCK_INPUT; file = unbind_to (count, file); } @@ -8760,7 +8791,7 @@ DEFVAR_BOOL ("w32-strict-painting", &w32_strict_painting, doc: /* Non-nil means use strict rules for repainting frames. -Set this to nil to get the old behaviour for repainting; this should +Set this to nil to get the old behavior for repainting; this should only be necessary if the default setting causes problems. */); w32_strict_painting = 1; @@ -8953,24 +8984,25 @@ #undef abort +void w32_abort (void) NO_RETURN; + void w32_abort() { int button; button = MessageBox (NULL, "A fatal error has occurred!\n\n" - "Select Abort to exit, Retry to debug, Ignore to continue", + "Would you like to attach a debugger?\n\n" + "Select YES to debug, NO to abort Emacs", "Emacs Abort Dialog", MB_ICONEXCLAMATION | MB_TASKMODAL - | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE); + | MB_SETFOREGROUND | MB_YESNO); switch (button) { - case IDRETRY: + case IDYES: DebugBreak (); - break; - case IDIGNORE: - break; - case IDABORT: + exit (2); /* tell the compiler we will never return */ + case IDNO: default: abort (); break;
--- a/src/w32term.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/w32term.c Wed Jun 15 23:32:15 2005 +0000 @@ -89,6 +89,10 @@ /* Last window where we saw the mouse. Used by mouse-autoselect-window. */ static Lisp_Object last_window; +/* Non-zero means make use of UNDERLINE_POSITION font properties. + (Not yet supported, see TODO in x_draw_glyph_string.) */ +int x_use_underline_position_properties; + extern unsigned int msh_mousewheel; extern void free_frame_menubar (); @@ -2639,7 +2643,9 @@ unsigned long dy = s->height - h; /* TODO: Use font information for positioning and thickness - of underline. See OUTLINETEXTMETRIC, and xterm.c. */ + of underline. See OUTLINETEXTMETRIC, and xterm.c. + Note: If you make this work, don't forget to change the + doc string of x-use-underline-position-properties below. */ if (s->face->underline_defaulted_p) { w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, @@ -6707,6 +6713,18 @@ &w32_use_visible_system_caret, 0)) w32_use_visible_system_caret = 0; + /* We don't yet support this, but defining this here avoids whining + from cus-start.el and other places, like "M-x set-variable". */ + DEFVAR_BOOL ("x-use-underline-position-properties", + &x_use_underline_position_properties, + doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties. +nil means ignore them. If you encounter fonts with bogus +UNDERLINE_POSITION font properties, for example 7x13 on XFree prior +to 4.1, set this to nil. + +NOTE: Not supported on MS-Windows yet. */); + x_use_underline_position_properties = 0; + DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars, doc: /* If not nil, Emacs uses toolkit scroll bars. */); Vx_toolkit_scroll_bars = Qt;
--- a/src/window.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/window.c Wed Jun 15 23:32:15 2005 +0000 @@ -3234,7 +3234,7 @@ so that FRAME_FOCUS_FRAME is moved appropriately as we move around in the state where a minibuffer in a separate frame is active. */ - Fselect_frame (WINDOW_FRAME (w), Qnil); + Fselect_frame (WINDOW_FRAME (w)); } else sf->selected_window = window;
--- a/src/xdisp.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/xdisp.c Wed Jun 15 23:32:15 2005 +0000 @@ -1901,7 +1901,7 @@ int *heightp; { struct frame *f = XFRAME (WINDOW_FRAME (w)); - int x, y, wd, h, h0, y0; + int y, wd, h, h0, y0; /* Compute the width of the rectangle to draw. If on a stretch glyph, and `x-stretch-block-cursor' is nil, don't draw a @@ -8358,7 +8358,6 @@ format_mode_line_unwind_data (obuf) struct buffer *obuf; { - int i = 0; Lisp_Object vector; /* Reduce consing by keeping one vector in @@ -19302,7 +19301,7 @@ struct it *it; Lisp_Object prop; { - Lisp_Object position, val; + Lisp_Object position; if (STRINGP (it->object)) position = make_number (IT_STRING_CHARPOS (*it)); @@ -19647,7 +19646,6 @@ else { Lisp_Object spacing; - int total = 0; it->phys_ascent = it->ascent; it->phys_descent = it->descent; @@ -21664,7 +21662,7 @@ int ignore; int vpos, hpos; - + b = Fprevious_single_property_change (make_number (charpos + 1), Qmouse_face, string, Qnil); if (NILP (b)) @@ -21712,18 +21710,18 @@ hpos = (area == ON_MODE_LINE ? (w->current_matrix)->nrows - 1 : 0); - + /* If the re-rendering position is included in the last re-rendering area, we should do nothing. */ - if ( window == dpyinfo->mouse_face_window + if ( EQ (window, dpyinfo->mouse_face_window) && dpyinfo->mouse_face_beg_col <= vpos && vpos < dpyinfo->mouse_face_end_col && dpyinfo->mouse_face_beg_row == hpos ) return; - + if (clear_mouse_face (dpyinfo)) cursor = No_Cursor; - + dpyinfo->mouse_face_beg_col = vpos; dpyinfo->mouse_face_beg_row = hpos; @@ -21748,8 +21746,9 @@ if (NILP (pointer)) pointer = Qhand; } - } - + else if ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)) + clear_mouse_face (dpyinfo); + } define_frame_cursor1 (f, cursor, pointer); }
--- a/src/xfaces.c Thu Jun 09 07:36:24 2005 +0000 +++ b/src/xfaces.c Wed Jun 15 23:32:15 2005 +0000 @@ -6258,7 +6258,7 @@ 1, 2, 0, doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported. The optional argument DISPLAY can be a display name, a frame, or -nil (meaning the selected frame's display) +nil (meaning the selected frame's display). The definition of `supported' is somewhat heuristic, but basically means that a face containing all the attributes in ATTRIBUTES, when merged @@ -6271,7 +6271,7 @@ any display that can display bold, and a `:foreground \"yellow\"' as long as it can display a yellowish color, but `:slant italic' will _not_ be satisfied by the tty display code's automatic substitution of a `dim' -face for italic. */) +face for italic. */) (attributes, display) Lisp_Object attributes, display; {