Mercurial > emacs
changeset 83082:108bb5537c12
Merged in changes from CVS HEAD
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-161
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-162
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-163
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-164
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-165
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-166
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-167
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-168
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-169
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-170
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-171
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-172
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-122
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Thu, 25 Mar 2004 22:21:45 +0000 |
| parents | 32a426d0a0e3 (current diff) b136a4512609 (diff) |
| children | e4a9e06cbd64 |
| files | ChangeLog etc/TODO lisp/ChangeLog lisp/allout.el lisp/emacs-lisp/bytecomp.el lisp/gdb-ui.el lisp/smerge-mode.el lisp/vc-cvs.el lisp/vc-hooks.el lisp/vc-rcs.el lisp/vc-sccs.el lisp/vc.el src/buffer.c src/dispextern.h src/lisp.h src/term.c src/xdisp.c src/xterm.c |
| diffstat | 105 files changed, 4478 insertions(+), 3200 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,15 @@ +2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * update-subdirs: Add local variables to prevent byte-compiling. + +2004-03-21 Dave Love <fx@gnu.org> + + * configure.in: Fix previous change. + +2004-03-18 Dave Love <fx@gnu.org> + + * configure.in: Add -znocombreloc to LDFLAGS if compiler supports it. + 2004-03-15 Luc Teirlinck <teirllm@auburn.edu> * info/dir (File): Add SMTP and SES. @@ -34,7 +46,7 @@ 2004-01-06 Eric Hanchrow <offby1@blarg.net> (tiny change) - * make-dist (tempdir): Include cursors in nt/icons + * make-dist (tempdir): Include cursors in nt/icons. 2003-12-30 Eli Zaretskii <eliz@elta.co.il>
--- a/configure.in Fri Mar 19 23:21:11 2004 +0000 +++ b/configure.in Thu Mar 25 22:21:45 2004 +0000 @@ -1273,6 +1273,25 @@ ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi +dnl We need -znocombreloc if we're using a relatively recent GNU ld. +dnl If we can link with the flag, it shouldn't do any harm anyhow. +dnl (Don't use `-z nocombreloc' as -z takes no arg on Irix.) +dnl Treat GCC specially since it just gives a non-fatal `unrecognized option' +dnl if not built to support GNU ld. + +late_LDFLAGS=$LDFLAGS +if test $GCC = yes; then + LDFLAGS="$LDFLAGS -Wl,-znocombreloc" +else + LDFLAGS="$LDFLAGS -znocombreloc" +fi + +AC_MSG_CHECKING([For -znocombreloc]) +AC_LINK_IFELSE([main(){return 0;}], + [AC_MSG_RESULT(yes)], + LDFLAGS=$late_LDFLAGS + [AC_MSG_RESULT(no)]) + dnl checks for Unix variants AC_AIX
--- a/etc/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/etc/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,8 @@ +2004-03-19 Kim F. Storm <storm@cua.dk> + + * TODO: Remove entries for fringe related issues (DONE). + Remove entry about image-relative coordinates of mouse clicks (DONE). + 2004-03-11 Daniel Pfeiffer <occitan@esperanto.org> * compilation.txt: New file.
--- a/etc/NEWS Fri Mar 19 23:21:11 2004 +0000 +++ b/etc/NEWS Thu Mar 25 22:21:45 2004 +0000 @@ -92,7 +92,7 @@ It now uses font-lock for turning compiler output into hypertext. Quite a few more kinds of messages are recognized. Messages that are recognized as -warnings or informational come in orange or green, instead of red. +warnings or informational come in orange or green, instead of red. Informational messages are by default skipped with `next-error'. The new file etc/compilation.txt gives examples of each type of message. @@ -233,7 +233,7 @@ *** Microsoft SQLServer support has been significantly improved. Keyword highlighting for SqlServer 2000 is implemented. sql-interactive-mode defaults to use osql, rather than isql, because -osql flushes it's error stream more frequently. Thus error messages +osql flushes its error stream more frequently. Thus error messages are displayed when they occur rather than when the session is terminated. @@ -1627,7 +1627,7 @@ L: shows the log of the revision at line W: annotates the workfile (most up to date) version -* New modes and packages in 21.4 +* New modes and packages in Emacs 21.4 +++ ** The new global minor mode `size-indication-mode' (off by default) @@ -1850,6 +1850,65 @@ * Lisp Changes in Emacs 21.4 +** The display space :width and :align-to text properties are now +supported on text terminals. + +** Enhancements to stretch display properties + +The display property stretch specification form `(space PROPS)', where +PROPS is a property list now allows pixel based width and height +specifications, as well as enhanced horizontal text alignment. + +The value of these properties can now be a (primitive) expression +which is evaluated during redisplay. The following expressions +are supported: + +EXPR ::= NUM | (NUM) | UNIT | ELEM | POS | IMAGE | FORM +NUM ::= INTEGER | FLOAT | SYMBOL +UNIT ::= in | mm | cm | width | height +ELEM ::= left-fringe | right-fringe | left-margin | right-margin + | scroll-bar | text +POS ::= left | center | right +FORM ::= (NUM . EXPR) | (OP EXPR ...) +OP ::= + | - + +The form `NUM' specifies a fractional width or height of the default +frame font size. The form `(NUM)' specifies an absolute number of +pixels. If a symbol is specified, its buffer-local variable binding +is used. The `in', `mm', and `cm' units specifies the number of +pixels per inch, milli-meter, and centi-meter, resp. The `width' and +`height' units correspond to the width and height of the current face +font. An image specification corresponds to the width or height of +the image. + +The `left-fringe', `right-fringe', `left-margin', `right-margin', +`scroll-bar', and `text' elements specify to the width of the +corresponding area of the window. + +The `left', `center', and `right' positions can be used with :align-to +to specify a position relative to the left edge, center, or right edge +of the text area. One of the above window elements (except `text') +can also be used with :align-to to specify that the position is +relative to the left edge of the given area. Once the base offset for +a relative position has been set (by the first occurrence of one of +these symbols), further occurences of these symbols are interpreted as +the width of the area. + +For example, to align to the center of the left-margin, use + :align-to (+ left-margin (0.5 . left-margin)) + +If no specific base offset is set for alignment, it is always relative +to the left edge of the text area. For example, :align-to 0 in a +header-line aligns with the first text column in the text area. + +The value of the form `(NUM . EXPR)' is the value of NUM multiplied by +the value of the expression EXPR. For example, (2 . in) specifies a +width of 2 inches, while (0.5 . IMAGE) specifies half the width (or +height) of the specified image. + +The form `(+ EXPR ...)' adds up the value of the expressions. +The form `(- EXPR ...)' negates or subtracts the value of the expressions. + ** New macro with-local-quit temporarily sets inhibit-quit to nil for use around potentially blocking or long-running code in timers and post-command-hooks.
--- a/etc/PROBLEMS Fri Mar 19 23:21:11 2004 +0000 +++ b/etc/PROBLEMS Thu Mar 25 22:21:45 2004 +0000 @@ -58,20 +58,18 @@ running make) will solve the problem. It appears to be caused by some problems with the unexec code and its interaction with libSystem.B. -* Emacs crashes with SIGSEGV on Solaris in XtInitializeWidgetClass +* Emacs crashes with SIGSEGV in XtInitializeWidgetClass It crashes on X, but runs fine when called with option "-nw". -This has been observed when emacs is linked with GNU ld instead of -Solaris ld. To check which ld is used by gcc add "-V" to -TEMACS_LDFLAGS in src/Makefile. Alternatively the executable size may -be used as an indication of which linker is used. The size is -approximately 15M when linked with solaris ld compared to 9M when -linked with GNU ld. - -The fix is to reconfigure/install gcc, making sure that the SUN linker -is used. - +This has been observed when Emacs is linked with GNU ld but without passing +the -z nocombreloc flag. Emacs normally knows to pass the -z nocombreloc +flag when needed, so if you come across a situation where the flag is +necessary but missing, please report it via M-x report-emacs-bug. + +On platforms such as Solaris, you can also work around this problem by +configuring your compiler to use the native linker instead of GNU ld. + * Characters from the mule-unicode charsets aren't displayed under X. XFree86 4 contains many fonts in iso10646-1 encoding which have
--- a/etc/TODO Fri Mar 19 23:21:11 2004 +0000 +++ b/etc/TODO Thu Mar 25 22:21:45 2004 +0000 @@ -63,14 +63,6 @@ * Remove the limitation that window and frame widths and heights can be only full columns/lines. -* Move fringe to be displayed between display margins and text area. - [KFS is looking into this]. - -* Set fringe widths per-window/per-buffer. - -* Make fringe bitmaps user configurable. Maybe add ability to add - additional bitmaps to the fringe from lisp. - Other features we would like: * Have a command suggestion help system that recognizes patterns @@ -266,10 +258,6 @@ cvs-status (should be described in PCL-CVS manual); other progmodes, probably in separate manual. -* Provide a means to extract image-relative coordinates from mouse - clicks on images. (Needed for W3, at least.) Also useful for W3 - and Gnus: allow images to scroll properly. - * Convert the XPM bitmaps to PPM, replace the PBMs with them and scrap the XPMs so that the colour versions work generally. (Requires care with the colour used for the transparent regions.)
--- a/leim/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/leim/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -722,7 +722,7 @@ translation. * quail/japanese.el ("japanese"): Delete the key sequence for - Roman transliteration from the docstring because it's now shonw + Roman transliteration from the docstring because it's now shown automatically. ("japanese-ascii", "japanese-zenkaku") ("japanese-hankaku-kana", "japanese-hiragana")
--- a/leim/quail/cyrillic.el Fri Mar 19 23:21:11 2004 +0000 +++ b/leim/quail/cyrillic.el Thu Mar 25 22:21:45 2004 +0000 @@ -52,8 +52,8 @@ nil t t t t nil nil nil nil nil t) ;; 1! 2" 3' 4* 5: 6, 7. 8; 9( 0) -_ =+ ,L!(B -;; ,L9(B ,LF(B ,LC(B ,L:(B ,L5(B ,L=(B ,L3(B ,LH(B ,LI(B ,L7(B ,LE(B ,Lj(B -;; ,LD(B ,LK(B ,L2(B ,L0(B ,L?(B ,L@(B ,L>(B ,L;(B ,L4(B ,L6(B ,LM(B +;; ,L9(B ,LF(B ,LC(B ,L:(B ,L5(B ,L=(B ,L3(B ,LH(B ,LI(B ,L7(B ,LE(B ,LJ(B +;; ,LD(B ,LK(B ,L2(B ,L0(B ,L?(B ,L@(B ,L>(B ,L;(B ,L4(B ,L6(B ,LM(B ;; ,LO(B ,LG(B ,LA(B ,L<(B ,L8(B ,LB(B ,LL(B ,L1(B ,LN(B /? (quail-define-rules @@ -174,8 +174,8 @@ nil t t t t nil nil nil nil nil t) ;; 1! 2" 3,Lp(B 4; 5% 6: 7? 8* 9( 0) -_ =+ ,Lq!(B -;; ,L9(B ,LF(B ,LC(B ,L:(B ,L5(B ,L=(B ,L3(B ,LH(B ,LI(B ,L7(B ,LE(B ,Lj(B -;; ,LD(B ,LK(B ,L2(B ,L0(B ,L?(B ,L@(B ,L>(B ,L;(B ,L4(B ,L6(B ,LM(B +;; ,L9(B ,LF(B ,LC(B ,L:(B ,L5(B ,L=(B ,L3(B ,LH(B ,LI(B ,L7(B ,LE(B ,LJ(B +;; ,LD(B ,LK(B ,L2(B ,L0(B ,L?(B ,L@(B ,L>(B ,L;(B ,L4(B ,L6(B ,LM(B ;; ,LO(B ,LG(B ,LA(B ,L<(B ,L8(B ,LB(B ,LL(B ,L1(B ,LN(B ., (quail-define-rules @@ -999,8 +999,8 @@ (quail-define-package "cyrillic-translit" "Cyrillic" ",L6(Bt" nil "Intuitively transliterated keyboard layout. -Most convenient for entering Russian but all Cyrillic characters are included. -Should handle most cases. However: +Most convenient for entering Russian, but all Cyrillic characters +are included. Should handle most cases. However: for ,Lf(B (TSE) use \"c\", never \"ts\" ,Li(B (SHCHA = Bulgarian SHT) = \"shch\", \"sj\", \"/sht\" or \"/t\", ,Lm(B (REVERSE ROUNDED E) = \"e'\" or \"e`\" @@ -1072,8 +1072,8 @@ nil t t t t nil nil nil nil nil t) ;; $,1(q(!(B 1! 2" 3N 4; 5% 6: 7? 8* 9( 0) -_ =+ -;; $,1(9(B $,1(F(B $,1(C(B $,1(:(B $,1(5(B $,1(=(B $,1(3(B $,1(H(B $,1(.(B $,1(7(B $,1(E(B ' -;; $,1(D(B $,1(K(B $,1(2(B $,1(0(B $,1(?(B $,1(@(B $,1(>(B $,1(;(B $,1(4(B $,1(6(B $,1(M(B +;; $,1(9(B $,1(F(B $,1(C(B $,1(:(B $,1(5(B $,1(=(B $,1(3(B $,1(H(B $,1(.(B $,1(7(B $,1(E(B ' +;; $,1(D(B $,1(K(B $,1(2(B $,1(0(B $,1(?(B $,1(@(B $,1(>(B $,1(;(B $,1(4(B $,1(6(B $,1(M(B ;; $,1(O(B $,1(G(B $,1(A(B $,1(<(B $,1(&(B $,1(B(B $,1(L(B $,1(1(B $,1(N(B ., (quail-define-rules
--- a/leim/quail/hebrew.el Fri Mar 19 23:21:11 2004 +0000 +++ b/leim/quail/hebrew.el Thu Mar 25 22:21:45 2004 +0000 @@ -35,10 +35,10 @@ Hebrew letters are assigned to lowercases. " nil t t t t nil nil nil nil nil t) -;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) _- += ~; -;; /Q 'W ,Hw(BE ,Hx(BR ,H`(BT ,Hh(BY ,He(BU ,Ho(BI ,Hm(BO ,Ht(BP {[ {] -;; ,Hy(BA ,Hc(BS ,Hb(BD ,Hk(BF ,Hr(BG ,Hi(BH ,Hg(BJ ,Hl(BK ,Hj(BL :,Hs(B ", |\ -;; ,Hf(BZ ,Hq(BX ,Ha(BC ,Hd(BV ,Hp(BB ,Hn(BN ,Hv(BM <,Hz(B >,Hu(B ?. +;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ ;~ +;; /Q 'W ,Hw(BE ,Hx(BR ,H`(BT ,Hh(BY ,He(BU ,Ho(BI ,Hm(BO ,Ht(BP [{ ]} +;; ,Hy(BA ,Hc(BS ,Hb(BD ,Hk(BF ,Hr(BG ,Hi(BH ,Hg(BJ ,Hl(BK ,Hj(BL ,Hs(B: ," \| +;; ,Hf(BZ ,Hq(BX ,Ha(BC ,Hd(BV ,Hp(BB ,Hn(BN ,Hv(BM ,Hz(B< ,Hu(B> .? ;; (quail-define-rules
--- a/lib-src/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/lib-src/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -45,12 +45,6 @@ Only try su-fallback if the socket name was not explicit. Check socket name length in su-fallback case as well. -2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca> - - * emacsclient.c (main): Stop if socket name too long. - Only try su-fallback if the socket name was not explicit. - Check socket name length in su-fallback case as well. - 2004-01-08 Andreas Schwab <schwab@suse.de> * emacsclient.c (main): Save errno from socket_status.
--- a/lisp/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,310 @@ +2004-03-26 Masatake YAMATO <jet@gyve.org> + + * simple.el (completion-setup-function): Emphasize the + first uncommon characters in the completions;and de-emphasize + the common prefix substrings. + (completion-emphasis): New face. + (completion-de-emphasis): New face. + +2004-03-25 Sam Steingold <sds@gnu.org> + + * vc.el (vc-print-log): Fixed a bug in the last patch: + backend-function may be a byte-compiled object, not a lambda + +2004-03-25 Juri Linkov <juri@jurta.org> + + * descr-text.el (describe-property-list): Add a button + for `face' property that calls `describe-face'. + Suggested by luis fernandes <elf@ee.ryerson.ca> + + * international/mule.el (keyboard-coding-system): + * kmacro.el (kmacro-call-macro): Fix docstring. + + * dired.el: Fix comments. + + * textmodes/fill.el (fill): Fix Info link. + + * font-lock.el (fast-lock, lazy-lock): + * jit-lock.el (jit-lock): Remove links to removed Support Modes + Info node. + + * info-xref.el: Fix commentary. + +2004-03-25 Kevin Ryde <user42@zip.com.au> + + * info-xref.el (info-xref-check-buffer): Report empty filename parts. + Remove spurious node duplicate suppression, doesn't work, not wanted. + (info-xref-output): Take format style args, add "sit-for 0" to let + user see the results as they progress. + (info-xref-check-all-custom): New function. + +2004-03-25 Nick Roberts <nick@nick.uklinux.net> + + * gdb-ui.el: Moved to progmodes. + +2004-03-24 Glenn Morris <gmorris@ast.cam.ac.uk> + + * calendar/appt.el (appt-check): Remove superfluous progn. + When finished with diary buffer: if it was not being displayed + before, kill it; otherwise restore its original state. + Suggested by Matthew Mundell <matt@mundell.ukfsn.org>. + + * calendar/calendar.el (calendar-set-mode-line): Use total + available mode-line width, rather than frame-width. + + * calendar/diary-lib.el (fancy-diary-display): Set mode-line + after mode change so effect not lost. + +2004-03-23 Dave Love <fx@gnu.org> + + * dired.el (dired) <defgroup>: Add link to manual. + (dired-font-lock-keywords): Add highlighting on unusual permissions. + (dired-revert): Use dolist. + (dired-mode-map): Add U binding. + (dired-mode): Add font-lock-beginning-of-syntax-function. + (dired-garbage-files-regexp): Make it a defcustom. + +2004-03-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-arch.el (vc-arch-diff): Handle the special case where `newvers' + is equivalent to nil. + (vc-arch-diff3-rej-p): Be a bit more flexible in what we accept. + (vc-arch-mode-line-string): Accept `added' state. + (vc-arch-state): Use inode-sigs if available. + (vc-arch-add-tagline): Rename from vc-arch-add-tag. + Copy&delete existing id file if any. Fallback if uuidgen is absent. + (vc-arch-tagline-re): New var. + (vc-arch-file-source-p, vc-arch-file-id, vc-arch-tagging-method): + New functions. + (vc-arch-find-file-not-found-hook, vc-arch-register): New backend ops. + (vc-arch-registered): Try our best guess using vc-arch-file-source-p. + + * vc-hooks.el (vc-default-find-file-not-found-hook): New fun. + (vc-file-not-found-hook): Use it. + + * diff-mode.el (diff-default-read-only): Change default. + (diff-mode-hook): Make it a defcustom. Add some options. + (diff-mode-map): Bind diff-refine-hook. + (diff-yank-handler): New var. + (diff-yank-function): New fun. + (diff-font-lock-keywords): Use them. + (diff-end-of-file): Handle case where file-header looks like diff text. + (diff-hunk-kill): Adjust to "new" hunk-next behavior. + (diff-file-kill): Delete a subsequent empty line, if applicable. + (diff-hunk-file-names): New fun, extracted from diff-tell-file-name. + (diff-find-file-name): Use it. + (diff-tell-file-name): New command. + (diff-mode): Be careful with view-mode. + (diff-delete-if-empty, diff-delete-empty-files, diff-make-unified): + New functions, for use in diff-mode-hook. + (diff-find-source-location): Catch "regex too large" errors. + (diff-apply-hunk, diff-test-hunk): Go to old or new file. + (diff-refine-hunk): New command. + + * smerge-mode.el (smerge-mode-menu): Fix activate pred for resolve. + (smerge-context-menu-map): Remove unused var. + (smerge-keep-all): Preserve markers. + (smerge-keep-n): New fun. + (smerge-keep-base, smerge-keep-other, smerge-keep-mine) + (smerge-keep-current, smerge-ediff): Use it. + (smerge-kill-current): Use it. Make it work on some 3-part conflicts. + (smerge-popup-context-menu): Also use context-menu on 3-part conflicts. + (smerge-resolve): Resolve trivial 3-part conflicts. + +2004-03-23 Juri Linkov <juri@jurta.org> + + * man.el (Man-width): New var. + (Man-getpage-in-background): Use it. + (Man-support-local-filenames): New var and fun. + (Man-build-man-command): Don't add a second %s. + (Man-fontify-manpage): Clean up message. + (Man-mode): Set outline-regexp, outline-level, + imenu-generic-expression. + + * woman.el (woman-fill-frame): Doc fix. + (woman-decode-region): Use window-width instead of frame-width. + + * abbrevlist.el (list-one-abbrev-table): + * descr-text.el (describe-char): + * international/mule-diag.el (describe-current-coding-system): + * international/quail.el (quail-insert-decode-map): + Use window-width instead of frame-width. + + * jka-compr.el (jka-compr-compression-info-list): Add tbz and dz. + (jka-compr-mode-alist-additions): Add tbz. + (jka-compr-write-region, jka-compr-insert-file-contents): + Add message for undefined compress-program. + (jka-compr-write-region): Remove redundant var bindings. + + * dired-x.el (dired-guess-shell-alist-default): Add choices for + extracting files into subdirectory. Add tbz and dz. Fix regexps. + Add extensions .[0-9] for man and nroff, and .pod for perldoc. + (dired-man): Use dired-guess-shell-command. + (dired-guess-shell-case-fold-search): Change defvar to defcustom. + Change default nil to t. + + * dired-aux.el (dired-compress-file-suffixes): Add dz and tbz. + (dired-compare-directories): Add default value for empty input. + + * help-at-pt.el: Move suggestions for key bindings to Commentary. + + * time.el (display-time-string-forms): Fix help-echo date format. + +2004-03-22 Luc Teirlinck <teirllm@auburn.edu> + + * autorevert.el (global-auto-revert-non-file-buffers): Expand docstring. + (buffer-stale-function): New variable. + (auto-revert-list-diff, auto-revert-dired-file-list) + (auto-revert-dired-changed-p, auto-revert-buffer-p): Delete. + (auto-revert-handler): Take over some functionality of deleted + functions. + (auto-revert-buffers): Delete call to auto-revert-buffer-p. + + * dired.el (dired-directory-changed-p, dired-buffer-stale-p): New funs. + (dired-internal-noselect): Use dired-directory-changed-p. + Eliminate revert messages. + (dired-mode): Set buffer-stale-function to dired-buffer-stale-p. + +2004-03-23 Kenichi Handa <handa@etlken2> + + * international/characters.el: Setup syntaxes for more parentheses + Unicode characters. + + * international/mule-cmds.el (select-safe-coding-system): + Merge coding-system and auto-cs before comparing them. + +2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pp.el (pp-eval-expression): Simplify. + + * emacs-lisp/lisp-mode.el (lisp-mode-variables): Don't set + normal-auto-fill-function and comment-indent-function. + The default values now work just as well. + Don't set font-lock-beginning-of-syntax-function since we already set + syntax-begin-function. + (lisp-outline-level): Put ;;;###autoload at same level as (. + (prin1-char): Quote special chars. + + * emacs-lisp/lisp-mnt.el (lm-keywords-finder-p): Use defvar rather + than with-no-warnings. + + * emacs-lisp/edebug.el (edebug-display): Bring up a debug trace + if the source location can't be found. + (edebug-compute-previous-result): Use prin1-char. + + * emacs-lisp/checkdoc.el (checkdoc-error): Dont' assume point-min == 1. + (debug-ignored-errors): Add an entry. + + * emacs-lisp/bytecomp.el (byte-recompile-directory): Ignore hidden dir. + (byte-compile-file): Output warning when deleting a file. + + * emacs-lisp/byte-run.el (defsubst): Add edebug spec and use backquote. + (dont-compile, eval-when-compile, eval-and-compile): Add edebug spec. + + * emacs-lisp/byte-opt.el (byte-compile-log-lap) + (byte-compile-inline-expand): Use backquote. + (byte-optimize-pure-func): Rename from byte-optimize-concat. + (symbol-name, regexp-opt, regexp-quote): Mark as pure. + + * emacs-lisp/backquote.el (backquote-list*-macro): Use nreverse. + + * emacs-lisp/advice.el (ad-subr-arglist): Simplify. + +2004-03-22 Juri Linkov <juri@jurta.org> + + * finder.el (finder-known-keywords): Fix data, tex, unix. + + * play/landmark.el: Fix keywords. + + * language/ethio-util.el (ethio-find-file): Doc fix. + + * emacs-lisp/warnings.el: Doc fix. + + * textmodes/ispell.el (ispell-help): Doc fix. + +2004-03-21 Luc Teirlinck <teirllm@auburn.edu> + + * format.el (format-insert-file): Always return a list of two + elements, like insert-file-contents does. + +2004-03-21 Andre Spiegel <spiegel@gnu.org> + + * vc.el Add new optional BUFFER argument to vc-BACKEND-print-log + and vc-BACKEND-diff. + (vc-print-log): If the print-log implementation supports it, use + the new BUFFER argument to direct output to *vc-change-log*, not *vc*. + (vc-version-diff, vc-diff-internal): Doc fixes. + + * vc-hooks.el (vc-default-workfile-unchanged-p): If the + implementation supports it, let diff output go to *vc*, + not *vc-diff*, since this is an internal call. + + * vc-cvs.el (vc-cvs-print-log, vc-cvs-diff): Add optional BUFFER arg. + + * vc-rcs.el (vc-rcs-print-log, vc-rcs-diff): Likewise. + + * vc-sccs.el (vc-sccs-print-log, vc-sccs-diff): Likewise. + +2004-03-21 Dave Love <fx@gnu.org> + + * progmodes/cfengine.el (cfengine-mode): + Set parse-sexp-ignore-comments. + + * emacs-lisp/rx.el (rx): Work at compile time, not run time. + +2004-03-21 Juanma Barranquero <lektu@terra.es> + + * allout.el (allout-mode): Fix docstring. + +2004-03-20 Luc Teirlinck <teirllm@auburn.edu> + + * files.el (insert-directory): Fix bug if SWITCHES is a list. + + * autorevert.el (auto-revert-interval): Make new value take + effect immediately when set through Custom. + (auto-revert-set-timer): Add interactive declaration. + +2004-03-19 David Ponce <david@dponce.com> + + * ruler-mode.el (ruler-mode-header-line-format-old): + Don't `make-variable-buffer-local'. + (ruler-mode-ruler-function): Default to `ruler-mode-ruler'. + (ruler-mode-header-line-format): Simply funcall the above. + (ruler-mode): Use `make-local-variable' and `kill-local-variable' + to save/restore a previous header line format. + (ruler-mode-space): Don't depend on a numeric WIDTH value. + (ruler-mode-ruler): Use symbolic display elements for scrollbar, + fringes and margins width. + (ruler-mode-ruler-function): Default to ruler-mode-ruler. + +2004-03-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * log-edit.el (log-edit-font-lock-keywords): Typo. + + * textmodes/tex-mode.el (tex-shell): Set error parsing function here. + (tex-send-tex-command): Rather than here. + (tex-compilation-parse-errors): Simplify. + + * info.el (Info-default-dirs): Don't ignore last part of I-d-d-l. + + * time.el (display-time-string-forms): Add help-echo with date on time. + + * composite.el (compose-region): Use restore-buffer-modified-p. + + * disp-table.el (standard-display-8bit): Simplify. + + * server.el (server-process-filter): Delete temp frame. + + * add-log.el (add-change-log-entry): Simplify. + +2004-03-19 Kim F. Storm <storm@cua.dk> + + * hexl.el (hexl-mode-ruler): Adapt to new :align-to semantics. + (hexl-follow-line): Don't require 'fringe. + + * progmodes/compile.el (compilation-start): Always set + compilation-last-buffer and return it. + 2004-03-17 Luc Teirlinck <teirllm@auburn.edu> * simple.el (clone-buffer): Doc fix. @@ -443,7 +750,7 @@ to 'pty. Suggested by Piet van Oostrum <piet@cs.uu.nl>. (top-level): Setting default value in `tramp-default-method-alist' corrected. Order of USER and HOST have been wrong. - Nobody complaimed for months ... + Nobody complained for months ... (tramp-smb-maybe-open-connection): Use `tramp-process-connection-type'. (tramp-smb-open-connection): Clear password cache if login has failed. @@ -805,8 +1112,7 @@ (rsf-bbdb-dont-create-entries-for-deleted-messages): Rename from rsf-bbdb-dont-create-entries-for-spam. (check-field): New function, extracted from code in - rmail-spam-filter to ease addition of header fields like - content-type. + rmail-spam-filter to ease addition of header fields like content-type. (message-content-type): New variable to check the content-type: field added, also in defcustom of rsf-definitions-alist. (rmail-spam-filter): Replace repeated test code for header fields @@ -862,9 +1168,8 @@ 2004-02-16 Jari Aalto <jari.aalto@poboxes.com> - Autorevert: Add support to detect changed dired buffers and for - VC controlled files. - * autorevert.el (auto-revert-active-p, auto-revert-list-diff) + * autorevert.el: Add support to detect changed dired and VC buffers. + (auto-revert-active-p, auto-revert-list-diff) (auto-revert-dired-file-list, auto-revert-dired-changed-p) (auto-revert-handler, auto-revert-active-p): New functions. (auto-revert-buffers): Move revert logic to `auto-revert-handler' @@ -974,7 +1279,7 @@ 2004-02-10 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * x-dnd.el (x-dnd-types-alist): Add COMPOUND_TEXT, FILE_NAME - handeled by x-dnd-handle-file-name. + handled by x-dnd-handle-file-name. (x-dnd-known-types): Add COMPOUND_TEXT. (x-dnd-init-frame): Call x-dnd-init-motif-for-frame. (x-dnd-get-state-cons-for-frame): Must do copy-sequence on
--- a/lisp/abbrevlist.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/abbrevlist.el Thu Mar 25 22:21:45 2004 +0000 @@ -39,7 +39,7 @@ abbrev-table) (setq abbrev-list (sort abbrev-list 'string-lessp)) (while abbrev-list - (if (> (+ first-column 40) (frame-width)) + (if (> (+ first-column 40) (window-width)) (progn (insert "\n") (setq first-column 0)))
--- a/lisp/add-log.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/add-log.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; add-log.el --- change log maintenance commands for Emacs -;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000, 2003 +;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000, 03, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -489,8 +489,7 @@ (funcall add-log-buffer-file-name-function) buffer-file-name)) (buffer-file (if buf-file-name (expand-file-name buf-file-name))) - (file-name (expand-file-name - (or file-name (find-change-log file-name buffer-file)))) + (file-name (expand-file-name (find-change-log file-name buffer-file))) ;; Set ITEM to the file name to use in the new item. (item (add-log-file-name buffer-file file-name)) bound)
--- a/lisp/allout.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/allout.el Thu Mar 25 22:21:45 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: Ken Manheimer <klm@zope.com> ;; Maintainer: Ken Manheimer <klm@zope.com> ;; Created: Dec 1991 - first release to usenet -;; Version: $Id: allout.el,v 1.46 2004/03/01 22:44:04 lektu Exp $|| +;; Version: $Id: allout.el,v 1.47 2004/03/21 15:21:38 lektu Exp $|| ;; Keywords: outlines mode wp languages ;; This file is part of GNU Emacs. @@ -508,7 +508,7 @@ ;;;_ : Version ;;;_ = allout-version (defvar allout-version - (let ((rcs-rev "$Revision: 1.46 $")) + (let ((rcs-rev "$Revision: 1.47 $")) (condition-case err (save-match-data (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) @@ -1049,7 +1049,7 @@ Below is a description of the bindings, and then explanation of special `allout-mode' features and terminology. See also the outline menubar additions for quick reference to many of the features, and see -the docstring of the variable `allout-init' for instructions on +the docstring of the function `allout-init' for instructions on priming your emacs session for automatic activation of `allout-mode'.
--- a/lisp/autorevert.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/autorevert.el Thu Mar 25 22:21:45 2004 +0000 @@ -103,13 +103,27 @@ Never set this variable directly, use the command `auto-revert-mode' instead.") (put 'auto-revert-mode 'permanent-local t) +(defvar auto-revert-timer nil + "Timer used by Auto-Revert Mode.") + (defcustom auto-revert-interval 5 "Time, in seconds, between Auto-Revert Mode file checks. -Setting this variable has no effect on buffers that are already in -auto-revert-mode; it only affects buffers that are put into -auto-revert-mode afterwards." +The value may be an integer or floating point number. + +If a timer is already active, there are two ways to make sure +that the new value will take effect immediately. You can set +this variable through Custom or you can call the command +`auto-revert-set-timer' after setting the variable. Otherwise, +the new value will take effect the first time Auto Revert Mode +calls `auto-revert-set-timer' for internal reasons or in your +next editing session." :group 'auto-revert - :type 'integer) + :type 'number + :set (lambda (variable value) + (set-default variable value) + (and (boundp 'auto-revert-timer) + auto-revert-timer + (auto-revert-set-timer)))) (defcustom auto-revert-stop-on-user-input t "When non-nil Auto-Revert Mode stops checking files on user input." @@ -158,7 +172,12 @@ When non-nil, both file buffers and buffers with a custom `revert-buffer-function' are reverted by Global Auto-Revert Mode. -Use this option with care since it could lead to excessive reverts." +Use this option with care since it could lead to excessive reverts. +Note also that for some non-file buffers the check whether the +buffer needs updating may be imperfect, due to efficiency +considerations, and may not take all information listed in the +buffer into account. Hence, a non-nil value for this option does +not necessarily make manual updates useless for non-file buffers." :group 'auto-revert :type 'boolean) @@ -179,6 +198,18 @@ This variable becomes buffer local when set in any fashion.") (make-variable-buffer-local 'global-auto-revert-ignore-buffer) +(defvar buffer-stale-function nil + "Function to check whether a non-file buffer needs reverting. +This should be a function with one optional argument NOCONFIRM. +Auto Revert Mode sets NOCONFIRM to t. The function should return +non-nil if the buffer should be reverted. The buffer is current +when this function is called. + +The idea behind the NOCONFIRM argument is that the same function +can also be used to ask the user whether the buffer should be +reverted. In such a situation one has to be less careful about, +say, reverting remote files, than if the function is called at +regular intervals by Auto Revert Mode.") ;; Internal variables: @@ -191,9 +222,6 @@ The timer function `auto-revert-buffers' is responsible for purging the list of old buffers.") -(defvar auto-revert-timer nil - "Timer used by Auto-Revert Mode.") - (defvar auto-revert-remaining-buffers '() "Buffers not checked when user input stopped execution.") @@ -242,6 +270,7 @@ (defun auto-revert-set-timer () "Restart or cancel the timer." + (interactive) (if (timerp auto-revert-timer) (cancel-timer auto-revert-timer)) (setq auto-revert-timer @@ -260,61 +289,6 @@ (not (memq major-mode global-auto-revert-ignore-modes))))) -(defun auto-revert-list-diff (a b) - "Check if strings in list A differ from list B." - (when (and a b) - (setq a (sort a 'string-lessp)) - (setq b (sort b 'string-lessp)) - (let (elt1 elt2) - (catch 'break - (while (and (setq elt1 (and a (pop a))) - (setq elt2 (and b (pop b)))) - (if (not (string= elt1 elt2)) - (throw 'break t))))))) - -(defun auto-revert-dired-file-list () - "Return list of dired files." - (let (file list) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (setq file (dired-get-filename t t)) - (push file list)) - (forward-line 1))) - list)) - -(defun auto-revert-dired-changed-p () - "Check if dired buffer has changed." - (when (and (stringp dired-directory) - ;; Exclude remote buffers, would be too slow for user - ;; modem, timeouts, network lag ... all is possible - (not (string-match "@" dired-directory)) - (file-directory-p dired-directory)) - (let ((files (directory-files dired-directory)) - (dired (auto-revert-dired-file-list))) - (or (not (eq (length files) (length dired))) - (auto-revert-list-diff files dired))))) - -(defun auto-revert-buffer-p () - "Check if current buffer should be reverted." - ;; - Always include dired buffers to list. It would be too expensive - ;; to test the "revert" status here each time timer launches. - ;; - Same for VC buffers. - (or (and (eq major-mode 'dired-mode) - (or (and global-auto-revert-mode - global-auto-revert-non-file-buffers) - auto-revert-mode)) - (and (not (buffer-modified-p)) - (auto-revert-vc-buffer-p)) - (and (not (buffer-modified-p)) - (if (buffer-file-name) - (and (file-readable-p (buffer-file-name)) - (not (verify-visited-file-modtime (current-buffer)))) - (and revert-buffer-function - (or (and global-auto-revert-mode - global-auto-revert-non-file-buffers) - auto-revert-mode)))))) - (defun auto-revert-vc-cvs-file-version (file) "Get version of FILE by reading control file on disk." (let* ((control "CVS/Entries") @@ -371,25 +345,27 @@ (defun auto-revert-handler () "Revert current buffer." - (let (revert) - (cond - ((eq major-mode 'dired-mode) - ;; Dired includes revert-buffer-function - (when (and revert-buffer-function - (auto-revert-dired-changed-p)) + (unless (buffer-modified-p) + (let (revert) + (cond + ((auto-revert-vc-buffer-p) + (when (auto-revert-handler-vc) + (setq revert 'vc))) + ((or (and (buffer-file-name) + (file-readable-p (buffer-file-name)) + (not (verify-visited-file-modtime (current-buffer)))) + (and global-auto-revert-non-file-buffers + revert-buffer-function + (boundp 'buffer-stale-function) + (functionp buffer-stale-function) + (funcall buffer-stale-function t))) (setq revert t))) - ((auto-revert-vc-buffer-p) - (when (auto-revert-handler-vc) - (setq revert 'vc))) - ((or (buffer-file-name) - revert-buffer-function) - (setq revert t))) - (when revert - (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes) - (if (eq revert 'vc) - (vc-mode-line buffer-file-name)) - (if auto-revert-verbose - (message "Reverting buffer `%s'." (buffer-name)))))) + (when revert + (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes) + (if (eq revert 'vc) + (vc-mode-line buffer-file-name)) + (if auto-revert-verbose + (message "Reverting buffer `%s'." (buffer-name))))))) (defun auto-revert-buffers () "Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode. @@ -441,8 +417,7 @@ (memq buf auto-revert-buffer-list)) (setq auto-revert-buffer-list (delq buf auto-revert-buffer-list))) - (when (and (auto-revert-active-p) - (auto-revert-buffer-p)) + (when (auto-revert-active-p) (auto-revert-handler) ;; `preserve-modes' avoids changing the (minor) modes. But we ;; do want to reset the mode for VC, so we do it explicitly.
--- a/lisp/calendar/appt.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/calendar/appt.el Thu Mar 25 22:21:45 2004 +0000 @@ -325,19 +325,33 @@ ;; At the first check in any given day, update our ;; appointments to today's list. - (if (or force + (if (or force ; eg initialize, diary save (null appt-prev-comp-time) ; first check (< cur-comp-time appt-prev-comp-time)) ; new day (condition-case nil - (progn - (if appt-display-diary - (let ((diary-hook - (if (assoc 'appt-make-list diary-hook) - diary-hook - (cons 'appt-make-list diary-hook)))) - (diary)) - (let ((diary-display-hook 'appt-make-list)) - (diary)))) + (if appt-display-diary + (let ((diary-hook + (if (assoc 'appt-make-list diary-hook) + diary-hook + (cons 'appt-make-list diary-hook)))) + (diary)) + (let ((diary-display-hook 'appt-make-list) + (d-buff (find-buffer-visiting + (substitute-in-file-name diary-file))) + selective) + (if d-buff ; diary buffer exists + (with-current-buffer d-buff + (setq selective selective-display))) + (diary) + ;; If the diary buffer existed before this command, + ;; restore its display state. Otherwise, kill it. + (if d-buff + ;; Displays the diary buffer. + (or selective (show-all-diary-entries)) + (and + (setq d-buff (find-buffer-visiting + (substitute-in-file-name diary-file))) + (kill-buffer d-buff))))) (error nil))) (setq appt-prev-comp-time cur-comp-time @@ -637,7 +651,7 @@ (defun appt-update-list () "If the current buffer is visiting the diary, update appointments. This function is intended for use with `write-file-functions'." - (and (equal buffer-file-name (expand-file-name diary-file)) + (and (string-equal buffer-file-name (expand-file-name diary-file)) appt-timer (let ((appt-display-diary nil)) (appt-check t)))
--- a/lisp/calendar/calendar.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/calendar/calendar.el Thu Mar 25 22:21:45 2004 +0000 @@ -1915,6 +1915,7 @@ font-lock-mode) (font-lock-fontify-buffer)) (and mark-holidays-in-calendar +;;; (calendar-date-is-legal-p today) ; useful for BC dates (mark-calendar-holidays) (sit-for 0)) (unwind-protect @@ -2933,7 +2934,10 @@ (defun calendar-set-mode-line (str) "Set mode line to STR, centered, surrounded by dashes." (setq mode-line-format - (calendar-string-spread (list str) ?- (frame-width)))) + (calendar-string-spread + (list str) ?- + ;; As per doc of window-width, total visible mode-line length. + (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges)))))) (defun calendar-mod (m n) "Non-negative remainder of M/N with N instead of 0."
--- a/lisp/calendar/diary-lib.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/calendar/diary-lib.el Thu Mar 25 22:21:45 2004 +0000 @@ -554,7 +554,6 @@ (message "%s" msg) (set-buffer (get-buffer-create holiday-buffer)) (setq buffer-read-only nil) - (calendar-set-mode-line date-string) (erase-buffer) (insert (mapconcat 'identity holiday-list "\n")) (goto-char (point-min)) @@ -658,6 +657,7 @@ (setq buffer-read-only t) (display-buffer fancy-diary-buffer) (fancy-diary-display-mode) + (calendar-set-mode-line date-string) (message "Preparing diary...done")))) (defun make-fancy-diary-buffer ()
--- a/lisp/composite.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/composite.el Thu Mar 25 22:21:45 2004 +0000 @@ -193,7 +193,7 @@ (if (or (vectorp components) (listp components)) (setq components (encode-composition-components components))) (compose-region-internal start end components modification-func) - (set-buffer-modified-p modified-p))) + (restore-buffer-modified-p modified-p))) ;;;###autoload (defun decompose-region (start end)
--- a/lisp/descr-text.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/descr-text.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; descr-text.el --- describe text mode -;; Copyright (c) 1994, 1995, 1996, 2001, 02, 03 Free Software Foundation, Inc. +;; Copyright (c) 1994, 95, 96, 2001, 02, 03, 04 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: faces @@ -99,8 +99,8 @@ (defun describe-property-list (properties) "Insert a description of PROPERTIES in the current buffer. PROPERTIES should be a list of overlay or text properties. -The `category' property is made into a widget button that call -`describe-text-category' when pushed." +The `category' and `face' properties are made into widget buttons +that call `describe-text-category' or `describe-face' when pushed." ;; Sort the properties by the size of their value. (dolist (elt (sort (let ((ret nil) (key nil) @@ -110,7 +110,7 @@ (setq key (pop properties) val (pop properties) len 0) - (unless (or (eq key 'category) + (unless (or (memq key '(category face)) (widgetp val)) (setq val (pp-to-string val) len (length val))) @@ -128,6 +128,11 @@ :notify `(lambda (&rest ignore) (describe-text-category ',value)) (format "%S" value))) + ((eq key 'face) + (widget-create 'link + :notify `(lambda (&rest ignore) + (describe-face ',value)) + (format "%S" value))) ((widgetp value) (describe-text-widget value)) (t @@ -338,7 +343,7 @@ ;;; (string-to-number (nth 2 fields)) ;;; '((0 . "Spacing") ;;; (1 . "Overlays and interior") -;;; (7 . "Nuktas") +;;; (7 . "Nuktas") ;;; (8 . "Hiragana/Katakana voicing marks") ;;; (9 . "Viramas") ;;; (10 . "Start of fixed position classes") @@ -589,7 +594,7 @@ (when (>= (+ (current-column) (or (string-match "\n" clm) (string-width clm)) 1) - (frame-width)) + (window-width)) (insert "\n") (indent-to (1+ max-width))) (insert " " clm)) @@ -611,7 +616,7 @@ "\n "))) (insert "these terminal codes:\n") (dotimes (i (length disp-vector)) - (insert (car (aref disp-vector i)) + (insert (car (aref disp-vector i)) (propertize " " 'display '(space :align-to 5)) (or (cdr (aref disp-vector i)) "-- not encodable --") "\n"))))
--- a/lisp/diff-mode.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/diff-mode.el Thu Mar 25 22:21:45 2004 +0000 @@ -38,20 +38,19 @@ ;; Todo: -;; - Improve narrowed-view support. -;; - re-enable (conditionally) the `compile' support after improving it to use -;; the same code as diff-goto-source. -;; - Support for # comments in context->unified. -;; - Allow diff.el to use diff-mode. -;; This mostly means ability to jump from half-hunk to half-hunk -;; in context (and normal) diffs and to jump to the corresponding -;; (i.e. new or old) file. +;; - Add a `delete-after-apply' so C-c C-a automatically deletes hunks. +;; Also allow C-c C-a to delete already-applied hunks. +;; +;; - Try `diff <file> <hunk>' to try and fuzzily discover the source location +;; of a hunk. Show then the changes between <file> and <hunk> and make it +;; possible to apply them to <file>, <hunk-src>, or <hunk-dst>. +;; Or maybe just make it into a ".rej to diff3-markers converter". +;; +;; - Refine hunk on a word-by-word basis. +;; +;; - Use the new next-error-function to allow C-x `. ;; - Handle `diff -b' output in context->unified. -;; Low priority: -;; - Spice up the minor-mode with font-lock support. -;; - Recognize pcl-cvs' special string for `cvs-execute-single'. - ;;; Code: (eval-when-compile (require 'cl)) @@ -63,7 +62,7 @@ :group 'tools :group 'diff) -(defcustom diff-default-read-only t +(defcustom diff-default-read-only nil "If non-nil, `diff-mode' buffers default to being read-only." :type 'boolean :group 'diff-mode) @@ -87,8 +86,10 @@ :type 'boolean) -(defvar diff-mode-hook nil - "Run after setting up the `diff-mode' major mode.") +(defcustom diff-mode-hook nil + "Run after setting up the `diff-mode' major mode." + :type 'hook + :options '(diff-delete-empty-files diff-make-unified)) (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -136,6 +137,7 @@ ;; From compilation-minor-mode. ("\C-c\C-c" . diff-goto-source) ;; Misc operations. + ("\C-c\C-r" . diff-refine-hunk) ("\C-c\C-s" . diff-split-hunk) ("\C-c\C-a" . diff-apply-hunk) ("\C-c\C-t" . diff-test-hunk)) @@ -241,8 +243,31 @@ "`diff-mode' face used to highlight nonexistent files in recursive diffs.") (defvar diff-nonexistent-face 'diff-nonexistent-face) +(defconst diff-yank-handler '(diff-yank-function)) +(defun diff-yank-function (text) + ;; FIXME: the yank-handler is now called separately on each piece of text + ;; with a yank-handler property, so the next-single-property-change call + ;; below will always return nil :-( --stef + (let ((mixed (next-single-property-change 0 'yank-handler text)) + (start (point))) + ;; First insert the text. + (insert text) + ;; If the text does not include any diff markers and if we're not + ;; yanking back into a diff-mode buffer, get rid of the prefixes. + (unless (or mixed (derived-mode-p 'diff-mode)) + (undo-boundary) ; Just in case the user wanted the prefixes. + (let ((re (save-excursion + (if (re-search-backward "^[><!][ \t]" start t) + (if (eq (char-after) ?!) + "^[!+- ][ \t]" "^[<>][ \t]") + "^[ <>!+-]")))) + (save-excursion + (while (re-search-backward re start t) + (replace-match "" t t))))))) + + (defvar diff-font-lock-keywords - '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified + `(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified (1 diff-hunk-header-face) (2 diff-function-face)) ("^--- .+ ----$" . diff-hunk-header-face) ;context @@ -253,13 +278,13 @@ ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n" (0 diff-header-face) (2 diff-file-header-face prepend)) ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) - ("^!.*\n" . diff-changed-face) ;context - ("^[+>].*\n" . diff-added-face) - ("^[-<].*\n" . diff-removed-face) + ("^!.*\n" (0 diff-changed-face)) + ("^[+>].*\n" (0 diff-added-face)) + ("^[-<].*\n" (0 diff-removed-face)) ("^Index: \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend)) ("^Only in .*\n" . diff-nonexistent-face) ("^#.*" . font-lock-string-face) - ("^[^-=+*!<>].*\n" . diff-context-face))) + ("^[^-=+*!<>].*\n" (0 diff-context-face)))) (defconst diff-font-lock-defaults '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil))) @@ -311,8 +336,11 @@ (defun diff-end-of-file () (re-search-forward "^[-+#!<>0-9@* \\]" nil t) - (re-search-forward "^[^-+#!<>0-9@* \\]" nil 'move) - (beginning-of-line)) + (re-search-forward (concat "^[^-+#!<>0-9@* \\]\\|" diff-file-header-re) + nil 'move) + (if (match-beginning 1) + (goto-char (match-beginning 1)) + (beginning-of-line))) ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation @@ -337,7 +365,8 @@ (interactive) (diff-beginning-of-hunk) (let* ((start (point)) - (nexthunk (ignore-errors (diff-hunk-next) (point))) + (nexthunk (when (re-search-forward diff-hunk-header-re nil t) + (match-beginning 0))) (firsthunk (ignore-errors (goto-char start) (diff-beginning-of-file) (diff-hunk-next) (point))) @@ -363,6 +392,7 @@ (re-search-backward "^Index: " prevhunk t)))) (when index (setq start index)) (diff-end-of-file) + (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. (kill-region start (point)))) (defun diff-kill-junk () @@ -439,6 +469,47 @@ (match-string 4 str) (substring str (match-end 6) (match-end 5)))))) +(defun diff-tell-file-name (old name) + "Tell Emacs where the find the source file of the current hunk. +If the OLD prefix arg is passed, tell the file NAME of the old file." + (interactive + (let* ((old current-prefix-arg) + (fs (diff-hunk-file-names current-prefix-arg))) + (unless fs (error "No file name to look for")) + (list old (read-file-name (format "File for %s: " (car fs)) + nil (diff-find-file-name old) t)))) + (let ((fs (diff-hunk-file-names old))) + (unless fs (error "No file name to look for")) + (push (cons fs name) diff-remembered-files-alist))) + +(defun diff-hunk-file-names (&optional old) + "Give the list of file names textually mentioned for the current hunk." + (save-excursion + (unless (looking-at diff-file-header-re) + (or (ignore-errors (diff-beginning-of-file)) + (re-search-forward diff-file-header-re nil t))) + (let ((limit (save-excursion + (condition-case () + (progn (diff-hunk-prev) (point)) + (error (point-min))))) + (header-files + (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)") + (list (if old (match-string 1) (match-string 3)) + (if old (match-string 3) (match-string 1))) + (forward-line 1) nil))) + (delq nil + (append + (when (and (not old) + (save-excursion + (re-search-backward "^Index: \\(.+\\)" limit t))) + (list (match-string 1))) + header-files + (when (re-search-backward + "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" + nil t) + (list (if old (match-string 2) (match-string 4)) + (if old (match-string 4) (match-string 2))))))))) + (defun diff-find-file-name (&optional old) "Return the file corresponding to the current patch. Non-nil OLD means that we want the old file." @@ -446,24 +517,7 @@ (unless (looking-at diff-file-header-re) (or (ignore-errors (diff-beginning-of-file)) (re-search-forward diff-file-header-re nil t))) - (let* ((limit (save-excursion - (condition-case () - (progn (diff-hunk-prev) (point)) - (error (point-min))))) - (header-files - (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)") - (list (if old (match-string 1) (match-string 3)) - (if old (match-string 3) (match-string 1))) - (forward-line 1) nil)) - (fs (append - (when (save-excursion - (re-search-backward "^Index: \\(.+\\)" limit t)) - (list (match-string 1))) - header-files - (when (re-search-backward "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" nil t) - (list (if old (match-string 2) (match-string 4)) - (if old (match-string 4) (match-string 2)))))) - (fs (delq nil fs))) + (let ((fs (diff-hunk-file-names old))) (or ;; use any previously used preference (cdr (assoc fs diff-remembered-files-alist)) @@ -876,8 +930,14 @@ (add-hook 'after-change-functions 'diff-after-change-function nil t) (add-hook 'post-command-hook 'diff-post-command-hook nil t)) ;; Neat trick from Dave Love to add more bindings in read-only mode: - (add-to-list 'minor-mode-overriding-map-alist - (cons 'buffer-read-only diff-mode-shared-map)) + (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map))) + (add-to-list 'minor-mode-overriding-map-alist ro-bind) + ;; Turn off this little trick in case the buffer is put in view-mode. + (add-hook 'view-mode-hook + `(lambda () + (setq minor-mode-overriding-map-alist + (delq ,ro-bind minor-mode-overriding-map-alist))) + nil t)) ;; add-log support (set (make-local-variable 'add-log-current-defun-function) 'diff-current-defun) @@ -897,6 +957,29 @@ (add-hook 'after-change-functions 'diff-after-change-function nil t) (add-hook 'post-command-hook 'diff-post-command-hook nil t))) +;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun diff-delete-if-empty () + ;; An empty diff file means there's no more diffs to integrate, so we + ;; can just remove the file altogether. Very handy for .rej files if we + ;; remove hunks as we apply them. + (when (and buffer-file-name + (eq 0 (nth 7 (file-attributes buffer-file-name)))) + (delete-file buffer-file-name))) + +(defun diff-delete-empty-files () + "Arrange for empty diff files to be removed." + (add-hook 'after-save-hook 'diff-delete-if-empty nil t)) + +(defun diff-make-unified () + "Turn context diffs into unified diffs if applicable." + (if (save-excursion + (goto-char (point-min)) + (looking-at "\\*\\*\\* ")) + (let ((mod (buffer-modified-p))) + (unwind-protect + (diff-context->unified (point-min) (point-max)) + (restore-buffer-modified-p mod))))) ;;; ;;; Misc operations that have proved useful at some point. @@ -1060,12 +1143,17 @@ (goto-line (string-to-number line)) (let* ((orig-pos (point)) (switched nil) + ;; FIXME: Check for case where both OLD and NEW are found. (pos (or (diff-find-text (car old)) (progn (setq switched t) (diff-find-text (car new))) (progn (setq switched nil) - (diff-find-approx-text (car old))) + (condition-case nil + (diff-find-approx-text (car old)) + (invalid-regexp nil))) ;Regex too big. (progn (setq switched t) - (diff-find-approx-text (car new))) + (condition-case nil + (diff-find-approx-text (car new)) + (invalid-regexp nil))) ;Regex too big. (progn (setq switched nil) nil)))) (nconc (list buf) @@ -1096,7 +1184,8 @@ With a prefix argument, REVERSE the hunk." (interactive "P") (destructuring-bind (buf line-offset pos old new &optional switched) - (diff-find-source-location nil reverse) + ;; If REVERSE go to the new file, otherwise go to the old. + (diff-find-source-location (not reverse) reverse) (cond ((null line-offset) (error "Can't find the text to patch")) @@ -1128,7 +1217,8 @@ With a prefix argument, try to REVERSE the hunk." (interactive "P") (destructuring-bind (buf line-offset pos src dst &optional switched) - (diff-find-source-location nil reverse) + ;; If REVERSE go to the new file, otherwise go to the old. + (diff-find-source-location (not reverse) reverse) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) @@ -1173,6 +1263,49 @@ (goto-char (+ (car pos) (cdr src))) (add-log-current-defun)))))) +(defun diff-refine-hunk () + "Refine the current hunk by ignoring space differences." + (interactive) + (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk) (point)))) + (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) + (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") + (error "Can't find line number")) + (string-to-number (match-string 1)))) + (hunk (delete-and-extract-region + (point) (save-excursion (diff-end-of-hunk) (point)))) + (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1. + (file1 (make-temp-file "diff1")) + (file2 (make-temp-file "diff2")) + (coding-system-for-read buffer-file-coding-system) + old new) + (unwind-protect + (save-excursion + (setq old (diff-hunk-text hunk nil char-offset)) + (setq new (diff-hunk-text hunk t char-offset)) + (write-region (concat lead (car old)) nil file1 nil 'nomessage) + (write-region (concat lead (car new)) nil file2 nil 'nomessage) + (with-temp-buffer + (let ((status + (call-process diff-command nil t nil + opts file1 file2))) + (case status + (0 nil) ;Nothing to reformat. + (1 (goto-char (point-min)) + ;; Remove the file-header. + (when (re-search-forward diff-hunk-header-re nil t) + (delete-region (point-min) (match-beginning 0)))) + (t (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert hunk))) + (setq hunk (buffer-string)) + (unless (memq status '(0 1)) + (error "Diff returned: %s" status))))) + ;; Whatever happens, put back some equivalent text: either the new + ;; one or the original one in case some error happened. + (insert hunk) + (delete-file file1) + (delete-file file2)))) + ;; provide the package (provide 'diff-mode)
--- a/lisp/dired-aux.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/dired-aux.el Thu Mar 25 22:21:45 2004 +0000 @@ -93,6 +93,8 @@ Compare file attributes of files in the current directory with file attributes in directory DIR2 using PREDICATE on pairs of files with the same name. Mark files for which PREDICATE returns non-nil. +Mark files with different names if PREDICATE is nil (or interactively +when the user enters empty input at the predicate prompt). PREDICATE is a Lisp expression that can refer to the following variables: @@ -115,7 +117,7 @@ (list (read-file-name (format "Compare %s with: " (dired-current-directory)) (dired-dwim-target-directory)) - (read-minibuffer "Mark if (lisp expr): "))) + (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil"))) (let* ((dir1 (dired-current-directory)) (file-alist1 (dired-files-attributes dir1)) (file-alist2 (dired-files-attributes dir2)) @@ -659,6 +661,8 @@ ;; For .z, try gunzip. It might be an old gzip file, ;; or it might be from compact? pack? (which?) but gunzip handles both. ("\\.z\\'" "" "gunzip") + ("\\.dz\\'" "" "dictunzip") + ("\\.tbz\\'" ".tar" "bunzip2") ("\\.bz2\\'" "" "bunzip2") ;; This item controls naming for compression. ("\\.tar\\'" ".tgz" nil))
--- a/lisp/dired-x.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/dired-x.el Thu Mar 25 22:21:45 2004 +0000 @@ -7,7 +7,7 @@ ;; Date: 1994/08/18 19:27:42 ;; Keywords: dired extensions files -;; Copyright (C) 1993, 1994, 1997, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1997, 2001, 2003, 2004 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -887,9 +887,17 @@ (defvar dired-guess-shell-alist-default (list - (list "\\.tar$" '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " xvf") - "tar xvf")) + (list "\\.tar$" + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " xvf") + "tar xvf") + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -xvf") + (concat "mkdir " (file-name-sans-extension file) + "; tar -C " (file-name-sans-extension file) " -xvf"))) ;; REGEXPS for compressed archives must come before the .Z rule to ;; be recognized: @@ -907,31 +915,67 @@ '(if dired-guess-shell-gnutar (concat dired-guess-shell-gnutar " zxvf") (concat "gunzip -qc * | tar xvf -")) + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -zxvf") + (concat "mkdir " (file-name-sans-extension file) + "; gunzip -qc * | tar -C " + (file-name-sans-extension file) " -xvf -")) ;; Optional decompression. '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" ""))) + ;; bzip2'ed archives - (list "\\.tar\\.bz2$" + (list "\\.t\\(ar\\.bz2\\|bz\\)$" "bunzip2 -c * | tar xvf -" + ;; Extract files into a separate subdirectory + '(concat "mkdir " (file-name-sans-extension file) + "; bunzip2 -c * | tar -C " + (file-name-sans-extension file) " -xvf -") ;; Optional decompression. "bunzip2") - '("\\.shar.Z$" "zcat * | unshar") - '("\\.shar.g?z$" "gunzip -qc * | unshar") + '("\\.shar\\.Z$" "zcat * | unshar") + '("\\.shar\\.g?z$" "gunzip -qc * | unshar") '("\\.e?ps$" "ghostview" "xloadimage" "lpr") - (list "\\.e?ps.g?z$" "gunzip -qc * | ghostview -" + (list "\\.e?ps\\.g?z$" "gunzip -qc * | ghostview -" ;; Optional decompression. '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.e?ps.Z$" "zcat * | ghostview -" + (list "\\.e?ps\\.Z$" "zcat * | ghostview -" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + '("\\.patch$" "cat * | patch") + (list "\\.patch\\.g?z$" "gunzip -qc * | patch" + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.patch\\.Z$" "zcat * | patch" ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) - '("\\.patch$" "cat * | patch") - '("\\.patch.g?z$" "gunzip -qc * | patch") - (list "\\.patch.Z$" "zcat * | patch" + + ;; The following four extensions are useful with dired-man ("N" key) + (list "\\.[0-9]$" '(progn (require 'man) + (if (Man-support-local-filenames) + "man -l" + "cat * | tbl | nroff -man -h"))) + (list "\\.[0-9]\\.g?z$" '(progn (require 'man) + (if (Man-support-local-filenames) + "man -l" + "gunzip -qc * | tbl | nroff -man -h")) + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.[0-9]\\.Z$" '(progn (require 'man) + (if (Man-support-local-filenames) + "man -l" + "zcat * | tbl | nroff -man -h")) ;; Optional conversion to gzip format. '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") " " dired-guess-shell-znew-switches)) + '("\\.pod$" "perldoc" "pod2man * | nroff -man") '("\\.dvi$" "xdvi" "dvips") ; preview and printing '("\\.au$" "play") ; play Sun audiofiles @@ -945,7 +989,7 @@ '("\\.gif$" "xloadimage") ; view gif pictures '("\\.tif$" "xloadimage") '("\\.png$" "display") ; xloadimage 4.1 doesn't grok PNG - '("\\.jpg$" "xloadimage") + '("\\.jpe?g$" "xloadimage") '("\\.fig$" "xfig") ; edit fig pictures '("\\.out$" "xgraph") ; for plotting purposes. '("\\.tex$" "latex" "tex") @@ -953,14 +997,18 @@ '("\\.pdf$" "xpdf") ; edit PDF files ;; Some other popular archivers. + (list "\\.zip$" "unzip" + ;; Extract files into a separate subdirectory + '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q") + " -d " (file-name-sans-extension file))) '("\\.zoo$" "zoo x//") - '("\\.zip$" "unzip") '("\\.lzh$" "lharc x") '("\\.arc$" "arc x") '("\\.shar$" "unshar") ;; Compression. (list "\\.g?z$" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.dz$" "dictunzip") (list "\\.bz2$" "bunzip2") (list "\\.Z$" "uncompress" ;; Optional conversion to gzip format. @@ -998,9 +1046,11 @@ :group 'dired-x :type '(alist :key-type regexp :value-type (repeat sexp))) -(defvar dired-guess-shell-case-fold-search nil - "*If non-nil, `dired-guess-shell-alist-default' and -`dired-guess-shell-alist-user' are matched case-insensitively.") +(defcustom dired-guess-shell-case-fold-search t + "If non-nil, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-user' are matched case-insensitively." + :group 'dired-x + :type 'boolean) (defun dired-guess-default (files) "Guess a shell commands for FILES. Return command or list of commands. @@ -1278,8 +1328,10 @@ Uses ../lisp/man.el of \\[manual-entry] fame." (interactive) (require 'man) - (let ((file (dired-get-filename)) - (manual-program "nroff -man -h")) + (let* ((file (dired-get-filename)) + (manual-program (replace-regexp-in-string "\\*" "%s" + (dired-guess-shell-command + "Man command: " (list file))))) (Man-getpage-in-background file))) ;;; Run Info on files.
--- a/lisp/dired.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/dired.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; dired.el --- directory-browsing commands -;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001, 2003 +;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 2000, 01, 03, 2004 ;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> @@ -39,6 +39,7 @@ (defgroup dired nil "Directory editing." + :link '(custom-manual "(emacs)Dired") :group 'files) (defgroup dired-mark nil @@ -192,6 +193,7 @@ ;; Note this can't simply be run inside function `dired-ls' as the hook ;; functions probably depend on the dired-subdir-alist to be OK. +;; Fixme: This should use mailcap. (defcustom dired-view-command-alist '(("[.]\\(ps\\|ps_pages\\|eps\\)\\'" . "gv -spartan -color -watch %s") ("[.]pdf\\'" . "xpdf %s") @@ -308,6 +310,16 @@ ;;; "\\([-d]\\(....w....\\|.......w.\\)\\)") ;;; '(1 font-lock-comment-face) ;;; '(".+" (dired-move-to-filename) nil (0 font-lock-comment-face))) + ;; However, we don't need to highlight the file name, only the + ;; permissions, to win generally. -- fx. + ;; Fixme: we could also put text properties on the permission + ;; fields with keymaps to frob the permissions, somewhat a la XEmacs. + (list (concat dired-re-maybe-mark dired-re-inode-size + "[-d]....\\(w\\)..\\(w\\).") ; group writable + '(1 font-lock-warning-face)) + (list (concat dired-re-maybe-mark dired-re-inode-size + "[-d]....\\(w\\)....") ; world writable + '(1 font-lock-comment-face)) ;; ;; Subdirectories. (list dired-re-dir @@ -327,12 +339,12 @@ ;;; Macros must be defined before they are used, for the byte compiler. -;; Mark all files for which CONDITION evals to non-nil. -;; CONDITION is evaluated on each line, with point at beginning of line. -;; MSG is a noun phrase for the type of files being marked. -;; It should end with a noun that can be pluralized by adding `s'. -;; Return value is the number of files marked, or nil if none were marked. (defmacro dired-mark-if (predicate msg) + "Mark all files for which PREDICATE evals to non-nil. +PREDICATE is evaluated on each line, with point at beginning of line. +MSG is a noun phrase for the type of files being marked. +It should end with a noun that can be pluralized by adding `s'. +Return value is the number of files marked, or nil if none were marked." `(let (buffer-read-only count) (save-excursion (setq count 0) @@ -513,12 +525,34 @@ (setq dir-or-list dirname)) (dired-internal-noselect dir-or-list switches))) +;; The following is an internal dired function. It returns non-nil if +;; the directory visited by the current dired buffer has changed on +;; disk. DIRNAME should be the directory name of that directory. +(defun dired-directory-changed-p (dirname) + (not (let ((attributes (file-attributes dirname)) + (modtime (visited-file-modtime))) + (or (eq modtime 0) + (not (eq (car attributes) t)) + (and (= (car (nth 5 attributes)) (car modtime)) + (= (nth 1 (nth 5 attributes)) (cdr modtime))))))) + +(defun dired-buffer-stale-p (&optional noconfirm) + "Return non-nil if current dired buffer needs updating. +If NOCONFIRM is non-nil, then this function always returns nil +for a remote directory. This feature is used by Auto Revert Mode." + (let ((dirname + (if (consp dired-directory) (car dired-directory) dired-directory))) + (and (stringp dirname) + (not (when noconfirm (file-remote-p dirname))) + (file-readable-p dirname) + (dired-directory-changed-p dirname)))) + ;; Separate function from dired-noselect for the sake of dired-vms.el. (defun dired-internal-noselect (dir-or-list &optional switches mode) ;; If there is an existing dired buffer for DIRNAME, just leave ;; buffer as it is (don't even call dired-revert). ;; This saves time especially for deep trees or with ange-ftp. - ;; The user can type `g'easily, and it is more consistent with find-file. + ;; The user can type `g' easily, and it is more consistent with find-file. ;; But if SWITCHES are given they are probably different from the ;; buffer's old value, so call dired-sort-other, which does ;; revert the buffer. @@ -544,20 +578,14 @@ ;; kill-all-local-variables any longer. (setq buffer (create-file-buffer (directory-file-name dirname))))) (set-buffer buffer) - (if (not new-buffer-p) ; existing buffer ... - (cond (switches ; ... but new switches + (if (not new-buffer-p) ; existing buffer ... + (cond (switches ; ... but new switches ;; file list may have changed (setq dired-directory dir-or-list) ;; this calls dired-revert (dired-sort-other switches)) ;; If directory has changed on disk, offer to revert. - ((if (let ((attributes (file-attributes dirname)) - (modtime (visited-file-modtime))) - (or (eq modtime 0) - (not (eq (car attributes) t)) - (and (= (car (nth 5 attributes)) (car modtime)) - (= (nth 1 (nth 5 attributes)) (cdr modtime))))) - nil + ((when (dired-directory-changed-p dirname) (message "%s" (substitute-command-keys "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) @@ -618,10 +646,12 @@ ;; Read in a new dired buffer -;; dired-readin differs from dired-insert-subdir in that it accepts -;; wildcards, erases the buffer, and builds the subdir-alist anew -;; (including making it buffer-local and clearing it first). (defun dired-readin () + "Read in a new dired buffer. +Differs from dired-insert-subdir in that it accepts +wildcards, erases the buffer, and builds the subdir-alist anew +\(including making it buffer-local and clearing it first)." + ;; default-directory and dired-actual-switches must be buffer-local ;; and initialized by now. (let (dirname) @@ -634,7 +664,6 @@ ;; based on dired-directory, e.g. with ange-ftp to a SysV host ;; where ls won't understand -Al switches. (run-hooks 'dired-before-readin-hook) - (message "Reading directory %s..." dirname) (if (consp buffer-undo-list) (setq buffer-undo-list nil)) (let (buffer-read-only @@ -643,7 +672,6 @@ (widen) (erase-buffer) (dired-readin-insert)) - (message "Reading directory %s...done" dirname) (goto-char (point-min)) ;; Must first make alist buffer local and set it to nil because ;; dired-build-subdir-alist will call dired-clear-alist first @@ -740,8 +768,8 @@ ;; Insert "wildcard" line where "total" line would be for a full dir. (insert " wildcard " (file-name-nondirectory dir) "\n"))))) -;; Make the file names highlight when the mouse is on them. (defun dired-insert-set-properties (beg end) + "Make the file names highlight when the mouse is on them." (save-excursion (goto-char beg) (while (< (point) end) @@ -760,10 +788,10 @@ ;; Reverting a dired buffer (defun dired-revert (&optional arg noconfirm) - ;; Reread the dired buffer. Must also be called after - ;; dired-actual-switches have changed. - ;; Should not fail even on completely garbaged buffers. - ;; Preserves old cursor, marks/flags, hidden-p. + "Reread the dired buffer. +Must also be called after dired-actual-switches have changed. +Should not fail even on completely garbaged buffers. +Preserves old cursor, marks/flags, hidden-p." (widen) ; just in case user narrowed (let ((opoint (point)) (ofile (dired-get-filename nil t)) @@ -790,10 +818,9 @@ (goto-char opoint)) ; was before (dired-move-to-filename) (save-excursion ; hide subdirs that were hidden - (mapcar (function (lambda (dir) - (if (dired-goto-subdir dir) - (dired-hide-subdir 1)))) - hidden-subdirs))) + (dolist (dir hidden-subdirs) + (if (dired-goto-subdir dir) + (dired-hide-subdir 1))))) ;; outside of the let scope ;;; Might as well not override the user if the user changed this. ;;; (setq buffer-read-only t) @@ -803,7 +830,7 @@ ;; Some of these are also used when inserting subdirs. (defun dired-remember-marks (beg end) - ;; Return alist of files and their marks, from BEG to END. + "Return alist of files and their marks, from BEG to END." (if selective-display ; must unhide to make this work. (let (buffer-read-only) (subst-char-in-region beg end ?\r ?\n))) @@ -816,9 +843,9 @@ alist (cons (cons fil chr) alist))))) alist)) -;; Mark all files remembered in ALIST. -;; Each element of ALIST looks like (FILE . MARKERCHAR). (defun dired-mark-remembered (alist) + "Mark all files remembered in ALIST. +Each element of ALIST looks like (FILE . MARKERCHAR)." (let (elt fil chr) (while alist (setq elt (car alist) @@ -831,8 +858,8 @@ (delete-char 1) (insert chr)))))) -;; Return a list of names of subdirs currently hidden. (defun dired-remember-hidden () + "Return a list of names of subdirs currently hidden." (let ((l dired-subdir-alist) dir pos result) (while l (setq dir (car (car l)) @@ -844,9 +871,9 @@ (setq result (cons dir result)))) result)) -;; Try to insert all subdirs that were displayed before, -;; according to the former subdir alist OLD-SUBDIR-ALIST. (defun dired-insert-old-subdirs (old-subdir-alist) + "Try to insert all subdirs that were displayed before. +Do so according to the former subdir alist OLD-SUBDIR-ALIST." (or (string-match "R" dired-actual-switches) (let (elt dir) (while old-subdir-alist @@ -859,20 +886,17 @@ (dired-insert-subdir dir)) (error nil)))))) -;; Remove directory DIR from any directory cache. (defun dired-uncache (dir) + "Remove directory DIR from any directory cache." (let ((handler (find-file-name-handler dir 'dired-uncache))) (if handler (funcall handler 'dired-uncache dir)))) ;; dired mode key bindings and initialization -(defvar dired-mode-map nil "Local keymap for dired-mode buffers.") -(if dired-mode-map - nil +(defvar dired-mode-map ;; This looks ugly when substitute-command-keys uses C-d instead d: ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion) - (let ((map (make-keymap))) (suppress-keymap map) (define-key map [mouse-2] 'dired-mouse-find-file-other-window) @@ -937,6 +961,7 @@ (define-key map "*u" 'dired-unmark) (define-key map "*?" 'dired-unmark-all-files) (define-key map "*!" 'dired-unmark-all-marks) + (define-key map "U" 'dired-unmark-all-marks) (define-key map "*\177" 'dired-unmark-backward) (define-key map "*\C-n" 'dired-next-marked-file) (define-key map "*\C-p" 'dired-prev-marked-file) @@ -1196,11 +1221,14 @@ '(menu-item "Copy to..." dired-do-copy :help "Copy current file or all marked files")) - (setq dired-mode-map map))) + map) + "Local keymap for `dired-mode' buffers.") ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) +(defvar buffer-stale-function) + (defun dired-mode (&optional dirname switches) "\ Mode for \"editing\" directory listings. @@ -1279,6 +1307,8 @@ (propertized-buffer-identification "%17b")) (set (make-local-variable 'revert-buffer-function) (function dired-revert)) + (set (make-local-variable 'buffer-stale-function) + (function dired-buffer-stale-p)) (set (make-local-variable 'page-delimiter) "\n\n") (set (make-local-variable 'dired-directory) @@ -1290,7 +1320,8 @@ dired-directory))) (set (make-local-variable 'dired-actual-switches) (or switches dired-listing-switches)) - (set (make-local-variable 'font-lock-defaults) '(dired-font-lock-keywords t)) + (set (make-local-variable 'font-lock-defaults) + '(dired-font-lock-keywords t nil nil beginning-of-line)) (dired-sort-other dired-actual-switches t) (run-hooks 'dired-mode-hook) (when (featurep 'x-dnd) @@ -2617,11 +2648,15 @@ (file-name-nondirectory fn))))) "auto save file"))) -(defvar dired-garbage-files-regexp +(defcustom dired-garbage-files-regexp + ;; `log' here is dubious, since it's typically used for useful log + ;; files, not just TeX stuff. -- fx (concat (regexp-opt '(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux")) "\\'") - "*Regular expression to match \"garbage\" files for `dired-flag-garbage-files'.") + "Regular expression to match \"garbage\" files for `dired-flag-garbage-files'." + :type 'regexp + :group 'dired) (defun dired-flag-garbage-files () "Flag for deletion all files that match `dired-garbage-files-regexp'."
--- a/lisp/disp-table.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/disp-table.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; disp-table.el --- functions for dealing with char tables -;; Copyright (C) 1987, 1994, 1995, 1999 Free Software Foundation, Inc. +;; Copyright (C) 1987, 94, 95, 1999, 2004 Free Software Foundation, Inc. ;; Author: Erik Naggum <erik@naggum.no> ;; Based on a previous version by Howard Gayle @@ -116,9 +116,7 @@ (or standard-display-table (setq standard-display-table (make-display-table))) (while (<= l h) - (if (and (>= l ?\ ) (< l 127)) - (aset standard-display-table l nil) - (aset standard-display-table l (vector l))) + (aset standard-display-table l (if (or (< l ?\ ) (>= l 127)) (vector l))) (setq l (1+ l)))) ;;;###autoload
--- a/lisp/emacs-lisp/advice.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/advice.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; advice.el --- an overloading mechanism for Emacs Lisp functions -;; Copyright (C) 1993,1994,2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1993,1994,2000,01,2004 Free Software Foundation, Inc. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu> ;; Maintainer: FSF @@ -2563,29 +2563,31 @@ Either use the one stored under the `ad-subr-arglist' property, or try to retrieve it from the docstring and cache it under that property, or otherwise use `(&rest ad-subr-args)'." - (cond ((ad-subr-args-defined-p subr-name) - (ad-get-subr-args subr-name)) - ;; says jwz: Should use this for Lemacs 19.8 and above: - ;;((fboundp 'subr-min-args) - ;; ...) - ;; says hans: I guess what Jamie means is that I should use the values - ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist - ;; without having to look it up via parsing the docstring, e.g., - ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an - ;; argument list. However, that won't work because there is no - ;; way to distinguish a subr with args `(a &optional b &rest c)' from - ;; one with args `(a &rest c)' using that mechanism. Also, the argument - ;; names from the docstring are more meaningful. Hence, I'll stick with - ;; the old way of doing things. - (t (let ((doc (or (ad-real-documentation subr-name t) ""))) - (cond ((string-match "^\\(([^\)]+)\\)\n?\\'" doc) - (ad-define-subr-args - subr-name - (cdr (car (read-from-string - (downcase (match-string 1 doc)))))) - (ad-get-subr-args subr-name)) - ;; This is actually an error. - (t '(&rest ad-subr-args))))))) + (if (ad-subr-args-defined-p subr-name) + (ad-get-subr-args subr-name) + ;; says jwz: Should use this for Lemacs 19.8 and above: + ;;((fboundp 'subr-min-args) + ;; ...) + ;; says hans: I guess what Jamie means is that I should use the values + ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist + ;; without having to look it up via parsing the docstring, e.g., + ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an + ;; argument list. However, that won't work because there is no + ;; way to distinguish a subr with args `(a &optional b &rest c)' from + ;; one with args `(a &rest c)' using that mechanism. Also, the argument + ;; names from the docstring are more meaningful. Hence, I'll stick with + ;; the old way of doing things. + (let ((doc (or (ad-real-documentation subr-name t) ""))) + (if (not (string-match "\n\n\\((.+)\\)\\'" doc)) + ;; Signalling an error leads to bugs during bootstrapping because + ;; the DOC file is not yet built (which is an error, BTW). + ;; (error "The usage info is missing from the subr %s" subr-name) + '(&rest ad-subr-args) + (ad-define-subr-args + subr-name + (cdr (car (read-from-string + (downcase (match-string 1 doc)))))) + (ad-get-subr-args subr-name))))) (defun ad-docstring (definition) "Return the unexpanded docstring of DEFINITION."
--- a/lisp/emacs-lisp/backquote.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/backquote.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; backquote.el --- implement the ` Lisp construct -;;; Copyright (C) 1990, 1992, 1994, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1990, 92, 1994, 2001, 2004 Free Software Foundation, Inc. ;; Author: Rick Sladkey <jrs@world.std.com> ;; Maintainer: FSF @@ -44,6 +44,9 @@ "Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c)" + ;; The recursive solution is much nicer: + ;; (if list (cons first (apply 'backquote-list*-function list)) first)) + ;; but Emacs is not very good at efficiently processing recursion. (if list (let* ((rest list) (newlist (cons first nil)) (last newlist)) (while (cdr rest) @@ -58,7 +61,10 @@ "Like `list' but the last argument is the tail of the new list. For example (backquote-list* 'a 'b 'c) => (a b . c)" - (setq list (reverse (cons first list)) + ;; The recursive solution is much nicer: + ;; (if list (list 'cons first (cons 'backquote-list*-macro list)) first)) + ;; but Emacs is not very good at efficiently processing such things. + (setq list (nreverse (cons first list)) first (car list) list (cdr list)) (if list
--- a/lisp/emacs-lisp/byte-opt.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/byte-opt.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -;;; Copyright (c) 1991, 1994, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (c) 1991,1994,2000,01,02,2004 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -148,37 +148,37 @@ ;; Other things to consider: -;;;;; Associative math should recognize subcalls to identical function: -;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) -;;;;; This should generate the same as (1+ x) and (1- x) - -;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1)))) -;;;;; An awful lot of functions always return a non-nil value. If they're -;;;;; error free also they may act as true-constants. - -;;;(disassemble (lambda (x) (and (point) (foo)))) -;;;;; When -;;;;; - all but one arguments to a function are constant -;;;;; - the non-constant argument is an if-expression (cond-expression?) -;;;;; then the outer function can be distributed. If the guarding -;;;;; condition is side-effect-free [assignment-free] then the other -;;;;; arguments may be any expressions. Since, however, the code size -;;;;; can increase this way they should be "simple". Compare: - -;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c))) -;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) - -;;;;; (car (cons A B)) -> (progn B A) -;;;(disassemble (lambda (x) (car (cons (foo) 42)))) - -;;;;; (cdr (cons A B)) -> (progn A B) -;;;(disassemble (lambda (x) (cdr (cons 42 (foo))))) - -;;;;; (car (list A B ...)) -> (progn B ... A) -;;;(disassemble (lambda (x) (car (list (foo) 42 (bar))))) - -;;;;; (cdr (list A B ...)) -> (progn A (list B ...)) -;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar))))) +;; ;; Associative math should recognize subcalls to identical function: +;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) +;; ;; This should generate the same as (1+ x) and (1- x) + +;; (disassemble (lambda (x) (cons (+ x 1) (- x 1)))) +;; ;; An awful lot of functions always return a non-nil value. If they're +;; ;; error free also they may act as true-constants. + +;; (disassemble (lambda (x) (and (point) (foo)))) +;; ;; When +;; ;; - all but one arguments to a function are constant +;; ;; - the non-constant argument is an if-expression (cond-expression?) +;; ;; then the outer function can be distributed. If the guarding +;; ;; condition is side-effect-free [assignment-free] then the other +;; ;; arguments may be any expressions. Since, however, the code size +;; ;; can increase this way they should be "simple". Compare: + +;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c))) +;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) + +;; ;; (car (cons A B)) -> (prog1 A B) +;; (disassemble (lambda (x) (car (cons (foo) 42)))) + +;; ;; (cdr (cons A B)) -> (progn A B) +;; (disassemble (lambda (x) (cdr (cons 42 (foo))))) + +;; ;; (car (list A B ...)) -> (prog1 A B ...) +;; (disassemble (lambda (x) (car (list (foo) 42 (bar))))) + +;; ;; (cdr (list A B ...)) -> (progn A (list B ...)) +;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar))))) ;;; Code: @@ -217,10 +217,8 @@ args))))) (defmacro byte-compile-log-lap (format-string &rest args) - (list 'and - '(memq byte-optimize-log '(t byte)) - (cons 'byte-compile-log-lap-1 - (cons format-string args)))) + `(and (memq byte-optimize-log '(t byte)) + (byte-compile-log-lap-1 ,format-string ,@args))) ;;; byte-compile optimizers to support inlining @@ -274,18 +272,18 @@ (let (string) (fetch-bytecode fn) (setq string (aref fn 1)) + ;; Isn't it an error for `string' not to be unibyte?? --stef (if (fboundp 'string-as-unibyte) (setq string (string-as-unibyte string))) - (cons (list 'lambda (aref fn 0) - (list 'byte-code string (aref fn 2) (aref fn 3))) + (cons `(lambda ,(aref fn 0) + (byte-code ,string ,(aref fn 2) ,(aref fn 3))) (cdr form))) (if (eq (car-safe fn) 'lambda) (cons fn (cdr form)) ;; Give up on inlining. form)))))) -;;; ((lambda ...) ...) -;;; +;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) (let ((lambda (car form)) @@ -604,14 +602,14 @@ (nreverse result))) -;;; some source-level optimizers -;;; -;;; when writing optimizers, be VERY careful that the optimizer returns -;;; something not EQ to its argument if and ONLY if it has made a change. -;;; This implies that you cannot simply destructively modify the list; -;;; you must return something not EQ to it if you make an optimization. -;;; -;;; It is now safe to optimize code such that it introduces new bindings. +;; some source-level optimizers +;; +;; when writing optimizers, be VERY careful that the optimizer returns +;; something not EQ to its argument if and ONLY if it has made a change. +;; This implies that you cannot simply destructively modify the list; +;; you must return something not EQ to it if you make an optimization. +;; +;; It is now safe to optimize code such that it introduces new bindings. ;; I'd like this to be a defsubst, but let's not be self-referential... (defmacro byte-compile-trueconstp (form) @@ -721,10 +719,10 @@ (condition-case () (eval form) (error form))) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker). -;; ((null (cdr (cdr form))) (nth 1 form)) +;;; It is not safe to delete the function entirely +;;; (actually, it would be safe if we know the sole arg +;;; is not a marker). +;;; ((null (cdr (cdr form))) (nth 1 form)) ((null (cddr form)) (if (numberp (nth 1 form)) (nth 1 form) @@ -763,9 +761,9 @@ (numberp last)) (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) (delq last (copy-sequence (nthcdr 3 form)))))))) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker). +;;; It is not safe to delete the function entirely +;;; (actually, it would be safe if we know the sole arg +;;; is not a marker). ;;; (if (eq (nth 2 form) 0) ;;; (nth 1 form) ; (- x 0) --> x (byte-optimize-predicate @@ -780,9 +778,9 @@ (setq form (byte-optimize-delay-constants-math form 1 '*)) ;; If there is a constant in FORM, it is now the last element. (cond ((null (cdr form)) 1) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker or if it appears in other arithmetic). +;;; It is not safe to delete the function entirely +;;; (actually, it would be safe if we know the sole arg +;;; is not a marker or if it appears in other arithmetic). ;;; ((null (cdr (cdr form))) (nth 1 form)) ((let ((last (car (reverse form)))) (cond ((eq 0 last) (cons 'progn (cdr form))) @@ -1117,8 +1115,16 @@ (byte-optimize-predicate form)) form)) -(put 'concat 'byte-optimizer 'byte-optimize-concat) -(defun byte-optimize-concat (form) +(put 'concat 'byte-optimizer 'byte-optimize-pure-func) +(put 'symbol-name 'byte-optimizer 'byte-optimize-pure-func) +(put 'regexp-opt 'byte-optimizer 'byte-optimize-pure-func) +(put 'regexp-quote 'byte-optimizer 'byte-optimize-pure-func) +(defun byte-optimize-pure-func (form) + "Do constant folding for pure functions. +This assumes that the function will not have any side-effects and that +its return value depends solely on its arguments. +If the function can signal an error, this might change the semantics +of FORM by signalling the error at compile-time." (let ((args (cdr form)) (constant t)) (while (and args constant) @@ -1181,28 +1187,28 @@ `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form)))) (t form)))) -;;; enumerating those functions which need not be called if the returned -;;; value is not used. That is, something like -;;; (progn (list (something-with-side-effects) (yow)) -;;; (foo)) -;;; may safely be turned into -;;; (progn (progn (something-with-side-effects) (yow)) -;;; (foo)) -;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo. +;; enumerating those functions which need not be called if the returned +;; value is not used. That is, something like +;; (progn (list (something-with-side-effects) (yow)) +;; (foo)) +;; may safely be turned into +;; (progn (progn (something-with-side-effects) (yow)) +;; (foo)) +;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo. -;;; Some of these functions have the side effect of allocating memory -;;; and it would be incorrect to replace two calls with one. -;;; But we don't try to do those kinds of optimizations, -;;; so it is safe to list such functions here. -;;; Some of these functions return values that depend on environment -;;; state, so that constant folding them would be wrong, -;;; but we don't do constant folding based on this list. +;; Some of these functions have the side effect of allocating memory +;; and it would be incorrect to replace two calls with one. +;; But we don't try to do those kinds of optimizations, +;; so it is safe to list such functions here. +;; Some of these functions return values that depend on environment +;; state, so that constant folding them would be wrong, +;; but we don't do constant folding based on this list. -;;; However, at present the only optimization we normally do -;;; is delete calls that need not occur, and we only do that -;;; with the error-free functions. +;; However, at present the only optimization we normally do +;; is delete calls that need not occur, and we only do that +;; with the error-free functions. -;;; I wonder if I missed any :-\) +;; I wonder if I missed any :-\) (let ((side-effect-free-fns '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan assoc assq @@ -1298,8 +1304,8 @@ (defconst byte-constref-ops '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) -;;; This function extracts the bitfields from variable-length opcodes. -;;; Originally defined in disass.el (which no longer uses it.) +;; This function extracts the bitfields from variable-length opcodes. +;; Originally defined in disass.el (which no longer uses it.) (defun disassemble-offset () "Don't call this!" @@ -1336,11 +1342,11 @@ (aref bytes ptr)))) -;;; This de-compiler is used for inline expansion of compiled functions, -;;; and by the disassembler. -;;; -;;; This list contains numbers, which are pc values, -;;; before each instruction. +;; This de-compiler is used for inline expansion of compiled functions, +;; and by the disassembler. +;; +;; This list contains numbers, which are pc values, +;; before each instruction. (defun byte-decompile-bytecode (bytes constvec) "Turns BYTECODE into lapcode, referring to CONSTVEC." (let ((byte-compile-constants nil) @@ -1461,38 +1467,39 @@ byte-member byte-assq byte-quo byte-rem) byte-compile-side-effect-and-error-free-ops)) -;;; This crock is because of the way DEFVAR_BOOL variables work. -;;; Consider the code -;;; -;;; (defun foo (flag) -;;; (let ((old-pop-ups pop-up-windows) -;;; (pop-up-windows flag)) -;;; (cond ((not (eq pop-up-windows old-pop-ups)) -;;; (setq old-pop-ups pop-up-windows) -;;; ...)))) -;;; -;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is -;;; something else. But if we optimize -;;; -;;; varref flag -;;; varbind pop-up-windows -;;; varref pop-up-windows -;;; not -;;; to -;;; varref flag -;;; dup -;;; varbind pop-up-windows -;;; not -;;; -;;; we break the program, because it will appear that pop-up-windows and -;;; old-pop-ups are not EQ when really they are. So we have to know what -;;; the BOOL variables are, and not perform this optimization on them. +;; This crock is because of the way DEFVAR_BOOL variables work. +;; Consider the code +;; +;; (defun foo (flag) +;; (let ((old-pop-ups pop-up-windows) +;; (pop-up-windows flag)) +;; (cond ((not (eq pop-up-windows old-pop-ups)) +;; (setq old-pop-ups pop-up-windows) +;; ...)))) +;; +;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is +;; something else. But if we optimize +;; +;; varref flag +;; varbind pop-up-windows +;; varref pop-up-windows +;; not +;; to +;; varref flag +;; dup +;; varbind pop-up-windows +;; not +;; +;; we break the program, because it will appear that pop-up-windows and +;; old-pop-ups are not EQ when really they are. So we have to know what +;; the BOOL variables are, and not perform this optimization on them. -;;; The variable `byte-boolean-vars' is now primitive and updated -;;; automatically by DEFVAR_BOOL. +;; The variable `byte-boolean-vars' is now primitive and updated +;; automatically by DEFVAR_BOOL. (defun byte-optimize-lapcode (lap &optional for-effect) - "Simple peephole optimizer. LAP is both modified and returned." + "Simple peephole optimizer. LAP is both modified and returned. +If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (let (lap0 lap1 lap2
--- a/lisp/emacs-lisp/byte-run.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/byte-run.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; byte-run.el --- byte-compiler support for inlining -;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2004 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -67,14 +67,14 @@ ;; This has a special byte-hunk-handler in bytecomp.el. (defmacro defsubst (name arglist &rest body) "Define an inline function. The syntax is just like that of `defun'." + (declare (debug defun)) (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) - (list 'prog1 - (cons 'defun (cons name (cons arglist body))) - (list 'eval-and-compile - (list 'put (list 'quote name) - ''byte-optimizer ''byte-compile-inline-expand)))) + `(prog1 + (defun ,name ,arglist ,@body) + (eval-and-compile + (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) (defun make-obsolete (fn new &optional when) "Make the byte-compiler warn that FUNCTION is obsolete. @@ -109,6 +109,7 @@ (defmacro dont-compile (&rest body) "Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere." + (declare (debug t)) (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) @@ -121,6 +122,7 @@ (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant." + (declare (debug t)) ;; Not necessary because we have it in b-c-initial-macro-environment ;; (list 'quote (eval (cons 'progn body))) (cons 'progn body)) @@ -128,6 +130,7 @@ (put 'eval-and-compile 'lisp-indent-hook 0) (defmacro eval-and-compile (&rest body) "Like `progn', but evaluates the body at compile time and at load time." + (declare (debug t)) ;; Remember, it's magic. (cons 'progn body))
--- a/lisp/emacs-lisp/bytecomp.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code -;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, 2003 +;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004 ;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> @@ -10,7 +10,7 @@ ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.143 $") +(defconst byte-compile-version "$Revision: 2.144 $") ;; This file is part of GNU Emacs. @@ -1493,7 +1493,8 @@ source dest) (dolist (file files) (setq source (expand-file-name file directory)) - (if (and (not (member file '("." ".." "RCS" "CVS"))) + (if (and (not (member file '("RCS" "CVS"))) + (not (eq ?\. (aref file 0))) (file-directory-p source) (not (file-symlink-p source))) ;; This file is a subdirectory. Handle them differently. @@ -1611,11 +1612,14 @@ ;; compile this file. (if (with-current-buffer input-buffer no-byte-compile) (progn - (message "%s not compiled because of `no-byte-compile: %s'" - (file-relative-name filename) - (with-current-buffer input-buffer no-byte-compile)) - (if (file-exists-p target-file) - (condition-case nil (delete-file target-file) (error nil))) + ;; (message "%s not compiled because of `no-byte-compile: %s'" + ;; (file-relative-name filename) + ;; (with-current-buffer input-buffer no-byte-compile)) + (when (file-exists-p target-file) + (message "%s deleted because of `no-byte-compile: %s'" + (file-relative-name target-file) + (buffer-local-value 'no-byte-compile input-buffer)) + (condition-case nil (delete-file target-file) (error nil))) ;; We successfully didn't compile this file. 'no-byte-compile) (when byte-compile-verbose
--- a/lisp/emacs-lisp/checkdoc.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/checkdoc.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; checkdoc.el --- check documentation strings for style requirements -;;; Copyright (C) 1997, 1998, 2001 Free Software Foundation +;;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.6.2 @@ -2657,7 +2657,7 @@ (setq checkdoc-pending-errors t) (checkdoc-output-to-error-buffer "\n" (checkdoc-buffer-label) ":" - (int-to-string (count-lines (point-min) (or point 1))) ": " + (int-to-string (count-lines (point-min) (or point (point-min)))) ": " msg)) (defun checkdoc-output-to-error-buffer (&rest text) @@ -2692,6 +2692,8 @@ (add-to-list 'debug-ignored-errors "Argument `.*' should appear (as .*) in the doc string") +(add-to-list 'debug-ignored-errors + "Lisp symbol `.*' should appear in quotes") (add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*") (provide 'checkdoc)
--- a/lisp/emacs-lisp/edebug.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/edebug.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; edebug.el --- a source-level debugger for Emacs Lisp -;; Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 97, 1999, 2000, 01, 2003 +;; Copyright (C) 1988,89,90,91,92,93,94,95,97,1999,2000,01,03,2004 ;; Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> @@ -2509,6 +2509,11 @@ (defun edebug-display () + (unless (marker-position edebug-def-mark) + ;; The buffer holding the source has been killed. + ;; Let's at least show a backtrace so the user can figure out + ;; which function we're talking about. + (debug)) ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. ;; Uses local variables of edebug-enter, edebug-before, edebug-after ;; and edebug-debugger. @@ -3681,17 +3686,14 @@ (edebug-prin1-to-string value))) (defun edebug-compute-previous-result (edebug-previous-value) + (if edebug-unwrap-results + (setq edebug-previous-value + (edebug-unwrap* edebug-previous-value))) (setq edebug-previous-result - (if (and (integerp edebug-previous-value) - (< edebug-previous-value 256) - (>= edebug-previous-value 0)) - (format "Result: %s = %s" edebug-previous-value - (single-key-description edebug-previous-value)) - (if edebug-unwrap-results - (setq edebug-previous-value - (edebug-unwrap* edebug-previous-value))) - (concat "Result: " - (edebug-safe-prin1-to-string edebug-previous-value))))) + (concat "Result: " + (edebug-safe-prin1-to-string edebug-previous-value) + (let ((name (prin1-char edebug-previous-value))) + (if name (concat " = " name)))))) (defun edebug-previous-result () "Print the previous result."
--- a/lisp/emacs-lisp/lisp-mnt.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/lisp-mnt.el Thu Mar 25 22:21:45 2004 +0000 @@ -452,14 +452,14 @@ (if keywords (split-string keywords ",?[ \t]")))) +(defvar finder-known-keywords) (defun lm-keywords-finder-p (&optional file) "Return non-nil if any keywords in FILE are known to finder." (require 'finder) (let ((keys (lm-keywords-list file))) (catch 'keyword-found (while keys - (if (assoc (intern (car keys)) - (with-no-warnings finder-known-keywords)) + (if (assoc (intern (car keys)) finder-known-keywords) (throw 'keyword-found t)) (setq keys (cdr keys))) nil)))
--- a/lisp/emacs-lisp/lisp-mode.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/lisp-mode.el Thu Mar 25 22:21:45 2004 +0000 @@ -173,8 +173,6 @@ ;; because lisp-fill-paragraph should do the job. ;; I believe that newcomment's auto-fill code properly deals with it -stef ;;(set (make-local-variable 'adaptive-fill-mode) nil) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'lisp-mode-auto-fill) (make-local-variable 'indent-line-function) (setq indent-line-function 'lisp-indent-line) (make-local-variable 'indent-region-function) @@ -195,8 +193,6 @@ (setq comment-add 1) ;default to `;;' in comment-region (make-local-variable 'comment-column) (setq comment-column 40) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'lisp-comment-indent) ;; Don't get confused by `;' in doc strings when paragraph-filling. (set (make-local-variable 'comment-use-global-state) t) (make-local-variable 'imenu-generic-expression) @@ -207,14 +203,14 @@ (setq font-lock-defaults '((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) - nil nil (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun + nil nil (("+-*/.<>=!?$%_&~^:" . "w")) nil (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function)))) (defun lisp-outline-level () "Lisp mode `outline-level' function." - (if (looking-at "(") + (if (looking-at "(\\|;;;###autoload") 1000 (looking-at outline-regexp) (- (match-end 0) (match-beginning 0)))) @@ -453,14 +449,18 @@ If CHAR is not a character, return nil." (and (integerp char) (char-valid-p (event-basic-type char)) - (concat - "?" - (mapconcat - (lambda (modif) - (cond ((eq modif 'super) "\\s-") - (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) - (event-modifiers char) "") - (string (event-basic-type char))))) + (let ((c (event-basic-type char))) + (concat + "?" + (mapconcat + (lambda (modif) + (cond ((eq modif 'super) "\\s-") + (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) + (event-modifiers char) "") + (cond + ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) + ((eq c 127) "\\C-?") + (t (string c))))))) (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. @@ -671,8 +671,8 @@ ;; This function just forces a more costly detection of comments (using ;; parse-partial-sexp from beginning-of-defun). I.e. It avoids the problem of ;; taking a `;' inside a string started on another line for a comment starter. -;; Note: `newcomment' gets it right in 99% of the cases if you're using -;; font-lock, anyway, so we could get rid of it. -stef +;; Note: `newcomment' gets it right now since we set comment-use-global-state +;; so we could get rid of it. -stef (defun lisp-mode-auto-fill () (if (> (current-column) (current-fill-column)) (if (save-excursion
--- a/lisp/emacs-lisp/pp.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/pp.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; pp.el --- pretty printer for Emacs Lisp -;; Copyright (C) 1989, 1993, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1993, 2001, 2004 Free Software Foundation, Inc. ;; Author: Randal Schwartz <merlyn@stonehenge.com> ;; Keywords: lisp @@ -120,12 +120,10 @@ (message "%s" (buffer-substring (point-min) (point))) )))))) (with-output-to-temp-buffer "*Pp Eval Output*" - (pp (car values))) - (save-excursion - (set-buffer "*Pp Eval Output*") - (emacs-lisp-mode) - (make-local-variable 'font-lock-verbose) - (setq font-lock-verbose nil)))) + (pp (car values)) + (with-current-buffer standard-output + (emacs-lisp-mode) + (set (make-local-variable 'font-lock-verbose) nil))))) ;;;###autoload (defun pp-eval-last-sexp (arg)
--- a/lisp/emacs-lisp/rx.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/rx.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; rx.el --- sexp notation for regular expressions -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 03, 2004 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: FSF @@ -799,14 +799,17 @@ `(repeat N M SEXP)' matches N to M occurrences of what SEXP matches. +`(backref N)' + matches what was matched previously by submatch N. + `(eval FORM)' - evaluate FORM and insert result. If result is a string, - `regexp-quote' it. + evaluate FORM and insert result. If result is a string, + `regexp-quote' it. `(regexp REGEXP)' - include REGEXP in string notation in the result." + include REGEXP in string notation in the result." - `(rx-to-string ',regexp)) + (rx-to-string regexp)) (provide 'rx)
--- a/lisp/emacs-lisp/warnings.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/emacs-lisp/warnings.el Thu Mar 25 22:21:45 2004 +0000 @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file implements the entry points `warn', `lwarn' -;; and `display-warnings'. +;; and `display-warning'. ;;; Code:
--- a/lisp/files.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/files.el Thu Mar 25 22:21:45 2004 +0000 @@ -4205,14 +4205,20 @@ (defun insert-directory (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. -SWITCHES may be a string of options, or a list of strings. +SWITCHES may be a string of options, or a list of strings +representing individual options. Optional third arg WILDCARD means treat FILE as shell wildcard. Optional fourth arg FULL-DIRECTORY-P means file is a directory and switches do not contain `d', so that a full listing is expected. This works by running a directory listing program whose name is in the variable `insert-directory-program'. -If WILDCARD, it also runs the shell specified by `shell-file-name'." +If WILDCARD, it also runs the shell specified by `shell-file-name'. + +When SWITCHES contains the long `--dired' option,this function +treats it specially, for the sake of dired. However, the +normally equivalent short `-D' option is just passed on to +`insert-directory-program', as any other option." ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) @@ -4301,7 +4307,9 @@ (access-file file "Reading directory") (error "Listing directory failed but `access-file' worked"))) - (when (string-match "--dired\\>" switches) + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) (forward-line -2) (when (looking-at "//SUBDIRED//") (delete-region (point) (progn (forward-line 1) (point)))
--- a/lisp/finder.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/finder.el Thu Mar 25 22:21:45 2004 +0000 @@ -61,7 +61,7 @@ (calendar . "calendar and time management support") (comm . "communications, networking, remote access to files") (convenience . "convenience features for faster editing") - (data . "support editing files of data") + (data . "support for editing files of data") (docs . "support for Emacs documentation") (emulations . "emulations of other editors") (extensions . "Emacs Lisp language extensions") @@ -87,9 +87,9 @@ (outlines . "support for hierarchical outlining") (processes . "process, subshell, compilation, and job control support") (terminals . "support for terminal types") - (tex . "code related to the TeX formatter") + (tex . "supporting code for the TeX formatter") (tools . "programming tools") - (unix . "front-ends/assistants for, or emulators of, UNIX features") + (unix . "front-ends/assistants for, or emulators of, UNIX-like features") ;; Not a custom group and not currently useful. ;; (vms . "support code for vms") (wp . "word processing")
--- a/lisp/font-lock.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/font-lock.el Thu Mar 25 22:21:45 2004 +0000 @@ -228,13 +228,11 @@ ;; Define support mode groups here to impose `font-lock' group order. (defgroup fast-lock nil "Font Lock support mode to cache fontification." - :link '(custom-manual "(emacs)Support Modes") :load 'fast-lock :group 'font-lock) (defgroup lazy-lock nil "Font Lock support mode to fontify lazily." - :link '(custom-manual "(emacs)Support Modes") :load 'lazy-lock :group 'font-lock)
--- a/lisp/format.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/format.el Thu Mar 25 22:21:45 2004 +0000 @@ -416,7 +416,7 @@ the part of the file to read. The return value is like the value of `insert-file-contents': -a list (ABSOLUTE-FILE-NAME . SIZE)." +a list (ABSOLUTE-FILE-NAME SIZE)." (interactive ;; Same interactive spec as write-file, plus format question. (let* ((file (read-file-name "Find file: ")) @@ -429,7 +429,7 @@ (setq size (nth 1 value))) (if format (setq size (format-decode format size) - value (cons (car value) size))) + value (list (car value) size))) value)) (defun format-read (&optional prompt)
--- a/lisp/gdb-ui.el Fri Mar 19 23:21:11 2004 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1966 +0,0 @@ -;;; gdb-ui.el --- User Interface for running GDB - -;; Author: Nick Roberts <nick@nick.uklinux.net> -;; Maintainer: FSF -;; Keywords: unix, tools - -;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This mode acts as a graphical user interface to GDB. You can interact with -;; GDB through the GUD buffer in the usual way, but there are also further -;; buffers which control the execution and describe the state of your program. -;; It separates the input/output of your program from that of GDB and displays -;; expressions and their current values in their own buffers. It also uses -;; features of Emacs 21 such as the display margin for breakpoints, and the -;; toolbar (see the GDB Graphical Interface section in the Emacs info manual). - -;; Start the debugger with M-x gdba. - -;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim -;; Kingdon and uses GDB's annotation interface. You don't need to know about -;; annotations to use this mode as a debugger, but if you are interested -;; developing the mode itself, then see the Annotations section in the GDB -;; info manual. Some GDB/MI commands are also used through th CLI command -;; 'interpreter mi <mi-command>'. -;; -;; Known Bugs: -;; - -;;; Code: - -(require 'gud) - -(defvar gdb-current-address "main" "Initialisation for Assembler buffer.") -(defvar gdb-previous-address nil) -(defvar gdb-previous-frame nil) -(defvar gdb-current-frame "main") -(defvar gdb-current-language nil) -(defvar gdb-view-source t "Non-nil means that source code can be viewed.") -(defvar gdb-selected-view 'source "Code type that user wishes to view.") -(defvar gdb-var-list nil "List of variables in watch window") -(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") -(defvar gdb-buffer-type nil) -(defvar gdb-overlay-arrow-position nil) -(defvar gdb-variables '() - "A list of variables that are local to the GUD buffer.") - -;;;###autoload -(defun gdba (command-line) - "Run gdb on program FILE in buffer *gud-FILE*. -The directory containing FILE becomes the initial working directory -and source-file directory for your debugger. - -If `gdb-many-windows' is nil (the default value) then gdb starts with -just two windows : the GUD and the source buffer. If it is t the -following layout will appear (keybindings given in relevant buffer) : - ---------------------------------------------------------------------- - GDB Toolbar ---------------------------------------------------------------------- -GUD buffer (I/O of GDB) | Locals buffer - | - | - | ---------------------------------------------------------------------- -Source buffer | Input/Output (of debuggee) buffer - | (comint-mode) - | - | - | - | - | - | ---------------------------------------------------------------------- -Stack buffer | Breakpoints buffer - RET gdb-frames-select | SPC gdb-toggle-breakpoint - | RET gdb-goto-breakpoint - | d gdb-delete-breakpoint ---------------------------------------------------------------------- - -All the buffers share the toolbar and source should always display in the same -window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint -icons are displayed both by setting a break with gud-break and by typing break -in the GUD buffer. - -This works best (depending on the size of your monitor) using most of the -screen. - -Displayed expressions appear in separate frames. Arrays may be displayed -as slices and visualised using the graph program from plotutils if installed. -Pointers in structures may be followed in a tree-like fashion. - -The following interactive lisp functions help control operation : - -`gdb-many-windows' - Toggle the number of windows gdb uses. -`gdb-restore-windows' - To restore the window layout." - ;; - (interactive (list (gud-query-cmdline 'gdba))) - ;; - ;; Let's start with a basic gud-gdb buffer and then modify it a bit. - (gdb command-line) - (gdb-ann3)) - -(defun gdb-ann3 () - (set (make-local-variable 'gud-minor-mode) 'gdba) - (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) - ;; - (gud-def gud-break (if (not (string-equal mode-name "Machine")) - (gud-call "break %f:%l" arg) - (save-excursion - (beginning-of-line) - (forward-char 2) - (gud-call "break *%a" arg))) - "\C-b" "Set breakpoint at current line or address.") - ;; - (gud-def gud-remove (if (not (string-equal mode-name "Machine")) - (gud-call "clear %f:%l" arg) - (save-excursion - (beginning-of-line) - (forward-char 2) - (gud-call "clear *%a" arg))) - "\C-d" "Remove breakpoint at current line or address.") - ;; - (gud-def gud-until (if (not (string-equal mode-name "Machine")) - (gud-call "until %f:%l" arg) - (save-excursion - (beginning-of-line) - (forward-char 2) - (gud-call "until *%a" arg))) - "\C-u" "Continue to current line or address.") - - (define-key gud-minor-mode-map [left-margin mouse-1] - 'gdb-mouse-toggle-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-1] - 'gdb-mouse-toggle-breakpoint) - - (setq comint-input-sender 'gdb-send) - ;; - ;; (re-)initialise - (setq gdb-current-address "main") - (setq gdb-previous-address nil) - (setq gdb-previous-frame nil) - (setq gdb-current-frame "main") - (setq gdb-view-source t) - (setq gdb-selected-view 'source) - (setq gdb-var-list nil) - (setq gdb-var-changed nil) - (setq gdb-first-prompt nil) - ;; - (mapc 'make-local-variable gdb-variables) - (setq gdb-buffer-type 'gdba) - ;; - (gdb-clear-inferior-io) - ;; - (if (eq window-system 'w32) - (gdb-enqueue-input (list "set new-console off\n" 'ignore))) - (gdb-enqueue-input (list "set height 0\n" 'ignore)) - ;; find source file and compilation directory here - (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program - (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program - (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) - ;; - (run-hooks 'gdba-mode-hook)) - -(defcustom gdb-use-colon-colon-notation nil - "Non-nil means use FUNCTION::VARIABLE format to display variables in the -speedbar." - :type 'boolean - :group 'gud) - -(defun gud-watch () - "Watch expression at point." - (interactive) - (require 'tooltip) - (let ((expr (tooltip-identifier-from-point (point)))) - (if (and (string-equal gdb-current-language "c") - gdb-use-colon-colon-notation) - (setq expr (concat gdb-current-frame "::" expr))) - (catch 'already-watched - (dolist (var gdb-var-list) - (if (string-equal expr (car var)) (throw 'already-watched nil))) - (set-text-properties 0 (length expr) nil expr) - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-create - * " expr "\"\n") - `(lambda () (gdb-var-create-handler ,expr)))))) - (select-window (get-buffer-window gud-comint-buffer))) - -(defconst gdb-var-create-regexp -"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") - -(defun gdb-var-create-handler (expr) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (if (re-search-forward gdb-var-create-regexp nil t) - (let ((var (list expr - (match-string 1) - (match-string 2) - (match-string 3) - nil nil))) - (push var gdb-var-list) - (setq speedbar-update-flag t) - (speedbar 1) - (if (equal (nth 2 var) "0") - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-evaluate-expression " - (nth 1 var) "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 var) nil)))) - (setq gdb-var-changed t))) - (if (re-search-forward "Undefined command" nil t) - (message "Watching expressions requires gdb 6.0 onwards") - (message "No symbol %s in current context." expr))))) - -(defun gdb-var-evaluate-expression-handler (varnum changed) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) - (catch 'var-found - (let ((var-list nil) (num 0)) - (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) - (progn - (if changed (setcar (nthcdr 5 var) t)) - (setcar (nthcdr 4 var) (match-string 1)) - (setcar (nthcdr num gdb-var-list) var) - (throw 'var-found nil))) - (setq num (+ num 1)))))) - (setq gdb-var-changed t)) - -(defun gdb-var-list-children (varnum) - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n") - `(lambda () (gdb-var-list-children-handler ,varnum))))) - -(defconst gdb-var-list-children-regexp -"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"") - -(defun gdb-var-list-children-handler (varnum) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (let ((var-list nil)) - (catch 'child-already-watched - (dolist (var gdb-var-list) - (if (string-equal varnum (cadr var)) - (progn - (push var var-list) - (while (re-search-forward gdb-var-list-children-regexp nil t) - (let ((varchild (list (match-string 2) - (match-string 1) - (match-string 3) - nil nil nil))) - (if (looking-at ",type=\"\\(.*?\\)\"") - (setcar (nthcdr 3 varchild) (match-string 1))) - (dolist (var1 gdb-var-list) - (if (string-equal (cadr var1) (cadr varchild)) - (throw 'child-already-watched nil))) - (push varchild var-list) - (if (equal (nth 2 varchild) "0") - (gdb-enqueue-input - (list - (concat - "server interpreter mi \"-var-evaluate-expression " - (nth 1 varchild) "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 varchild) nil)))))))) - (push var var-list))) - (setq gdb-var-list (nreverse var-list)))))) - -(defun gdb-var-update () - (if (not (member 'gdb-var-update (gdb-get-pending-triggers))) - (progn - (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" - 'gdb-var-update-handler)) - (gdb-set-pending-triggers (cons 'gdb-var-update - (gdb-get-pending-triggers)))))) - -(defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"") - -(defun gdb-var-update-handler () - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (while (re-search-forward gdb-var-update-regexp nil t) - (let ((varnum (match-string 1))) - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-evaluate-expression " - varnum "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler - ,varnum t))))))) - (gdb-set-pending-triggers - (delq 'gdb-var-update (gdb-get-pending-triggers)))) - -(defun gdb-var-delete () - "Delete watched expression from the speedbar." - (interactive) - (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) - (let ((text (speedbar-line-text))) - (string-match "\\(\\S-+\\)" text) - (let* ((expr (match-string 1 text)) - (var (assoc expr gdb-var-list)) - (varnum (cadr var))) - (unless (string-match "\\." varnum) - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-delete " - varnum "\"\n") - 'ignore)) - (setq gdb-var-list (delq var gdb-var-list)) - (dolist (varchild gdb-var-list) - (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) - (setq gdb-var-list (delq varchild gdb-var-list)))) - (setq gdb-var-changed t)))))) - -(defun gdb-edit-value (text token indent) - "Assign a value to a variable displayed in the speedbar" - (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) - (varnum (cadr var)) (value)) - (setq value (read-string "New value: ")) - (gdb-enqueue-input - (list (concat "server interpreter mi \"-var-assign " - varnum " " value "\"\n") - 'ignore)))) - -(defcustom gdb-show-changed-values t - "Non-nil means use font-lock-warning-face to display values that have -recently changed in the speedbar." - :type 'boolean - :group 'gud) - -(defun gdb-speedbar-expand-node (text token indent) - "Expand the node the user clicked on. -TEXT is the text of the button we clicked on, a + or - item. -TOKEN is data related to this node. -INDENT is the current indentation depth." - (cond ((string-match "+" text) ;expand this node - (gdb-var-list-children token)) - ((string-match "-" text) ;contract this node - (dolist (var gdb-var-list) - (if (string-match (concat token "\\.") (nth 1 var)) - (setq gdb-var-list (delq var gdb-var-list)))) - (setq gdb-var-changed t)))) - - -;; ====================================================================== -;; -;; In this world, there are gdb variables (of unspecified -;; representation) and buffers associated with those objects. -;; The list of variables is built up by the expansions of -;; def-gdb-variable - -(defmacro def-gdb-var (root-symbol &optional default doc) - (let* ((root (symbol-name root-symbol)) - (accessor (intern (concat "gdb-get-" root))) - (setter (intern (concat "gdb-set-" root))) - (name (intern (concat "gdb-" root)))) - `(progn - (defvar ,name ,default ,doc) - (if (not (memq ',name gdb-variables)) - (push ',name gdb-variables)) - (defun ,accessor () - (buffer-local-value ',name gud-comint-buffer)) - (defun ,setter (val) - (with-current-buffer gud-comint-buffer - (setq ,name val)))))) - -(def-gdb-var buffer-type nil - "One of the symbols bound in gdb-buffer-rules") - -(def-gdb-var burst "" - "A string of characters from gdb that have not yet been processed.") - -(def-gdb-var input-queue () - "A list of gdb command objects.") - -(def-gdb-var prompting nil - "True when gdb is idle with no pending input.") - -(def-gdb-var output-sink 'user - "The disposition of the output of the current gdb command. -Possible values are these symbols: - - user -- gdb output should be copied to the GUD buffer - for the user to see. - - inferior -- gdb output should be copied to the inferior-io buffer - - pre-emacs -- output should be ignored util the post-prompt - annotation is received. Then the output-sink - becomes:... - emacs -- output should be collected in the partial-output-buffer - for subsequent processing by a command. This is the - disposition of output generated by commands that - gdb mode sends to gdb on its own behalf. - post-emacs -- ignore input until the prompt annotation is - received, then go to USER disposition. -") - -(def-gdb-var current-item nil - "The most recent command item sent to gdb.") - -(def-gdb-var pending-triggers '() - "A list of trigger functions that have run later than their output -handlers.") - -;; end of gdb variables - -(defun gdb-get-target-string () - (with-current-buffer gud-comint-buffer - gud-target-name)) - - -;; -;; gdb buffers. -;; -;; Each buffer has a TYPE -- a symbol that identifies the function -;; of that particular buffer. -;; -;; The usual gdb interaction buffer is given the type `gdba' and -;; is constructed specially. -;; -;; Others are constructed by gdb-get-create-buffer and -;; named according to the rules set forth in the gdb-buffer-rules-assoc - -(defvar gdb-buffer-rules-assoc '()) - -(defun gdb-get-buffer (key) - "Return the gdb buffer tagged with type KEY. -The key should be one of the cars in `gdb-buffer-rules-assoc'." - (save-excursion - (gdb-look-for-tagged-buffer key (buffer-list)))) - -(defun gdb-get-create-buffer (key) - "Create a new gdb buffer of the type specified by KEY. -The key should be one of the cars in `gdb-buffer-rules-assoc'." - (or (gdb-get-buffer key) - (let* ((rules (assoc key gdb-buffer-rules-assoc)) - (name (funcall (gdb-rules-name-maker rules))) - (new (get-buffer-create name))) - (with-current-buffer new - ;; FIXME: This should be set after calling the function, since the - ;; function should run kill-all-local-variables. - (set (make-local-variable 'gdb-buffer-type) key) - (if (cdr (cdr rules)) - (funcall (car (cdr (cdr rules))))) - (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer) - (set (make-local-variable 'gud-minor-mode) 'gdba) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) - new)))) - -(defun gdb-rules-name-maker (rules) (car (cdr rules))) - -(defun gdb-look-for-tagged-buffer (key bufs) - (let ((retval nil)) - (while (and (not retval) bufs) - (set-buffer (car bufs)) - (if (eq gdb-buffer-type key) - (setq retval (car bufs))) - (setq bufs (cdr bufs))) - retval)) - -;; -;; This assoc maps buffer type symbols to rules. Each rule is a list of -;; at least one and possible more functions. The functions have these -;; roles in defining a buffer type: -;; -;; NAME - Return a name for this buffer type. -;; -;; The remaining function(s) are optional: -;; -;; MODE - called in a new buffer with no arguments, should establish -;; the proper mode for the buffer. -;; - -(defun gdb-set-buffer-rules (buffer-type &rest rules) - (let ((binding (assoc buffer-type gdb-buffer-rules-assoc))) - (if binding - (setcdr binding rules) - (push (cons buffer-type rules) - gdb-buffer-rules-assoc)))) - -;; GUD buffers are an exception to the rules -(gdb-set-buffer-rules 'gdba 'error) - -;; -;; Partial-output buffer : This accumulates output from a command executed on -;; behalf of emacs (rather than the user). -;; -(gdb-set-buffer-rules 'gdb-partial-output-buffer - 'gdb-partial-output-name) - -(defun gdb-partial-output-name () - (concat "*partial-output-" - (gdb-get-target-string) - "*")) - - -(gdb-set-buffer-rules 'gdb-inferior-io - 'gdb-inferior-io-name - 'gdb-inferior-io-mode) - -(defun gdb-inferior-io-name () - (concat "*input/output of " - (gdb-get-target-string) - "*")) - -(defvar gdb-inferior-io-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt) - (define-key map "\C-c\C-z" 'gdb-inferior-io-stop) - (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit) - (define-key map "\C-c\C-d" 'gdb-inferior-io-eof) - map)) - -(define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O" - "Major mode for gdb inferior-io." - :syntax-table nil :abbrev-table nil - ;; We want to use comint because it has various nifty and familiar - ;; features. We don't need a process, but comint wants one, so create - ;; a dummy one. - (make-comint-in-buffer - (substring (buffer-name) 1 (- (length (buffer-name)) 1)) - (current-buffer) "hexl") - (setq comint-input-sender 'gdb-inferior-io-sender)) - -(defun gdb-inferior-io-sender (proc string) - ;; PROC is the pseudo-process created to satisfy comint. - (with-current-buffer (process-buffer proc) - (setq proc (get-buffer-process gud-comint-buffer)) - (process-send-string proc string) - (process-send-string proc "\n"))) - -(defun gdb-inferior-io-interrupt () - "Interrupt the program being debugged." - (interactive) - (interrupt-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-inferior-io-quit () - "Send quit signal to the program being debugged." - (interactive) - (quit-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-inferior-io-stop () - "Stop the program being debugged." - (interactive) - (stop-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-inferior-io-eof () - "Send end-of-file to the program being debugged." - (interactive) - (process-send-eof - (get-buffer-process gud-comint-buffer))) - - -;; -;; gdb communications -;; - -;; INPUT: things sent to gdb -;; -;; The queues are lists. Each element is either a string (indicating user or -;; user-like input) or a list of the form: -;; -;; (INPUT-STRING HANDLER-FN) -;; -;; The handler function will be called from the partial-output buffer when the -;; command completes. This is the way to write commands which invoke gdb -;; commands autonomously. -;; -;; These lists are consumed tail first. -;; - -(defun gdb-send (proc string) - "A comint send filter for gdb. -This filter may simply queue output for a later time." - (gdb-enqueue-input (concat string "\n"))) - -;; Note: Stuff enqueued here will be sent to the next prompt, even if it -;; is a query, or other non-top-level prompt. - -(defun gdb-enqueue-input (item) - (if (gdb-get-prompting) - (progn - (gdb-send-item item) - (gdb-set-prompting nil)) - (gdb-set-input-queue - (cons item (gdb-get-input-queue))))) - -(defun gdb-dequeue-input () - (let ((queue (gdb-get-input-queue))) - (and queue - (let ((last (car (last queue)))) - (unless (nbutlast queue) (gdb-set-input-queue '())) - last)))) - - -;; -;; output -- things gdb prints to emacs -;; -;; GDB output is a stream interrupted by annotations. -;; Annotations can be recognized by their beginning -;; with \C-j\C-z\C-z<tag><opt>\C-j -;; -;; The tag is a string obeying symbol syntax. -;; -;; The optional part `<opt>' can be either the empty string -;; or a space followed by more data relating to the annotation. -;; For example, the SOURCE annotation is followed by a filename, -;; line number and various useless goo. This data must not include -;; any newlines. -;; - -(defcustom gud-gdba-command-name "gdb -annotate=3" - "Default command to execute an executable under the GDB-UI debugger." - :type 'string - :group 'gud) - -(defvar gdb-annotation-rules - '(("pre-prompt" gdb-pre-prompt) - ("prompt" gdb-prompt) - ("commands" gdb-subprompt) - ("overload-choice" gdb-subprompt) - ("query" gdb-subprompt) - ("prompt-for-continue" gdb-subprompt) - ("post-prompt" gdb-post-prompt) - ("source" gdb-source) - ("starting" gdb-starting) - ("exited" gdb-stopping) - ("signalled" gdb-stopping) - ("signal" gdb-stopping) - ("breakpoint" gdb-stopping) - ("watchpoint" gdb-stopping) - ("frame-begin" gdb-frame-begin) - ("stopped" gdb-stopped) - ) "An assoc mapping annotation tags to functions which process them.") - -(defconst gdb-source-spec-regexp - "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") - -;; Do not use this except as an annotation handler. -(defun gdb-source (args) - (string-match gdb-source-spec-regexp args) - ;; Extract the frame position from the marker. - (setq gud-last-frame - (cons - (match-string 1 args) - (string-to-int (match-string 2 args)))) - (setq gdb-current-address (match-string 3 args)) - (setq gdb-view-source t)) - -(defun gdb-send-item (item) - (gdb-set-current-item item) - (if (stringp item) - (progn - (gdb-set-output-sink 'user) - (process-send-string (get-buffer-process gud-comint-buffer) item)) - (progn - (gdb-clear-partial-output) - (gdb-set-output-sink 'pre-emacs) - (process-send-string (get-buffer-process gud-comint-buffer) - (car item))))) - -(defun gdb-pre-prompt (ignored) - "An annotation handler for `pre-prompt'. This terminates the collection of -output from a previous command if that happens to be in effect." - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'user) t) - ((eq sink 'emacs) - (gdb-set-output-sink 'post-emacs)) - (t - (gdb-set-output-sink 'user) - (error "Phase error in gdb-pre-prompt (got %s)" sink))))) - -(defun gdb-prompt (ignored) - "An annotation handler for `prompt'. -This sends the next command (if any) to gdb." - (when gdb-first-prompt (gdb-ann3)) - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'user) t) - ((eq sink 'post-emacs) - (gdb-set-output-sink 'user) - (let ((handler - (car (cdr (gdb-get-current-item))))) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (funcall handler)))) - (t - (gdb-set-output-sink 'user) - (error "Phase error in gdb-prompt (got %s)" sink)))) - (let ((input (gdb-dequeue-input))) - (if input - (gdb-send-item input) - (progn - (gdb-set-prompting t) - (gud-display-frame))))) - -(defun gdb-subprompt (ignored) - "An annotation handler for non-top-level prompts." - (gdb-set-prompting t)) - -(defun gdb-starting (ignored) - "An annotation handler for `starting'. This says that I/O for the -subprocess is now the program being debugged, not GDB." - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'user) - (progn - (setq gud-running t) - (gdb-set-output-sink 'inferior))) - (t (error "Unexpected `starting' annotation"))))) - -(defun gdb-stopping (ignored) - "An annotation handler for `exited' and other annotations which say that I/O -for the subprocess is now GDB, not the program being debugged." - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'inferior) - (gdb-set-output-sink 'user)) - (t (error "Unexpected stopping annotation"))))) - -(defun gdb-frame-begin (ignored) - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'inferior) - (gdb-set-output-sink 'user)) - ((eq sink 'user) t) - ((eq sink 'emacs) t) - (t (error "Unexpected frame-begin annotation (%S)" sink))))) - -(defun gdb-stopped (ignored) - "An annotation handler for `stopped'. It is just like gdb-stopping, except -that if we already set the output sink to 'user in gdb-stopping, that is fine." - (setq gud-running nil) - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'inferior) - (gdb-set-output-sink 'user)) - ((eq sink 'user) t) - (t (error "Unexpected stopped annotation"))))) - -(defun gdb-post-prompt (ignored) - "An annotation handler for `post-prompt'. This begins the collection of -output from the current command if that happens to be appropriate." - (if (not (gdb-get-pending-triggers)) - (progn - (gdb-get-current-frame) - (gdb-invalidate-frames) - (gdb-invalidate-breakpoints) - (gdb-invalidate-assembler) - (gdb-invalidate-registers) - (gdb-invalidate-locals) - (gdb-invalidate-threads) - (dolist (frame (frame-list)) - (when (string-equal (frame-parameter frame 'name) "Speedbar") - (setq gdb-var-changed t) ; force update - (dolist (var gdb-var-list) - (setcar (nthcdr 5 var) nil)))) - (gdb-var-update))) - (let ((sink (gdb-get-output-sink))) - (cond - ((eq sink 'user) t) - ((eq sink 'pre-emacs) - (gdb-set-output-sink 'emacs)) - (t - (gdb-set-output-sink 'user) - (error "Phase error in gdb-post-prompt (got %s)" sink))))) - -(defun gud-gdba-marker-filter (string) - "A gud marker filter for gdb. Handle a burst of output from GDB." - ;; Recall the left over gud-marker-acc from last time - (setq gud-marker-acc (concat gud-marker-acc string)) - ;; Start accumulating output for the GUD buffer - (let ((output "")) - ;; - ;; Process all the complete markers in this chunk. - (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((annotation (match-string 1 gud-marker-acc))) - ;; - ;; Stuff prior to the match is just ordinary output. - ;; It is either concatenated to OUTPUT or directed - ;; elsewhere. - (setq output - (gdb-concat-output - output - (substring gud-marker-acc 0 (match-beginning 0)))) - ;; - ;; Take that stuff off the gud-marker-acc. - (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) - ;; - ;; Parse the tag from the annotation, and maybe its arguments. - (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) - (let* ((annotation-type (match-string 1 annotation)) - (annotation-arguments (match-string 2 annotation)) - (annotation-rule (assoc annotation-type - gdb-annotation-rules))) - ;; Call the handler for this annotation. - (if annotation-rule - (funcall (car (cdr annotation-rule)) - annotation-arguments) - ;; Else the annotation is not recognized. Ignore it silently, - ;; so that GDB can add new annotations without causing - ;; us to blow up. - )))) - ;; - ;; Does the remaining text end in a partial line? - ;; If it does, then keep part of the gud-marker-acc until we get more. - (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" - gud-marker-acc) - (progn - ;; Everything before the potential marker start can be output. - (setq output - (gdb-concat-output output - (substring gud-marker-acc 0 - (match-beginning 0)))) - ;; - ;; Everything after, we save, to combine with later input. - (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) - ;; - ;; In case we know the gud-marker-acc contains no partial annotations: - (progn - (setq output (gdb-concat-output output gud-marker-acc)) - (setq gud-marker-acc ""))) - output)) - -(defun gdb-concat-output (so-far new) - (let ((sink (gdb-get-output-sink ))) - (cond - ((eq sink 'user) (concat so-far new)) - ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) - ((eq sink 'emacs) - (gdb-append-to-partial-output new) - so-far) - ((eq sink 'inferior) - (gdb-append-to-inferior-io new) - so-far) - (t (error "Bogon output sink %S" sink))))) - -(defun gdb-append-to-partial-output (string) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert string))) - -(defun gdb-clear-partial-output () - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (erase-buffer))) - -(defun gdb-append-to-inferior-io (string) - (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) - (goto-char (point-max)) - (insert-before-markers string)) - (if (not (string-equal string "")) - (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))) - -(defun gdb-clear-inferior-io () - (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) - (erase-buffer))) - - -;; One trick is to have a command who's output is always available in a buffer -;; of it's own, and is always up to date. We build several buffers of this -;; type. -;; -;; There are two aspects to this: gdb has to tell us when the output for that -;; command might have changed, and we have to be able to run the command -;; behind the user's back. -;; -;; The output phasing associated with the variable gdb-output-sink -;; help us to run commands behind the user's back. -;; -;; Below is the code for specificly managing buffers of output from one -;; command. -;; - -;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES -;; It adds an input for the command we are tracking. It should be the -;; annotation rule binding of whatever gdb sends to tell us this command -;; might have changed it's output. -;; -;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. -;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the -;; input in the input queue (see comment about ``gdb communications'' above). - -(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command - output-handler) - `(defun ,name (&optional ignored) - (if (and (,demand-predicate) - (not (member ',name - (gdb-get-pending-triggers)))) - (progn - (gdb-enqueue-input - (list ,gdb-command ',output-handler)) - (gdb-set-pending-triggers - (cons ',name - (gdb-get-pending-triggers))))))) - -(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) - `(defun ,name () - (gdb-set-pending-triggers - (delq ',trigger - (gdb-get-pending-triggers))) - (let ((buf (gdb-get-buffer ',buf-key))) - (and buf - (with-current-buffer buf - (let ((p (point)) - (buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring (gdb-get-create-buffer - 'gdb-partial-output-buffer)) - (goto-char p))))) - ;; put customisation here - (,custom-defun))) - -(defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command - output-handler-name custom-defun) - `(progn - (def-gdb-auto-update-trigger ,trigger-name - ;; The demand predicate: - (lambda () (gdb-get-buffer ',buffer-key)) - ,gdb-command - ,output-handler-name) - (def-gdb-auto-update-handler ,output-handler-name - ,trigger-name ,buffer-key ,custom-defun))) - - -;; -;; Breakpoint buffer : This displays the output of `info breakpoints'. -;; -(gdb-set-buffer-rules 'gdb-breakpoints-buffer - 'gdb-breakpoints-buffer-name - 'gdb-breakpoints-mode) - -(def-gdb-auto-updated-buffer gdb-breakpoints-buffer - ;; This defines the auto update rule for buffers of type - ;; `gdb-breakpoints-buffer'. - ;; - ;; It defines a function to serve as the annotation handler that - ;; handles the `foo-invalidated' message. That function is called: - gdb-invalidate-breakpoints - ;; - ;; To update the buffer, this command is sent to gdb. - "server info breakpoints\n" - ;; - ;; This also defines a function to be the handler for the output - ;; from the command above. That function will copy the output into - ;; the appropriately typed buffer. That function will be called: - gdb-info-breakpoints-handler - ;; buffer specific functions - gdb-info-breakpoints-custom) - -(defvar gdb-cdir nil "Compilation directory.") - -(defconst breakpoint-xpm-data "/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -\"10 10 2 1\", -\" c red\", -\"+ c None\", -/* pixels */ -\"+++ +++\", -\"++ ++\", -\"+ +\", -\" \", -\" \", -\" \", -\" \", -\"+ +\", -\"++ ++\", -\"+++ +++\", -};" - "XPM data used for breakpoint icon.") - -(defconst breakpoint-enabled-pbm-data -"P1 -10 10\", -0 0 0 0 1 1 1 1 0 0 0 0 -0 0 0 1 1 1 1 1 1 0 0 0 -0 0 1 1 1 1 1 1 1 1 0 0 -0 1 1 1 1 1 1 1 1 1 1 0 -0 1 1 1 1 1 1 1 1 1 1 0 -0 1 1 1 1 1 1 1 1 1 1 0 -0 1 1 1 1 1 1 1 1 1 1 0 -0 0 1 1 1 1 1 1 1 1 0 0 -0 0 0 1 1 1 1 1 1 0 0 0 -0 0 0 0 1 1 1 1 0 0 0 0" - "PBM data used for enabled breakpoint icon.") - -(defconst breakpoint-disabled-pbm-data -"P1 -10 10\", -0 0 1 0 1 0 1 0 0 0 -0 1 0 1 0 1 0 1 0 0 -1 0 1 0 1 0 1 0 1 0 -0 1 0 1 0 1 0 1 0 1 -1 0 1 0 1 0 1 0 1 0 -0 1 0 1 0 1 0 1 0 1 -1 0 1 0 1 0 1 0 1 0 -0 1 0 1 0 1 0 1 0 1 -0 0 1 0 1 0 1 0 1 0 -0 0 0 1 0 1 0 1 0 0" - "PBM data used for disabled breakpoint icon.") - -(defvar breakpoint-enabled-icon nil - "Icon for enabled breakpoint in display margin") - -(defvar breakpoint-disabled-icon nil - "Icon for disabled breakpoint in display margin") - -(defvar breakpoint-bitmap nil - "Bitmap for breakpoint in fringe") - -(defface breakpoint-enabled-bitmap-face - '((t - :inherit fringe - :foreground "red")) - "Face for enabled breakpoint icon in fringe.") - -(defface breakpoint-disabled-bitmap-face - '((t - :inherit fringe - :foreground "grey60")) - "Face for disabled breakpoint icon in fringe.") - - -;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) -(defun gdb-info-breakpoints-custom () - (let ((flag)(address)) - ;; - ;; remove all breakpoint-icons in source buffers but not assembler buffer - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (if (and (eq gud-minor-mode 'gdba) - (not (string-match "^\*" (buffer-name)))) - (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) - (save-excursion - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at "[^\t].*breakpoint") - (progn - (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") - (setq flag (char-after (match-beginning 1))) - (beginning-of-line) - (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) - (progn - (looking-at "\\(\\S-*\\):\\([0-9]+\\)") - (let ((line (match-string 2)) (buffer-read-only nil) - (file (match-string 1))) - (add-text-properties (point-at-bol) (point-at-eol) - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint")) - (with-current-buffer - (find-file-noselect - (if (file-exists-p file) file - (expand-file-name file gdb-cdir))) - (save-current-buffer - (set (make-local-variable 'gud-minor-mode) 'gdba) - (set (make-local-variable 'tool-bar-map) - gud-tool-bar-map)) - ;; only want one breakpoint icon at each location - (save-excursion - (goto-line (string-to-number line)) - (gdb-put-breakpoint-icon (eq flag ?y))))))))) - (end-of-line))))) - (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) - -(defun gdb-mouse-toggle-breakpoint (event) - "Toggle breakpoint with mouse click in left margin." - (interactive "e") - (mouse-minibuffer-check event) - (let ((posn (event-end event))) - (if (numberp (posn-point posn)) - (with-selected-window (posn-window posn) - (save-excursion - (goto-char (posn-point posn)) - (if (or (posn-object posn) - (and breakpoint-bitmap - (eq (car (fringe-bitmaps-at-pos (posn-point posn))) - breakpoint-bitmap))) - (gud-remove nil) - (gud-break nil))))))) - -(defun gdb-breakpoints-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*breakpoints of " (gdb-get-target-string) "*"))) - -(defun gdb-display-breakpoints-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-breakpoints-buffer))) - -(defun gdb-frame-breakpoints-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-breakpoints-buffer))) - -(defvar gdb-breakpoints-mode-map - (let ((map (make-sparse-keymap)) - (menu (make-sparse-keymap "Breakpoints"))) - (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint)) - (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) - (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) - - (suppress-keymap map) - (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) - (define-key map " " 'gdb-toggle-breakpoint) - (define-key map "d" 'gdb-delete-breakpoint) - (define-key map "\r" 'gdb-goto-breakpoint) - (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint) - map)) - -(defun gdb-breakpoints-mode () - "Major mode for gdb breakpoints. - -\\{gdb-breakpoints-mode-map}" - (setq major-mode 'gdb-breakpoints-mode) - (setq mode-name "Breakpoints") - (use-local-map gdb-breakpoints-mode-map) - (setq buffer-read-only t) - (gdb-invalidate-breakpoints)) - -(defun gdb-toggle-breakpoint () - "Enable/disable the breakpoint at current line." - (interactive) - (save-excursion - (beginning-of-line 1) - (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) - (error "Not recognized as break/watchpoint line") - (gdb-enqueue-input - (list - (concat - (if (eq ?y (char-after (match-beginning 2))) - "server disable " - "server enable ") - (match-string 1) "\n") - 'ignore))))) - -(defun gdb-delete-breakpoint () - "Delete the breakpoint at current line." - (interactive) - (beginning-of-line 1) - (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) - (error "Not recognized as break/watchpoint line") - (gdb-enqueue-input - (list (concat "server delete " (match-string 1) "\n") 'ignore)))) - -(defvar gdb-source-window nil) - -(defun gdb-goto-breakpoint () - "Display the file in the source buffer at the breakpoint specified on the -current line." - (interactive) - (save-excursion - (beginning-of-line 1) - (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) - (looking-at "\\(\\S-*\\):\\([0-9]+\\)")) - (if (match-string 2) - (let ((line (match-string 2)) - (file (match-string 1))) - (save-selected-window - (select-window gdb-source-window) - (switch-to-buffer (find-file-noselect - (if (file-exists-p file) - file - (expand-file-name file gdb-cdir)))) - (goto-line (string-to-number line)))))) - -(defun gdb-mouse-goto-breakpoint (event) - "Display the file in the source buffer at the selected breakpoint." - (interactive "e") - (mouse-set-point event) - (gdb-goto-breakpoint)) - -;; -;; Frames buffer. This displays a perpetually correct bactracktrace -;; (from the command `where'). -;; -;; Alas, if your stack is deep, it is costly. -;; -(gdb-set-buffer-rules 'gdb-stack-buffer - 'gdb-stack-buffer-name - 'gdb-frames-mode) - -(def-gdb-auto-updated-buffer gdb-stack-buffer - gdb-invalidate-frames - "server where\n" - gdb-info-frames-handler - gdb-info-frames-custom) - -(defun gdb-info-frames-custom () - (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (add-text-properties (point-at-bol) (point-at-eol) - '(mouse-face highlight - help-echo "mouse-2, RET: Select frame")) - (beginning-of-line) - (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") - (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) - (equal (match-string 1) gdb-current-frame)) - (put-text-property (point-at-bol) (point-at-eol) - 'face '(:inverse-video t))) - (forward-line 1)))))) - -(defun gdb-stack-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*stack frames of " (gdb-get-target-string) "*"))) - -(defun gdb-display-stack-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-stack-buffer))) - -(defun gdb-frame-stack-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-stack-buffer))) - -(defvar gdb-frames-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" 'gdb-frames-select) - (define-key map [mouse-2] 'gdb-frames-mouse-select) - map)) - -(defun gdb-frames-mode () - "Major mode for gdb frames. - -\\{gdb-frames-mode-map}" - (setq major-mode 'gdb-frames-mode) - (setq mode-name "Frames") - (setq buffer-read-only t) - (use-local-map gdb-frames-mode-map) - (font-lock-mode -1) - (gdb-invalidate-frames)) - -(defun gdb-get-frame-number () - (save-excursion - (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t)) - (n (or (and pos (match-string-no-properties 1)) "0"))) - n))) - -(defun gdb-frames-select () - "Make the frame on the current line become the current frame and display the -source in the source buffer." - (interactive) - (gdb-enqueue-input - (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) - (gud-display-frame)) - -(defun gdb-frames-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." - (interactive "e") - (mouse-set-point event) - (gdb-frames-select)) - -;; -;; Threads buffer. This displays a selectable thread list. -;; -(gdb-set-buffer-rules 'gdb-threads-buffer - 'gdb-threads-buffer-name - 'gdb-threads-mode) - -(def-gdb-auto-updated-buffer gdb-threads-buffer - gdb-invalidate-threads - "server info threads\n" - gdb-info-threads-handler - gdb-info-threads-custom) - -(defun gdb-info-threads-custom () - (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (add-text-properties (point-at-bol) (point-at-eol) - '(mouse-face highlight - help-echo "mouse-2, RET: select thread")) - (forward-line 1))))) - -(defun gdb-threads-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*threads of " (gdb-get-target-string) "*"))) - -(defun gdb-display-threads-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-threads-buffer))) - -(defun gdb-frame-threads-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-threads-buffer))) - -(defvar gdb-threads-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" 'gdb-threads-select) - (define-key map [mouse-2] 'gdb-threads-mouse-select) - map)) - -(defun gdb-threads-mode () - "Major mode for gdb frames. - -\\{gdb-frames-mode-map}" - (setq major-mode 'gdb-threads-mode) - (setq mode-name "Threads") - (setq buffer-read-only t) - (use-local-map gdb-threads-mode-map) - (gdb-invalidate-threads)) - -(defun gdb-get-thread-number () - (save-excursion - (re-search-backward "^\\s-*\\([0-9]*\\)" nil t) - (match-string-no-properties 1))) - -(defun gdb-threads-select () - "Make the thread on the current line become the current thread and display the -source in the source buffer." - (interactive) - (gdb-enqueue-input - (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) - (gud-display-frame)) - -(defun gdb-threads-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." - (interactive "e") - (mouse-set-point event) - (gdb-threads-select)) - -;; -;; Registers buffer. -;; -(gdb-set-buffer-rules 'gdb-registers-buffer - 'gdb-registers-buffer-name - 'gdb-registers-mode) - -(def-gdb-auto-updated-buffer gdb-registers-buffer - gdb-invalidate-registers - "server info registers\n" - gdb-info-registers-handler - gdb-info-registers-custom) - -(defun gdb-info-registers-custom ()) - -(defvar gdb-registers-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - map)) - -(defun gdb-registers-mode () - "Major mode for gdb registers. - -\\{gdb-registers-mode-map}" - (setq major-mode 'gdb-registers-mode) - (setq mode-name "Registers") - (setq buffer-read-only t) - (use-local-map gdb-registers-mode-map) - (gdb-invalidate-registers)) - -(defun gdb-registers-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*registers of " (gdb-get-target-string) "*"))) - -(defun gdb-display-registers-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-registers-buffer))) - -(defun gdb-frame-registers-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-registers-buffer))) - -;; -;; Locals buffer. -;; -(gdb-set-buffer-rules 'gdb-locals-buffer - 'gdb-locals-buffer-name - 'gdb-locals-mode) - -(def-gdb-auto-updated-buffer gdb-locals-buffer - gdb-invalidate-locals - "server info locals\n" - gdb-info-locals-handler - gdb-info-locals-custom) - -;; Abbreviate for arrays and structures. -;; These can be expanded using gud-display. -(defun gdb-info-locals-handler nil - (gdb-set-pending-triggers (delq 'gdb-invalidate-locals - (gdb-get-pending-triggers))) - (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^ .*\n" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) - (while (re-search-forward "{[-0-9, {}\]*\n" nil t) - (replace-match "(array);\n" nil nil)) - (goto-char (point-min)) - (while (re-search-forward "{.*=.*\n" nil t) - (replace-match "(structure);\n" nil nil)))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf (with-current-buffer buf - (let ((p (point)) - (buffer-read-only nil)) - (delete-region (point-min) (point-max)) - (insert-buffer-substring (gdb-get-create-buffer - 'gdb-partial-output-buffer)) - (goto-char p))))) - (run-hooks 'gdb-info-locals-hook)) - -(defun gdb-info-locals-custom () - nil) - -(defvar gdb-locals-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - map)) - -(defun gdb-locals-mode () - "Major mode for gdb locals. - -\\{gdb-locals-mode-map}" - (setq major-mode 'gdb-locals-mode) - (setq mode-name "Locals") - (setq buffer-read-only t) - (use-local-map gdb-locals-mode-map) - (gdb-invalidate-locals)) - -(defun gdb-locals-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*locals of " (gdb-get-target-string) "*"))) - -(defun gdb-display-locals-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-locals-buffer))) - -(defun gdb-frame-locals-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-locals-buffer))) - - -;;;; Window management - -;;; The way we abuse the dedicated-p flag is pretty gross, but seems -;;; to do the right thing. Seeing as there is no way for Lisp code to -;;; get at the use_time field of a window, I'm not sure there exists a -;;; more elegant solution without writing C code. - -(defun gdb-display-buffer (buf &optional size) - (let ((must-split nil) - (answer nil)) - (unwind-protect - (progn - (walk-windows - #'(lambda (win) - (if (or (eq gud-comint-buffer (window-buffer win)) - (eq gdb-source-window win)) - (set-window-dedicated-p win t)))) - (setq answer (get-buffer-window buf)) - (if (not answer) - (let ((window (get-lru-window))) - (if window - (progn - (set-window-buffer window buf) - (setq answer window)) - (setq must-split t))))) - (walk-windows - #'(lambda (win) - (if (or (eq gud-comint-buffer (window-buffer win)) - (eq gdb-source-window win)) - (set-window-dedicated-p win nil))))) - (if must-split - (let* ((largest (get-largest-window)) - (cur-size (window-height largest)) - (new-size (and size (< size cur-size) (- cur-size size)))) - (setq answer (split-window largest new-size)) - (set-window-buffer answer buf))) - answer)) - -(defun gdb-display-source-buffer (buffer) - (if (eq gdb-selected-view 'source) - (progn - (if (window-live-p gdb-source-window) - (set-window-buffer gdb-source-window buffer) - (gdb-display-buffer buffer) - (setq gdb-source-window (get-buffer-window buffer))) - gdb-source-window) - (if (window-live-p gdb-source-window) - (set-window-buffer gdb-source-window - (gdb-get-buffer 'gdb-assembler-buffer)) - (let ((buf (gdb-get-buffer 'gdb-assembler-buffer))) - (gdb-display-buffer buf) - (setq gdb-source-window (get-buffer-window buf)))) - nil)) - - -;;; Shared keymap initialization: - -(let ((menu (make-sparse-keymap "GDB-Frames"))) - (define-key gud-menu-map [frames] - `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) - (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) - (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) - (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) - (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) - (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) - (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) -; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) -) - -(let ((menu (make-sparse-keymap "GDB-Windows"))) - (define-key gud-menu-map [displays] - `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) - (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) - (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) - (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) - (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) - (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) - (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) -; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) -) - -(let ((menu (make-sparse-keymap "View"))) - (define-key gud-menu-map [view] - `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba))) -; (define-key menu [both] '(menu-item "Both" gdb-view-both -; :help "Display both source and assembler" -; :button (:radio . (eq gdb-selected-view 'both)))) - (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler - :help "Display assembler only" - :button (:radio . (eq gdb-selected-view 'assembler)))) - (define-key menu [source] '(menu-item "Source" gdb-view-source-function - :help "Display source only" - :button (:radio . (eq gdb-selected-view 'source))))) - -(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] - '("Restore window layout" . gdb-restore-windows)) - (define-key menu [gdb-many-windows] - (menu-bar-make-toggle gdb-many-windows gdb-many-windows - "Display other windows" "Many Windows %s" - "Display locals, stack and breakpoint information"))) - -(defun gdb-frame-gdb-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdba))) - -(defun gdb-display-gdb-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdba))) - -(defvar gdb-main-file nil "Source file from which program execution begins.") - -(defun gdb-view-source-function () - (interactive) - (if gdb-view-source - (if gud-last-last-frame - (set-window-buffer gdb-source-window - (gud-find-file (car gud-last-last-frame))) - (set-window-buffer gdb-source-window (gud-find-file gdb-main-file)))) - (setq gdb-selected-view 'source)) - -(defun gdb-view-assembler() - (interactive) - (set-window-buffer gdb-source-window - (gdb-get-create-buffer 'gdb-assembler-buffer)) - (setq gdb-selected-view 'assembler)) - -;(defun gdb-view-both() -;(interactive) -;(setq gdb-selected-view 'both)) - -;; layout for all the windows -(defun gdb-setup-windows () - (gdb-display-locals-buffer) - (gdb-display-stack-buffer) - (delete-other-windows) - (gdb-display-breakpoints-buffer) - (delete-other-windows) - (switch-to-buffer gud-comint-buffer) - (split-window nil ( / ( * (window-height) 3) 4)) - (split-window nil ( / (window-height) 3)) - (split-window-horizontally) - (other-window 1) - (switch-to-buffer (gdb-locals-buffer-name)) - (other-window 1) - (switch-to-buffer - (if (and gdb-view-source - (eq gdb-selected-view 'source)) - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file)) - (gdb-get-create-buffer 'gdb-assembler-buffer))) - (setq gdb-source-window (get-buffer-window (current-buffer))) - (split-window-horizontally) - (other-window 1) - (switch-to-buffer (gdb-inferior-io-name)) - (other-window 1) - (switch-to-buffer (gdb-stack-buffer-name)) - (split-window-horizontally) - (other-window 1) - (switch-to-buffer (gdb-breakpoints-buffer-name)) - (other-window 1)) - -(defcustom gdb-many-windows nil - "Nil means that gdb starts with just two windows : the GUD and -the source buffer." - :type 'boolean - :group 'gud) - -(defun gdb-many-windows (arg) -"Toggle the number of windows in the basic arrangement." - (interactive "P") - (setq gdb-many-windows - (if (null arg) - (not gdb-many-windows) - (> (prefix-numeric-value arg) 0))) - (gdb-restore-windows)) - -(defun gdb-restore-windows () - "Restore the basic arrangement of windows used by gdba. -This arrangement depends on the value of `gdb-many-windows'." - (interactive) - (if gdb-many-windows - (progn - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (gdb-setup-windows)) - (switch-to-buffer gud-comint-buffer) - (delete-other-windows) - (split-window) - (other-window 1) - (switch-to-buffer - (if (and gdb-view-source - (eq gdb-selected-view 'source)) - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file)) - (gdb-get-create-buffer 'gdb-assembler-buffer))) - (setq gdb-source-window (get-buffer-window (current-buffer))) - (other-window 1))) - -(defun gdb-reset () - "Exit a debugging session cleanly by killing the gdb buffers and resetting - the source buffers." - (dolist (buffer (buffer-list)) - (if (not (eq buffer gud-comint-buffer)) - (with-current-buffer buffer - (if (memq gud-minor-mode '(gdba pdb)) - (if (string-match "^\*.+*$" (buffer-name)) - (kill-buffer nil) - (gdb-remove-breakpoint-icons (point-min) (point-max) t) - (setq gud-minor-mode nil) - (kill-local-variable 'tool-bar-map) - (setq gud-running nil)))))) - (when (markerp gdb-overlay-arrow-position) - (move-marker gdb-overlay-arrow-position nil) - (setq gdb-overlay-arrow-position nil)) - (setq overlay-arrow-variable-list - (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))) - -(defun gdb-source-info () - "Find the source file where the program starts and displays it with related -buffers." - (goto-char (point-min)) - (if (search-forward "directory is " nil t) - (if (looking-at "\\S-*:\\(\\S-*\\)") - (setq gdb-cdir (match-string 1)) - (looking-at "\\S-*") - (setq gdb-cdir (match-string 0)))) - (if (search-forward "Located in " nil t) - (if (looking-at "\\S-*") - (setq gdb-main-file (match-string 0))) - (setq gdb-view-source nil)) - (delete-other-windows) - (switch-to-buffer gud-comint-buffer) - (if gdb-many-windows - (gdb-setup-windows) - (gdb-display-breakpoints-buffer) - (delete-other-windows) - (split-window) - (other-window 1) - (switch-to-buffer - (if gdb-view-source - (gud-find-file gdb-main-file) - (gdb-get-create-buffer 'gdb-assembler-buffer))) - (setq gdb-source-window (get-buffer-window (current-buffer))) - (other-window 1))) - -;;from put-image -(defun gdb-put-string (putstring pos &optional dprop) - "Put string PUTSTRING in front of POS in the current buffer. -PUTSTRING is displayed by putting an overlay into the current buffer with a -`before-string' STRING that has a `display' property whose value is -PUTSTRING." - (let ((gdb-string "x") - (buffer (current-buffer))) - (let ((overlay (make-overlay pos pos buffer)) - (prop (or dprop - (list (list 'margin 'left-margin) putstring)))) - (put-text-property 0 (length gdb-string) 'display prop gdb-string) - (overlay-put overlay 'put-break t) - (overlay-put overlay 'before-string gdb-string)))) - -;;from remove-images -(defun gdb-remove-strings (start end &optional buffer) - "Remove strings between START and END in BUFFER. -Remove only strings that were put in BUFFER with calls to `gdb-put-string'. -BUFFER nil or omitted means use the current buffer." - (unless buffer - (setq buffer (current-buffer))) - (let ((overlays (overlays-in start end))) - (while overlays - (let ((overlay (car overlays))) - (when (overlay-get overlay 'put-break) - (delete-overlay overlay))) - (setq overlays (cdr overlays))))) - -(defun gdb-put-breakpoint-icon (enabled) - (let ((start (progn (beginning-of-line) (- (point) 1))) - (end (progn (end-of-line) (+ (point) 1)))) - (gdb-remove-breakpoint-icons start end) - (if (display-images-p) - (if (>= (car (window-fringes)) 8) - (gdb-put-string - nil (1+ start) - `(left-fringe - ,(or breakpoint-bitmap - (setq breakpoint-bitmap - (define-fringe-bitmap - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c"))) - ,(if enabled - 'breakpoint-enabled-bitmap-face - 'breakpoint-disabled-bitmap-face))) - (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) - (put-image - (if enabled - (or breakpoint-enabled-icon - (setq breakpoint-enabled-icon - (find-image `((:type xpm :data - ,breakpoint-xpm-data - :ascent 100 :pointer hand) - (:type pbm :data - ,breakpoint-enabled-pbm-data - :ascent 100 :pointer hand))))) - (or breakpoint-disabled-icon - (setq breakpoint-disabled-icon - (find-image `((:type xpm :data - ,breakpoint-xpm-data - :conversion disabled - :ascent 100) - (:type pbm :data - ,breakpoint-disabled-pbm-data - :ascent 100)))))) - (+ start 1) nil 'left-margin)) - (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) - (gdb-put-string (if enabled "B" "b") (1+ start))))) - -(defun gdb-remove-breakpoint-icons (start end &optional remove-margin) - (gdb-remove-strings start end) - (if (display-images-p) - (remove-images start end)) - (when remove-margin - (setq left-margin-width 0) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) - - -;; -;; Assembler buffer. -;; -(gdb-set-buffer-rules 'gdb-assembler-buffer - 'gdb-assembler-buffer-name - 'gdb-assembler-mode) - -(def-gdb-auto-updated-buffer gdb-assembler-buffer - gdb-invalidate-assembler - (concat "server disassemble " gdb-current-address "\n") - gdb-assembler-handler - gdb-assembler-custom) - -(defun gdb-assembler-custom () - (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) - (pos 1) (address) (flag)) - (with-current-buffer buffer - (if (not (equal gdb-current-address "main")) - (progn - (goto-char (point-min)) - (if (re-search-forward gdb-current-address nil t) - (progn - (setq pos (point)) - (beginning-of-line) - (or gdb-overlay-arrow-position - (setq gdb-overlay-arrow-position (make-marker))) - (set-marker gdb-overlay-arrow-position - (point) (current-buffer)))))) - ;; remove all breakpoint-icons in assembler buffer before updating. - (gdb-remove-breakpoint-icons (point-min) (point-max))) - (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at "[^\t].*breakpoint") - (progn - (looking-at - "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)") - (setq flag (char-after (match-beginning 1))) - (setq address (match-string 2)) - ;; remove leading 0s from output of info break. - (if (string-match "^0+\\(.*\\)" address) - (setq address (match-string 1 address))) - (with-current-buffer buffer - (goto-char (point-min)) - (if (re-search-forward address nil t) - (gdb-put-breakpoint-icon (eq flag ?y)))))))) - (if (not (equal gdb-current-address "main")) - (set-window-point (get-buffer-window buffer) pos)))) - -(defvar gdb-assembler-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - map)) - -(defun gdb-assembler-mode () - "Major mode for viewing code assembler. - -\\{gdb-assembler-mode-map}" - (setq major-mode 'gdb-assembler-mode) - (setq mode-name "Machine") - (setq gdb-overlay-arrow-position nil) - (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) - (put 'gdb-overlay-arrow-position 'overlay-arrow-string "=>") - (setq fringes-outside-margins t) - (setq buffer-read-only t) - (use-local-map gdb-assembler-mode-map) - (gdb-invalidate-assembler)) - -(defun gdb-assembler-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*Machine Code " (gdb-get-target-string) "*"))) - -(defun gdb-display-assembler-buffer () - (interactive) - (gdb-display-buffer - (gdb-get-create-buffer 'gdb-assembler-buffer))) - -(defun gdb-frame-assembler-buffer () - (interactive) - (switch-to-buffer-other-frame - (gdb-get-create-buffer 'gdb-assembler-buffer))) - -;; modified because if gdb-current-address has changed value a new command -;; must be enqueued to update the buffer with the new output -(defun gdb-invalidate-assembler (&optional ignored) - (if (gdb-get-buffer 'gdb-assembler-buffer) - (progn - (unless (string-equal gdb-current-frame gdb-previous-frame) - (if (or (not (member 'gdb-invalidate-assembler - (gdb-get-pending-triggers))) - (not (string-equal gdb-current-address - gdb-previous-address))) - (progn - ;; take previous disassemble command off the queue - (with-current-buffer gud-comint-buffer - (let ((queue (gdb-get-input-queue)) (item)) - (dolist (item queue) - (if (equal (cdr item) '(gdb-assembler-handler)) - (gdb-set-input-queue - (delete item (gdb-get-input-queue))))))) - (gdb-enqueue-input - (list (concat "server disassemble " gdb-current-address "\n") - 'gdb-assembler-handler)) - (gdb-set-pending-triggers - (cons 'gdb-invalidate-assembler - (gdb-get-pending-triggers))) - (setq gdb-previous-address gdb-current-address) - (setq gdb-previous-frame gdb-current-frame))))))) - -(defun gdb-get-current-frame () - (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers))) - (progn - (gdb-enqueue-input - (list (concat "server info frame\n") 'gdb-frame-handler)) - (gdb-set-pending-triggers - (cons 'gdb-get-current-frame - (gdb-get-pending-triggers)))))) - -(defun gdb-frame-handler () - (gdb-set-pending-triggers - (delq 'gdb-get-current-frame (gdb-get-pending-triggers))) - (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (forward-line) - (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*\\)") - (progn - (setq gdb-current-frame (match-string 2)) - (let ((address (match-string 1))) - ;; remove leading 0s from output of info frame command. - (if (string-match "^0+\\(.*\\)" address) - (setq gdb-current-address - (concat "0x" (match-string 1 address))) - (setq gdb-current-address (concat "0x" address)))) - (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t)) - (progn (setq gdb-view-source nil) t)) - (eq gdb-selected-view 'assembler)) - (progn - (set-window-buffer - gdb-source-window - (gdb-get-create-buffer 'gdb-assembler-buffer)) - ;;update with new frame for machine code if necessary - (gdb-invalidate-assembler)))))) - (if (re-search-forward " source language \\(\\S-*\\)\." nil t) - (setq gdb-current-language (match-string 1)))) - -(provide 'gdb-ui) - -;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 -;;; gdb-ui.el ends here
--- a/lisp/gnus/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/gnus/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,16 @@ +2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-art.el: Use inhibit-read-only instead of buffer-read-only. + (gnus-narrow-to-page): Don't assume point-min == 1. + (gnus-article-edit-mode): Derive from message-mode. + (gnus-button-alist): Add buttons to (info "(emacs)Keymaps"). + + * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume + point-min == 1. + + * imap.el (imap-parse-address-list, imap-parse-body-ext): + Disable incorrect use of `assert'. + 2004-03-05 Stefan Monnier <monnier@iro.umontreal.ca> * message.el (message-mode): Fix last change.
--- a/lisp/gnus/gnus-art.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/gnus/gnus-art.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 97, 98, 1999, 2000, 01, 02, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1142,7 +1142,7 @@ (unless gnus-inhibit-hiding (save-excursion (save-restriction - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (case-fold-search t) (max (1+ (length gnus-sorted-header-list))) (ignored (when (not gnus-visible-headers) @@ -1200,7 +1200,7 @@ (not gnus-show-all-headers)) (save-excursion (save-restriction - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (list gnus-boring-article-headers) (inhibit-point-motion-hooks t) elem) @@ -1303,7 +1303,7 @@ (defun article-normalize-headers () "Make all header lines 40 characters long." (interactive) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) column) (save-excursion (save-restriction @@ -1346,7 +1346,7 @@ characters to translate to." (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (x (make-string 225 ?x)) (i -1)) (while (< (incf i) (length x)) @@ -1362,7 +1362,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) elem) (while (setq elem (pop map)) (save-excursion @@ -1374,7 +1374,7 @@ (interactive) (save-excursion (when (article-goto-body) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (while (search-forward "\b" nil t) (let ((next (char-after)) (previous (char-after (- (point) 2)))) @@ -1399,7 +1399,7 @@ "Fill lines that are wider than the window width." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (width (window-width (get-buffer-window (current-buffer))))) (save-restriction (article-goto-body) @@ -1417,7 +1417,7 @@ "Capitalize the first word in each sentence." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (paragraph-start "^[\n\^L]")) (article-goto-body) (while (not (eobp)) @@ -1428,7 +1428,7 @@ "Remove trailing CRs and then translate remaining CRs into LFs." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) @@ -1440,7 +1440,7 @@ "Remove all trailing blank lines from the article." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-max)) (delete-region (point) @@ -1583,7 +1583,7 @@ or not." (interactive (list 'force)) (save-excursion - (let ((buffer-read-only nil) type charset) + (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq type @@ -1610,7 +1610,7 @@ If FORCE, decode the article whether it is marked as base64 not." (interactive (list 'force)) (save-excursion - (let ((buffer-read-only nil) type charset) + (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq type @@ -1643,14 +1643,14 @@ (interactive) (require 'rfc1843) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (rfc1843-decode-region (point-min) (point-max))))) (defun article-wash-html () "Format an html article." (interactive) (save-excursion - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) charset) (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer @@ -1794,7 +1794,7 @@ (save-excursion (set-buffer gnus-article-buffer) (when (article-goto-body) - (let* ((buffer-read-only nil) + (let* ((inhibit-read-only t) (start (point)) (end (point-max)) (orig (buffer-substring start end)) @@ -1812,7 +1812,7 @@ (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (save-restriction - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (when (gnus-article-narrow-to-signature) (gnus-article-hide-text-type (point-min) (point-max) 'signature))))))) @@ -2001,7 +2001,7 @@ (defun gnus-article-show-hidden-text (type &optional dummy) "Show all hidden text of type TYPE. Originally it is hide instead of DUMMY." - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t)) (gnus-remove-text-properties-when 'article-type type @@ -2054,7 +2054,7 @@ (forward-line 1)) (when (and date (not (string= date ""))) (goto-char (point-min)) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) ;; Delete any old Date headers. (while (re-search-forward date-regexp nil t) (if pos @@ -2238,7 +2238,7 @@ "Show all hidden text in the article buffer." (interactive) (save-excursion - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (gnus-article-unhide-text (point-min) (point-max))))) (defun article-emphasize (&optional arg) @@ -2252,7 +2252,7 @@ gnus-article-emphasis-alist) (error)) gnus-emphasis-alist)) - (buffer-read-only nil) + (inhibit-read-only t) (props (append '(article-type emphasis) gnus-hidden-properties)) regexp elem beg invisible visible face) @@ -2837,7 +2837,7 @@ (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) + (if (not (setq result (let ((inhibit-read-only t)) (gnus-request-article-this-buffer article group)))) ;; There is no such article. @@ -3671,7 +3671,7 @@ (widen) ;; Remove any old next/prev buttons. (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) (when @@ -3686,12 +3686,12 @@ (match-beginning 0) (point))) (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) + (> (point-min) (save-restriction (widen) (point-min)))) (save-excursion (goto-char (point-min)) (gnus-insert-prev-page-button))) (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) + (< (point-max) (save-restriction (widen) (point-max)))) (save-excursion (goto-char (point-max)) (gnus-insert-next-page-button))))) @@ -4044,7 +4044,7 @@ (methods (and (stringp article) gnus-refer-article-method)) result - (buffer-read-only nil)) + (inhibit-read-only t)) (if (or (not (listp methods)) (and (symbolp (car methods)) (assq (car methods) nnoo-definition-alist))) @@ -4140,7 +4140,7 @@ "\C-c\C-w" gnus-article-edit-mode-map) "f" gnus-article-edit-full-stops)) -(define-derived-mode gnus-article-edit-mode text-mode "Article Edit" +(define-derived-mode gnus-article-edit-mode message-mode "Article Edit" "Major mode for editing articles. This is an extended text-mode. @@ -4212,7 +4212,7 @@ (gnus-article-edit-exit) (save-excursion (set-buffer buf) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (funcall func arg)) ;; The cache and backlog have to be flushed somewhat. (when gnus-keep-backlog @@ -4289,6 +4289,9 @@ ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1) + ;; Info manual references. + ("(\\(info\\|Info-goto-node\\)[ \n\t]+\"\\(([^)\"\n]+)[^\"\n]+\\)\")" + 0 t Info-goto-node 2) ;; Raw URLs. (,gnus-button-url-regexp 0 t browse-url 0)) "*Alist of regexps matching buttons in article bodies. @@ -4296,7 +4299,7 @@ Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a lisp expression which must eval to true for the button to +FORM: is a Lisp expression which must eval to true for the button to be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. @@ -4405,7 +4408,7 @@ (set-buffer gnus-article-buffer) (save-restriction (let ((alist gnus-header-face-alist) - (buffer-read-only nil) + (inhibit-read-only t) (case-fold-search t) (inhibit-point-motion-hooks t) entry regexp header-face field-face from hpoints fpoints) @@ -4444,7 +4447,7 @@ (interactive) (save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face @@ -4469,7 +4472,7 @@ (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) @@ -4514,7 +4517,7 @@ (save-excursion (set-buffer gnus-article-buffer) (save-restriction - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-header-button-alist) @@ -4572,7 +4575,7 @@ (defun gnus-signature-toggle (end) (save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (inhibit-point-motion-hooks t)) (if (text-property-any end (point-max) 'article-type 'signature) (gnus-remove-text-properties-when @@ -4737,7 +4740,7 @@ (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map @@ -4768,7 +4771,7 @@ (select-window win))) (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (gnus-eval-format gnus-next-page-line-format nil `(gnus-next t local-map ,gnus-next-page-map @@ -4796,8 +4799,8 @@ "List of methods used to decode headers. This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item -is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to these newsgroups +is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a +\(REGEXP . FUNCTION), FUNCTION will be only applied to these newsgroups whose names match REGEXP. For example:
--- a/lisp/gnus/gnus-score.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/gnus/gnus-score.el Thu Mar 25 22:21:45 2004 +0000 @@ -2586,13 +2586,11 @@ (replace-match ".*" t t)) (goto-char (point-min)) ;; Deal with "not."s. - (if (looking-at "not.") - (progn - (setq not-match t) - (setq regexp - (concat "^" (buffer-substring 5 (point-max)) "$"))) - (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$")) - (setq not-match nil)) + (setq not-match (looking-at "not.")) + (setq regexp + (concat "^" (buffer-substring (+ (point-min) (if not-match 4 0)) + (point-max)) + "$")) ;; Finally - if this resulting regexp matches the group name, ;; we add this score file to the list of score files ;; applicable to this group.
--- a/lisp/gnus/imap.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/gnus/imap.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,5 +1,5 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas@pdc.kth.se> @@ -1803,7 +1803,8 @@ (when (eq (char-after) ?\)) (imap-forward) (nreverse addresses))) - (assert (imap-parse-nil)))) + ;; (assert (imap-parse-nil)) ; With assert, the code might not be eval'd. + (imap-parse-nil))) ;; mailbox = "INBOX" / astring ;; ; INBOX is case-insensitive. All case variants of @@ -2343,7 +2344,8 @@ (imap-forward) (push (imap-parse-string-list) dsp) (imap-forward)) - (assert (imap-parse-nil))) + ;; (assert (imap-parse-nil)) ; Code in assert might not be eval'd. + (imap-parse-nil)) (push (nreverse dsp) ext)) (when (eq (char-after) ?\ );; body-fld-lang (imap-forward)
--- a/lisp/help-at-pt.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/help-at-pt.el Thu Mar 25 22:21:45 2004 +0000 @@ -40,6 +40,11 @@ ;; previous region with available local help and print the help found ;; there. ;; +;; Suggested key bindings: +;; +;; (global-set-key [C-tab] 'scan-buf-next-region) +;; (global-set-key [C-M-tab] 'scan-buf-previous-region) +;; ;; You do not have to do anything special to use the functionality ;; provided by this file, because all important functions autoload. @@ -346,11 +351,6 @@ (defvar help-at-pt-unload-hook '(help-at-pt-cancel-timer) "Normal hook run when `help-at-pt' is unloaded.") -;; Suggested key bindings: -;; -;; (global-set-key [C-tab] 'scan-buf-next-region) -;; (global-set-key [C-M-tab] 'scan-buf-previous-region) - (provide 'help-at-pt) ;;; arch-tag: d0b8b86d-d23f-45d0-a82d-208d6205a583
--- a/lisp/hexl.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/hexl.el Thu Mar 25 22:21:45 2004 +0000 @@ -900,7 +900,6 @@ (defun hexl-follow-line () "Activate `hl-line-mode'" (require 'frame) - (require 'fringe) (require 'hl-line) (set (make-local-variable 'hl-line-range-function) 'hexl-highlight-line-range) @@ -927,11 +926,8 @@ (defun hexl-mode-ruler () "Return a string ruler for hexl mode." (let* ((highlight (mod (hexl-current-address) 16)) - (s "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef") - (pos 0) - (spaces (+ (scroll-bar-columns 'left) - (fringe-columns 'left) - (or (car (window-margins)) 0)))) + (s " 87654321 0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef") + (pos 0)) (set-text-properties 0 (length s) nil s) ;; Turn spaces in the header into stretch specs so they work ;; regardless of the header-line face. @@ -939,21 +935,16 @@ (setq pos (match-end 0)) (put-text-property (match-beginning 0) pos 'display ;; Assume fixed-size chars - `(space :align-to (+ (scroll-bar . left) - left-fringe left-margin - ,pos)) + `(space :align-to ,(1- pos)) s)) ;; Highlight the current column. - (put-text-property (+ 10 (/ (* 5 highlight) 2)) - (+ 12 (/ (* 5 highlight) 2)) + (put-text-property (+ 11 (/ (* 5 highlight) 2)) + (+ 13 (/ (* 5 highlight) 2)) 'face 'highlight s) ;; Highlight the current ascii column - (put-text-property (+ 12 39 highlight) (+ 12 40 highlight) + (put-text-property (+ 13 39 highlight) (+ 13 40 highlight) 'face 'highlight s) - ;; Add the leading space. - (concat (propertize (make-string (floor spaces) ? ) - 'display `(space :width ,spaces)) - s))) + s)) ;; startup stuff.
--- a/lisp/info-xref.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/info-xref.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,27 +1,27 @@ -;;; info-xref.el --- check external references in an Info document. +;;; info-xref.el --- check external references in an Info document -;; Copyright 2003 Free Software Foundation, Inc -;; +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. + ;; Author: Kevin Ryde <user42@zip.com.au> ;; Keywords: docs -;; -;; info-xref.el is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by the -;; Free Software Foundation; either version 2, or (at your option) any later -;; version. -;; -;; info-xref.el is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -;; Public License for more details. -;; -;; You can get a copy of the GNU General Public License online at -;; http://www.gnu.org/licenses/gpl.txt, or you should have one in the file -;; COPYING which comes with GNU Emacs and other GNU programs. Failing that, -;; write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. - ;;; Commentary: ;; This file implements some simple checking of external cross references in @@ -59,31 +59,10 @@ ;; this is that if for instance there's a source code directory in ;; `Info-directory-list' then a lot of extraneous files might be read, which ;; will be time consuming but should be harmless. - - -;;; Install: - -;; Put info-xref.el somewhere in your `load-path', and in your .emacs put ;; -;; (autoload 'info-xref-check "info-xref" nil t) -;; (autoload 'info-xref-check-all "info-xref" nil t) -;; -;; then -;; -;; M-x info-xref-check -;; -;; and enter an info file name. - - -;;; Emacsen: - -;; Designed for use with GNU Emacs 21. - - -;;; History: - -;; Version 1 - the first version. - +;; `M-x info-xref-check-all-custom' is a related command, it goes through +;; all info document references in customizable variables, checking them +;; like info file cross references. ;;; Code: @@ -204,32 +183,37 @@ This should be the raw file contents, not `Info-mode'." (goto-char (point-min)) (while (re-search-forward - "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]+)\\)[^.,]+\\)[.,]" + "\\*[Nn]ote[ \n\t]+[^:]*:[ \n\t]+\\(\\(([^)]*)\\)[^.,]+\\)[.,]" nil t) (let* ((file (match-string 2)) (node ;; Canonicalize spaces: we could use "[\t\n ]+" but ;; we try to avoid uselessly replacing " " with " ". (replace-regexp-in-string "[\t\n][\t\n ]*\\| [\t\n ]+" " " (match-string 1) t t))) - ;; see if the file exists, if we haven't tried it before - (unless (assoc file info-xref-xfile-alist) - (let ((found (info-xref-goto-node-p file))) - (push (cons file found) info-xref-xfile-alist) - (unless found - (info-xref-output (format "Not available to check: %s\n" file))))) - ;; if the file exists, try the node, if we haven't before - (when (cdr (assoc file info-xref-xfile-alist)) - (unless (assoc node info-xref-xfile-alist) + (if (string-equal "()" file) + (info-xref-output "Empty filename part: %s\n" node) + ;; see if the file exists, if we haven't tried it before + (unless (assoc file info-xref-xfile-alist) + (let ((found (info-xref-goto-node-p file))) + (push (cons file found) info-xref-xfile-alist) + (unless found + (info-xref-output "Not available to check: %s\n" file)))) + ;; if the file exists, try the node + (when (cdr (assoc file info-xref-xfile-alist)) (if (info-xref-goto-node-p node) (setq info-xref-good (1+ info-xref-good)) (setq info-xref-bad (1+ info-xref-bad)) - (info-xref-output (format "No such node: %s\n" node)))))))) + (info-xref-output "No such node: %s\n" node))))))) -(defun info-xref-output (str) - "Emit STR as an info-xref result message." +(defun info-xref-output (str &rest args) + "Emit a `format'-ed message STR+ARGS to the info-xref output buffer." (with-current-buffer info-xref-results-buffer - (insert info-xref-filename-heading str) - (setq info-xref-filename-heading ""))) + (insert info-xref-filename-heading + (apply 'format str args)) + (setq info-xref-filename-heading "") + ;; all this info-xref can be pretty slow, display now so the user can + ;; see some progress + (sit-for 0))) ;; When asking Info-goto-node to fork, *info* needs to be the current ;; buffer, otherwise it seems to clone the current buffer but then do the @@ -259,6 +243,67 @@ (unless (equal (current-buffer) oldbuf) (kill-buffer (current-buffer)))))))) +;;;###autoload +(defun info-xref-check-all-custom () + "Check info references in all customize groups and variables. +`custom-manual' and `info-link' entries in the `custom-links' list are checked. + +`custom-load' autoloads for all symbols are loaded in order to get all the +link information. This will be a lot of lisp packages loaded, and can take +quite a while." + + (interactive) + (pop-to-buffer info-xref-results-buffer t) + (erase-buffer) + (let ((info-xref-filename-heading "")) + + ;; `custom-load-symbol' is not used, since it quietly ignores errors, + ;; but we want to show them (since they may mean incomplete checking). + ;; + ;; Just one pass through mapatoms is made. There shouldn't be any new + ;; custom-loads setup by packages loaded. + ;; + (info-xref-output "Loading custom-load autoloads ...\n") + (require 'cus-start) + (require 'cus-load) + (let ((viper-mode nil)) ;; tell viper.el not to ask about viperizing + (mapatoms + (lambda (symbol) + (dolist (load (get symbol 'custom-loads)) + (cond ((symbolp load) + (condition-case cause (require load) + (error + (info-xref-output "Symbol `%s': cannot require '%s: %s\n" + symbol load cause)))) + ;; skip if previously loaded + ((assoc load load-history)) + ((assoc (locate-library load) load-history)) + (t + (condition-case cause (load load) + (error + (info-xref-output "Symbol `%s': cannot load \"%s\": %s\n" + symbol load cause))))))))) + + ;; Don't bother to check whether the info file exists as opposed to just + ;; a missing node. If you have the lisp then you should have the + ;; documentation, so missing node name will be the usual fault. + ;; + (info-xref-output "\nChecking custom-links references ...\n") + (let ((good 0) + (bad 0)) + (mapatoms + (lambda (symbol) + (dolist (link (get symbol 'custom-links)) + (when (memq (car link) '(custom-manual info-link)) + (if (info-xref-goto-node-p (cadr link)) + (setq good (1+ good)) + (setq bad (1+ bad)) + ;; symbol-file gives nil for preloaded variables, would need + ;; to copy what describe-variable does to show the right place + (info-xref-output "Symbol `%s' (in %s): cannot goto node: %s\n" + symbol (symbol-file symbol) (cadr link))))))) + (info-xref-output "%d good, %d bad\n" good bad)))) + (provide 'info-xref) ;;; arch-tag: 69d4d528-69ed-4cc2-8eb4-c666a0c1d5ac
--- a/lisp/info.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/info.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,7 +1,6 @@ ;;; info.el --- info package for Emacs -;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, -;; 2002, 2003 +;; Copyright (C) 1985,86,92,93,94,95,96,97,98,99,2000,01,02,03,2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -387,7 +386,9 @@ ;; version, so we should look there first. `Info-insert-dir' ;; currently expects to find `alternative' first on the list. (cons alternative - (reverse (cdr (reverse Info-default-directory-list))))))) + ;; Don't drop the last part, it might contain non-Emacs stuff. + ;; (reverse (cdr (reverse + Info-default-directory-list)))) ;; ))) (defun info-initialize () "Initialize `Info-directory-list', if that hasn't been done yet."
--- a/lisp/international/characters.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/international/characters.el Thu Mar 25 22:21:45 2004 +0000 @@ -153,21 +153,6 @@ (modify-syntax-entry ?\$A#)(B ")$A#((B") (modify-syntax-entry ?\$A#}(B ")$A#{(B") (modify-syntax-entry ?\$A#](B ")$A#[(B") -;; Unicode equivalents of above -(modify-syntax-entry ?\$,2=T(B "($,2=U(B") -(modify-syntax-entry ?\$,2=H(B "($,2=I(B") -(modify-syntax-entry ?\$,2=J(B "($,2=K(B") -(modify-syntax-entry ?\$,2=L(B "($,2=M(B") -(modify-syntax-entry ?\$,2=N(B "($,2=O(B") -(modify-syntax-entry ?\$,2=V(B "($,2=W(B") -(modify-syntax-entry ?\$,2=P(B "($,2=Q(B") -(modify-syntax-entry ?\$,2=U(B ")$,2=T(B") -(modify-syntax-entry ?\$,2=I(B ")$,2=H(B") -(modify-syntax-entry ?\$,2=K(B ")$,2=J(B") -(modify-syntax-entry ?\$,2=M(B ")$,2=L(B") -(modify-syntax-entry ?\$,2=O(B ")$,2=N(B") -(modify-syntax-entry ?\$,2=W(B ")$,2=V(B") -(modify-syntax-entry ?\$,2=Q(B ")$,2=P(B") (let ((chars "$A#,!"!##.!$#;#:#?#!!C!-!'#|#_!.!/!0!1#"!e#`!d(B")) (dotimes (i (length chars)) @@ -187,8 +172,6 @@ ;; Chinese character set (BIG5) - - (let ((from (decode-big5-char #xA141)) (to (decode-big5-char #xA15D))) (while (< from to) @@ -1141,6 +1124,67 @@ ;; Fixme: syntax for symbols &c ) + +(let ((pairs + '("$,1sEsF(B" ; U+2045 U+2046 + "$,1s}s~(B" ; U+207D U+207E + "$,1t-t.(B" ; U+208D U+208E + "$,1zhzi(B" ; U+2308 U+2309 + "$,1zjzk(B" ; U+230A U+230B + "$,1{){*(B" ; U+2329 U+232A + "$,1|T|U(B" ; U+23B4 U+23B5 + "$,2&H&I(B" ; U+2768 U+2769 + "$,2&J&K(B" ; U+276A U+276B + "$,2&L&M(B" ; U+276C U+276D + "$,2&P&Q(B" ; U+2770 U+2771 + "$,2&R&S(B" ; U+2772 U+2773 + "$,2&T&U(B" ; U+2774 U+2775 + "$,2'f'g(B" ; U+27E6 U+27E7 + "$,2'h'i(B" ; U+27E8 U+27E9 + "$,2'j'k(B" ; U+27EA U+27EB + "$,2,#,$(B" ; U+2983 U+2984 + "$,2,%,&(B" ; U+2985 U+2986 + "$,2,',((B" ; U+2987 U+2988 + "$,2,),*(B" ; U+2989 U+298A + "$,2,+,,(B" ; U+298B U+298C + "$,2,-,.(B" ; U+298D U+298E + "$,2,/,0(B" ; U+298F U+2990 + "$,2,1,2(B" ; U+2991 U+2992 + "$,2,3,4(B" ; U+2993 U+2994 + "$,2,5,6(B" ; U+2995 U+2996 + "$,2,7,8(B" ; U+2997 U+2998 + "$,2-<-=(B" ; U+29FC U+29FD + "$,2=H=I(B" ; U+3008 U+3009 + "$,2=J=K(B" ; U+300A U+300B + "$,2=L=M(B" ; U+300C U+300D + "$,2=N=O(B" ; U+300E U+300F + "$,2=P=Q(B" ; U+3010 U+3011 + "$,2=T=U(B" ; U+3014 U+3015 + "$,2=V=W(B" ; U+3016 U+3017 + "$,2=X=Y(B" ; U+3018 U+3019 + "$,2=Z=[(B" ; U+301A U+301B + "$,3m~m(B" ; U+FD3E U+FD3F + "$,3pUpV(B" ; U+FE35 U+FE36 + "$,3pWpX(B" ; U+FE37 U+FE38 + "$,3pYpZ(B" ; U+FE39 U+FE3A + "$,3p[p\(B" ; U+FE3B U+FE3C + "$,3p]p^(B" ; U+FE3D U+FE3E + "$,3p_p`(B" ; U+FE3F U+FE40 + "$,3papb(B" ; U+FE41 U+FE42 + "$,3pcpd(B" ; U+FE43 U+FE44 + "$,3pypz(B" ; U+FE59 U+FE5A + "$,3p{p|(B" ; U+FE5B U+FE5C + "$,3p}p~(B" ; U+FE5D U+FE5E + "$,3rhri(B" ; U+FF08 U+FF09 + "$,3s;s=(B" ; U+FF3B U+FF3D + "$,3s[s](B" ; U+FF5B U+FF5D + "$,3s_s`(B" ; U+FF5F U+FF60 + "$,3sbsc(B" ; U+FF62 U+FF63 + ))) + (dolist (elt pairs) + (modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1))) + (modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0))))) + ;;; Setting word boundary.
--- a/lisp/international/mule-cmds.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/international/mule-cmds.el Thu Mar 25 22:21:45 2004 +0000 @@ -926,13 +926,33 @@ (goto-char (point-min)) (set-auto-coding (or file buffer-file-name "") (buffer-size)))))) - (if (and auto-cs coding-system + ;; Merge coding-system and auto-cs as far as possible. + (if (not coding-system) + (setq coding-system auto-cs) + (if (not auto-cs) + (setq auto-cs coding-system) + (let ((eol-type-1 (coding-system-eol-type coding-system)) + (eol-type-2 (coding-system-eol-type auto-cs))) + (if (eq (coding-system-base coding-system) 'undecided) + (setq coding-system (coding-system-change-text-conversion + coding-system auto-cs)) + (if (eq (coding-system-base auto-cs) 'undecided) + (setq auto-cs (coding-system-change-text-conversion + auto-cs coding-system)))) + (if (vectorp eol-type-1) + (or (vectorp eol-type-2) + (setq coding-system (coding-system-change-eol-conversion + coding-system eol-type-2))) + (if (vectorp eol-type-2) + (setq auto-cs (coding-system-change-eol-conversion + auto-cs eol-type-1))))))) + + (if (and auto-cs ;; Don't barf if writing a compressed file, say. ;; This check perhaps isn't ideal, but is probably ;; the best thing to do. (not (auto-coding-alist-lookup (or file buffer-file-name ""))) - (not (coding-system-equal (coding-system-base coding-system) - (coding-system-base auto-cs)))) + (not (coding-system-equal coding-system auto-cs))) (unless (yes-or-no-p (format "Selected encoding %s disagrees with \ %s specified by file contents. Really save (else edit coding cookies \
--- a/lisp/international/mule-diag.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/international/mule-diag.el Thu Mar 25 22:21:45 2004 +0000 @@ -845,7 +845,7 @@ (setq codings (cons x codings)))) (get (car categories) 'coding-systems)) (if codings - (let ((max-col (frame-width)) + (let ((max-col (window-width)) pos) (princ (format "\ The following are decoded correctly but recognized as %s:\n "
--- a/lisp/international/mule.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/international/mule.el Thu Mar 25 22:21:45 2004 +0000 @@ -1249,7 +1249,7 @@ On non-windowing terminals, this is set from the locale by default. Setting this variable directly does not take effect; -use either M-x customize or \\[set-keyboard-coding-system]." +use either \\[customize] or \\[set-keyboard-coding-system]." :type '(coding-system :tag "Coding system") :link '(info-link "(emacs)Specify Coding") :link '(info-link "(emacs)Single-Byte Character Support")
--- a/lisp/international/quail.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/international/quail.el Thu Mar 25 22:21:45 2004 +0000 @@ -2289,8 +2289,8 @@ (or (> (length x) (length y)) (and (= (length x) (length y)) (not (string< x y)))))))) - (let ((frame-width (frame-width (window-frame (get-buffer-window - (current-buffer) 'visible)))) + (let ((window-width (window-width (get-buffer-window + (current-buffer) 'visible))) (single-key-width 3) (single-trans-width 4) (multiple-key-width 3) @@ -2319,7 +2319,7 @@ (setq multiple-key-width width))) (when single-list (setq col-width (+ single-key-width 1 single-trans-width 1) - cols (/ frame-width col-width) + cols (/ window-width col-width) rows (/ (length single-list) cols)) (if (> (% (length single-list) cols) 0) (setq rows (1+ rows))) @@ -2365,7 +2365,7 @@ (lambda (x) (let ((width (if (integerp x) (char-width x) (string-width x)))) - (when (> (+ (current-column) 1 width) frame-width) + (when (> (+ (current-column) 1 width) window-width) (insert "\n") (indent-to multiple-key-width)) (insert " " x)))) @@ -2402,7 +2402,7 @@ (with-current-buffer standard-output (setq quail-current-package package-def)))) ;; Then, insert text in the help buffer while paying attention to - ;; the width of the frame in which the buffer displayed. + ;; the width of the window in which the buffer displayed. (with-current-buffer (help-buffer) (setq buffer-read-only nil) (insert "Input method: " (quail-name)
--- a/lisp/jit-lock.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/jit-lock.el Thu Mar 25 22:21:45 2004 +0000 @@ -60,7 +60,6 @@ (defgroup jit-lock nil "Font Lock support mode to fontify just-in-time." - :link '(custom-manual "(emacs)Support Modes") :version "21.1" :group 'font-lock)
--- a/lisp/jka-compr.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/jka-compr.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; jka-compr.el --- reading/writing/loading compressed files -;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Maintainer: FSF @@ -138,6 +138,10 @@ "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil t "BZh"] + ["\\.tbz\\'" + "bzip2ing" "bzip2" nil + "bunzip2ing" "bzip2" ("-d") + nil nil "BZh"] ["\\.tgz\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") @@ -145,7 +149,14 @@ ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") - t t "\037\213"]) + t t "\037\213"] + ;; dzip is gzip with random access. Its compression program can't + ;; read/write stdin/out, so .dz files can only be viewed without + ;; saving, having their contents decompressed with gzip. + ["\\.dz\\'" + nil nil nil + "unzipping" "gzip" ("-c" "-q" "-d") + nil t "\037\213"]) "List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of @@ -160,6 +171,7 @@ type of compression (nil means no message) compress-program is a program that performs this compression + (nil means visit file in read-only mode) compress-args is a list of args to pass to the compress program @@ -199,7 +211,7 @@ :group 'jka-compr) (defcustom jka-compr-mode-alist-additions - (list (cons "\\.tgz\\'" 'tar-mode)) + (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode)) "A list of pairs to add to `auto-mode-alist' when jka-compr is installed." :type '(repeat (cons string symbol)) :group 'jka-compr) @@ -421,10 +433,7 @@ (let ((can-append (jka-compr-info-can-append info)) (compress-program (jka-compr-info-compress-program info)) (compress-message (jka-compr-info-compress-message info)) - (uncompress-program (jka-compr-info-uncompress-program info)) - (uncompress-message (jka-compr-info-uncompress-message info)) (compress-args (jka-compr-info-compress-args info)) - (uncompress-args (jka-compr-info-uncompress-args info)) (base-name (file-name-nondirectory visit-file)) temp-file temp-buffer ;; we need to leave `last-coding-system-used' set to its @@ -432,6 +441,9 @@ ;; that `basic-save-buffer' sees the right value. (coding-system-used last-coding-system-used)) + (or compress-program + (error "No compression program defined")) + (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*")) (with-current-buffer temp-buffer (widen) (erase-buffer)) @@ -631,6 +643,9 @@ ;;; (setq size insval))) ;;; (setq p (cdr p)))) + (or (jka-compr-info-compress-program info) + (message "You can't save this buffer because compression program is not defined")) + (list filename size)) (jka-compr-run-real-handler 'insert-file-contents
--- a/lisp/kmacro.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/kmacro.el Thu Mar 25 22:21:45 2004 +0000 @@ -609,7 +609,7 @@ for details on how to adjust or disable this behaviour. To make a macro permanent so you can call it even after defining -others, use M-x name-last-kbd-macro." +others, use \\[name-last-kbd-macro]." (interactive "p") (let ((repeat-key (and (null no-repeat) (> (length (this-single-command-keys)) 1)
--- a/lisp/language/ethio-util.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/language/ethio-util.el Thu Mar 25 22:21:45 2004 +0000 @@ -1826,7 +1826,7 @@ ;;;###autoload (defun ethio-find-file nil - "Transcribe file content into Ethiopic dependig on filename suffix." + "Transcribe file content into Ethiopic depending on filename suffix." (cond ((string-match "\\.sera$" (buffer-file-name))
--- a/lisp/log-edit.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/log-edit.el Thu Mar 25 22:21:45 2004 +0000 @@ -299,7 +299,7 @@ ;;; Actual code ;;; -(defar log-edit-font-lock-keywords +(defvar log-edit-font-lock-keywords '(("\\`\\(Summary:\\)\\(.*\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
--- a/lisp/man.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/man.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw <bwarsaw@cen.com> ;; Maintainer: FSF @@ -175,6 +175,17 @@ (const polite) (const quiet) (const meek)) :group 'man) +(defcustom Man-width nil + "*Number of columns for which manual pages should be formatted. +If nil, the width of the window selected at the moment of man +invocation is used. If non-nil, the width of the frame selected +at the moment of man invocation is used. The value also can be a +positive integer." + :type '(choice (const :tag "Window width" nil) + (const :tag "Frame width" t) + (integer :tag "Specific width" :value 65)) + :group 'man) + (defcustom Man-frame-parameters nil "*Frame parameter list for creating a new frame for a manual page." :type 'sexp @@ -317,6 +328,12 @@ "") "Option that indicates a specified a manual section name.") +(defvar Man-support-local-filenames 'auto-detect + "Internal cache for the value of the function `Man-support-local-filenames'. +`auto-detect' means the value is not yet determined. +Otherwise, the value is whatever the function +`Man-support-local-filenames' should return.") + ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user variables @@ -486,13 +503,15 @@ (defsubst Man-build-man-command () "Builds the entire background manpage and cleaning command." (let ((command (concat manual-program " " Man-switches - ; Stock MS-DOS shells cannot redirect stderr; - ; `call-process' below sends it to /dev/null, - ; so we don't need `2>' even with DOS shells - ; which do support stderr redirection. - (if (not (fboundp 'start-process)) - " %s" - (concat " %s 2>" null-device)))) + (cond + ;; Already has %s + ((string-match "%s" manual-program) "") + ;; Stock MS-DOS shells cannot redirect stderr; + ;; `call-process' below sends it to /dev/null, + ;; so we don't need `2>' even with DOS shells + ;; which do support stderr redirection. + ((not (fboundp 'start-process)) " %s") + ((concat " %s 2>" null-device))))) (flist Man-filter-list)) (while (and flist (car flist)) (let ((pcom (car (car flist))) @@ -555,6 +574,31 @@ slist nil)))) (concat Man-specified-section-option section " " name)))) +(defun Man-support-local-filenames () + "Check the availability of `-l' option of the man command. +This option allows `man' to interpret command line arguments +as local filenames. +Return the value of the variable `Man-support-local-filenames' +if it was set to nil or t before the call of this function. +If t, the man command supports `-l' option. If nil, it don't. +Otherwise, if the value of `Man-support-local-filenames' +is neither t nor nil, then determine a new value, set it +to the variable `Man-support-local-filenames' and return +a new value." + (if (or (not Man-support-local-filenames) + (eq Man-support-local-filenames t)) + Man-support-local-filenames + (setq Man-support-local-filenames + (with-temp-buffer + (and (equal (condition-case nil + (call-process manual-program nil t nil "--help") + (error nil)) + 0) + (progn + (goto-char (point-min)) + (search-forward "--local-file" nil t)) + t))))) + ;; ====================================================================== ;; default man entry: get word under point @@ -679,7 +723,12 @@ ;; This isn't strictly correct, since we don't know how ;; the page will actually be displayed, but it seems ;; reasonable. - (setenv "COLUMNS" (number-to-string (frame-width))))) + (setenv "COLUMNS" (number-to-string + (cond + ((and (integerp Man-width) (> Man-width 0)) + Man-width) + (Man-width (frame-width)) + ((window-width))))))) (setenv "GROFF_NO_SGR" "1") (if (fboundp 'start-process) (set-process-sentinel @@ -757,7 +806,7 @@ "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." (interactive) - (message "Please wait: making up the %s man page..." Man-arguments) + (message "Please wait: formatting the %s man page..." Man-arguments) (goto-char (point-min)) (while (search-forward "\e[1m" nil t) (delete-backward-char 4) @@ -976,6 +1025,9 @@ (auto-fill-mode -1) (use-local-map Man-mode-map) (set-syntax-table man-mode-syntax-table) + (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) + (set (make-local-variable 'outline-regexp) Man-heading-regexp) + (set (make-local-variable 'outline-level) (lambda () 1)) (Man-build-page-list) (Man-strip-page-headers) (Man-unindent)
--- a/lisp/play/landmark.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/play/landmark.el Thu Mar 25 22:21:45 2004 +0000 @@ -4,7 +4,7 @@ ;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>) ;; Created: December 16, 1996 - first release to usenet -;; Keywords: gomoku neural network adaptive search chemotaxis +;; Keywords: gomoku, neural network, adaptive search, chemotaxis ;;;_* Usage ;;; Just type
--- a/lisp/progmodes/cfengine.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/progmodes/cfengine.el Thu Mar 25 22:21:45 2004 +0000 @@ -239,7 +239,11 @@ (setq imenu-generic-expression cfengine-imenu-expression) (set (make-local-variable 'beginning-of-defun-function) #'cfengine-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun)) + (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun) + ;; Like Lisp mode. Without this, we lose with, say, + ;; `backward-up-list' when there's an unbalanced quote in a + ;; preceding comment. + (set (make-local-variable 'parse-sexp-ignore-comments) t)) (provide 'cfengine)
--- a/lisp/progmodes/compile.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/progmodes/compile.el Thu Mar 25 22:21:45 2004 +0000 @@ -927,9 +927,9 @@ (if (buffer-local-value 'compilation-scroll-output outbuf) (save-selected-window (select-window outwin) - (goto-char (point-max))) - ;; Make it so the next C-x ` will use this buffer. - (setq compilation-last-buffer outbuf)))) + (goto-char (point-max)))) + ;; Make it so the next C-x ` will use this buffer. + (setq compilation-last-buffer outbuf))) (defun compilation-set-window-height (window) "Set the height of WINDOW according to `compilation-window-height'."
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/gdb-ui.el Thu Mar 25 22:21:45 2004 +0000 @@ -0,0 +1,1966 @@ +;;; gdb-ui.el --- User Interface for running GDB + +;; Author: Nick Roberts <nick@nick.uklinux.net> +;; Maintainer: FSF +;; Keywords: unix, tools + +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This mode acts as a graphical user interface to GDB. You can interact with +;; GDB through the GUD buffer in the usual way, but there are also further +;; buffers which control the execution and describe the state of your program. +;; It separates the input/output of your program from that of GDB and displays +;; expressions and their current values in their own buffers. It also uses +;; features of Emacs 21 such as the display margin for breakpoints, and the +;; toolbar (see the GDB Graphical Interface section in the Emacs info manual). + +;; Start the debugger with M-x gdba. + +;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim +;; Kingdon and uses GDB's annotation interface. You don't need to know about +;; annotations to use this mode as a debugger, but if you are interested +;; developing the mode itself, then see the Annotations section in the GDB +;; info manual. Some GDB/MI commands are also used through th CLI command +;; 'interpreter mi <mi-command>'. +;; +;; Known Bugs: +;; + +;;; Code: + +(require 'gud) + +(defvar gdb-current-address "main" "Initialisation for Assembler buffer.") +(defvar gdb-previous-address nil) +(defvar gdb-previous-frame nil) +(defvar gdb-current-frame "main") +(defvar gdb-current-language nil) +(defvar gdb-view-source t "Non-nil means that source code can be viewed.") +(defvar gdb-selected-view 'source "Code type that user wishes to view.") +(defvar gdb-var-list nil "List of variables in watch window") +(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") +(defvar gdb-buffer-type nil) +(defvar gdb-overlay-arrow-position nil) +(defvar gdb-variables '() + "A list of variables that are local to the GUD buffer.") + +;;;###autoload +(defun gdba (command-line) + "Run gdb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger. + +If `gdb-many-windows' is nil (the default value) then gdb starts with +just two windows : the GUD and the source buffer. If it is t the +following layout will appear (keybindings given in relevant buffer) : + +--------------------------------------------------------------------- + GDB Toolbar +--------------------------------------------------------------------- +GUD buffer (I/O of GDB) | Locals buffer + | + | + | +--------------------------------------------------------------------- +Source buffer | Input/Output (of debuggee) buffer + | (comint-mode) + | + | + | + | + | + | +--------------------------------------------------------------------- +Stack buffer | Breakpoints buffer + RET gdb-frames-select | SPC gdb-toggle-breakpoint + | RET gdb-goto-breakpoint + | d gdb-delete-breakpoint +--------------------------------------------------------------------- + +All the buffers share the toolbar and source should always display in the same +window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint +icons are displayed both by setting a break with gud-break and by typing break +in the GUD buffer. + +This works best (depending on the size of your monitor) using most of the +screen. + +Displayed expressions appear in separate frames. Arrays may be displayed +as slices and visualised using the graph program from plotutils if installed. +Pointers in structures may be followed in a tree-like fashion. + +The following interactive lisp functions help control operation : + +`gdb-many-windows' - Toggle the number of windows gdb uses. +`gdb-restore-windows' - To restore the window layout." + ;; + (interactive (list (gud-query-cmdline 'gdba))) + ;; + ;; Let's start with a basic gud-gdb buffer and then modify it a bit. + (gdb command-line) + (gdb-ann3)) + +(defun gdb-ann3 () + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) + ;; + (gud-def gud-break (if (not (string-equal mode-name "Machine")) + (gud-call "break %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "break *%a" arg))) + "\C-b" "Set breakpoint at current line or address.") + ;; + (gud-def gud-remove (if (not (string-equal mode-name "Machine")) + (gud-call "clear %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "clear *%a" arg))) + "\C-d" "Remove breakpoint at current line or address.") + ;; + (gud-def gud-until (if (not (string-equal mode-name "Machine")) + (gud-call "until %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "until *%a" arg))) + "\C-u" "Continue to current line or address.") + + (define-key gud-minor-mode-map [left-margin mouse-1] + 'gdb-mouse-toggle-breakpoint) + (define-key gud-minor-mode-map [left-fringe mouse-1] + 'gdb-mouse-toggle-breakpoint) + + (setq comint-input-sender 'gdb-send) + ;; + ;; (re-)initialise + (setq gdb-current-address "main") + (setq gdb-previous-address nil) + (setq gdb-previous-frame nil) + (setq gdb-current-frame "main") + (setq gdb-view-source t) + (setq gdb-selected-view 'source) + (setq gdb-var-list nil) + (setq gdb-var-changed nil) + (setq gdb-first-prompt nil) + ;; + (mapc 'make-local-variable gdb-variables) + (setq gdb-buffer-type 'gdba) + ;; + (gdb-clear-inferior-io) + ;; + (if (eq window-system 'w32) + (gdb-enqueue-input (list "set new-console off\n" 'ignore))) + (gdb-enqueue-input (list "set height 0\n" 'ignore)) + ;; find source file and compilation directory here + (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program + (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program + (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) + ;; + (run-hooks 'gdba-mode-hook)) + +(defcustom gdb-use-colon-colon-notation nil + "Non-nil means use FUNCTION::VARIABLE format to display variables in the +speedbar." + :type 'boolean + :group 'gud) + +(defun gud-watch () + "Watch expression at point." + (interactive) + (require 'tooltip) + (let ((expr (tooltip-identifier-from-point (point)))) + (if (and (string-equal gdb-current-language "c") + gdb-use-colon-colon-notation) + (setq expr (concat gdb-current-frame "::" expr))) + (catch 'already-watched + (dolist (var gdb-var-list) + (if (string-equal expr (car var)) (throw 'already-watched nil))) + (set-text-properties 0 (length expr) nil expr) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-create - * " expr "\"\n") + `(lambda () (gdb-var-create-handler ,expr)))))) + (select-window (get-buffer-window gud-comint-buffer))) + +(defconst gdb-var-create-regexp +"name=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",type=\"\\(.*?\\)\"") + +(defun gdb-var-create-handler (expr) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (re-search-forward gdb-var-create-regexp nil t) + (let ((var (list expr + (match-string 1) + (match-string 2) + (match-string 3) + nil nil))) + (push var gdb-var-list) + (setq speedbar-update-flag t) + (speedbar 1) + (if (equal (nth 2 var) "0") + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-evaluate-expression " + (nth 1 var) "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 var) nil)))) + (setq gdb-var-changed t))) + (if (re-search-forward "Undefined command" nil t) + (message "Watching expressions requires gdb 6.0 onwards") + (message "No symbol %s in current context." expr))))) + +(defun gdb-var-evaluate-expression-handler (varnum changed) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) + (catch 'var-found + (let ((var-list nil) (num 0)) + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (if changed (setcar (nthcdr 5 var) t)) + (setcar (nthcdr 4 var) (match-string 1)) + (setcar (nthcdr num gdb-var-list) var) + (throw 'var-found nil))) + (setq num (+ num 1)))))) + (setq gdb-var-changed t)) + +(defun gdb-var-list-children (varnum) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-list-children " varnum "\"\n") + `(lambda () (gdb-var-list-children-handler ,varnum))))) + +(defconst gdb-var-list-children-regexp +"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"") + +(defun gdb-var-list-children-handler (varnum) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (let ((var-list nil)) + (catch 'child-already-watched + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (push var var-list) + (while (re-search-forward gdb-var-list-children-regexp nil t) + (let ((varchild (list (match-string 2) + (match-string 1) + (match-string 3) + nil nil nil))) + (if (looking-at ",type=\"\\(.*?\\)\"") + (setcar (nthcdr 3 varchild) (match-string 1))) + (dolist (var1 gdb-var-list) + (if (string-equal (cadr var1) (cadr varchild)) + (throw 'child-already-watched nil))) + (push varchild var-list) + (if (equal (nth 2 varchild) "0") + (gdb-enqueue-input + (list + (concat + "server interpreter mi \"-var-evaluate-expression " + (nth 1 varchild) "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 varchild) nil)))))))) + (push var var-list))) + (setq gdb-var-list (nreverse var-list)))))) + +(defun gdb-var-update () + (if (not (member 'gdb-var-update (gdb-get-pending-triggers))) + (progn + (gdb-enqueue-input (list "server interpreter mi \"-var-update *\"\n" + 'gdb-var-update-handler)) + (gdb-set-pending-triggers (cons 'gdb-var-update + (gdb-get-pending-triggers)))))) + +(defconst gdb-var-update-regexp "name=\"\\(.*?\\)\"") + +(defun gdb-var-update-handler () + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (while (re-search-forward gdb-var-update-regexp nil t) + (let ((varnum (match-string 1))) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-evaluate-expression " + varnum "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,varnum t))))))) + (gdb-set-pending-triggers + (delq 'gdb-var-update (gdb-get-pending-triggers)))) + +(defun gdb-var-delete () + "Delete watched expression from the speedbar." + (interactive) + (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) + (let ((text (speedbar-line-text))) + (string-match "\\(\\S-+\\)" text) + (let* ((expr (match-string 1 text)) + (var (assoc expr gdb-var-list)) + (varnum (cadr var))) + (unless (string-match "\\." varnum) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-delete " + varnum "\"\n") + 'ignore)) + (setq gdb-var-list (delq var gdb-var-list)) + (dolist (varchild gdb-var-list) + (if (string-match (concat (nth 1 var) "\\.") (nth 1 varchild)) + (setq gdb-var-list (delq varchild gdb-var-list)))) + (setq gdb-var-changed t)))))) + +(defun gdb-edit-value (text token indent) + "Assign a value to a variable displayed in the speedbar" + (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) + (varnum (cadr var)) (value)) + (setq value (read-string "New value: ")) + (gdb-enqueue-input + (list (concat "server interpreter mi \"-var-assign " + varnum " " value "\"\n") + 'ignore)))) + +(defcustom gdb-show-changed-values t + "Non-nil means use font-lock-warning-face to display values that have +recently changed in the speedbar." + :type 'boolean + :group 'gud) + +(defun gdb-speedbar-expand-node (text token indent) + "Expand the node the user clicked on. +TEXT is the text of the button we clicked on, a + or - item. +TOKEN is data related to this node. +INDENT is the current indentation depth." + (cond ((string-match "+" text) ;expand this node + (gdb-var-list-children token)) + ((string-match "-" text) ;contract this node + (dolist (var gdb-var-list) + (if (string-match (concat token "\\.") (nth 1 var)) + (setq gdb-var-list (delq var gdb-var-list)))) + (setq gdb-var-changed t)))) + + +;; ====================================================================== +;; +;; In this world, there are gdb variables (of unspecified +;; representation) and buffers associated with those objects. +;; The list of variables is built up by the expansions of +;; def-gdb-variable + +(defmacro def-gdb-var (root-symbol &optional default doc) + (let* ((root (symbol-name root-symbol)) + (accessor (intern (concat "gdb-get-" root))) + (setter (intern (concat "gdb-set-" root))) + (name (intern (concat "gdb-" root)))) + `(progn + (defvar ,name ,default ,doc) + (if (not (memq ',name gdb-variables)) + (push ',name gdb-variables)) + (defun ,accessor () + (buffer-local-value ',name gud-comint-buffer)) + (defun ,setter (val) + (with-current-buffer gud-comint-buffer + (setq ,name val)))))) + +(def-gdb-var buffer-type nil + "One of the symbols bound in gdb-buffer-rules") + +(def-gdb-var burst "" + "A string of characters from gdb that have not yet been processed.") + +(def-gdb-var input-queue () + "A list of gdb command objects.") + +(def-gdb-var prompting nil + "True when gdb is idle with no pending input.") + +(def-gdb-var output-sink 'user + "The disposition of the output of the current gdb command. +Possible values are these symbols: + + user -- gdb output should be copied to the GUD buffer + for the user to see. + + inferior -- gdb output should be copied to the inferior-io buffer + + pre-emacs -- output should be ignored util the post-prompt + annotation is received. Then the output-sink + becomes:... + emacs -- output should be collected in the partial-output-buffer + for subsequent processing by a command. This is the + disposition of output generated by commands that + gdb mode sends to gdb on its own behalf. + post-emacs -- ignore input until the prompt annotation is + received, then go to USER disposition. +") + +(def-gdb-var current-item nil + "The most recent command item sent to gdb.") + +(def-gdb-var pending-triggers '() + "A list of trigger functions that have run later than their output +handlers.") + +;; end of gdb variables + +(defun gdb-get-target-string () + (with-current-buffer gud-comint-buffer + gud-target-name)) + + +;; +;; gdb buffers. +;; +;; Each buffer has a TYPE -- a symbol that identifies the function +;; of that particular buffer. +;; +;; The usual gdb interaction buffer is given the type `gdba' and +;; is constructed specially. +;; +;; Others are constructed by gdb-get-create-buffer and +;; named according to the rules set forth in the gdb-buffer-rules-assoc + +(defvar gdb-buffer-rules-assoc '()) + +(defun gdb-get-buffer (key) + "Return the gdb buffer tagged with type KEY. +The key should be one of the cars in `gdb-buffer-rules-assoc'." + (save-excursion + (gdb-look-for-tagged-buffer key (buffer-list)))) + +(defun gdb-get-create-buffer (key) + "Create a new gdb buffer of the type specified by KEY. +The key should be one of the cars in `gdb-buffer-rules-assoc'." + (or (gdb-get-buffer key) + (let* ((rules (assoc key gdb-buffer-rules-assoc)) + (name (funcall (gdb-rules-name-maker rules))) + (new (get-buffer-create name))) + (with-current-buffer new + ;; FIXME: This should be set after calling the function, since the + ;; function should run kill-all-local-variables. + (set (make-local-variable 'gdb-buffer-type) key) + (if (cdr (cdr rules)) + (funcall (car (cdr (cdr rules))))) + (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer) + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + new)))) + +(defun gdb-rules-name-maker (rules) (car (cdr rules))) + +(defun gdb-look-for-tagged-buffer (key bufs) + (let ((retval nil)) + (while (and (not retval) bufs) + (set-buffer (car bufs)) + (if (eq gdb-buffer-type key) + (setq retval (car bufs))) + (setq bufs (cdr bufs))) + retval)) + +;; +;; This assoc maps buffer type symbols to rules. Each rule is a list of +;; at least one and possible more functions. The functions have these +;; roles in defining a buffer type: +;; +;; NAME - Return a name for this buffer type. +;; +;; The remaining function(s) are optional: +;; +;; MODE - called in a new buffer with no arguments, should establish +;; the proper mode for the buffer. +;; + +(defun gdb-set-buffer-rules (buffer-type &rest rules) + (let ((binding (assoc buffer-type gdb-buffer-rules-assoc))) + (if binding + (setcdr binding rules) + (push (cons buffer-type rules) + gdb-buffer-rules-assoc)))) + +;; GUD buffers are an exception to the rules +(gdb-set-buffer-rules 'gdba 'error) + +;; +;; Partial-output buffer : This accumulates output from a command executed on +;; behalf of emacs (rather than the user). +;; +(gdb-set-buffer-rules 'gdb-partial-output-buffer + 'gdb-partial-output-name) + +(defun gdb-partial-output-name () + (concat "*partial-output-" + (gdb-get-target-string) + "*")) + + +(gdb-set-buffer-rules 'gdb-inferior-io + 'gdb-inferior-io-name + 'gdb-inferior-io-mode) + +(defun gdb-inferior-io-name () + (concat "*input/output of " + (gdb-get-target-string) + "*")) + +(defvar gdb-inferior-io-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt) + (define-key map "\C-c\C-z" 'gdb-inferior-io-stop) + (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit) + (define-key map "\C-c\C-d" 'gdb-inferior-io-eof) + map)) + +(define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O" + "Major mode for gdb inferior-io." + :syntax-table nil :abbrev-table nil + ;; We want to use comint because it has various nifty and familiar + ;; features. We don't need a process, but comint wants one, so create + ;; a dummy one. + (make-comint-in-buffer + (substring (buffer-name) 1 (- (length (buffer-name)) 1)) + (current-buffer) "hexl") + (setq comint-input-sender 'gdb-inferior-io-sender)) + +(defun gdb-inferior-io-sender (proc string) + ;; PROC is the pseudo-process created to satisfy comint. + (with-current-buffer (process-buffer proc) + (setq proc (get-buffer-process gud-comint-buffer)) + (process-send-string proc string) + (process-send-string proc "\n"))) + +(defun gdb-inferior-io-interrupt () + "Interrupt the program being debugged." + (interactive) + (interrupt-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-quit () + "Send quit signal to the program being debugged." + (interactive) + (quit-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-stop () + "Stop the program being debugged." + (interactive) + (stop-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-eof () + "Send end-of-file to the program being debugged." + (interactive) + (process-send-eof + (get-buffer-process gud-comint-buffer))) + + +;; +;; gdb communications +;; + +;; INPUT: things sent to gdb +;; +;; The queues are lists. Each element is either a string (indicating user or +;; user-like input) or a list of the form: +;; +;; (INPUT-STRING HANDLER-FN) +;; +;; The handler function will be called from the partial-output buffer when the +;; command completes. This is the way to write commands which invoke gdb +;; commands autonomously. +;; +;; These lists are consumed tail first. +;; + +(defun gdb-send (proc string) + "A comint send filter for gdb. +This filter may simply queue output for a later time." + (gdb-enqueue-input (concat string "\n"))) + +;; Note: Stuff enqueued here will be sent to the next prompt, even if it +;; is a query, or other non-top-level prompt. + +(defun gdb-enqueue-input (item) + (if (gdb-get-prompting) + (progn + (gdb-send-item item) + (gdb-set-prompting nil)) + (gdb-set-input-queue + (cons item (gdb-get-input-queue))))) + +(defun gdb-dequeue-input () + (let ((queue (gdb-get-input-queue))) + (and queue + (let ((last (car (last queue)))) + (unless (nbutlast queue) (gdb-set-input-queue '())) + last)))) + + +;; +;; output -- things gdb prints to emacs +;; +;; GDB output is a stream interrupted by annotations. +;; Annotations can be recognized by their beginning +;; with \C-j\C-z\C-z<tag><opt>\C-j +;; +;; The tag is a string obeying symbol syntax. +;; +;; The optional part `<opt>' can be either the empty string +;; or a space followed by more data relating to the annotation. +;; For example, the SOURCE annotation is followed by a filename, +;; line number and various useless goo. This data must not include +;; any newlines. +;; + +(defcustom gud-gdba-command-name "gdb -annotate=3" + "Default command to execute an executable under the GDB-UI debugger." + :type 'string + :group 'gud) + +(defvar gdb-annotation-rules + '(("pre-prompt" gdb-pre-prompt) + ("prompt" gdb-prompt) + ("commands" gdb-subprompt) + ("overload-choice" gdb-subprompt) + ("query" gdb-subprompt) + ("prompt-for-continue" gdb-subprompt) + ("post-prompt" gdb-post-prompt) + ("source" gdb-source) + ("starting" gdb-starting) + ("exited" gdb-stopping) + ("signalled" gdb-stopping) + ("signal" gdb-stopping) + ("breakpoint" gdb-stopping) + ("watchpoint" gdb-stopping) + ("frame-begin" gdb-frame-begin) + ("stopped" gdb-stopped) + ) "An assoc mapping annotation tags to functions which process them.") + +(defconst gdb-source-spec-regexp + "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") + +;; Do not use this except as an annotation handler. +(defun gdb-source (args) + (string-match gdb-source-spec-regexp args) + ;; Extract the frame position from the marker. + (setq gud-last-frame + (cons + (match-string 1 args) + (string-to-int (match-string 2 args)))) + (setq gdb-current-address (match-string 3 args)) + (setq gdb-view-source t)) + +(defun gdb-send-item (item) + (gdb-set-current-item item) + (if (stringp item) + (progn + (gdb-set-output-sink 'user) + (process-send-string (get-buffer-process gud-comint-buffer) item)) + (progn + (gdb-clear-partial-output) + (gdb-set-output-sink 'pre-emacs) + (process-send-string (get-buffer-process gud-comint-buffer) + (car item))))) + +(defun gdb-pre-prompt (ignored) + "An annotation handler for `pre-prompt'. This terminates the collection of +output from a previous command if that happens to be in effect." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'emacs) + (gdb-set-output-sink 'post-emacs)) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-pre-prompt (got %s)" sink))))) + +(defun gdb-prompt (ignored) + "An annotation handler for `prompt'. +This sends the next command (if any) to gdb." + (when gdb-first-prompt (gdb-ann3)) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'post-emacs) + (gdb-set-output-sink 'user) + (let ((handler + (car (cdr (gdb-get-current-item))))) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (funcall handler)))) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-prompt (got %s)" sink)))) + (let ((input (gdb-dequeue-input))) + (if input + (gdb-send-item input) + (progn + (gdb-set-prompting t) + (gud-display-frame))))) + +(defun gdb-subprompt (ignored) + "An annotation handler for non-top-level prompts." + (gdb-set-prompting t)) + +(defun gdb-starting (ignored) + "An annotation handler for `starting'. This says that I/O for the +subprocess is now the program being debugged, not GDB." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) + (progn + (setq gud-running t) + (gdb-set-output-sink 'inferior))) + (t (error "Unexpected `starting' annotation"))))) + +(defun gdb-stopping (ignored) + "An annotation handler for `exited' and other annotations which say that I/O +for the subprocess is now GDB, not the program being debugged." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + (t (error "Unexpected stopping annotation"))))) + +(defun gdb-frame-begin (ignored) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + ((eq sink 'user) t) + ((eq sink 'emacs) t) + (t (error "Unexpected frame-begin annotation (%S)" sink))))) + +(defun gdb-stopped (ignored) + "An annotation handler for `stopped'. It is just like gdb-stopping, except +that if we already set the output sink to 'user in gdb-stopping, that is fine." + (setq gud-running nil) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + ((eq sink 'user) t) + (t (error "Unexpected stopped annotation"))))) + +(defun gdb-post-prompt (ignored) + "An annotation handler for `post-prompt'. This begins the collection of +output from the current command if that happens to be appropriate." + (if (not (gdb-get-pending-triggers)) + (progn + (gdb-get-current-frame) + (gdb-invalidate-frames) + (gdb-invalidate-breakpoints) + (gdb-invalidate-assembler) + (gdb-invalidate-registers) + (gdb-invalidate-locals) + (gdb-invalidate-threads) + (dolist (frame (frame-list)) + (when (string-equal (frame-parameter frame 'name) "Speedbar") + (setq gdb-var-changed t) ; force update + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)))) + (gdb-var-update))) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'pre-emacs) + (gdb-set-output-sink 'emacs)) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-post-prompt (got %s)" sink))))) + +(defun gud-gdba-marker-filter (string) + "A gud marker filter for gdb. Handle a burst of output from GDB." + ;; Recall the left over gud-marker-acc from last time + (setq gud-marker-acc (concat gud-marker-acc string)) + ;; Start accumulating output for the GUD buffer + (let ((output "")) + ;; + ;; Process all the complete markers in this chunk. + (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) + (let ((annotation (match-string 1 gud-marker-acc))) + ;; + ;; Stuff prior to the match is just ordinary output. + ;; It is either concatenated to OUTPUT or directed + ;; elsewhere. + (setq output + (gdb-concat-output + output + (substring gud-marker-acc 0 (match-beginning 0)))) + ;; + ;; Take that stuff off the gud-marker-acc. + (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) + ;; + ;; Parse the tag from the annotation, and maybe its arguments. + (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) + (let* ((annotation-type (match-string 1 annotation)) + (annotation-arguments (match-string 2 annotation)) + (annotation-rule (assoc annotation-type + gdb-annotation-rules))) + ;; Call the handler for this annotation. + (if annotation-rule + (funcall (car (cdr annotation-rule)) + annotation-arguments) + ;; Else the annotation is not recognized. Ignore it silently, + ;; so that GDB can add new annotations without causing + ;; us to blow up. + )))) + ;; + ;; Does the remaining text end in a partial line? + ;; If it does, then keep part of the gud-marker-acc until we get more. + (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" + gud-marker-acc) + (progn + ;; Everything before the potential marker start can be output. + (setq output + (gdb-concat-output output + (substring gud-marker-acc 0 + (match-beginning 0)))) + ;; + ;; Everything after, we save, to combine with later input. + (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0)))) + ;; + ;; In case we know the gud-marker-acc contains no partial annotations: + (progn + (setq output (gdb-concat-output output gud-marker-acc)) + (setq gud-marker-acc ""))) + output)) + +(defun gdb-concat-output (so-far new) + (let ((sink (gdb-get-output-sink ))) + (cond + ((eq sink 'user) (concat so-far new)) + ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) + ((eq sink 'emacs) + (gdb-append-to-partial-output new) + so-far) + ((eq sink 'inferior) + (gdb-append-to-inferior-io new) + so-far) + (t (error "Bogon output sink %S" sink))))) + +(defun gdb-append-to-partial-output (string) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert string))) + +(defun gdb-clear-partial-output () + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (erase-buffer))) + +(defun gdb-append-to-inferior-io (string) + (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) + (goto-char (point-max)) + (insert-before-markers string)) + (if (not (string-equal string "")) + (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))) + +(defun gdb-clear-inferior-io () + (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) + (erase-buffer))) + + +;; One trick is to have a command who's output is always available in a buffer +;; of it's own, and is always up to date. We build several buffers of this +;; type. +;; +;; There are two aspects to this: gdb has to tell us when the output for that +;; command might have changed, and we have to be able to run the command +;; behind the user's back. +;; +;; The output phasing associated with the variable gdb-output-sink +;; help us to run commands behind the user's back. +;; +;; Below is the code for specificly managing buffers of output from one +;; command. +;; + +;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES +;; It adds an input for the command we are tracking. It should be the +;; annotation rule binding of whatever gdb sends to tell us this command +;; might have changed it's output. +;; +;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. +;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the +;; input in the input queue (see comment about ``gdb communications'' above). + +(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command + output-handler) + `(defun ,name (&optional ignored) + (if (and (,demand-predicate) + (not (member ',name + (gdb-get-pending-triggers)))) + (progn + (gdb-enqueue-input + (list ,gdb-command ',output-handler)) + (gdb-set-pending-triggers + (cons ',name + (gdb-get-pending-triggers))))))) + +(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) + `(defun ,name () + (gdb-set-pending-triggers + (delq ',trigger + (gdb-get-pending-triggers))) + (let ((buf (gdb-get-buffer ',buf-key))) + (and buf + (with-current-buffer buf + (let ((p (point)) + (buffer-read-only nil)) + (erase-buffer) + (insert-buffer-substring (gdb-get-create-buffer + 'gdb-partial-output-buffer)) + (goto-char p))))) + ;; put customisation here + (,custom-defun))) + +(defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command + output-handler-name custom-defun) + `(progn + (def-gdb-auto-update-trigger ,trigger-name + ;; The demand predicate: + (lambda () (gdb-get-buffer ',buffer-key)) + ,gdb-command + ,output-handler-name) + (def-gdb-auto-update-handler ,output-handler-name + ,trigger-name ,buffer-key ,custom-defun))) + + +;; +;; Breakpoint buffer : This displays the output of `info breakpoints'. +;; +(gdb-set-buffer-rules 'gdb-breakpoints-buffer + 'gdb-breakpoints-buffer-name + 'gdb-breakpoints-mode) + +(def-gdb-auto-updated-buffer gdb-breakpoints-buffer + ;; This defines the auto update rule for buffers of type + ;; `gdb-breakpoints-buffer'. + ;; + ;; It defines a function to serve as the annotation handler that + ;; handles the `foo-invalidated' message. That function is called: + gdb-invalidate-breakpoints + ;; + ;; To update the buffer, this command is sent to gdb. + "server info breakpoints\n" + ;; + ;; This also defines a function to be the handler for the output + ;; from the command above. That function will copy the output into + ;; the appropriately typed buffer. That function will be called: + gdb-info-breakpoints-handler + ;; buffer specific functions + gdb-info-breakpoints-custom) + +(defvar gdb-cdir nil "Compilation directory.") + +(defconst breakpoint-xpm-data "/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +\"10 10 2 1\", +\" c red\", +\"+ c None\", +/* pixels */ +\"+++ +++\", +\"++ ++\", +\"+ +\", +\" \", +\" \", +\" \", +\" \", +\"+ +\", +\"++ ++\", +\"+++ +++\", +};" + "XPM data used for breakpoint icon.") + +(defconst breakpoint-enabled-pbm-data +"P1 +10 10\", +0 0 0 0 1 1 1 1 0 0 0 0 +0 0 0 1 1 1 1 1 1 0 0 0 +0 0 1 1 1 1 1 1 1 1 0 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 0 1 1 1 1 1 1 1 1 0 0 +0 0 0 1 1 1 1 1 1 0 0 0 +0 0 0 0 1 1 1 1 0 0 0 0" + "PBM data used for enabled breakpoint icon.") + +(defconst breakpoint-disabled-pbm-data +"P1 +10 10\", +0 0 1 0 1 0 1 0 0 0 +0 1 0 1 0 1 0 1 0 0 +1 0 1 0 1 0 1 0 1 0 +0 1 0 1 0 1 0 1 0 1 +1 0 1 0 1 0 1 0 1 0 +0 1 0 1 0 1 0 1 0 1 +1 0 1 0 1 0 1 0 1 0 +0 1 0 1 0 1 0 1 0 1 +0 0 1 0 1 0 1 0 1 0 +0 0 0 1 0 1 0 1 0 0" + "PBM data used for disabled breakpoint icon.") + +(defvar breakpoint-enabled-icon nil + "Icon for enabled breakpoint in display margin") + +(defvar breakpoint-disabled-icon nil + "Icon for disabled breakpoint in display margin") + +(defvar breakpoint-bitmap nil + "Bitmap for breakpoint in fringe") + +(defface breakpoint-enabled-bitmap-face + '((t + :inherit fringe + :foreground "red")) + "Face for enabled breakpoint icon in fringe.") + +(defface breakpoint-disabled-bitmap-face + '((t + :inherit fringe + :foreground "grey60")) + "Face for disabled breakpoint icon in fringe.") + + +;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) +(defun gdb-info-breakpoints-custom () + (let ((flag)(address)) + ;; + ;; remove all breakpoint-icons in source buffers but not assembler buffer + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (if (and (eq gud-minor-mode 'gdba) + (not (string-match "^\*" (buffer-name)))) + (gdb-remove-breakpoint-icons (point-min) (point-max))))) + (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) + (save-excursion + (goto-char (point-min)) + (while (< (point) (- (point-max) 1)) + (forward-line 1) + (if (looking-at "[^\t].*breakpoint") + (progn + (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") + (setq flag (char-after (match-beginning 1))) + (beginning-of-line) + (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) + (progn + (looking-at "\\(\\S-*\\):\\([0-9]+\\)") + (let ((line (match-string 2)) (buffer-read-only nil) + (file (match-string 1))) + (add-text-properties (point-at-bol) (point-at-eol) + '(mouse-face highlight + help-echo "mouse-2, RET: visit breakpoint")) + (with-current-buffer + (find-file-noselect + (if (file-exists-p file) file + (expand-file-name file gdb-cdir))) + (save-current-buffer + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) + gud-tool-bar-map)) + ;; only want one breakpoint icon at each location + (save-excursion + (goto-line (string-to-number line)) + (gdb-put-breakpoint-icon (eq flag ?y))))))))) + (end-of-line))))) + (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) + +(defun gdb-mouse-toggle-breakpoint (event) + "Toggle breakpoint with mouse click in left margin." + (interactive "e") + (mouse-minibuffer-check event) + (let ((posn (event-end event))) + (if (numberp (posn-point posn)) + (with-selected-window (posn-window posn) + (save-excursion + (goto-char (posn-point posn)) + (if (or (posn-object posn) + (and breakpoint-bitmap + (eq (car (fringe-bitmaps-at-pos (posn-point posn))) + breakpoint-bitmap))) + (gud-remove nil) + (gud-break nil))))))) + +(defun gdb-breakpoints-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*breakpoints of " (gdb-get-target-string) "*"))) + +(defun gdb-display-breakpoints-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-breakpoints-buffer))) + +(defun gdb-frame-breakpoints-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-breakpoints-buffer))) + +(defvar gdb-breakpoints-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "Breakpoints"))) + (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint)) + (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) + (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) + + (suppress-keymap map) + (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) + (define-key map " " 'gdb-toggle-breakpoint) + (define-key map "d" 'gdb-delete-breakpoint) + (define-key map "\r" 'gdb-goto-breakpoint) + (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint) + map)) + +(defun gdb-breakpoints-mode () + "Major mode for gdb breakpoints. + +\\{gdb-breakpoints-mode-map}" + (setq major-mode 'gdb-breakpoints-mode) + (setq mode-name "Breakpoints") + (use-local-map gdb-breakpoints-mode-map) + (setq buffer-read-only t) + (gdb-invalidate-breakpoints)) + +(defun gdb-toggle-breakpoint () + "Enable/disable the breakpoint at current line." + (interactive) + (save-excursion + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) + (error "Not recognized as break/watchpoint line") + (gdb-enqueue-input + (list + (concat + (if (eq ?y (char-after (match-beginning 2))) + "server disable " + "server enable ") + (match-string 1) "\n") + 'ignore))))) + +(defun gdb-delete-breakpoint () + "Delete the breakpoint at current line." + (interactive) + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) + (error "Not recognized as break/watchpoint line") + (gdb-enqueue-input + (list (concat "server delete " (match-string 1) "\n") 'ignore)))) + +(defvar gdb-source-window nil) + +(defun gdb-goto-breakpoint () + "Display the file in the source buffer at the breakpoint specified on the +current line." + (interactive) + (save-excursion + (beginning-of-line 1) + (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) + (looking-at "\\(\\S-*\\):\\([0-9]+\\)")) + (if (match-string 2) + (let ((line (match-string 2)) + (file (match-string 1))) + (save-selected-window + (select-window gdb-source-window) + (switch-to-buffer (find-file-noselect + (if (file-exists-p file) + file + (expand-file-name file gdb-cdir)))) + (goto-line (string-to-number line)))))) + +(defun gdb-mouse-goto-breakpoint (event) + "Display the file in the source buffer at the selected breakpoint." + (interactive "e") + (mouse-set-point event) + (gdb-goto-breakpoint)) + +;; +;; Frames buffer. This displays a perpetually correct bactracktrace +;; (from the command `where'). +;; +;; Alas, if your stack is deep, it is costly. +;; +(gdb-set-buffer-rules 'gdb-stack-buffer + 'gdb-stack-buffer-name + 'gdb-frames-mode) + +(def-gdb-auto-updated-buffer gdb-stack-buffer + gdb-invalidate-frames + "server where\n" + gdb-info-frames-handler + gdb-info-frames-custom) + +(defun gdb-info-frames-custom () + (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (add-text-properties (point-at-bol) (point-at-eol) + '(mouse-face highlight + help-echo "mouse-2, RET: Select frame")) + (beginning-of-line) + (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") + (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) + (equal (match-string 1) gdb-current-frame)) + (put-text-property (point-at-bol) (point-at-eol) + 'face '(:inverse-video t))) + (forward-line 1)))))) + +(defun gdb-stack-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*stack frames of " (gdb-get-target-string) "*"))) + +(defun gdb-display-stack-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-stack-buffer))) + +(defun gdb-frame-stack-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-stack-buffer))) + +(defvar gdb-frames-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-frames-select) + (define-key map [mouse-2] 'gdb-frames-mouse-select) + map)) + +(defun gdb-frames-mode () + "Major mode for gdb frames. + +\\{gdb-frames-mode-map}" + (setq major-mode 'gdb-frames-mode) + (setq mode-name "Frames") + (setq buffer-read-only t) + (use-local-map gdb-frames-mode-map) + (font-lock-mode -1) + (gdb-invalidate-frames)) + +(defun gdb-get-frame-number () + (save-excursion + (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t)) + (n (or (and pos (match-string-no-properties 1)) "0"))) + n))) + +(defun gdb-frames-select () + "Make the frame on the current line become the current frame and display the +source in the source buffer." + (interactive) + (gdb-enqueue-input + (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) + (gud-display-frame)) + +(defun gdb-frames-mouse-select (event) + "Make the selected frame become the current frame and display the source in +the source buffer." + (interactive "e") + (mouse-set-point event) + (gdb-frames-select)) + +;; +;; Threads buffer. This displays a selectable thread list. +;; +(gdb-set-buffer-rules 'gdb-threads-buffer + 'gdb-threads-buffer-name + 'gdb-threads-mode) + +(def-gdb-auto-updated-buffer gdb-threads-buffer + gdb-invalidate-threads + "server info threads\n" + gdb-info-threads-handler + gdb-info-threads-custom) + +(defun gdb-info-threads-custom () + (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (add-text-properties (point-at-bol) (point-at-eol) + '(mouse-face highlight + help-echo "mouse-2, RET: select thread")) + (forward-line 1))))) + +(defun gdb-threads-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*threads of " (gdb-get-target-string) "*"))) + +(defun gdb-display-threads-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-threads-buffer))) + +(defun gdb-frame-threads-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-threads-buffer))) + +(defvar gdb-threads-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-threads-select) + (define-key map [mouse-2] 'gdb-threads-mouse-select) + map)) + +(defun gdb-threads-mode () + "Major mode for gdb frames. + +\\{gdb-frames-mode-map}" + (setq major-mode 'gdb-threads-mode) + (setq mode-name "Threads") + (setq buffer-read-only t) + (use-local-map gdb-threads-mode-map) + (gdb-invalidate-threads)) + +(defun gdb-get-thread-number () + (save-excursion + (re-search-backward "^\\s-*\\([0-9]*\\)" nil t) + (match-string-no-properties 1))) + +(defun gdb-threads-select () + "Make the thread on the current line become the current thread and display the +source in the source buffer." + (interactive) + (gdb-enqueue-input + (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) + (gud-display-frame)) + +(defun gdb-threads-mouse-select (event) + "Make the selected frame become the current frame and display the source in +the source buffer." + (interactive "e") + (mouse-set-point event) + (gdb-threads-select)) + +;; +;; Registers buffer. +;; +(gdb-set-buffer-rules 'gdb-registers-buffer + 'gdb-registers-buffer-name + 'gdb-registers-mode) + +(def-gdb-auto-updated-buffer gdb-registers-buffer + gdb-invalidate-registers + "server info registers\n" + gdb-info-registers-handler + gdb-info-registers-custom) + +(defun gdb-info-registers-custom ()) + +(defvar gdb-registers-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-registers-mode () + "Major mode for gdb registers. + +\\{gdb-registers-mode-map}" + (setq major-mode 'gdb-registers-mode) + (setq mode-name "Registers") + (setq buffer-read-only t) + (use-local-map gdb-registers-mode-map) + (gdb-invalidate-registers)) + +(defun gdb-registers-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*registers of " (gdb-get-target-string) "*"))) + +(defun gdb-display-registers-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-registers-buffer))) + +(defun gdb-frame-registers-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-registers-buffer))) + +;; +;; Locals buffer. +;; +(gdb-set-buffer-rules 'gdb-locals-buffer + 'gdb-locals-buffer-name + 'gdb-locals-mode) + +(def-gdb-auto-updated-buffer gdb-locals-buffer + gdb-invalidate-locals + "server info locals\n" + gdb-info-locals-handler + gdb-info-locals-custom) + +;; Abbreviate for arrays and structures. +;; These can be expanded using gud-display. +(defun gdb-info-locals-handler nil + (gdb-set-pending-triggers (delq 'gdb-invalidate-locals + (gdb-get-pending-triggers))) + (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^ .*\n" nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (while (re-search-forward "{[-0-9, {}\]*\n" nil t) + (replace-match "(array);\n" nil nil)) + (goto-char (point-min)) + (while (re-search-forward "{.*=.*\n" nil t) + (replace-match "(structure);\n" nil nil)))) + (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) + (and buf (with-current-buffer buf + (let ((p (point)) + (buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring (gdb-get-create-buffer + 'gdb-partial-output-buffer)) + (goto-char p))))) + (run-hooks 'gdb-info-locals-hook)) + +(defun gdb-info-locals-custom () + nil) + +(defvar gdb-locals-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-locals-mode () + "Major mode for gdb locals. + +\\{gdb-locals-mode-map}" + (setq major-mode 'gdb-locals-mode) + (setq mode-name "Locals") + (setq buffer-read-only t) + (use-local-map gdb-locals-mode-map) + (gdb-invalidate-locals)) + +(defun gdb-locals-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*locals of " (gdb-get-target-string) "*"))) + +(defun gdb-display-locals-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-locals-buffer))) + +(defun gdb-frame-locals-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-locals-buffer))) + + +;;;; Window management + +;;; The way we abuse the dedicated-p flag is pretty gross, but seems +;;; to do the right thing. Seeing as there is no way for Lisp code to +;;; get at the use_time field of a window, I'm not sure there exists a +;;; more elegant solution without writing C code. + +(defun gdb-display-buffer (buf &optional size) + (let ((must-split nil) + (answer nil)) + (unwind-protect + (progn + (walk-windows + #'(lambda (win) + (if (or (eq gud-comint-buffer (window-buffer win)) + (eq gdb-source-window win)) + (set-window-dedicated-p win t)))) + (setq answer (get-buffer-window buf)) + (if (not answer) + (let ((window (get-lru-window))) + (if window + (progn + (set-window-buffer window buf) + (setq answer window)) + (setq must-split t))))) + (walk-windows + #'(lambda (win) + (if (or (eq gud-comint-buffer (window-buffer win)) + (eq gdb-source-window win)) + (set-window-dedicated-p win nil))))) + (if must-split + (let* ((largest (get-largest-window)) + (cur-size (window-height largest)) + (new-size (and size (< size cur-size) (- cur-size size)))) + (setq answer (split-window largest new-size)) + (set-window-buffer answer buf))) + answer)) + +(defun gdb-display-source-buffer (buffer) + (if (eq gdb-selected-view 'source) + (progn + (if (window-live-p gdb-source-window) + (set-window-buffer gdb-source-window buffer) + (gdb-display-buffer buffer) + (setq gdb-source-window (get-buffer-window buffer))) + gdb-source-window) + (if (window-live-p gdb-source-window) + (set-window-buffer gdb-source-window + (gdb-get-buffer 'gdb-assembler-buffer)) + (let ((buf (gdb-get-buffer 'gdb-assembler-buffer))) + (gdb-display-buffer buf) + (setq gdb-source-window (get-buffer-window buf)))) + nil)) + + +;;; Shared keymap initialization: + +(let ((menu (make-sparse-keymap "GDB-Frames"))) + (define-key gud-menu-map [frames] + `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) + (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) + (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) + (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) + (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) + (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) + (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) +; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) +) + +(let ((menu (make-sparse-keymap "GDB-Windows"))) + (define-key gud-menu-map [displays] + `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) + (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) + (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) + (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) + (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) + (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) + (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) +; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) +) + +(let ((menu (make-sparse-keymap "View"))) + (define-key gud-menu-map [view] + `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba))) +; (define-key menu [both] '(menu-item "Both" gdb-view-both +; :help "Display both source and assembler" +; :button (:radio . (eq gdb-selected-view 'both)))) + (define-key menu [assembler] '(menu-item "Machine" gdb-view-assembler + :help "Display assembler only" + :button (:radio . (eq gdb-selected-view 'assembler)))) + (define-key menu [source] '(menu-item "Source" gdb-view-source-function + :help "Display source only" + :button (:radio . (eq gdb-selected-view 'source))))) + +(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] + '("Restore window layout" . gdb-restore-windows)) + (define-key menu [gdb-many-windows] + (menu-bar-make-toggle gdb-many-windows gdb-many-windows + "Display other windows" "Many Windows %s" + "Display locals, stack and breakpoint information"))) + +(defun gdb-frame-gdb-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdba))) + +(defun gdb-display-gdb-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdba))) + +(defvar gdb-main-file nil "Source file from which program execution begins.") + +(defun gdb-view-source-function () + (interactive) + (if gdb-view-source + (if gud-last-last-frame + (set-window-buffer gdb-source-window + (gud-find-file (car gud-last-last-frame))) + (set-window-buffer gdb-source-window (gud-find-file gdb-main-file)))) + (setq gdb-selected-view 'source)) + +(defun gdb-view-assembler() + (interactive) + (set-window-buffer gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + (setq gdb-selected-view 'assembler)) + +;(defun gdb-view-both() +;(interactive) +;(setq gdb-selected-view 'both)) + +;; layout for all the windows +(defun gdb-setup-windows () + (gdb-display-locals-buffer) + (gdb-display-stack-buffer) + (delete-other-windows) + (gdb-display-breakpoints-buffer) + (delete-other-windows) + (switch-to-buffer gud-comint-buffer) + (split-window nil ( / ( * (window-height) 3) 4)) + (split-window nil ( / (window-height) 3)) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-locals-buffer-name)) + (other-window 1) + (switch-to-buffer + (if (and gdb-view-source + (eq gdb-selected-view 'source)) + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file)) + (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-inferior-io-name)) + (other-window 1) + (switch-to-buffer (gdb-stack-buffer-name)) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-breakpoints-buffer-name)) + (other-window 1)) + +(defcustom gdb-many-windows nil + "Nil means that gdb starts with just two windows : the GUD and +the source buffer." + :type 'boolean + :group 'gud) + +(defun gdb-many-windows (arg) +"Toggle the number of windows in the basic arrangement." + (interactive "P") + (setq gdb-many-windows + (if (null arg) + (not gdb-many-windows) + (> (prefix-numeric-value arg) 0))) + (gdb-restore-windows)) + +(defun gdb-restore-windows () + "Restore the basic arrangement of windows used by gdba. +This arrangement depends on the value of `gdb-many-windows'." + (interactive) + (if gdb-many-windows + (progn + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (gdb-setup-windows)) + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer + (if (and gdb-view-source + (eq gdb-selected-view 'source)) + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file)) + (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (other-window 1))) + +(defun gdb-reset () + "Exit a debugging session cleanly by killing the gdb buffers and resetting + the source buffers." + (dolist (buffer (buffer-list)) + (if (not (eq buffer gud-comint-buffer)) + (with-current-buffer buffer + (if (memq gud-minor-mode '(gdba pdb)) + (if (string-match "^\*.+*$" (buffer-name)) + (kill-buffer nil) + (gdb-remove-breakpoint-icons (point-min) (point-max) t) + (setq gud-minor-mode nil) + (kill-local-variable 'tool-bar-map) + (setq gud-running nil)))))) + (when (markerp gdb-overlay-arrow-position) + (move-marker gdb-overlay-arrow-position nil) + (setq gdb-overlay-arrow-position nil)) + (setq overlay-arrow-variable-list + (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))) + +(defun gdb-source-info () + "Find the source file where the program starts and displays it with related +buffers." + (goto-char (point-min)) + (if (search-forward "directory is " nil t) + (if (looking-at "\\S-*:\\(\\S-*\\)") + (setq gdb-cdir (match-string 1)) + (looking-at "\\S-*") + (setq gdb-cdir (match-string 0)))) + (if (search-forward "Located in " nil t) + (if (looking-at "\\S-*") + (setq gdb-main-file (match-string 0))) + (setq gdb-view-source nil)) + (delete-other-windows) + (switch-to-buffer gud-comint-buffer) + (if gdb-many-windows + (gdb-setup-windows) + (gdb-display-breakpoints-buffer) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer + (if gdb-view-source + (gud-find-file gdb-main-file) + (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (other-window 1))) + +;;from put-image +(defun gdb-put-string (putstring pos &optional dprop) + "Put string PUTSTRING in front of POS in the current buffer. +PUTSTRING is displayed by putting an overlay into the current buffer with a +`before-string' STRING that has a `display' property whose value is +PUTSTRING." + (let ((gdb-string "x") + (buffer (current-buffer))) + (let ((overlay (make-overlay pos pos buffer)) + (prop (or dprop + (list (list 'margin 'left-margin) putstring)))) + (put-text-property 0 (length gdb-string) 'display prop gdb-string) + (overlay-put overlay 'put-break t) + (overlay-put overlay 'before-string gdb-string)))) + +;;from remove-images +(defun gdb-remove-strings (start end &optional buffer) + "Remove strings between START and END in BUFFER. +Remove only strings that were put in BUFFER with calls to `gdb-put-string'. +BUFFER nil or omitted means use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + (let ((overlays (overlays-in start end))) + (while overlays + (let ((overlay (car overlays))) + (when (overlay-get overlay 'put-break) + (delete-overlay overlay))) + (setq overlays (cdr overlays))))) + +(defun gdb-put-breakpoint-icon (enabled) + (let ((start (progn (beginning-of-line) (- (point) 1))) + (end (progn (end-of-line) (+ (point) 1)))) + (gdb-remove-breakpoint-icons start end) + (if (display-images-p) + (if (>= (car (window-fringes)) 8) + (gdb-put-string + nil (1+ start) + `(left-fringe + ,(or breakpoint-bitmap + (setq breakpoint-bitmap + (define-fringe-bitmap + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c"))) + ,(if enabled + 'breakpoint-enabled-bitmap-face + 'breakpoint-disabled-bitmap-face))) + (when (< left-margin-width 2) + (save-current-buffer + (setq left-margin-width 2) + (if (get-buffer-window (current-buffer)) + (set-window-margins (get-buffer-window + (current-buffer)) + left-margin-width + right-margin-width)))) + (put-image + (if enabled + (or breakpoint-enabled-icon + (setq breakpoint-enabled-icon + (find-image `((:type xpm :data + ,breakpoint-xpm-data + :ascent 100 :pointer hand) + (:type pbm :data + ,breakpoint-enabled-pbm-data + :ascent 100 :pointer hand))))) + (or breakpoint-disabled-icon + (setq breakpoint-disabled-icon + (find-image `((:type xpm :data + ,breakpoint-xpm-data + :conversion disabled + :ascent 100) + (:type pbm :data + ,breakpoint-disabled-pbm-data + :ascent 100)))))) + (+ start 1) nil 'left-margin)) + (when (< left-margin-width 2) + (save-current-buffer + (setq left-margin-width 2) + (if (get-buffer-window (current-buffer)) + (set-window-margins (get-buffer-window + (current-buffer)) + left-margin-width + right-margin-width)))) + (gdb-put-string (if enabled "B" "b") (1+ start))))) + +(defun gdb-remove-breakpoint-icons (start end &optional remove-margin) + (gdb-remove-strings start end) + (if (display-images-p) + (remove-images start end)) + (when remove-margin + (setq left-margin-width 0) + (if (get-buffer-window (current-buffer)) + (set-window-margins (get-buffer-window + (current-buffer)) + left-margin-width + right-margin-width)))) + + +;; +;; Assembler buffer. +;; +(gdb-set-buffer-rules 'gdb-assembler-buffer + 'gdb-assembler-buffer-name + 'gdb-assembler-mode) + +(def-gdb-auto-updated-buffer gdb-assembler-buffer + gdb-invalidate-assembler + (concat "server disassemble " gdb-current-address "\n") + gdb-assembler-handler + gdb-assembler-custom) + +(defun gdb-assembler-custom () + (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) + (pos 1) (address) (flag)) + (with-current-buffer buffer + (if (not (equal gdb-current-address "main")) + (progn + (goto-char (point-min)) + (if (re-search-forward gdb-current-address nil t) + (progn + (setq pos (point)) + (beginning-of-line) + (or gdb-overlay-arrow-position + (setq gdb-overlay-arrow-position (make-marker))) + (set-marker gdb-overlay-arrow-position + (point) (current-buffer)))))) + ;; remove all breakpoint-icons in assembler buffer before updating. + (gdb-remove-breakpoint-icons (point-min) (point-max))) + (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) + (goto-char (point-min)) + (while (< (point) (- (point-max) 1)) + (forward-line 1) + (if (looking-at "[^\t].*breakpoint") + (progn + (looking-at + "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)") + (setq flag (char-after (match-beginning 1))) + (setq address (match-string 2)) + ;; remove leading 0s from output of info break. + (if (string-match "^0+\\(.*\\)" address) + (setq address (match-string 1 address))) + (with-current-buffer buffer + (goto-char (point-min)) + (if (re-search-forward address nil t) + (gdb-put-breakpoint-icon (eq flag ?y)))))))) + (if (not (equal gdb-current-address "main")) + (set-window-point (get-buffer-window buffer) pos)))) + +(defvar gdb-assembler-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-assembler-mode () + "Major mode for viewing code assembler. + +\\{gdb-assembler-mode-map}" + (setq major-mode 'gdb-assembler-mode) + (setq mode-name "Machine") + (setq gdb-overlay-arrow-position nil) + (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) + (put 'gdb-overlay-arrow-position 'overlay-arrow-string "=>") + (setq fringes-outside-margins t) + (setq buffer-read-only t) + (use-local-map gdb-assembler-mode-map) + (gdb-invalidate-assembler)) + +(defun gdb-assembler-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*Machine Code " (gdb-get-target-string) "*"))) + +(defun gdb-display-assembler-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-assembler-buffer))) + +(defun gdb-frame-assembler-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-assembler-buffer))) + +;; modified because if gdb-current-address has changed value a new command +;; must be enqueued to update the buffer with the new output +(defun gdb-invalidate-assembler (&optional ignored) + (if (gdb-get-buffer 'gdb-assembler-buffer) + (progn + (unless (string-equal gdb-current-frame gdb-previous-frame) + (if (or (not (member 'gdb-invalidate-assembler + (gdb-get-pending-triggers))) + (not (string-equal gdb-current-address + gdb-previous-address))) + (progn + ;; take previous disassemble command off the queue + (with-current-buffer gud-comint-buffer + (let ((queue (gdb-get-input-queue)) (item)) + (dolist (item queue) + (if (equal (cdr item) '(gdb-assembler-handler)) + (gdb-set-input-queue + (delete item (gdb-get-input-queue))))))) + (gdb-enqueue-input + (list (concat "server disassemble " gdb-current-address "\n") + 'gdb-assembler-handler)) + (gdb-set-pending-triggers + (cons 'gdb-invalidate-assembler + (gdb-get-pending-triggers))) + (setq gdb-previous-address gdb-current-address) + (setq gdb-previous-frame gdb-current-frame))))))) + +(defun gdb-get-current-frame () + (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers))) + (progn + (gdb-enqueue-input + (list (concat "server info frame\n") 'gdb-frame-handler)) + (gdb-set-pending-triggers + (cons 'gdb-get-current-frame + (gdb-get-pending-triggers)))))) + +(defun gdb-frame-handler () + (gdb-set-pending-triggers + (delq 'gdb-get-current-frame (gdb-get-pending-triggers))) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (forward-line) + (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*\\)") + (progn + (setq gdb-current-frame (match-string 2)) + (let ((address (match-string 1))) + ;; remove leading 0s from output of info frame command. + (if (string-match "^0+\\(.*\\)" address) + (setq gdb-current-address + (concat "0x" (match-string 1 address))) + (setq gdb-current-address (concat "0x" address)))) + (if (or (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t)) + (progn (setq gdb-view-source nil) t)) + (eq gdb-selected-view 'assembler)) + (progn + (set-window-buffer + gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + ;;update with new frame for machine code if necessary + (gdb-invalidate-assembler)))))) + (if (re-search-forward " source language \\(\\S-*\\)\." nil t) + (setq gdb-current-language (match-string 1)))) + +(provide 'gdb-ui) + +;;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 +;;; gdb-ui.el ends here
--- a/lisp/ruler-mode.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/ruler-mode.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; ruler-mode.el --- display a ruler in the header line -;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -95,7 +95,7 @@ ;; important to use the same font family and size for ruler and text ;; areas. ;; -;; You can override the ruler format by defining an appropriate +;; You can override the ruler format by defining an appropriate ;; function as the buffer-local value of `ruler-mode-ruler-function'. ;; Installation @@ -531,19 +531,15 @@ (defvar ruler-mode-header-line-format-old nil "Hold previous value of `header-line-format'.") -(make-variable-buffer-local 'ruler-mode-header-line-format-old) -(defvar ruler-mode-ruler-function nil - "If non-nil, function to call to return ruler string. +(defvar ruler-mode-ruler-function 'ruler-mode-ruler + "Function to call to return ruler header line format. This variable is expected to be made buffer-local by modes.") (defconst ruler-mode-header-line-format - '(:eval (funcall (if ruler-mode-ruler-function - ruler-mode-ruler-function - 'ruler-mode-ruler))) + '(:eval (funcall ruler-mode-ruler-function)) "`header-line-format' used in ruler mode. -If the non-nil value for ruler-mode-ruler-function is given, use it. -Else use `ruler-mode-ruler' is used as default value.") +Call `ruler-mode-ruler-function' to compute the ruler value.") ;;;###autoload (define-minor-mode ruler-mode @@ -556,18 +552,18 @@ ;; When `ruler-mode' is on save previous header line format ;; and install the ruler header line format. (when (local-variable-p 'header-line-format) - (setq ruler-mode-header-line-format-old header-line-format)) + (set (make-local-variable 'ruler-mode-header-line-format-old) + header-line-format)) (setq header-line-format ruler-mode-header-line-format) - (add-hook 'post-command-hook ; add local hook - #'force-mode-line-update nil t)) + (add-hook 'post-command-hook 'force-mode-line-update nil t)) ;; When `ruler-mode' is off restore previous header line format if ;; the current one is the ruler header line format. (when (eq header-line-format ruler-mode-header-line-format) (kill-local-variable 'header-line-format) (when (local-variable-p 'ruler-mode-header-line-format-old) - (setq header-line-format ruler-mode-header-line-format-old))) - (remove-hook 'post-command-hook ; remove local hook - #'force-mode-line-update t))) + (setq header-line-format ruler-mode-header-line-format-old) + (kill-local-variable 'ruler-mode-header-line-format-old))) + (remove-hook 'post-command-hook 'force-mode-line-update t))) ;; Add ruler-mode to the minor mode menu in the mode line (define-key mode-line-mode-menu [ruler-mode] @@ -621,133 +617,124 @@ (defsubst ruler-mode-space (width &rest props) "Return a single space string of WIDTH times the normal character width. Optional argument PROPS specifies other text properties to apply." - (if (> width 0) - (apply 'propertize " " 'display (list 'space :width width) props) - "")) + (apply 'propertize " " 'display (list 'space :width width) props)) (defun ruler-mode-ruler () - "Return a string ruler." - (when ruler-mode - (let* ((w (window-width)) - (m (window-margins)) - (lsb (scroll-bar-columns 'left)) - (lf (fringe-columns 'left t)) - (lm (or (car m) 0)) - (rsb (scroll-bar-columns 'right)) - (rf (fringe-columns 'right t)) - (rm (or (cdr m) 0)) - (ruler (make-string w ruler-mode-basic-graduation-char)) - (i 0) - (j (window-hscroll)) - k c l1 l2 r2 r1 h1 h2 f1 f2) - - ;; Setup the default properties. - (put-text-property 0 w 'face 'ruler-mode-default-face ruler) - (put-text-property 0 w - 'help-echo - (cond - (ruler-mode-show-tab-stops - ruler-mode-ruler-help-echo-when-tab-stops) - (goal-column - ruler-mode-ruler-help-echo-when-goal-column) - (t - ruler-mode-ruler-help-echo)) - ruler) - ;; Setup the local map. - (put-text-property 0 w 'local-map ruler-mode-map ruler) - - ;; Setup the active area. - (while (< i w) - ;; Graduations. - (cond - ;; Show a number graduation. - ((= (mod j 10) 0) - (setq c (number-to-string (/ j 10)) - m (length c) - k i) - (put-text-property - i (1+ i) 'face 'ruler-mode-column-number-face - ruler) - (while (and (> m 0) (>= k 0)) - (aset ruler k (aref c (setq m (1- m)))) - (setq k (1- k)))) - ;; Show an intermediate graduation. - ((= (mod j 5) 0) - (aset ruler i ruler-mode-inter-graduation-char))) - ;; Special columns. - (cond - ;; Show the `current-column' marker. - ((= j (current-column)) - (aset ruler i ruler-mode-current-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-current-column-face - 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 - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-goal-column-help-echo - ruler)) - ;; Show the `comment-column' marker. - ((= j comment-column) - (aset ruler i ruler-mode-comment-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-comment-column-face - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-comment-column-help-echo - ruler)) - ;; Show the `fill-column' marker. - ((= j fill-column) - (aset ruler i ruler-mode-fill-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-fill-column-face - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-fill-column-help-echo - ruler)) - ;; Show the `tab-stop-list' markers. - ((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 - ruler))) - (setq i (1+ i) - j (1+ j))) - - ;; Highlight the fringes and margins. - (if (nth 2 (window-fringes)) - ;; fringes outside margins. - (setq l1 lf - l2 lm - r2 rm - r1 rf - h1 ruler-mode-fringe-help-echo - h2 ruler-mode-margin-help-echo - f1 'ruler-mode-fringes-face - f2 'ruler-mode-margins-face) - ;; fringes inside margins. - (setq l1 lm - l2 lf - r2 rf - r1 rm - h1 ruler-mode-margin-help-echo - h2 ruler-mode-fringe-help-echo - f1 'ruler-mode-margins-face - f2 'ruler-mode-fringes-face)) - ;; Return the ruler propertized string. Using list here, - ;; instead of concat visually separate the different areas. - (list - (ruler-mode-space lsb 'face 'ruler-mode-pad-face) - (ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1)) - (ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2)) - ruler - (ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2)) - (ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1)) - (ruler-mode-space rsb 'face 'ruler-mode-pad-face))))) + "Compute and return an header line ruler." + (let* ((w (window-width)) + (m (window-margins)) + (f (window-fringes)) + (i 0) + (j (window-hscroll)) + ;; Setup the scrollbar, fringes, and margins areas. + (lf (ruler-mode-space + 'left-fringe + 'face 'ruler-mode-fringes-face + 'help-echo (format ruler-mode-fringe-help-echo + "Left" (or (car f) 0)))) + (rf (ruler-mode-space + 'right-fringe + 'face 'ruler-mode-fringes-face + 'help-echo (format ruler-mode-fringe-help-echo + "Right" (or (cadr f) 0)))) + (lm (ruler-mode-space + 'left-margin + 'face 'ruler-mode-margins-face + 'help-echo (format ruler-mode-margin-help-echo + "Left" (or (car m) 0)))) + (rm (ruler-mode-space + 'right-margin + 'face 'ruler-mode-margins-face + 'help-echo (format ruler-mode-margin-help-echo + "Right" (or (cdr m) 0)))) + (sb (ruler-mode-space + 'scroll-bar + 'face 'ruler-mode-pad-face)) + ;; 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 + 'local-map ruler-mode-map + 'help-echo (cond + (ruler-mode-show-tab-stops + ruler-mode-ruler-help-echo-when-tab-stops) + (goal-column + ruler-mode-ruler-help-echo-when-goal-column) + (ruler-mode-ruler-help-echo)))) + k c) + ;; Setup the active area. + (while (< i w) + ;; Graduations. + (cond + ;; Show a number graduation. + ((= (mod j 10) 0) + (setq c (number-to-string (/ j 10)) + m (length c) + k i) + (put-text-property + i (1+ i) 'face 'ruler-mode-column-number-face + ruler) + (while (and (> m 0) (>= k 0)) + (aset ruler k (aref c (setq m (1- m)))) + (setq k (1- k)))) + ;; Show an intermediate graduation. + ((= (mod j 5) 0) + (aset ruler i ruler-mode-inter-graduation-char))) + ;; Special columns. + (cond + ;; Show the `current-column' marker. + ((= j (current-column)) + (aset ruler i ruler-mode-current-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-current-column-face + 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 + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-goal-column-help-echo + ruler)) + ;; Show the `comment-column' marker. + ((= j comment-column) + (aset ruler i ruler-mode-comment-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-comment-column-face + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-comment-column-help-echo + ruler)) + ;; Show the `fill-column' marker. + ((= j fill-column) + (aset ruler i ruler-mode-fill-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-fill-column-face + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-fill-column-help-echo + ruler)) + ;; Show the `tab-stop-list' markers. + ((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 + ruler))) + (setq i (1+ i) + j (1+ j))) + ;; Return the ruler propertized string. Using list here, + ;; instead of concat visually separate the different areas. + (if (nth 2 (window-fringes)) + ;; fringes outside margins. + (list "" (and (eq 'left sbvt) sb) lf lm + ruler rm rf (and (eq 'right sbvt) sb)) + ;; fringes inside margins. + (list "" (and (eq 'left sbvt) sb) lm lf + ruler rf rm (and (eq 'right sbvt) sb))))) (provide 'ruler-mode)
--- a/lisp/simple.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/simple.el Thu Mar 25 22:21:45 2004 +0000 @@ -4116,6 +4116,15 @@ ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. +(defface completion-emphasis + '((t (:inherit bold))) + "Face put on the first uncommon character in completions in *Completions* buffer." + :group 'completion) + +(defface completion-de-emphasis + '((t (:inherit default))) + "Face put on the common prefix substring in completions in *Completions* buffer." + :group 'completion) (defun completion-setup-function () (save-excursion @@ -4145,6 +4154,27 @@ (save-match-data (if (minibufferp mainbuf) (setq completion-base-size 0)))) + ;; Put emphasis and de-emphasis faces on completions. + (when completion-base-size + (let ((common-string-length (length + (substring mbuf-contents + completion-base-size))) + (element-start (next-single-property-change + (point-min) + 'mouse-face)) + element-common-end) + (while element-start + (setq element-common-end (+ element-start common-string-length)) + (when (and (get-char-property element-start 'mouse-face) + (get-char-property element-common-end 'mouse-face)) + (put-text-property element-start element-common-end + 'font-lock-face 'completion-de-emphasis) + (put-text-property element-common-end (1+ element-common-end) + 'font-lock-face 'completion-emphasis)) + (setq element-start (next-single-property-change + element-start + 'mouse-face))))) + ;; Insert help string. (goto-char (point-min)) (if (display-mouse-p) (insert (substitute-command-keys
--- a/lisp/smerge-mode.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/smerge-mode.el Thu Mar 25 22:21:45 2004 +0000 @@ -179,16 +179,13 @@ :help "Use Ediff to resolve the conflicts" :active (smerge-check 1)] ["Auto Resolve" smerge-resolve - :help "Use mode-provided resolution function" - :active (and (smerge-check 1) (local-variable-p 'smerge-resolve-function))] + :help "Try auto-resolution heuristics" + :active (smerge-check 1)] ["Combine" smerge-combine-with-next :help "Combine current conflict with next" :active (smerge-check 1)] )) -(easy-mmode-defmap smerge-context-menu-map - `(([down-mouse-3] . smerge-activate-context-menu)) - "Keymap for context menu appeared on conflicts area.") (easy-menu-define smerge-context-menu nil "Context menu for mine area in `smerge-mode'." '(nil @@ -246,15 +243,22 @@ (defun smerge-keep-all () - "Keep all three versions. -Convenient for the kind of conflicts that can arise in ChangeLog files." + "Concatenate all versions." (interactive) (smerge-match-conflict) - (replace-match (concat (or (match-string 1) "") - (or (match-string 2) "") - (or (match-string 3) "")) - t t) - (smerge-auto-leave)) + (let ((mb2 (or (match-beginning 2) (point-max))) + (me2 (or (match-end 2) (point-min)))) + (delete-region (match-end 3) (match-end 0)) + (delete-region (max me2 (match-end 1)) (match-beginning 3)) + (if (and (match-end 2) (/= (match-end 1) (match-end 3))) + (delete-region (match-end 1) (match-beginning 2))) + (delete-region (match-beginning 0) (min (match-beginning 1) mb2)) + (smerge-auto-leave))) + +(defun smerge-keep-n (n) + ;; We used to use replace-match, but that did not preserve markers so well. + (delete-region (match-end n) (match-end 0)) + (delete-region (match-beginning 0) (match-beginning n))) (defun smerge-combine-with-next () "Combine the current conflict with the next one." @@ -310,32 +314,30 @@ "Pop up the Smerge mode context menu under mouse." (interactive "e") (if (and smerge-mode - (save-excursion (mouse-set-point event) (smerge-check 1))) + (save-excursion (mouse-set-point event) (smerge-check 1))) (progn - (mouse-set-point event) - (smerge-match-conflict) - (let ((i (smerge-get-current)) - o) - (if (<= i 0) - ;; Out of range - (popup-menu smerge-mode-menu) - ;; Install overlay. - (setq o (make-overlay (match-beginning i) (match-end i))) - (unwind-protect - (progn - (overlay-put o 'face 'highlight) - (sit-for 0) - (popup-menu (if (smerge-check 2) - smerge-mode-menu - smerge-context-menu))) - ;; Delete overlay. - (delete-overlay o))))) + (mouse-set-point event) + (smerge-match-conflict) + (let ((i (smerge-get-current)) + o) + (if (<= i 0) + ;; Out of range + (popup-menu smerge-mode-menu) + ;; Install overlay. + (setq o (make-overlay (match-beginning i) (match-end i))) + (unwind-protect + (progn + (overlay-put o 'face 'highlight) + (sit-for 0) ;Display the new highlighting. + (popup-menu smerge-context-menu)) + ;; Delete overlay. + (delete-overlay o))))) ;; There's no conflict at point, the text-props are just obsolete. (save-excursion (let ((beg (re-search-backward smerge-end-re nil t)) - (end (re-search-forward smerge-begin-re nil t))) - (smerge-remove-props (or beg (point-min)) (or end (point-max))) - (push event unread-command-events))))) + (end (re-search-forward smerge-begin-re nil t))) + (smerge-remove-props (or beg (point-min)) (or end (point-max))) + (push event unread-command-events))))) (defun smerge-resolve () "Resolve the conflict at point intelligently. @@ -344,7 +346,24 @@ (interactive) (smerge-match-conflict) (smerge-remove-props) - (funcall smerge-resolve-function) + (cond + ;; Trivial diff3 -A non-conflicts. + ((and (eq (match-end 1) (match-end 3)) + (eq (match-beginning 1) (match-beginning 3))) + ;; FIXME: Add "if [ diff -b MINE OTHER ]; then select OTHER; fi" + (smerge-keep-n 3)) + ((and (match-end 2) + ;; FIXME: Add "diff -b BASE MINE | patch OTHER". + ;; FIXME: Add "diff -b BASE OTHER | patch MINE". + nil) + ) + ((and (not (match-end 2)) + ;; FIXME: Add "diff -b"-based refinement. + nil) + ) + (t + ;; Mode-specific conflict resolution. + (funcall smerge-resolve-function))) (smerge-auto-leave)) (defun smerge-keep-base () @@ -353,7 +372,7 @@ (smerge-match-conflict) (smerge-ensure-match 2) (smerge-remove-props) - (replace-match (match-string 2) t t) + (smerge-keep-n 2) (smerge-auto-leave)) (defun smerge-keep-other () @@ -362,7 +381,7 @@ (smerge-match-conflict) ;;(smerge-ensure-match 3) (smerge-remove-props) - (replace-match (match-string 3) t t) + (smerge-keep-n 3) (smerge-auto-leave)) (defun smerge-keep-mine () @@ -371,7 +390,7 @@ (smerge-match-conflict) ;;(smerge-ensure-match 1) (smerge-remove-props) - (replace-match (match-string 1) t t) + (smerge-keep-n 1) (smerge-auto-leave)) (defun smerge-get-current () @@ -389,7 +408,7 @@ (let ((i (smerge-get-current))) (if (<= i 0) (error "Not inside a version") (smerge-remove-props) - (replace-match (match-string i) t t) + (smerge-keep-n i) (smerge-auto-leave)))) (defun smerge-kill-current () @@ -399,11 +418,15 @@ (let ((i (smerge-get-current))) (if (<= i 0) (error "Not inside a version") (smerge-remove-props) - (replace-match (mapconcat - (lambda (j) - (match-string j)) - (remove i '(1 2 3)) "") t t) - (smerge-auto-leave)))) + (let ((left nil)) + (dolist (n '(3 2 1)) + (if (and (match-end n) (/= (match-end n) (match-end i))) + (push n left))) + (if (and (cdr left) + (/= (match-end (car left)) (match-end (cadr left)))) + (ding) ;We don't know how to do that. + (smerge-keep-n (car left)) + (smerge-auto-leave)))))) (defun smerge-diff-base-mine () "Diff 'base' and 'mine' version in current conflict region." @@ -567,7 +590,7 @@ (goto-char (point-min)) (while (smerge-find-conflict) (when (match-beginning 2) (setq base t)) - (replace-match (match-string 1) t t)) + (smerge-keep-n 1)) (buffer-enable-undo) (set-buffer-modified-p nil) (funcall mode)) @@ -577,7 +600,7 @@ (insert-buffer-substring buf) (goto-char (point-min)) (while (smerge-find-conflict) - (replace-match (match-string 3) t t)) + (smerge-keep-n 3)) (buffer-enable-undo) (set-buffer-modified-p nil) (funcall mode)) @@ -590,7 +613,9 @@ (insert-buffer-substring buf) (goto-char (point-min)) (while (smerge-find-conflict) - (replace-match (or (match-string 2) "") t t)) + (if (match-end 2) + (smerge-keep-n 2) + (delete-region (match-beginning 0) (match-end 0)))) (buffer-enable-undo) (set-buffer-modified-p nil) (funcall mode)))
--- a/lisp/textmodes/fill.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/textmodes/fill.el Thu Mar 25 22:21:45 2004 +0000 @@ -32,7 +32,7 @@ (defgroup fill nil "Indenting and filling text." - :link '(custom-manual "(emacs)Filling Text") + :link '(custom-manual "(emacs)Filling") :group 'editing) (defcustom fill-individual-varying-indent nil
--- a/lisp/textmodes/ispell.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/textmodes/ispell.el Thu Mar 25 22:21:45 2004 +0000 @@ -1947,7 +1947,7 @@ (help-2 (concat "[l]ook a word up in alternate dictionary; " "e[x/X]it; [q]uit session")) (help-3 (concat "[u]ncapitalized insert into dict. " - "Type 'x C-h d ispell-help' for more help"))) + "Type 'x C-h f ispell-help' for more help"))) (save-window-excursion (if ispell-help-in-bufferp (progn
--- a/lisp/textmodes/tex-mode.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/textmodes/tex-mode.el Thu Mar 25 22:21:45 2004 +0000 @@ -1,6 +1,6 @@ ;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- coding: utf-8 -*- -;; Copyright (C) 1985,86,89,92,94,95,96,97,98,1999,2002,2003 +;; Copyright (C) 1985,86,89,92,94,95,96,97,98,1999,2002,03,2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -1446,6 +1446,8 @@ ;; The utility functions: (define-derived-mode tex-shell shell-mode "TeX-Shell" + (set (make-local-variable 'compilation-parse-errors-function) + 'tex-compilation-parse-errors) (compilation-shell-minor-mode t)) ;;;###autoload @@ -1879,8 +1881,6 @@ (let (shell-dirtrack-verbose) (tex-send-command tex-shell-cd-command dir))) (with-current-buffer (process-buffer (tex-send-command cmd)) - (make-local-variable 'compilation-parse-errors-function) - (setq compilation-parse-errors-function 'tex-compilation-parse-errors) (setq compilation-last-buffer (current-buffer)) (compilation-forget-errors) ;; Don't parse previous compilations. @@ -1927,7 +1927,7 @@ end-of-error (match-end 0))) (re-search-forward "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move)) - (let* ((this-error (set-marker (make-marker) begin-of-error)) + (let* ((this-error (copy-marker begin-of-error)) (linenum (string-to-int (match-string 1))) (error-text (regexp-quote (match-string 3))) (filename
--- a/lisp/time.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/time.el Thu Mar 25 22:21:45 2004 +0000 @@ -173,9 +173,11 @@ '((if (and (not display-time-format) display-time-day-and-date) (format-time-string "%a %b %e " now) "") - (format-time-string (or display-time-format - (if display-time-24hr-format "%H:%M" "%-I:%M%p")) - now) + (propertize + (format-time-string (or display-time-format + (if display-time-24hr-format "%H:%M" "%-I:%M%p")) + now) + 'help-echo (format-time-string "%a %b %e, %Y" now)) load (if mail ;; Build the string every time to act on customization.
--- a/lisp/vc-arch.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc-arch.el Thu Mar 25 22:21:45 2004 +0000 @@ -25,22 +25,21 @@ ;;; Commentary: ;; The home page of the Arch version control system is at -;; +;; ;; http://www.gnuarch.org/ -;; +;; ;; This is derived from vc-mcvs.el as follows: ;; - cp vc-mcvs.el vc-arch.el and then M-% mcvs RET arch RET ;; ;; Then of course started the hacking. ;; ;; What has been partly tested: -;; - Open a file -;; - C-x v = without any prefix arg -;; - C-x v v to commit a change to a single file +;; - Open a file. +;; - C-x v = without any prefix arg. +;; - C-x v v to commit a change to a single file. ;; Bugs: -;; - Opening a new file prompts "blabla was lost; check out? (yes or no)". ;; - *VC-log*'s initial content lacks the `Summary:' lines. ;; - All files under the tree are considered as "under Arch's control" ;; without regards to =tagging-method and such. @@ -56,7 +55,7 @@ ;;; Code: -(eval-when-compile (require 'vc)) +(eval-when-compile (require 'vc) (require 'cl)) ;;; ;;; Customization options @@ -86,17 +85,103 @@ ;;;###autoload (load "vc-arch") ;;;###autoload (vc-arch-registered file))))) -(defun vc-arch-add-tag () +(defun vc-arch-add-tagline () "Add an `arch-tag' to the end of the current file." (interactive) + (comment-normalize-vars) (goto-char (point-max)) (forward-comment -1) (unless (bolp) (insert "\n")) - (let ((beg (point))) + (let ((beg (point)) + (idfile (and buffer-file-name + (expand-file-name + (concat ".arch-ids/" + (file-name-nondirectory buffer-file-name) + ".id") + (file-name-directory buffer-file-name))))) (insert "arch-tag: ") - (call-process "uuidgen" nil t) ;Also inserts a terminal newline. + (if (and idfile (file-exists-p idfile)) + ;; If the file is unreadable, we do want to get an error here. + (progn + (insert-file-contents idfile) + (forward-line 1) + (delete-file idfile)) + (condition-case nil + (call-process "uuidgen" nil t) + (file-error (insert (format "%s <%s> %s" + (current-time-string) + user-mail-address + (+ (nth 2 (current-time)) + (buffer-size))))))) (comment-region beg (point)))) +(defconst vc-arch-tagline-re "^\\W*arch-tag:[ \t]*\\(.*[^ \t\n]\\)") + +(defun vc-arch-file-source-p (file) + "Can return nil, `maybe' or a non-nil value. +Only the value `maybe' can be trusted :-(." + ;; FIXME: Check the tag and name of parent dirs. + (unless (string-match "\\`[,+]" (file-name-nondirectory file)) + (or (string-match "\\`{arch}/" + (file-relative-name file (vc-arch-root file))) + (file-exists-p + ;; Check the presence of an ID file. + (expand-file-name + (concat ".arch-ids/" (file-name-nondirectory file) ".id") + (file-name-directory file))) + ;; Check the presence of a tagline. + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-max)) + (or (re-search-backward vc-arch-tagline-re (- (point) 1000) t) + (progn + (goto-char (point-min)) + (re-search-forward vc-arch-tagline-re (+ (point) 1000) t))))) + ;; FIXME: check =tagging-method to see whether untagged files might + ;; be source or not. + (with-current-buffer + (find-file-noselect (expand-file-name "{arch}/=tagging-method" + (vc-arch-root file))) + (let ((untagged-source t)) ;Default is `names'. + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*\\(\\(tagline\\|implicit\\|names\\)\\|explicit\\)" nil t) + (setq untagged-source (match-end 2))) + (if (re-search-forward "^[ \t]*untagged-source[ \t]+\\(\\(source\\)\\|precious\\|backup\\|junk\\|unrecognized\\)" nil t) + (setq untagged-source (match-end 2)))) + (if untagged-source 'maybe)))))) + +(defun vc-arch-file-id (file) + ;; Don't include the kind of ID this is because it seems to be too messy. + (let ((idfile (expand-file-name + (concat ".arch-ids/" (file-name-nondirectory file) ".id") + (file-name-directory file)))) + (if (file-exists-p idfile) + (with-temp-buffer + (insert-file-contents idfile) + (looking-at ".*[^ \n\t]") + (match-string 0))) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-max)) + (if (or (re-search-backward vc-arch-tagline-re (- (point) 1000) t) + (progn + (goto-char (point-min)) + (re-search-forward vc-arch-tagline-re (+ (point) 1000) t))) + (match-string 1) + (concat "./" (file-relative-name file (vc-arch-root file)))))))) + +(defun vc-arch-tagging-method (file) + (with-current-buffer + (find-file-noselect + (expand-file-name "{arch}/=tagging-method" (vc-arch-root file))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + "^[ \t]*\\(tagline\\|implicit\\|names\\|explicit\\)" nil t) + (intern (match-string 1)) + 'names)))) + (defun vc-arch-root (file) "Return the root directory of a Arch project, if any." (or (vc-file-getprop file 'arch-root) @@ -111,11 +196,20 @@ (setq file (directory-file-name file)))) root)))) +(defun vc-arch-register (file &optional rev comment) + (if rev (error "Explicit initial revision not supported for Arch.")) + (let ((tagmet (vc-arch-tagging-method file))) + (if (and (memq tagmet '(tagline implicit)) comment-start) + (with-current-buffer (find-file-noselect file) + (vc-arch-add-tagline)) + (vc-arch-command nil 0 file "add")))) + (defun vc-arch-registered (file) - ;; Don't check whether it's source or not. Checking would require - ;; running TLA, so it's better to not do it, so it also works if TLA is - ;; not installed. - (vc-arch-root file)) + ;; Don't seriously check whether it's source or not. Checking would + ;; require running TLA, so it's better to not do it, so it also works if + ;; TLA is not installed. + (and (vc-arch-root file) + (vc-arch-file-source-p file))) (defun vc-arch-default-version (file) (or (vc-file-getprop (vc-arch-root file) 'arch-default-version) @@ -138,8 +232,47 @@ ;; There's no checkout operation and merging is not done from VC ;; so the only operation that's state dependent that VC supports is commit ;; which is only activated if the file is `edited'. - 'edited) - + (let* ((root (vc-arch-root file)) + (ver (vc-arch-default-version file)) + (pat (concat "\\`" (subst-char-in-string ?/ ?% ver))) + (dir (expand-file-name ",,inode-sigs/" + (expand-file-name "{arch}" root))) + (sigfile nil)) + (dolist (f (if (file-directory-p dir) (directory-files dir t pat))) + (if (or (not sigfile) (file-newer-than-file-p f sigfile)) + (setq sigfile f))) + (if (not sigfile) + 'edited ;We know nothing. + (let ((id (vc-arch-file-id file))) + (setq id (replace-regexp-in-string "[ \t]" "_" id)) + (with-current-buffer (find-file-noselect sigfile) + (goto-char (point-min)) + (while (and (search-forward id nil 'move) + (progn (goto-char (- (match-beginning 0) 2)) + ;; Ignore E_ entries used for foo.id files. + (or (not (bolp)) (looking-at "E_"))))) + (if (eobp) + ;; ID not found. + (if (equal (file-name-nondirectory sigfile) + (subst-char-in-string + ?/ ?% (vc-arch-workfile-version file))) + 'added + ;; Might be `added' or `up-to-date' as well. + ;; FIXME: Check in the patch logs to find out. + 'edited) + ;; Found the ID, let's check the inode. + (if (not (re-search-forward + "\t.*mtime=\\([0-9]+\\):size=\\([0-9]+\\)" + (line-end-position) t)) + ;; Buh? Unexpected format. + 'edited + (let ((ats (file-attributes file))) + (if (and (= (nth 7 ats) (string-to-number (match-string 2))) + (equal (format-time-string "%s" (nth 5 ats)) + (match-string 1))) + 'up-to-date + 'edited))))))))) + (defun vc-arch-workfile-version (file) (let* ((root (expand-file-name "{arch}" (vc-arch-root file))) (defbranch (vc-arch-default-version file))) @@ -180,15 +313,19 @@ (if (string-match (car rule) rev) (setq rev (replace-match (cdr rule) t nil rev)))) (format "Arch%c%s" - (if (memq (vc-state file) '(up-to-date needs-patch)) ?- ?:) + (case (vc-state file) + ((up-to-date needs-patch) ?-) + (added ?@) + (t ?:)) rev))) (defun vc-arch-diff3-rej-p (rej) - (and (eq (nth 7 (file-attributes rej)) 56) - (with-temp-buffer - (insert-file-contents rej) - (goto-char (point-min)) - (looking-at "Conflicts occured, diff3 conflict markers left in file\\.$")))) + (let ((attrs (file-attributes rej))) + (and attrs (< (nth 7 attrs) 60) + (with-temp-buffer + (insert-file-contents rej) + (goto-char (point-min)) + (looking-at "Conflicts occured, diff3 conflict markers left in file\\."))))) (defun vc-arch-delete-rej-if-obsolete () "For use in `write-file-functions'." @@ -216,6 +353,11 @@ (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) +(defun vc-arch-find-file-not-found-hook () + ;; Do nothing. We are not sure whether the file is `source' or not, + ;; so we shouldn't ask the user whether she wants to check it out. + ) + (defun vc-arch-checkout-model (file) 'implicit) (defun vc-arch-checkin (file rev comment) @@ -231,6 +373,12 @@ (defun vc-arch-diff (file &optional oldvers newvers) "Get a difference report using Arch between two versions of FILE." + (if (and newvers + (vc-up-to-date-p file) + (equal newvers (vc-workfile-version file))) + ;; Newvers is the base revision and the current file is unchanged, + ;; so we can diff with the current file. + (setq newvers nil)) (if newvers (error "Diffing specific revisions not implemented.") (let* ((async (fboundp 'start-process))
--- a/lisp/vc-cvs.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc-cvs.el Thu Mar 25 22:21:45 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $ +;; $Id: vc-cvs.el,v 1.68 2004/03/21 15:45:31 spiegel Exp $ ;; This file is part of GNU Emacs. @@ -533,14 +533,14 @@ ;;; History functions ;;; -(defun vc-cvs-print-log (file) +(defun vc-cvs-print-log (file &optional buffer) "Get change log associated with FILE." (vc-cvs-command - nil + buffer (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) file "log")) -(defun vc-cvs-diff (file &optional oldvers newvers) +(defun vc-cvs-diff (file &optional oldvers newvers buffer) "Get a difference report using CVS between two versions of FILE." (if (string= (vc-workfile-version file) "0") ;; This file is added but not yet committed; there is no master file. @@ -549,13 +549,13 @@ ;; We regard this as "changed". ;; Diff it against /dev/null. ;; Note: this is NOT a "cvs diff". - (apply 'vc-do-command "*vc-diff*" + (apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" file (append (vc-switches nil 'diff) '("/dev/null"))) ;; Even if it's empty, it's locally modified. 1) (let* ((async (and (vc-stay-local-p file) (fboundp 'start-process))) - (status (apply 'vc-cvs-command "*vc-diff*" + (status (apply 'vc-cvs-command (or buffer "*vc-diff*") (if async 'async 1) file "diff" (and oldvers (concat "-r" oldvers))
--- a/lisp/vc-hooks.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc-hooks.el Thu Mar 25 22:21:45 2004 +0000 @@ -6,7 +6,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-hooks.el,v 1.161 2004/03/15 03:53:05 monnier Exp $ +;; $Id: vc-hooks.el,v 1.163 2004/03/23 20:59:19 monnier Exp $ ;; This file is part of GNU Emacs. @@ -463,8 +463,15 @@ (defun vc-default-workfile-unchanged-p (backend file) "Check if FILE is unchanged by diffing against the master version. Return non-nil if FILE is unchanged." - ;; If rev1 is nil, `diff' uses the current workfile version. - (zerop (vc-call diff file))) + (let ((diff-args-length + (length (cadr (symbol-function + (vc-find-backend-function backend 'diff)))))) + (zerop (if (> diff-args-length 4) + ;; If the implementation supports it, let the output + ;; go to *vc*, not *vc-diff*, since this is an internal call. + (vc-call diff file nil nil "*vc*") + ;; for backward compatibility + (vc-call diff file))))) (defun vc-workfile-version (file) "Return the version level of the current workfile FILE. @@ -758,14 +765,17 @@ ;; When a file does not exist, ignore cached info about it ;; from a previous visit. (vc-file-clearprops buffer-file-name) - (if (and (vc-backend buffer-file-name) - (yes-or-no-p - (format "File %s was lost; check out from version control? " - (file-name-nondirectory buffer-file-name)))) - (save-excursion - (require 'vc) - (setq default-directory (file-name-directory buffer-file-name)) - (not (vc-error-occurred (vc-checkout buffer-file-name)))))) + (let ((backend (vc-backend buffer-file-name))) + (if backend (vc-call-backend backend find-file-not-found-hook)))) + +(defun vc-default-find-file-not-found-hook (backend) + (if (yes-or-no-p + (format "File %s was lost; check out from version control? " + (file-name-nondirectory buffer-file-name))) + (save-excursion + (require 'vc) + (setq default-directory (file-name-directory buffer-file-name)) + (not (vc-error-occurred (vc-checkout buffer-file-name)))))) (add-hook 'find-file-not-found-functions 'vc-file-not-found-hook)
--- a/lisp/vc-rcs.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc-rcs.el Thu Mar 25 22:21:45 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-rcs.el,v 1.38 2003/09/01 15:45:17 miles Exp $ +;; $Id: vc-rcs.el,v 1.39 2004/03/21 15:46:23 spiegel Exp $ ;; This file is part of GNU Emacs. @@ -479,14 +479,14 @@ ;;; History functions ;;; -(defun vc-rcs-print-log (file) +(defun vc-rcs-print-log (file &optional buffer) "Get change log associated with FILE." - (vc-do-command nil 0 "rlog" (vc-name file))) + (vc-do-command buffer 0 "rlog" (vc-name file))) -(defun vc-rcs-diff (file &optional oldvers newvers) +(defun vc-rcs-diff (file &optional oldvers newvers buffer) "Get a difference report using RCS between two versions of FILE." (if (not oldvers) (setq oldvers (vc-workfile-version file))) - (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file + (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file (append (list "-q" (concat "-r" oldvers) (and newvers (concat "-r" newvers)))
--- a/lisp/vc-sccs.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc-sccs.el Thu Mar 25 22:21:45 2004 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-sccs.el,v 1.24 2003/09/01 15:45:17 miles Exp $ +;; $Id: vc-sccs.el,v 1.25 2004/03/21 15:49:55 spiegel Exp $ ;; This file is part of GNU Emacs. @@ -270,9 +270,9 @@ ;;; History functions ;;; -(defun vc-sccs-print-log (file) +(defun vc-sccs-print-log (file &optional buffer) "Get change log associated with FILE." - (vc-do-command nil 0 "prs" (vc-name file))) + (vc-do-command buffer 0 "prs" (vc-name file))) (defun vc-sccs-logentry-check () "Check that the log entry in the current buffer is acceptable for SCCS." @@ -280,11 +280,11 @@ (goto-char 512) (error "Log must be less than 512 characters; point is now at pos 512"))) -(defun vc-sccs-diff (file &optional oldvers newvers) +(defun vc-sccs-diff (file &optional oldvers newvers buffer) "Get a difference report using SCCS between two versions of FILE." (setq oldvers (vc-sccs-lookup-triple file oldvers)) (setq newvers (vc-sccs-lookup-triple file newvers)) - (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" (vc-name file) + (apply 'vc-do-command (or buffer "*vc-diff*") 1 "vcdiff" (vc-name file) (append (list "-q" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)))
--- a/lisp/vc.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/vc.el Thu Mar 25 22:21:45 2004 +0000 @@ -7,7 +7,7 @@ ;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Keywords: tools -;; $Id: vc.el,v 1.368 2004/03/15 03:55:24 monnier Exp $ +;; $Id: vc.el,v 1.371 2004/03/25 15:39:03 sds Exp $ ;; This file is part of GNU Emacs. @@ -264,9 +264,10 @@ ;; ;; HISTORY FUNCTIONS ;; -;; * print-log (file) +;; * print-log (file &optional buffer) ;; -;; Insert the revision log of FILE into the *vc* buffer. +;; Insert the revision log of FILE into BUFFER, or the *vc* buffer +;; if BUFFER is nil. ;; ;; - show-log-entry (version) ;; @@ -301,17 +302,17 @@ ;; default implementation runs rcs2log, which handles RCS- and ;; CVS-style logs. ;; -;; * diff (file &optional rev1 rev2) +;; * diff (file &optional rev1 rev2 buffer) ;; -;; Insert the diff for FILE into the *vc-diff* buffer. If REV1 and -;; REV2 are non-nil, report differences from REV1 to REV2. If REV1 -;; is nil, use the current workfile version (as found in the -;; repository) as the older version; if REV2 is nil, use the current -;; workfile contents as the newer version. This function should -;; pass the value of (vc-switches BACKEND 'diff) to the backend -;; command. It should return a status of either 0 (no differences -;; found), or 1 (either non-empty diff or the diff is run -;; asynchronously). +;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if +;; BUFFER is nil. If REV1 and REV2 are non-nil, report differences +;; from REV1 to REV2. If REV1 is nil, use the current workfile +;; version (as found in the repository) as the older version; if +;; REV2 is nil, use the current workfile contents as the newer +;; version. This function should pass the value of (vc-switches +;; BACKEND 'diff) to the backend command. It should return a status +;; of either 0 (no differences found), or 1 (either non-empty diff +;; or the diff is run asynchronously). ;; ;; - diff-tree (dir &optional rev1 rev2) ;; @@ -434,8 +435,13 @@ ;; ;; - find-file-hook () ;; -;; Operation called in current buffer when opening a new file. This can +;; Operation called in current buffer when opening a file. This can ;; be used by the backend to setup some local variables it might need. +; +;; - find-file-not-found-hook () +;; +;; Operation called in current buffer when opening a non-existing file. +;; By default, this asks the user if she wants to check out the file. ;;; Code: @@ -1727,7 +1733,9 @@ 'diff-tree dir rel1 rel2)) (vc-exec-after `(let ((inhibit-read-only t)) (insert "\nEnd of diffs.\n")))) - ;; single file diff + ;; Single file diff. It is important that the vc-controlled buffer + ;; is still current at this time, because any local settings in that + ;; buffer should affect the diff command. (vc-diff-internal file rel1 rel2)) (set-buffer "*vc-diff*") (if (and (zerop (buffer-size)) @@ -1752,8 +1760,8 @@ (defun vc-diff-internal (file rel1 rel2) "Run diff to compare FILE's revisions REL1 and REL2. -Output goes to the current buffer, which is assumed properly set up. -The exit status of the diff command is returned. +Diff output goes to the *vc-diff* buffer. The exit status of the diff +command is returned. This function takes care to set up a proper coding system for diff output. If both revisions are available as local files, then it also does not @@ -2322,14 +2330,29 @@ ;;;###autoload (defun vc-print-log (&optional focus-rev) - "List the change log of the current buffer in a window. If -FOCUS-REV is non-nil, leave the point at that revision." + "List the change log of the current buffer in a window. +If FOCUS-REV is non-nil, leave the point at that revision." (interactive) (vc-ensure-vc-buffer) - (let ((file buffer-file-name)) + (let* ((file buffer-file-name) + (backend-function + (symbol-function + (vc-find-backend-function (vc-backend file) 'print-log))) + (print-log-args + (if (byte-code-function-p backend-function) + (aref backend-function 0) + (cadr backend-function)))) (or focus-rev (setq focus-rev (vc-workfile-version file))) - (vc-call print-log file) - (set-buffer "*vc*") + ;; Don't switch to the output buffer before running the command, + ;; so that any buffer-local settings in the vc-controlled + ;; buffer can be accessed by the command. + (if (cdr print-log-args) + (progn + (vc-call print-log file "*vc-change-log*") + (set-buffer "*vc-change-log*")) + ;; for backward compatibility + (vc-call print-log file) + (set-buffer "*vc*")) (pop-to-buffer (current-buffer)) (log-view-mode) (vc-exec-after @@ -3043,7 +3066,7 @@ (set (make-local-variable 'vc-annotate-parent-rev) vc-annotate-version) (set (make-local-variable 'vc-annotate-parent-display-mode) vc-annotate-display-mode)) - + ;; Don't use the temp-buffer-name until the buffer is created ;; (only after `with-output-to-temp-buffer'.) (setq vc-annotate-buffers @@ -3098,7 +3121,7 @@ (vc-annotate-warp-version rev-at-line)))))) (defun vc-annotate-revision-previous-to-line () - "Visit the annotation of the version before the version at line." + "Visit the annotation of the version before the version at line." (interactive) (if (not (equal major-mode 'vc-annotate-mode)) (message "Cannot be invoked outside of a vc annotate buffer")
--- a/lisp/woman.el Fri Mar 19 23:21:11 2004 +0000 +++ b/lisp/woman.el Thu Mar 25 22:21:45 2004 +0000 @@ -809,7 +809,7 @@ (defcustom woman-fill-frame nil ;; Based loosely on a suggestion by Theodore Jump: - "*If non-nil then most of the frame width is used." + "*If non-nil then most of the window width is used." :type 'boolean :group 'woman-formatting) @@ -2211,7 +2211,7 @@ ;; Based loosely on a suggestion by Theodore Jump: (if (or woman-fill-frame (not (and (integerp woman-fill-column) (> woman-fill-column 0)))) - (setq woman-fill-column (- (frame-width) woman-default-indent))) + (setq woman-fill-column (- (window-width) woman-default-indent))) ;; Check for preprocessor requests: (goto-char from)
--- a/lispref/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/lispref/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,10 @@ +2004-03-22 Juri Linkov <juri@jurta.org> + + * sequences.texi (Sequence Functions): Replace xref to `Vectors' + with `Vector Functions'. + + * text.texi (Sorting): Add missing quote. + 2004-03-14 Luc Teirlinck <teirllm@auburn.edu> * intro.texi (Lisp History): Replace xref to `cl' manual with
--- a/lispref/sequences.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/lispref/sequences.texi Thu Mar 25 22:21:45 2004 +0000 @@ -172,8 +172,8 @@ @xref{Text Properties}. See also @code{append} in @ref{Building Lists}, @code{concat} in -@ref{Creating Strings}, and @code{vconcat} in @ref{Vectors}, for other -ways to copy sequences. +@ref{Creating Strings}, and @code{vconcat} in @ref{Vector Functions}, +for other ways to copy sequences. @example @group
--- a/lispref/text.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/lispref/text.texi Thu Mar 25 22:21:45 2004 +0000 @@ -1750,7 +1750,7 @@ BEG and END (region to sort). The variable `sort-fold-case' determines\ whether alphabetic case affects -the sort order. +the sort order." @end group @group (interactive "P\nr")
--- a/man/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/man/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,19 @@ +2004-03-22 Juri Linkov <juri@jurta.org> + + * emacs.texi (Top): Add `Misc X'. + + * faq.texi, trouble.texi: Fix help key bindings. + + * glossary.texi: Improve references. + + * help.texi: Sync keywords with finder.el. + + * mini.texi (Completion): Add description for menu items. + + * misc.texi (Browse-URL, FFAP): Add information about keywords. + + * sending.texi (Mail Methods): Fix xref to Message manual. + 2004-03-17 Luc Teirlinck <teirllm@auburn.edu> * info.texi (Advanced): Replace @unnumberedsubsec by @subheading
--- a/man/emacs.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/emacs.texi Thu Mar 25 22:21:45 2004 +0000 @@ -810,6 +810,7 @@ * Borders X:: Internal and external borders, under X. * Title X:: Specifying the initial frame's title. * Icons X:: Choosing what sort of icon to use, under X. +* Misc X:: Other display options. X Resources
--- a/man/faq.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/faq.texi Thu Mar 25 22:21:45 2004 +0000 @@ -613,7 +613,7 @@ @cindex Command description in the manual @item -The command @kbd{C-h C-f} (@code{Info-goto-emacs-command-node}) prompts +The command @kbd{C-h F} (@code{Info-goto-emacs-command-node}) prompts for the name of a command, and then attempts to find the section in the Emacs manual where that command is described. @@ -980,7 +980,7 @@ @item Inside of Emacs itself. You can get it from selecting the @samp{Emacs FAQ} option from the @samp{Help} menu of the Emacs menu bar at the top -of any Emacs frame, or by typing @kbd{C-h F} (@kbd{M-x view-emacs-FAQ}). +of any Emacs frame, or by typing @kbd{C-h C-f} (@kbd{M-x view-emacs-FAQ}). @item Via USENET. If you can read news, the FAQ should be available in your @@ -1110,7 +1110,7 @@ @cindex Differences between Emacs 19 and Emacs 20 @cindex Emacs 20, new features in -To find out what has changed in recent versions, type @kbd{C-h n} +To find out what has changed in recent versions, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). The oldest changes are at the bottom of the file, so you might want to read it starting there, rather than at the top. @@ -2687,7 +2687,7 @@ The file @file{etc/PROBLEMS} in the Emacs distribution lists various known problems with building and using Emacs on specific platforms; -type @kbd{C-h P} to read it. +type @kbd{C-h C-e} to read it. @menu * Problems with very large files::
--- a/man/glossary.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/glossary.texi Thu Mar 25 22:21:45 2004 +0000 @@ -234,8 +234,8 @@ When a line of text is longer than the width of the window, it takes up more than one screen line when displayed. We say that the text line is continued, and all screen lines used for it after the -first are called continuation lines. @xref{Basic,Continuation,Basic -Editing}. A related Emacs feature is `filling' (q.v.@:). +first are called continuation lines. @xref{Continuation Lines}. +A related Emacs feature is `filling' (q.v.@:). @item Control Character A control character is a character that you type by holding down the @@ -280,7 +280,7 @@ called point (q.v.@:) at which insertion and deletion takes place. The cursor is on or under the character that follows point. Often people speak of `the cursor' when, strictly speaking, they mean -`point.' @xref{Basic,Cursor,Basic Editing}. +`point.' @xref{Point,Cursor}. @item Customization Customization is making minor changes in the way Emacs works. It is @@ -317,7 +317,7 @@ @key{DEL} is a character that runs the command to delete one character of text before the cursor. It is typically either the @key{DELETE} key or the @key{BACKSPACE} key, whichever one is easy to type. -@xref{Basic,DEL,Basic Editing}. +@xref{Erasing,DEL}. @item Deletion Deletion means erasing text without copying it into the kill ring @@ -547,7 +547,7 @@ Control (q.v.@:) characters are graphic characters. These include letters, digits, punctuation, and spaces; they do not include @key{RET} or @key{ESC}. In Emacs, typing a graphic character inserts -that character (in ordinary editing modes). @xref{Basic,,Basic Editing}. +that character (in ordinary editing modes). @xref{Inserting Text}. @item Highlighting Highlighting text means displaying it with a different foreground and/or @@ -639,7 +639,7 @@ @item Justification Justification means adding extra spaces within lines of text to make them extend exactly to a specified width. -@xref{Filling,Justification}. +@xref{Format Justification}. @item Keyboard Macro Keyboard macros are a way of defining new Emacs commands from @@ -730,7 +730,7 @@ @item @kbd{M-} @kbd{M-} in the name of a character is an abbreviation for @key{META}, one of the modifier keys that can accompany any character. -@xref{User Input}. +@xref{User Input,M-}. @item @kbd{M-C-} @kbd{M-C-} in the name of a character is an abbreviation for @@ -894,7 +894,7 @@ Point is the place in the buffer at which insertion and deletion occur. Point is considered to be between two characters, not at one character. The terminal's cursor (q.v.@:) indicates the location of -point. @xref{Basic,Point,Basic Editing}. +point. @xref{Point}. @item Prefix Argument See `numeric argument.' @@ -942,7 +942,7 @@ inserts itself; so in this context, a special character is any character that does not normally insert itself (such as @key{DEL}, for example), and quoting it makes it insert itself as if it were not special. Not -all contexts allow quoting. @xref{Basic,Quoting,Basic Editing}. +all contexts allow quoting. @xref{Inserting Text,Quoting}. @item Quoting File Names Quoting a file name turns off the special significance of constructs @@ -1035,7 +1035,7 @@ @item Scrolling Scrolling means shifting the text in the Emacs window so as to see a -different part of the buffer. @xref{Display,Scrolling}. +different part of the buffer. @xref{Scrolling}. @item Searching Searching means moving point to the next occurrence of a specified @@ -1055,7 +1055,7 @@ @item Selecting Selecting a buffer means making it the current (q.v.@:) buffer. -@xref{Buffers,Selecting}. +@xref{Select Buffer}. @item Selection Windowing systems allow an application program to specify @@ -1212,7 +1212,7 @@ Truncating text lines in the display means leaving out any text on a line that does not fit within the right margin of the window displaying it. See also `continuation line.' -@xref{Basic,Truncation,Basic Editing}. +@xref{Continuation Lines,Truncation}. @item TTY See `text-only terminal.'
--- a/man/help.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/help.texi Thu Mar 25 22:21:45 2004 +0000 @@ -71,7 +71,7 @@ expression) in the @emph{text} of the manual rather than in its indices. -@item C-h F +@item C-h C-f This brings up the Emacs FAQ, where you can use the usual search commands (@pxref{Search}) to find the information. @@ -343,38 +343,40 @@ @multitable {emulations} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} @item abbrev@tab abbreviation handling, typing shortcuts, macros. -@item bib@tab support for the bibliography processor @code{bib}. -@item c@tab C and C++ language support. +@item bib@tab code related to the @code{bib} bibliography processor. +@item c@tab support for the C language and related languages. @item calendar@tab calendar and time management support. @item comm@tab communications, networking, remote access to files. +@item convenience@tab convenience features for faster editing. @item data@tab support for editing files of data. @item docs@tab support for Emacs documentation. @item emulations@tab emulations of other editors. @item extensions@tab Emacs Lisp language extensions. -@item faces@tab support for using faces (fonts and colors; @pxref{Faces}). +@item faces@tab support for multiple fonts. +@item files@tab support for editing and manipulating files. @item frames@tab support for Emacs frames and window systems. @item games@tab games, jokes and amusements. @item hardware@tab support for interfacing with exotic hardware. @item help@tab support for on-line help systems. -@item hypermedia@tab support for links within text, or other media types. +@item hypermedia@tab support for links between text or other media types. @item i18n@tab internationalization and alternate character-set support. @item internal@tab code for Emacs internals, build process, defaults. @item languages@tab specialized modes for editing programming languages. -@item lisp@tab support for using Lisp (including Emacs Lisp). -@item local@tab libraries local to your site. +@item lisp@tab Lisp support, including Emacs Lisp. +@item local@tab code local to your site. @item maint@tab maintenance aids for the Emacs development group. @item mail@tab modes for electronic-mail handling. -@item matching@tab searching and matching. +@item matching@tab various sorts of searching and matching. +@item mouse@tab mouse support. +@item multimedia@tab images and sound support. @item news@tab support for netnews reading and posting. -@item non-text@tab support for editing files that are not ordinary text. @item oop@tab support for object-oriented programming. -@item outlines@tab hierarchical outlining. +@item outlines@tab support for hierarchical outlining. @item processes@tab process, subshell, compilation, and job control support. @item terminals@tab support for terminal types. -@item tex@tab support for the @TeX{} formatter. +@item tex@tab supporting code for the @TeX{} formatter. @item tools@tab programming tools. -@item unix@tab front-ends/assistants for, or emulators of, system features. -@item vms@tab support code for VMS. +@item unix@tab front-ends/assistants for, or emulators of, UNIX-like features. @item wp@tab word processing. @end multitable
--- a/man/mini.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/mini.texi Thu Mar 25 22:21:45 2004 +0000 @@ -206,10 +206,10 @@ case does not matter. @menu -* Example: Completion Example. -* Commands: Completion Commands. -* Strict Completion:: -* Options: Completion Options. +* Example: Completion Example. Examples of using completion. +* Commands: Completion Commands. A list of completion commands. +* Strict Completion:: Different types of completion. +* Options: Completion Options. Options for completion. @end menu @node Completion Example
--- a/man/misc.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/misc.texi Thu Mar 25 22:21:45 2004 +0000 @@ -2172,9 +2172,10 @@ @code{browse-url-browser-function}. You can invoke actions dependent on the type of URL by defining @code{browse-url-browser-function} as an association list. The package's commentary available via @kbd{C-h -p} provides more information. Packages with facilities for following -URLs should always go through Browse-URL, so that the customization -options for Browse-URL will affect all browsing in Emacs. +p} under the @samp{hypermedia} keyword provides more information. +Packages with facilities for following URLs should always go through +Browse-URL, so that the customization options for Browse-URL will +affect all browsing in Emacs. @node Goto-address @subsection Activating URLs @@ -2221,14 +2222,14 @@ This feature is useful for following references in mail or news buffers, @file{README} files, @file{MANIFEST} files, and so on. The -@samp{ffap} package's commentary available via @kbd{C-h p} and the -@code{ffap} Custom group provide details. +@samp{ffap} package's commentary available via @kbd{C-h p} under the +@samp{files} keyword and the @code{ffap} Custom group provide details. @cindex FFAP minor mode @findex ffap-mode - You can turn on FFAP minor mode to make the following key bindings -and to install hooks for using @code{ffap} in Rmail, Gnus and VM -article buffers. + You can turn on FFAP minor mode by calling @code{ffap-bindings} to +make the following key bindings and to install hooks for using +@code{ffap} in Rmail, Gnus and VM article buffers. @table @kbd @item C-x C-f @var{filename} @key{RET}
--- a/man/sending.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/sending.texi Thu Mar 25 22:21:45 2004 +0000 @@ -687,7 +687,7 @@ and sending mail---Mail mode. Emacs has alternative facilities for editing and sending mail, including MH-E and Message mode, not documented in this manual. -@xref{Top,,MH-E,mh-e, The Emacs Interface to MH}. @xref{Top,,,message, +@xref{Top,,MH-E,mh-e, The Emacs Interface to MH}. @xref{Top,,Message,message, Message Manual}. You can choose any of them as your preferred method. The commands @code{C-x m}, @code{C-x 4 m} and @code{C-x 5 m} use whichever agent you have specified, as do various other Emacs commands
--- a/man/ses.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/ses.texi Thu Mar 25 22:21:45 2004 +0000 @@ -835,7 +835,7 @@ Thomas Gehrlein @email{Thomas.Gehrlein@@t-online.de}@* Chris F.A. Johnson @email{c.f.a.johnson@@rogers.com}@* Yusong Li @email{lyusong@@hotmail.com}@* -Yuri Linkov @email{link0ff@@yahoo.com}@* +Juri Linkov @email{juri@@jurta.org}@* Harald Maier @email{maierh@@myself.com}@* Alan Nash @email{anash@@san.rr.com}@* François Pinard @email{pinard@@iro.umontreal.ca}@*
--- a/man/text.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/text.texi Thu Mar 25 22:21:45 2004 +0000 @@ -2198,7 +2198,7 @@ @kindex M-j f @r{(Enriched mode)} @findex set-justification-full @item M-j f -Make the region fully-justified (@code{set-justification-full}). +Make the region fully justified (@code{set-justification-full}). @kindex M-j c @r{(Enriched mode)} @kindex M-S @r{(Enriched mode)} @findex set-justification-center
--- a/man/trouble.texi Fri Mar 19 23:21:11 2004 +0000 +++ b/man/trouble.texi Thu Mar 25 22:21:45 2004 +0000 @@ -124,8 +124,8 @@ normally, and how to recognize them and correct them. For a list of additional problems you might encounter, see @ref{Bugs and problems, , Bugs and problems, efaq, GNU Emacs FAQ}, and the file @file{etc/PROBLEMS} -in the Emacs distribution. Type @kbd{C-h F} to read the FAQ; type -@kbd{C-h P} to read the @file{PROBLEMS} file. +in the Emacs distribution. Type @kbd{C-h C-f} to read the FAQ; type +@kbd{C-h C-e} to read the @file{PROBLEMS} file. @menu * DEL Does Not Delete:: What to do if @key{DEL} doesn't delete. @@ -426,7 +426,7 @@ Before reporting a bug, it is a good idea to see if it is already known. You can find the list of known problems in the file -@file{etc/PROBLEMS} in the Emacs distribution; type @kbd{C-h P} to read +@file{etc/PROBLEMS} in the Emacs distribution; type @kbd{C-h C-e} to read it. Some additional user-level problems can be found in @ref{Bugs and problems, , Bugs and problems, efaq, GNU Emacs FAQ}. Looking up your problem in these two documents might provide you with a solution or a
--- a/src/ChangeLog Fri Mar 19 23:21:11 2004 +0000 +++ b/src/ChangeLog Thu Mar 25 22:21:45 2004 +0000 @@ -1,3 +1,58 @@ +2004-03-26 Masatake YAMATO <jet@gyve.org> + + * insdel.c (adjust_markers_for_insert): Call + fix_start_end_in_overlays. + + * buffer.c (fix_start_end_in_overlays): Rename + fix_overlays_in_range. + + * editfns.c (Ftranspose_regions): Likewise. + + * lisp.h (top_level): Likewise. + +2004-03-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xterm.c (handle_one_xevent): Do not pass key press events to + GTK. + +2004-03-19 Richard M. Stallman <rms@gnu.org> + + * s/sol2-6.h: Delete previous change. + +2004-03-19 Kim F. Storm <storm@cua.dk> + + * xdisp.c (move_it_in_display_line_to): Fix MOVE_TO_POS case when + to_charpos corresponds to newline in right fringe. Use local + BUFFER_POS_REACHED_P macro. + +2004-03-19 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xdisp.c (calc_pixel_width_or_height): Add ifdef HAVE_WINDOW_SYSTEM + to compile on non-window system. + +2004-03-19 Kim F. Storm <storm@cua.dk> + + * dispextern.h (calc_pixel_width_or_height): Add prototype. + + * image.c (Qcenter): Move to xdisp.c. + + * xdisp.c (Qcenter): Declare here. + (syms_of_xdisp): intern and staticpro it. + (handle_single_display_prop): Allow space display property on all + platforms. + (display_mode_line): Set mode_line_p before displaying line. + (calc_pixel_width_or_height): Declare extern. Add separate :align-to + handling. Remove complex cases for fringes and scroll-bars. + Add left, right, and center alignment positions. Add text (area) + width/height. Return width or height for image specs. + (produce_stretch_glyph): Improve handling of :align-to. Is now + relative to left of text area by default, but other base offsets + can be specified -- also for text lines. + + * term.c (produce_glyphs): Handle IT_STRETCH. + (produce_stretch_glyph): New function to handle space width and + align-to display properties on non-window systems. + 2004-03-17 Stefan Monnier <monnier@iro.umontreal.ca> * fileio.c (Fread_file_name): Set completion-ignore-case for
--- a/src/buffer.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/buffer.c Thu Mar 25 22:21:45 2004 +0000 @@ -3293,7 +3293,7 @@ If so, we'll reverse the endpoints. Can you think of anything better to do in this situation? */ void -fix_overlays_in_range (start, end) +fix_start_end_in_overlays (start, end) register int start, end; { Lisp_Object overlay;
--- a/src/dispextern.h Fri Mar 19 23:21:11 2004 +0000 +++ b/src/dispextern.h Thu Mar 25 22:21:45 2004 +0000 @@ -74,7 +74,6 @@ #define NativeRectangle int #endif - /* Structure forward declarations. Some are here because function prototypes below reference structure types before their definition in this file. Some are here because not every file including @@ -2530,6 +2529,9 @@ extern int last_tool_bar_item; extern int mouse_autoselect_window; +extern int calc_pixel_width_or_height P_ ((double *, struct it *, Lisp_Object, + /* XFontStruct */ void *, int, int *)); + #ifdef HAVE_WINDOW_SYSTEM #if GLYPH_DEBUG
--- a/src/editfns.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/editfns.c Thu Mar 25 22:21:45 2004 +0000 @@ -4157,7 +4157,7 @@ transpose_markers (start1, end1, start2, end2, start1_byte, start1_byte + len1_byte, start2_byte, start2_byte + len2_byte); - fix_overlays_in_range (start1, end2); + fix_start_end_in_overlays (start1, end2); } return Qnil;
--- a/src/image.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/image.c Thu Mar 25 22:21:45 2004 +0000 @@ -606,6 +606,7 @@ extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile; extern Lisp_Object QCdata, QCtype; +extern Lisp_Object Qcenter; Lisp_Object QCascent, QCmargin, QCrelief; Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask; Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask; @@ -613,7 +614,6 @@ /* Other symbols. */ Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic; -Lisp_Object Qcenter; /* Time in seconds after which images should be removed from the cache if not displayed. */ @@ -7400,8 +7400,6 @@ staticpro (&Qedge_detection); Qheuristic = intern ("heuristic"); staticpro (&Qheuristic); - Qcenter = intern ("center"); - staticpro (&Qcenter); Qpostscript = intern ("postscript"); staticpro (&Qpostscript);
--- a/src/insdel.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/insdel.c Thu Mar 25 22:21:45 2004 +0000 @@ -441,9 +441,13 @@ } /* Adjusting only markers whose insertion-type is t may result in - disordered overlays in the slot `overlays_before'. */ + - disordered start and end in overlays, and + - disordered overlays in the slot `overlays_before' of current_buffer. */ if (adjusted) - fix_overlays_before (current_buffer, from, to); + { + fix_start_end_in_overlays(from, to); + fix_overlays_before (current_buffer, from, to); + } } /* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
--- a/src/lisp.h Fri Mar 19 23:21:11 2004 +0000 +++ b/src/lisp.h Thu Mar 25 22:21:45 2004 +0000 @@ -2656,7 +2656,7 @@ EXFUN (Foverlay_end, 1); extern void adjust_overlays_for_insert P_ ((EMACS_INT, EMACS_INT)); extern void adjust_overlays_for_delete P_ ((EMACS_INT, EMACS_INT)); -extern void fix_overlays_in_range P_ ((int, int)); +extern void fix_start_end_in_overlays P_ ((int, int)); extern void report_overlay_modification P_ ((Lisp_Object, Lisp_Object, int, Lisp_Object, Lisp_Object, Lisp_Object)); extern int overlay_touches_p P_ ((int));
--- a/src/s/sol2-6.h Fri Mar 19 23:21:11 2004 +0000 +++ b/src/s/sol2-6.h Thu Mar 25 22:21:45 2004 +0000 @@ -7,10 +7,5 @@ #define UNEXEC unexsol.o #endif -/* "Dennis McRitchie" <dmcr@Princeton.EDU> reported failures - with GNU ld without this. */ - -#define LD_SWITCH_SYSTEM_TEMACS -znocombreloc - /* arch-tag: 71ea3857-89dc-4395-9623-77964e6ed3ca (do not change this comment) */
--- a/src/term.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/term.c Thu Mar 25 22:21:45 2004 +0000 @@ -102,6 +102,10 @@ #define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) +/* Display space properties */ + +extern Lisp_Object Qspace, QCalign_to, QCwidth; + /* Function to use to ring the bell. */ Lisp_Object Vring_bell_function; @@ -1493,6 +1497,7 @@ ***********************************************************************/ static void append_glyph P_ ((struct it *)); +static void produce_stretch_glyph P_ ((struct it *)); /* Append glyphs to IT's glyph_row. Called from produce_glyphs for @@ -1556,9 +1561,14 @@ /* If a hook is installed, let it do the work. */ xassert (it->what == IT_CHARACTER || it->what == IT_COMPOSITION - || it->what == IT_IMAGE || it->what == IT_STRETCH); + if (it->what == IT_STRETCH) + { + produce_stretch_glyph (it); + goto done; + } + /* Nothing but characters are supported on terminal frames. For a composition sequence, it->c is the first character of the sequence. */ @@ -1632,6 +1642,7 @@ append_glyph (it); } + done: /* Advance current_x by the pixel width as a convenience for the caller. */ if (it->area == TEXT_AREA) @@ -1641,6 +1652,81 @@ } +/* Produce a stretch glyph for iterator IT. IT->object is the value + of the glyph property displayed. The value must be a list + `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs + being recognized: + + 1. `:width WIDTH' specifies that the space should be WIDTH * + canonical char width wide. WIDTH may be an integer or floating + point number. + + 2. `:align-to HPOS' specifies that the space should be wide enough + to reach HPOS, a value in canonical character units. */ + +static void +produce_stretch_glyph (it) + struct it *it; +{ + /* (space :width WIDTH ...) */ + Lisp_Object prop, plist; + int width = 0, align_to = -1; + int zero_width_ok_p = 0; + double tem; + + /* List should start with `space'. */ + xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace)); + plist = XCDR (it->object); + + /* Compute the width of the stretch. */ + if ((prop = Fplist_get (plist, QCwidth), !NILP (prop)) + && calc_pixel_width_or_height (&tem, it, prop, 0, 1, 0)) + { + /* Absolute width `:width WIDTH' specified and valid. */ + zero_width_ok_p = 1; + width = (int)(tem + 0.5); + } + else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop)) + && calc_pixel_width_or_height (&tem, it, prop, 0, 1, &align_to)) + { + if (it->glyph_row == NULL || !it->glyph_row->mode_line_p) + align_to = (align_to < 0 + ? 0 + : align_to - window_box_left_offset (it->w, TEXT_AREA)); + else if (align_to < 0) + align_to = window_box_left_offset (it->w, TEXT_AREA); + width = max (0, (int)(tem + 0.5) + align_to - it->current_x); + zero_width_ok_p = 1; + } + else + /* Nothing specified -> width defaults to canonical char width. */ + width = FRAME_COLUMN_WIDTH (it->f); + + if (width <= 0 && (width < 0 || !zero_width_ok_p)) + width = 1; + + if (width > 0 && it->glyph_row) + { + Lisp_Object o_object = it->object; + Lisp_Object object = it->stack[it->sp - 1].string; + int n = width; + int c = it->c; + + if (!STRINGP (object)) + object = it->w->buffer; + it->object = object; + it->c = ' '; + it->pixel_width = it->len = 1; + while (n--) + append_glyph (it); + it->object = o_object; + it->c = c; + } + it->pixel_width = width; + it->nglyphs = width; +} + + /* Get information about special display element WHAT in an environment described by IT. WHAT is one of IT_TRUNCATION or IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
--- a/src/xdisp.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/xdisp.c Thu Mar 25 22:21:45 2004 +0000 @@ -301,6 +301,7 @@ Lisp_Object Vdisplay_pixels_per_inch; Lisp_Object Qspace, QCalign_to, QCrelative_width, QCrelative_height; Lisp_Object Qleft_margin, Qright_margin, Qspace_width, Qraise; +Lisp_Object Qcenter; Lisp_Object Qmargin, Qpointer; extern Lisp_Object Qheight; extern Lisp_Object QCwidth, QCheight, QCascent; @@ -3603,16 +3604,11 @@ value = prop; } + valid_p = (STRINGP (value) #ifdef HAVE_WINDOW_SYSTEM - if (FRAME_TERMCAP_P (it->f)) - valid_p = STRINGP (value); - else - valid_p = (STRINGP (value) - || (CONSP (value) && EQ (XCAR (value), Qspace)) - || valid_image_p (value)); -#else /* not HAVE_WINDOW_SYSTEM */ - valid_p = STRINGP (value); + || (!FRAME_TERMCAP_P (it->f) && valid_image_p (value)) #endif /* not HAVE_WINDOW_SYSTEM */ + || (CONSP (value) && EQ (XCAR (value), Qspace))); if ((EQ (location, Qleft_margin) || EQ (location, Qright_margin) @@ -5594,15 +5590,18 @@ saved_glyph_row = it->glyph_row; it->glyph_row = NULL; +#define BUFFER_POS_REACHED_P() \ + ((op & MOVE_TO_POS) != 0 \ + && BUFFERP (it->object) \ + && IT_CHARPOS (*it) >= to_charpos) + while (1) { int x, i, ascent = 0, descent = 0; /* Stop when ZV or TO_CHARPOS reached. */ if (!get_next_display_element (it) - || ((op & MOVE_TO_POS) != 0 - && BUFFERP (it->object) - && IT_CHARPOS (*it) >= to_charpos)) + || BUFFER_POS_REACHED_P ()) { result = MOVE_POS_MATCH_OR_ZV; break; @@ -5689,7 +5688,8 @@ #ifdef HAVE_WINDOW_SYSTEM if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) { - if (!get_next_display_element (it)) + if (!get_next_display_element (it) + || BUFFER_POS_REACHED_P ()) { result = MOVE_POS_MATCH_OR_ZV; break; @@ -5761,7 +5761,8 @@ #ifdef HAVE_WINDOW_SYSTEM if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) { - if (!get_next_display_element (it)) + if (!get_next_display_element (it) + || BUFFER_POS_REACHED_P ()) { result = MOVE_POS_MATCH_OR_ZV; break; @@ -5778,6 +5779,8 @@ } } +#undef BUFFER_POS_REACHED_P + /* Restore the iterator settings altered at the beginning of this function. */ it->glyph_row = saved_glyph_row; @@ -15064,6 +15067,8 @@ init_iterator (&it, w, -1, -1, NULL, face_id); prepare_desired_row (it.glyph_row); + it.glyph_row->mode_line_p = 1; + if (! mode_line_inverse_video) /* Force the mode-line to be displayed in the default face. */ it.base_face_id = it.face_id = DEFAULT_FACE_ID; @@ -15080,7 +15085,6 @@ compute_line_metrics (&it); it.glyph_row->full_width_p = 1; - it.glyph_row->mode_line_p = 1; it.glyph_row->continued_p = 0; it.glyph_row->truncated_on_left_p = 0; it.glyph_row->truncated_on_right_p = 0; @@ -16694,6 +16698,252 @@ return 0; } +/* Calculate a width or height in pixels from a specification using + the following elements: + + SPEC ::= + NUM - a (fractional) multiple of the default font width/height + (NUM) - specifies exactly NUM pixels + UNIT - a fixed number of pixels, see below. + ELEMENT - size of a display element in pixels, see below. + (NUM . SPEC) - equals NUM * SPEC + (+ SPEC SPEC ...) - add pixel values + (- SPEC SPEC ...) - subtract pixel values + (- SPEC) - negate pixel value + + NUM ::= + INT or FLOAT - a number constant + SYMBOL - use symbol's (buffer local) variable binding. + + UNIT ::= + in - pixels per inch *) + mm - pixels per 1/1000 meter *) + cm - pixels per 1/100 meter *) + width - width of current font in pixels. + height - height of current font in pixels. + + *) using the ratio(s) defined in display-pixels-per-inch. + + ELEMENT ::= + + left-fringe - left fringe width in pixels + right-fringe - right fringe width in pixels + + left-margin - left margin width in pixels + right-margin - right margin width in pixels + + scroll-bar - scroll-bar area width in pixels + + Examples: + + Pixels corresponding to 5 inches: + (5 . in) + + Total width of non-text areas on left side of window (if scroll-bar is on left): + '(space :width (+ left-fringe left-margin scroll-bar)) + + Align to first text column (in header line): + '(space :align-to 0) + + Align to middle of text area minus half the width of variable `my-image' + containing a loaded image: + '(space :align-to (0.5 . (- text my-image))) + + Width of left margin minus width of 1 character in the default font: + '(space :width (- left-margin 1)) + + Width of left margin minus width of 2 characters in the current font: + '(space :width (- left-margin (2 . width))) + + Center 1 character over left-margin (in header line): + '(space :align-to (+ left-margin (0.5 . left-margin) -0.5)) + + Different ways to express width of left fringe plus left margin minus one pixel: + '(space :width (- (+ left-fringe left-margin) (1))) + '(space :width (+ left-fringe left-margin (- (1)))) + '(space :width (+ left-fringe left-margin (-1))) + +*/ + +#define NUMVAL(X) \ + ((INTEGERP (X) || FLOATP (X)) \ + ? XFLOATINT (X) \ + : - 1) + +int +calc_pixel_width_or_height (res, it, prop, font, width_p, align_to) + double *res; + struct it *it; + Lisp_Object prop; + void *font; + int width_p, *align_to; +{ + double pixels; + +#define OK_PIXELS(val) ((*res = (double)(val)), 1) +#define OK_ALIGN_TO(val) ((*align_to = (int)(val)), 1) + + if (NILP (prop)) + return OK_PIXELS (0); + + if (SYMBOLP (prop)) + { + if (SCHARS (SYMBOL_NAME (prop)) == 2) + { + char *unit = SDATA (SYMBOL_NAME (prop)); + + if (unit[0] == 'i' && unit[1] == 'n') + pixels = 1.0; + else if (unit[0] == 'm' && unit[1] == 'm') + pixels = 25.4; + else if (unit[0] == 'c' && unit[1] == 'm') + pixels = 2.54; + else + pixels = 0; + if (pixels > 0) + { + double ppi; + if ((ppi = NUMVAL (Vdisplay_pixels_per_inch), ppi > 0) + || (CONSP (Vdisplay_pixels_per_inch) + && (ppi = (width_p + ? NUMVAL (XCAR (Vdisplay_pixels_per_inch)) + : NUMVAL (XCDR (Vdisplay_pixels_per_inch))), + ppi > 0))) + return OK_PIXELS (ppi / pixels); + + return 0; + } + } + +#ifdef HAVE_WINDOW_SYSTEM + if (EQ (prop, Qheight)) + return OK_PIXELS (font ? FONT_HEIGHT ((XFontStruct *)font) : FRAME_LINE_HEIGHT (it->f)); + if (EQ (prop, Qwidth)) + return OK_PIXELS (font ? FONT_WIDTH ((XFontStruct *)font) : FRAME_COLUMN_WIDTH (it->f)); +#else + if (EQ (prop, Qheight) || EQ (prop, Qwidth)) + return OK_PIXELS (1); +#endif + + if (EQ (prop, Qtext)) + return OK_PIXELS (width_p + ? window_box_width (it->w, TEXT_AREA) + : WINDOW_BOX_HEIGHT_NO_MODE_LINE (it->w)); + + if (align_to && *align_to < 0) + { + *res = 0; + if (EQ (prop, Qleft)) + return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA)); + if (EQ (prop, Qright)) + return OK_ALIGN_TO (window_box_right_offset (it->w, TEXT_AREA)); + if (EQ (prop, Qcenter)) + return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA) + + window_box_width (it->w, TEXT_AREA) / 2); + if (EQ (prop, Qleft_fringe)) + return OK_ALIGN_TO (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w) + ? WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (it->w) + : window_box_right_offset (it->w, LEFT_MARGIN_AREA)); + if (EQ (prop, Qright_fringe)) + return OK_ALIGN_TO (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w) + ? window_box_right_offset (it->w, RIGHT_MARGIN_AREA) + : window_box_right_offset (it->w, TEXT_AREA)); + if (EQ (prop, Qleft_margin)) + return OK_ALIGN_TO (window_box_left_offset (it->w, LEFT_MARGIN_AREA)); + if (EQ (prop, Qright_margin)) + return OK_ALIGN_TO (window_box_left_offset (it->w, RIGHT_MARGIN_AREA)); + if (EQ (prop, Qscroll_bar)) + return OK_ALIGN_TO (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (it->w) + ? 0 + : (window_box_right_offset (it->w, RIGHT_MARGIN_AREA) + + (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w) + ? WINDOW_RIGHT_FRINGE_WIDTH (it->w) + : 0))); + } + else + { + if (EQ (prop, Qleft_fringe)) + return OK_PIXELS (WINDOW_LEFT_FRINGE_WIDTH (it->w)); + if (EQ (prop, Qright_fringe)) + return OK_PIXELS (WINDOW_RIGHT_FRINGE_WIDTH (it->w)); + if (EQ (prop, Qleft_margin)) + return OK_PIXELS (WINDOW_LEFT_MARGIN_WIDTH (it->w)); + if (EQ (prop, Qright_margin)) + return OK_PIXELS (WINDOW_RIGHT_MARGIN_WIDTH (it->w)); + if (EQ (prop, Qscroll_bar)) + return OK_PIXELS (WINDOW_SCROLL_BAR_AREA_WIDTH (it->w)); + } + + prop = Fbuffer_local_value (prop, it->w->buffer); + } + + if (INTEGERP (prop) || FLOATP (prop)) + { + int base_unit = (width_p + ? FRAME_COLUMN_WIDTH (it->f) + : FRAME_LINE_HEIGHT (it->f)); + return OK_PIXELS (XFLOATINT (prop) * base_unit); + } + + if (CONSP (prop)) + { + Lisp_Object car = XCAR (prop); + Lisp_Object cdr = XCDR (prop); + + if (SYMBOLP (car)) + { +#ifdef HAVE_WINDOW_SYSTEM + if (valid_image_p (prop)) + { + int id = lookup_image (it->f, prop); + struct image *img = IMAGE_FROM_ID (it->f, id); + + return OK_PIXELS (width_p ? img->width : img->height); + } +#endif + if (EQ (car, Qplus) || EQ (car, Qminus)) + { + int first = 1; + double px; + + pixels = 0; + while (CONSP (cdr)) + { + if (!calc_pixel_width_or_height (&px, it, XCAR (cdr), + font, width_p, align_to)) + return 0; + if (first) + pixels = (EQ (car, Qplus) ? px : -px), first = 0; + else + pixels += px; + cdr = XCDR (cdr); + } + if (EQ (car, Qminus)) + pixels = -pixels; + return OK_PIXELS (pixels); + } + + car = Fbuffer_local_value (car, it->w->buffer); + } + + if (INTEGERP (car) || FLOATP (car)) + { + double fact; + pixels = XFLOATINT (car); + if (NILP (cdr)) + return OK_PIXELS (pixels); + if (calc_pixel_width_or_height (&fact, it, cdr, + font, width_p, align_to)) + return OK_PIXELS (pixels * fact); + return 0; + } + + return 0; + } + + return 0; +} + /*********************************************************************** Glyph Display @@ -17977,209 +18227,6 @@ } -/* Calculate a width or height in pixels from a specification using - the following elements: - - SPEC ::= - NUM - a (fractional) multiple of the default font width/height - (NUM) - specifies exactly NUM pixels - UNIT - a fixed number of pixels, see below. - ELEMENT - size of a display element in pixels, see below. - (NUM . SPEC) - equals NUM * SPEC - (+ SPEC SPEC ...) - add pixel values - (- SPEC SPEC ...) - subtract pixel values - (- SPEC) - negate pixel value - - NUM ::= - INT or FLOAT - a number constant - SYMBOL - use symbol's (buffer local) variable binding. - - UNIT ::= - in - pixels per inch *) - mm - pixels per 1/1000 meter *) - cm - pixels per 1/100 meter *) - width - width of current font in pixels. - height - height of current font in pixels. - - *) using the ratio(s) defined in display-pixels-per-inch. - - ELEMENT ::= - - left-fringe - left fringe width in pixels - (left-fringe . nil) - left fringe width if inside margins, else 0 - (left-fringe . t) - left fringe width if outside margins, else 0 - - right-fringe - right fringe width in pixels - (right-fringe . nil) - right fringe width if inside margins, else 0 - (right-fringe . t) - right fringe width if outside margins, else 0 - - left-margin - left margin width in pixels - right-margin - right margin width in pixels - - scroll-bar - scroll-bar area width in pixels - (scroll-bar . left) - scroll-bar width if on left, else 0 - (scroll-bar . right) - scroll-bar width if on right, else 0 - - Examples: - - Pixels corresponding to 5 inches: - (5 . in) - - Total width of non-text areas on left side of window: - (+ left-fringe left-margin (scroll-bar . left)) - - Total width of fringes if inside display margins: - (+ (left-fringe) (right-fringe)) - - Width of left margin minus width of 1 character in the default font: - (- left-margin 1) - - Width of left margin minus width of 2 characters in the current font: - (- left-margin (2 . width)) - - Width of left fringe plus left margin minus one pixel: - (- (+ left-fringe left-margin) (1)) - (+ left-fringe left-margin (- (1))) - (+ left-fringe left-margin (-1)) - -*/ - -#define NUMVAL(X) \ - ((INTEGERP (X) || FLOATP (X)) \ - ? XFLOATINT (X) \ - : - 1) - -static int -calc_pixel_width_or_height (res, it, prop, font, width_p) - double *res; - struct it *it; - Lisp_Object prop; - XFontStruct *font; - int width_p; -{ - double pixels; - -#define OK_PIXELS(val) ((*res = (val)), 1) - - if (SYMBOLP (prop)) - { - if (SCHARS (SYMBOL_NAME (prop)) == 2) - { - char *unit = SDATA (SYMBOL_NAME (prop)); - - if (unit[0] == 'i' && unit[1] == 'n') - pixels = 1.0; - else if (unit[0] == 'm' && unit[1] == 'm') - pixels = 25.4; - else if (unit[0] == 'c' && unit[1] == 'm') - pixels = 2.54; - else - pixels = 0; - if (pixels > 0) - { - double ppi; - if ((ppi = NUMVAL (Vdisplay_pixels_per_inch), ppi > 0) - || (CONSP (Vdisplay_pixels_per_inch) - && (ppi = (width_p - ? NUMVAL (XCAR (Vdisplay_pixels_per_inch)) - : NUMVAL (XCDR (Vdisplay_pixels_per_inch))), - ppi > 0))) - return OK_PIXELS (ppi / pixels); - - return 0; - } - } - - if (EQ (prop, Qheight)) - return OK_PIXELS (font ? FONT_HEIGHT (font) : FRAME_LINE_HEIGHT (it->f)); - if (EQ (prop, Qwidth)) - return OK_PIXELS (font ? FONT_WIDTH (font) : FRAME_COLUMN_WIDTH (it->f)); - if (EQ (prop, Qleft_fringe)) - return OK_PIXELS (WINDOW_LEFT_FRINGE_WIDTH (it->w)); - if (EQ (prop, Qright_fringe)) - return OK_PIXELS (WINDOW_RIGHT_FRINGE_WIDTH (it->w)); - if (EQ (prop, Qleft_margin)) - return OK_PIXELS (WINDOW_LEFT_MARGIN_WIDTH (it->w)); - if (EQ (prop, Qright_margin)) - return OK_PIXELS (WINDOW_RIGHT_MARGIN_WIDTH (it->w)); - if (EQ (prop, Qscroll_bar)) - return OK_PIXELS (WINDOW_SCROLL_BAR_AREA_WIDTH (it->w)); - - prop = Fbuffer_local_value (prop, it->w->buffer); - } - - if (INTEGERP (prop) || FLOATP (prop)) - { - int base_unit = (width_p - ? FRAME_COLUMN_WIDTH (it->f) - : FRAME_LINE_HEIGHT (it->f)); - return OK_PIXELS (XFLOATINT (prop) * base_unit); - } - - if (CONSP (prop)) - { - Lisp_Object car = XCAR (prop); - Lisp_Object cdr = XCDR (prop); - - if (SYMBOLP (car)) - { - if (EQ (car, Qplus) || EQ (car, Qminus)) - { - int first = 1; - double px; - - pixels = 0; - while (CONSP (cdr)) - { - if (!calc_pixel_width_or_height (&px, it, XCAR (cdr), font, width_p)) - return 0; - if (first) - pixels = (EQ (car, Qplus) ? px : -px), first = 0; - else - pixels += px; - cdr = XCDR (cdr); - } - if (EQ (car, Qminus)) - pixels = -pixels; - return OK_PIXELS (pixels); - } - - if (EQ (car, Qleft_fringe)) - return OK_PIXELS ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w) - == !NILP (cdr)) - ? WINDOW_LEFT_FRINGE_WIDTH (it->w) - : 0); - if (EQ (car, Qright_fringe)) - return OK_PIXELS ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w) - == !NILP (cdr)) - ? WINDOW_RIGHT_FRINGE_WIDTH (it->w) - : 0); - if (EQ (car, Qscroll_bar)) - return OK_PIXELS ((WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (it->w) - == EQ (cdr, Qleft)) - ? WINDOW_SCROLL_BAR_AREA_WIDTH (it->w) - : 0); - - car = Fbuffer_local_value (car, it->w->buffer); - } - - if (INTEGERP (car) || FLOATP (car)) - { - double fact; - pixels = XFLOATINT (car); - if (NILP (cdr)) - return OK_PIXELS (pixels); - if (calc_pixel_width_or_height (&fact, it, cdr, font, width_p)) - return OK_PIXELS (pixels * fact); - return 0; - } - - return 0; - } - - return 0; -} - /* Produce a stretch glyph for iterator IT. IT->object is the value of the glyph property displayed. The value must be a list `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs @@ -18217,7 +18264,7 @@ { /* (space :width WIDTH :height HEIGHT ...) */ Lisp_Object prop, plist; - int width = 0, height = 0; + int width = 0, height = 0, align_to = -1; int zero_width_ok_p = 0, zero_height_ok_p = 0; int ascent = 0; double tem; @@ -18232,7 +18279,7 @@ /* Compute the width of the stretch. */ if ((prop = Fplist_get (plist, QCwidth), !NILP (prop)) - && calc_pixel_width_or_height (&tem, it, prop, font, 1)) + && calc_pixel_width_or_height (&tem, it, prop, font, 1, 0)) { /* Absolute width `:width WIDTH' specified and valid. */ zero_width_ok_p = 1; @@ -18263,9 +18310,15 @@ width = NUMVAL (prop) * it2.pixel_width; } else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop)) - && calc_pixel_width_or_height (&tem, it, prop, font, 1)) - { - width = max (0, (int)tem - it->current_x); + && calc_pixel_width_or_height (&tem, it, prop, font, 1, &align_to)) + { + if (it->glyph_row == NULL || !it->glyph_row->mode_line_p) + align_to = (align_to < 0 + ? 0 + : align_to - window_box_left_offset (it->w, TEXT_AREA)); + else if (align_to < 0) + align_to = window_box_left_offset (it->w, TEXT_AREA); + width = max (0, (int)tem + align_to - it->current_x); zero_width_ok_p = 1; } else @@ -18277,7 +18330,7 @@ /* Compute height. */ if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) - && calc_pixel_width_or_height (&tem, it, prop, font, 0)) + && calc_pixel_width_or_height (&tem, it, prop, font, 0, 0)) { height = (int)tem; zero_height_ok_p = 1; @@ -18298,7 +18351,7 @@ NUMVAL (prop) > 0 && NUMVAL (prop) <= 100) ascent = height * NUMVAL (prop) / 100.0; else if (!NILP (prop) - && calc_pixel_width_or_height (&tem, it, prop, font, 0)) + && calc_pixel_width_or_height (&tem, it, prop, font, 0, 0)) ascent = min (max (0, (int)tem), height); else ascent = (height * FONT_BASE (font)) / FONT_HEIGHT (font); @@ -21522,6 +21575,8 @@ staticpro (&Qleft_margin); Qright_margin = intern ("right-margin"); staticpro (&Qright_margin); + Qcenter = intern ("center"); + staticpro (&Qcenter); QCalign_to = intern (":align-to"); staticpro (&QCalign_to); QCrelative_width = intern (":relative-width");
--- a/src/xterm.c Fri Mar 19 23:21:11 2004 +0000 +++ b/src/xterm.c Thu Mar 25 22:21:45 2004 +0000 @@ -6225,6 +6225,14 @@ Lisp_Object coding_system = Qlatin_1; Lisp_Object c; +#ifdef USE_GTK + /* Don't pass keys to GTK. A Tab will shift focus to the + tool bar in GTK 2.4. Keys will still go to menus and + dialogs because in that case popup_activated is TRUE + (see above). */ + *finish = X_EVENT_DROP; +#endif + event.xkey.state |= x_emacs_to_x_modifiers (FRAME_X_DISPLAY_INFO (f), extra_keyboard_modifiers);
--- a/update-subdirs Fri Mar 19 23:21:11 2004 +0000 +++ b/update-subdirs Thu Mar 25 22:21:45 2004 +0000 @@ -1,7 +1,7 @@ #!/bin/sh # Write into $1/subdirs.el a list of subdirs of directory $1. -# Copyright (C) 1994, 1995, 1997, 1999, 2001 Free Software Foundation, Inc. +# Copyright (C) 1994,95,97,1999,2001,2004 Free Software Foundation, Inc. # # This file is part of GNU Emacs. # @@ -42,7 +42,11 @@ echo ";; In load-path, after this directory should come ;; certain of its subdirectories. Here we specify them." >> subdirs.el - echo "(normal-top-level-add-to-load-path '($subdirs))" >> subdirs.el + echo "(normal-top-level-add-to-load-path '($subdirs)) +;; Local" "Variables: +;; version-control: never +;; no-byte-compile: t +;; End:" >> subdirs.el fi # arch-tag: 56ebcf1b-5c30-4934-b0b4-72d374064704