Mercurial > emacs
changeset 107644:1d298baf84b9
Merge from mainline.
| author | Eli Zaretskii <eliz@gnu.org> |
|---|---|
| date | Sun, 28 Mar 2010 09:04:11 -0400 |
| parents | a5c1ccd17b3c (current diff) 0edec97c4c3b (diff) |
| children | 6e29ba4351e0 |
| files | etc/NEWS.23 lisp/progmodes/gdb-ui.el src/Makefile.in src/dispextern.h |
| diffstat | 127 files changed, 7634 insertions(+), 7004 deletions(-) [+] |
line wrap: on
line diff
--- a/.bzrignore Sat Mar 20 10:32:32 2010 -0400 +++ b/.bzrignore Sun Mar 28 09:04:11 2010 -0400 @@ -63,3 +63,5 @@ src/temacs src/deps configure.lineno +conftest* +confdefs.h
--- a/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,12 @@ +2010-03-27 Nick Roberts <nickrob@snap.net.nz> + + * Restore GDB/MI fuctionality removed by r99212. + +2010-03-27 Eli Zaretskii <eliz@gnu.org> + + * config.bat <lib-src>: Edit out lines that begin with several # + characters. + 2010-03-20 Dan Nicolaescu <dann@ics.uci.edu> * configure.in: Remove support for old UNIX System V systems and
--- a/admin/CPP-DEFINES Sat Mar 20 10:32:32 2010 -0400 +++ b/admin/CPP-DEFINES Sun Mar 28 09:04:11 2010 -0400 @@ -75,9 +75,6 @@ VIRT_ADDR_VARIES WORDS_BIG_ENDIAN -** Not used anymore by any port, can be cleaned up -NO_SOCK_SIGIO - ** Misc macros USER_FULL_NAME If defined, overrides the default pw->pw_gecos for getting at the full user name. Only MSDOS overrides the default.
--- a/admin/notes/bugtracker Sat Mar 20 10:32:32 2010 -0400 +++ b/admin/notes/bugtracker Sun Mar 28 09:04:11 2010 -0400 @@ -140,7 +140,7 @@ ** Not interested in tracker control messages (tags being set, etc)? Discard mails matching: -^X-Emacs-PR-Message: (transcript|closed) +^X-GNU-PR-Message: (transcript|closed) ** How to avoid multiple copies of mails. If you reply to reports in the normal way, this should work fine. @@ -166,18 +166,18 @@ 2) Send a mail to the original submitter telling them that their bug has been closed. This mail has a header: -X-Emacs-PR-Message: they-closed 123 +X-GNU-PR-Message: they-closed 123 3) Send a mail to you and to the emacs-bug-tracker list confirming that the bug has been closed. This mail has a header: -X-Emacs-PR-Message: closed 123 +X-GNU-PR-Message: closed 123 4) Send a copy of your mail to the bug-gnu-emacs list in exactly the same way as if you had sent mail to "123" (sans -done). This mail has headers: -X-Emacs-PR-Message: cc-closed 123 +X-GNU-PR-Message: cc-closed 123 Mail-Followup-To: 123@debbugs.gnu.org, person-who-closed (This is Emacs-specific. Normally the bug list gets the same mail as in 3).
--- a/admin/notes/copyright Sat Mar 20 10:32:32 2010 -0400 +++ b/admin/notes/copyright Sun Mar 28 09:04:11 2010 -0400 @@ -221,6 +221,11 @@ lib-src/getopt1.c, getopt_int.h - these are from the GNU C library. Leave the copyrights alone. +lisp/cedet/semantic/imenu.el + - See http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00410.html + in which Eric Ludlam established that the remaining contributions + from authors other than himself were negligible. + lisp/play/tetris.el - no special rules about the copyright. We note here that we believe (2007/1) there is no problem with our use of the name "tetris" or
--- a/config.bat Sat Mar 20 10:32:32 2010 -0400 +++ b/config.bat Sun Mar 28 09:04:11 2010 -0400 @@ -222,7 +222,7 @@ Echo Configuring the library source directory... cd lib-src rem Create "makefile" from "makefile.in". -sed -e "1,/== start of cpp stuff ==/s@^#[ ].*$@@" <Makefile.in >junk.c +sed -e "1,/== start of cpp stuff ==/s@^##*[ ].*$@@" <Makefile.in >junk.c gcc -E -traditional -I. -I../src junk.c | sed -e "s/^ / /" -e "/^#/d" -e "/^[ ]*$/d" >makefile.new If "%DJGPP_VER%" == "2" goto libsrc-v2 sed -f ../msdos/sed3.inp <makefile.new >Makefile
--- a/doc/emacs/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,39 @@ +2010-03-28 Nick Roberts <nickrob@snap.net.nz> + + * emacs.texi (Top): Update node names to those in building.texi. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * ack.texi (Acknowledgments): + * emacs.texi (Acknowledgments): Fix ispell attribution. (Bug#5759) + +2010-03-20 Jan Djärv <jan.h.d@swipnet.se> + + * xresources.texi (Table of Resources): Clarify toolBar number + for Gtk+. + + * frames.texi (Menu Bars): menuBarLines => menuBar (bug#5736). + +2010-03-21 Chong Yidong <cyd@stupidchicken.com> + + * dired.texi (Dired Updating): Document dired-auto-revert-buffer. + + * search.texi (Other Repeating Search): Document multi-isearch-buffers + and multi-isearch-buffers-regexp. + + * indent.texi (Indentation): Clarify description of + indent-for-tab-command. Document tab-always-indent. + +2010-03-20 Chong Yidong <cyd@stupidchicken.com> + + * cmdargs.texi (Font X): Move most content to Fonts. + + * frames.texi (Fonts): New node. Document font-use-system-font. + + * emacs.texi (Top): + * xresources.texi (Table of Resources): + * mule.texi (Defining Fontsets, Charsets): Update xrefs. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/doc/emacs/ack.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/ack.texi Sun Mar 28 09:04:11 2010 -0400 @@ -1,6 +1,7 @@ @c This is part of the Emacs manual. @c Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, -@c 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +@c 2004, 2005, 2006, 2007, 2008, 2009, 2010 +@c Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @c @node Acknowledgments, Screen, Concept Index, Top @@ -600,8 +601,7 @@ program. @item -Geoff Kuenning and Ken Stevens wrote @file{ispell.el}, a spell-checker -interface. +Ken Stevens wrote @file{ispell.el}, a spell-checker interface. @item David K@ringaccent{a}gedal wrote @file{tempo.el}, providing support for
--- a/doc/emacs/building.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/building.texi Sun Mar 28 09:04:11 2010 -0400 @@ -853,18 +853,19 @@ multiple programs within one Emacs session. @menu -* GDB-UI Layout:: Control the number of displayed buffers. +* GDB User Interface Layout:: Control the number of displayed buffers. * Source Buffers:: Use the mouse in the fringe/margin to control your program. * Breakpoints Buffer:: A breakpoint control panel. +* Threads Buffer:: Displays your threads. * Stack Buffer:: Select a frame from the call stack. -* Other GDB-UI Buffers:: Input/output, locals, registers, +* Other GDB Buffers:: Input/output, locals, registers, assembler, threads and memory buffers. * Watch Expressions:: Monitor variable values in the speedbar. -* Reverse Debugging:: Execute and reverse debug your program. +* Multithreaded Debugging:: Debugging programs with several threads. @end menu -@node GDB-UI Layout +@node GDB User Interface Layout @subsubsection GDB User Interface Layout @cindex GDB User Interface layout @@ -1014,10 +1015,92 @@ Visit the source line for the breakpoint you click on. @end table +@vindex gdb-show-threads-by-default When @code{gdb-many-windows} is non-@code{nil}, the breakpoints buffer shares its window with the threads buffer. To switch from one to the other click with @kbd{Mouse-1} on the relevant button in the header -line. +line. If @code{gdb-show-threads-by-default} is non-@code{nil}, the +threads buffer, rather than the breakpoints buffer, is shown at start +up. + +@node Threads Buffer +@subsubsection Threads Buffer + +@findex gdb-select-thread +The threads buffer displays a summary of all threads currently in your +program (@pxref{Threads, Threads, Debugging programs with multiple +threads, gdb, The GNU debugger}). Move point to any thread in the list +and press @key{RET} to select it (@code{gdb-select-thread}) and +display the associated source in the primary source buffer. +Alternatively, click @kbd{Mouse-2} on a thread to select it. Contents +of all GDB buffers are updated whenever you select a thread. + + You can customize variables under @code{gdb-buffers} group to select +fields included in threads buffer. + +@table @code +@item gdb-thread-buffer-verbose-names +@vindex gdb-thread-buffer-verbose-names +Show long thread names like @samp{Thread 0x4e2ab70 (LWP 1983)} in +threads buffer. + +@item gdb-thread-buffer-arguments +@vindex gdb-thread-buffer-arguments +Show arguments of thread top frames in threads buffer. + +@item gdb-thread-buffer-locations +@vindex gdb-thread-buffer-locations +Show file information or library names in threads buffer. + +@item gdb-thread-buffer-addresses +@vindex gdb-thread-buffer-addresses +Show addresses for thread frames in threads buffer. +@end table + + It’s possible to observe information for several threads +simultaneously (in addition to buffers which show information for +currently selected thread) using the following keys from the threads +buffer. + +@table @kbd +@item d +@kindex d @r{(GDB threads buffer)} +@findex gdb-display-disassembly-for-thread +Display disassembly buffer for the thread at current line. +(@code{gdb-display-disassembly-for-thread}) + +@item f +@kindex f @r{(GDB threads buffer)} +@findex gdb-display-stack-for-thread +Display stack buffer for the thread at current line. +(@code{gdb-display-stack-for-thread}). + +@item l +@kindex l @r{(GDB threads buffer)} +@findex gdb-display-locals-for-thread +Display locals buffer for the thread at current line. +(@code{gdb-display-locals-for-thread}). + +@item r +@kindex r @r{(GDB threads buffer)} +@findex gdb-display-registers-for-thread +Display registers buffer for the thread at current line. +(@code{gdb-display-registers-for-thread}). +@end table + +Pressing their upper-case counterparts, @kbd{D}, @kbd{F} ,@kbd{L} and +@kbd{R} displays the corresponding buffer in a new frame. + + When you create a buffer showing information about some specific +thread, it becomes bound to that thread and keeps showing actual +information while you debug your program. Every GDB buffer contains a +number of thread it shows information for in its mode name. Thread +number is also included in the buffer name of bound buffers to prevent +buffer names clashing. + +Further commands are available in the threads buffer which depend on the +mode of GDB that is used for controlling execution of your program. +(@pxref{Multithreaded Debugging, Stopping and Starting Multi-threaded Programs}). @node Stack Buffer @subsubsection Stack Buffer @@ -1035,7 +1118,7 @@ selecting a stack frame updates it to display the local variables of the new frame. -@node Other GDB-UI Buffers +@node Other GDB Buffers @subsubsection Other Buffers @table @asis @@ -1079,21 +1162,6 @@ breakpoints as in a source buffer. Breakpoint icons also appear in the fringe or margin. -@item Threads Buffer -@findex gdb-threads-select -The threads buffer displays a summary of all threads currently in your -program (@pxref{Threads, Threads, Debugging programs with multiple -threads, gdb, The GNU debugger}). Move point to any thread in the -list and press @key{RET} to select it (@code{gdb-threads-select}) and -display the associated source in the primary source buffer. -Alternatively, click @kbd{Mouse-2} on a thread to select it. If the -locals buffer is visible, its contents update to display the variables -that are local in the new thread. - -When there is more than one main thread and the threads buffer is -present, Emacs displays the selected thread number in the mode line of -many of the GDB-UI Buffers. - @item Memory Buffer The memory buffer lets you examine sections of program memory (@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}). @@ -1104,9 +1172,9 @@ size for these data items. @end table -When @code{gdb-many-windows} is non-@code{nil}, the threads buffer -shares its window with the breakpoints buffer, and the locals buffer -with the registers buffer. To switch from one to the other click with +When @code{gdb-many-windows} is non-@code{nil}, the locals buffer +shares its window with the registers buffer, just like breakpoints +and threads buffers. To switch from one to the other click with @kbd{Mouse-1} on the relevant button in the header line. @node Watch Expressions @@ -1175,26 +1243,96 @@ non-@code{nil}. This can be useful if you are debugging with a full screen Emacs frame. -@node Reverse Debugging -@subsubsection Reverse Debugging +@node Multithreaded Debugging +@subsubsection Stopping and Starting Multi-threaded Programs +@cindex Multithreaded debugging in GDB + +@subsubheading All-stop Debugging + +In all-stop mode, whenever your program stops, @emph{all} threads of +execution stop. Likewise, whenever you restart the program, all +threads start executing. @xref{All-Stop Mode, , All-Stop Mode, gdb, +The GNU debugger}. You can enable this behaviour in Emacs by setting +@code{gdb-non-stop-setting} to @code{nil} before starting a debugging +session. + +@subsubheading Non-stop Debugging +@cindex Non-stop debugging in GDB + +For some multi-threaded targets, GDB supports a further mode of +operation in which you can examine stopped program threads in the +debugger while other threads continue to execute freely. +@xref{Non-Stop Mode, , Non-Stop Mode, gdb, The GNU debugger}. +This is referred to as @dfn{non-stop} mode. + +Versions of GDB prior to 7.0 do not support non-stop mode and it does +not work on all targets. In such cases, Emacs uses all-stop mode +regardless of the value of @code{gdb-non-stop-setting}. + +@vindex gdb-non-stop-setting +If the variable @code{gdb-non-stop-setting} is non-@code{nil} (the +default value), Emacs tries to start GDB in non-stop mode. Note that +GDB debugging session needs to be restarted for change of this setting +to take effect. + +@vindex gdb-switch-when-another-stopped +When a thread stops in non-stop mode, Emacs automatically switches to +that thread. It may be undesirable to allow switching of current +thread when some other stopped thread is already selected. Set +@code{gdb-switch-when-another-stopped} to @code{nil} to prevent this. + +@vindex gdb-switch-reasons +Emacs can decide whether or not to switch to the stopped thread +depending on the reason which caused the stop. Customize +@code{gdb-switch-reasons} to select stop reasons which make Emacs +switch thread. - The GDB tool bar shares many buttons with the other GUD debuggers -for tasks like stepping and printing expressions. It also has a -further set of buttons that allow reverse debugging (@pxref{Process -Record and Replay, , ,gdb, The GNU debugger}). This is useful when it -takes a long time to reproduce the conditions where your program fails -or for transient problems, like race conditions in multi-threaded -programs, where a failure might otherwise be hard to reproduce. +@vindex gdb-stopped-hooks +The variable @code{gdb-stopped-hooks} allows you to execute your +functions whenever some thread stops. + + In non-stop mode, you can switch between different modes for GUD +execution control commands. + +@vindex gdb-gud-control-all-threads +@table @dfn +@item Non-stop/A + +When @code{gdb-gud-control-all-threads} is @code{t} (the default +value), interruption and continuation commands apply to all threads, +so you can halt or continue all your threads with one command using +@code{gud-stop-subjob} and @code{gud-cont}, respectively. The +@samp{Go} button is shown on the toolbar when at least one thread is +stopped, whereas @samp{Stop} button is shown when at least one thread +is running. + +@item Non-stop/T -To use reverse debugging, set a breakpoint slightly before the -location of interest and run your program to that point. Enable -process recording by clicking on the record button. At this point, a -new set of buttons appear. These buttons allow program execution in -the reverse direction. Run your program over the code where the -problem occurs, and then use the new set of buttons to retrace your -steps, examine values, and analyze the problem. When analysis is -complete, turn off process recording by clicking on the record button -again. +When @code{gdb-gud-control-all-threads} is @code{nil}, only the +current thread is stopped/continued. @samp{Go} and @samp{Stop} +buttons on the GUD toolbar are shown depending on the state of current +thread. +@end table + +You can change the current value of @code{gdb-gud-control-all-threads} +from the tool bar or from @samp{GUD->GDB-MI} menu. + + Stepping commands always apply to the current thread. + +@subsubheading Fine Thread Control + + In non-stop mode, you can interrupt/continue your threads without +selecting them. Hitting @kbd{i} in threads buffer interrupts thread +under point, @kbd{c} continues it, @kbd{s} steps through. More such +commands may be added in the future. + +Combined with creating bound buffers for any thread, this allows you +to change and track state of many threads in the same time. + + Note that when you interrupt a thread, it stops with @samp{signal +received} reason. If that reason is included in your +@code{gdb-switch-reasons} (it is by default), Emacs will switch to +that thread. @node Executing Lisp @section Executing Lisp Expressions
--- a/doc/emacs/cmdargs.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/cmdargs.texi Sun Mar 28 09:04:11 2010 -0400 @@ -755,10 +755,9 @@ @appendixsec Font Specification Options @cindex font name (X Window System) - By default, Emacs displays text in X using a twelve point monospace -font. You can specify a different font using the command line option -@samp{-fn @var{font}} (or @samp{--font}, which is an alias for -@samp{-fn}). +You can use the command line option @samp{-fn @var{font}} (or +@samp{--font}, which is an alias for @samp{-fn}) to specify a default +font: @table @samp @item -fn @var{font} @@ -772,252 +771,14 @@ When passing a font specification to Emacs on the command line, you may need to ``quote'' it, by enclosing it in quotation marks, if it contains characters that the shell treats specially (e.g. spaces). -Here is an example: +For example: @smallexample emacs -fn "DejaVu Sans Mono-12" @end smallexample -@cindex X defaults file -@cindex X resources file - You can also specify the font using your X resources file (usually a -file named @file{.Xdefaults} or @file{.Xresources} in your home -directory), by adding a line like this: - -@smallexample -emacs.font: @var{font} -@end smallexample - -@noindent -You must restart X, or use the @command{xrdb} command, for the X -resources file to take effect. @xref{Resources}. When specifying a -font in your X resources file, you should not quote it. - -@cindex fontconfig - Emacs recognizes two types of fonts: @dfn{client-side} fonts, which -are provided by the Xft and Fontconfig libraries, and -@dfn{server-side} fonts, which are provided by the X server itself. -Most client-side fonts support advanced font features such as -antialiasing and subpixel hinting, while server-side fonts do not. - - There are four different ways to express a ``font name''. The first -format consists of @dfn{Fontconfig patterns}. Fontconfig patterns -match only client-side fonts provided by Xft and Fontconfig, and have -the following form: - -@smallexample -@var{fontname}[-@var{fontsize}][:@var{name1}=@var{values1}][:@var{name2}=@var{values2}]... -@end smallexample - -@noindent -Within this format, any of the elements in braces may be omitted. -Here, @var{fontname} is the ``family name'' of the font, such as -@samp{Monospace} or @samp{DejaVu Serif}; @var{fontsize} is the ``point -size'' of the font (one ``printer's point'' is about 1/72 of an inch); -and the @samp{@var{name}=@var{values}} entries specify settings such -as the slant and weight of the font. Each @var{values} may be a -single value, or a list of values separated by commas. In addition, -some property values are valid with only one kind of property name, in -which case the @samp{@var{name}=} part may be omitted. - -Here is a list of common font properties: - -@table @samp -@item slant -One of @samp{italic}, @samp{oblique} or @samp{roman}. - -@item weight -One of @samp{light}, @samp{medium}, @samp{demibold}, @samp{bold} or -@samp{black}. - -@item style -Some fonts define special styles which are a combination of slant and -weight. For instance, the font @samp{Dejavu Sans} defines the style -@samp{book}. This property, if specified, overrides the slant and -weight properties. - -@item width -One of @samp{condensed}, @samp{normal}, or @samp{expanded}. - -@item spacing -One of @samp{monospace}, @samp{proportional}, @samp{dual-width}, or -@samp{charcell}. -@end table - -@noindent -Here are some examples of Fontconfig patterns: - -@smallexample -Monospace -Monospace-12 -Monospace-12:bold -DejaVu Sans Mono:bold:italic -Monospace-12:weight=bold:slant=italic -@end smallexample - -See the Fontconfig manual for a more detailed description of -Fontconfig patterns. This manual is located in the file -@file{fontconfig-user.html}, which is distributed with Fontconfig. It -is also available online at -@url{http://fontconfig.org/fontconfig-user.html}. In particular, the -manual describes additional font properties that influence how the -font is hinted, antialiased, or scaled. - - The second way to specify a font is to use a @dfn{GTK font -description}. Like Fontconfig patterns, GTK font descriptions match -only client-side fonts provided by Xft and Fontconfig. They have the -syntax - -@smallexample -@var{fontname} [@var{properties}] [@var{fontsize}] -@end smallexample - -@noindent -where @var{fontname} is the family name, @var{properties} is a list of -property values separated by spaces, and @var{fontsize} is the point -size. The properties that you may specify are as follows: - -@table @samp -@item style -One of @samp{roman}, @samp{italic} or @samp{oblique}. If omitted, the -@samp{roman} style is used. -@item weight -One of @samp{medium}, @samp{ultra-light}, @samp{light}, -@samp{semi-bold}, or @samp{bold}. If omitted, @samp{medium} weight is -used. -@end table - -@noindent -Here are some examples of GTK font descriptions: - -@smallexample -Monospace 12 -Monospace Bold Italic 12 -@end smallexample - -@cindex XLFD -@cindex X Logical Font Description - The third way to specify a font is to use an @dfn{XLFD} (@dfn{X -Logical Font Description}), which is the traditional method for -specifying fonts under X. Each XLFD consists of fourteen words or -numbers, separated by dashes, like this: - -@smallexample --misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1 -@end smallexample - -@noindent -A wildcard character (@samp{*}) in an XLFD matches any sequence of -characters (including none), and @samp{?} matches any single -character. However, matching is implementation-dependent, and can be -inaccurate when wildcards match dashes in a long name. For reliable -results, supply all 14 dashes and use wildcards only within a field. -Case is insignificant in an XLFD. The syntax for an XLFD is as -follows: - -@smallexample --@var{maker}-@var{family}-@var{weight}-@var{slant}-@var{widthtype}-@var{style}@dots{} -@dots{}-@var{pixels}-@var{height}-@var{horiz}-@var{vert}-@var{spacing}-@var{width}-@var{registry}-@var{encoding} -@end smallexample - -@noindent -The entries have the following meanings: - -@table @var -@item maker -The name of the font manufacturer. -@item family -The name of the font family (e.g. @samp{courier}). -@item weight -The font weight---normally either @samp{bold}, @samp{medium} or -@samp{light}. Some font names support other values. -@item slant -The font slant---normally @samp{r} (roman), @samp{i} (italic), -@samp{o} (oblique), @samp{ri} (reverse italic), or @samp{ot} (other). -Some font names support other values. -@item widthtype -The font width---normally @samp{condensed}, @samp{extended}, -@samp{semicondensed} or @samp{normal} (some font names support other -values). -@item style -An optional additional style name. Usually it is empty---most long -font names have two hyphens in a row at this point. -@item pixels -The font height, in pixels. -@item height -The font height on the screen, measured in tenths of a printer's -point. This is the point size of the font, times ten. For a given -vertical resolution, @var{height} and @var{pixels} are proportional; -therefore, it is common to specify just one of them and use @samp{*} -for the other. -@item horiz -The horizontal resolution, in pixels per inch, of the screen for which -the font is intended. -@item vert -The vertical resolution, in pixels per inch, of the screen for which -the font is intended. Normally the resolution of the fonts on your -system is the right value for your screen; therefore, you normally -specify @samp{*} for this and @var{horiz}. -@item spacing -This is @samp{m} (monospace), @samp{p} (proportional) or @samp{c} -(character cell). -@item width -The average character width, in pixels, multiplied by ten. -@item registry -@itemx encoding -The X font character set that the font depicts. (X font character -sets are not the same as Emacs character sets, but they are similar.) -You can use the @command{xfontsel} program to check which choices you -have. Normally you should use @samp{iso8859} for @var{registry} and -@samp{1} for @var{encoding}. -@end table - - Some fonts have shorter nicknames, which you can use instead of a -normal font specification. For instance, - -@smallexample --misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1 -@end smallexample - -@noindent -is equivalent to @samp{6x13}. This is the fourth and final method of -specifying a font. - -@cindex listing system fonts - You will probably want to use a fixed-width default font---that is, -a font in which all characters have the same width. Here's how to use -the @command{fc-list} command to list all fixed-width Xft and -Fontconfig fonts available on your system: - -@example -fc-list :spacing=mono -fc-list :spacing=charcell -@end example - - For server-side X fonts, any font with @samp{m} or @samp{c} in the -@var{spacing} field of the XLFD is a fixed-width font. Here's how to -use the @command{xlsfonts} program to list all the fixed-width fonts -available on your system: - -@example -xlsfonts -fn '*x*' | egrep "^[0-9]+x[0-9]+" -xlsfonts -fn '*-*-*-*-*-*-*-*-*-*-*-m*' -xlsfonts -fn '*-*-*-*-*-*-*-*-*-*-*-c*' -@end example - -@noindent -To see what a particular font looks like, use the @command{xfd} command. -For example: - -@example -xfd -fn 6x13 -@end example - -@noindent -displays the entire font @samp{6x13}. - - While running Emacs, you can set the font of a specific kind of text -(@pxref{Faces}), or of a particular frame (@pxref{Frame Parameters}). +@xref{Fonts}, for other ways to specify the default font and font name +formats. @node Colors @appendixsec Window Color Options
--- a/doc/emacs/dired.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/dired.texi Sun Mar 28 09:04:11 2010 -0400 @@ -1099,6 +1099,15 @@ If you use @kbd{l} on a subdirectory header line, it updates the contents of the corresponding subdirectory. +@vindex dired-auto-revert-buffer + If you use @kbd{C-x d} or some other Dired command to visit a +directory that is already being shown in a Dired buffer, Dired +switches to that buffer but does not update it. If the buffer is not +up-to-date, Dired displays a warning telling you to type @key{g} to +update it. You can also tell Emacs to revert each Dired buffer +automatically when you revisit it, by setting the variable +@code{dired-auto-revert-buffer} to a non-@code{nil} value. + @kindex k @r{(Dired)} @findex dired-do-kill-lines To delete the specified @emph{file lines} from the buffer---not
--- a/doc/emacs/emacs.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/emacs.texi Sun Mar 28 09:04:11 2010 -0400 @@ -12,8 +12,8 @@ updated for Emacs version @value{EMACSVER}. Copyright @copyright{} 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, -1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -Free Software Foundation, Inc. +1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +2010 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -502,6 +502,7 @@ * Mode Line Mouse:: Mouse clicks on the mode line. * Creating Frames:: Creating additional Emacs frames with various contents. * Frame Commands:: Iconifying, deleting, and switching frames. +* Fonts:: Changing the frame font. * Speedbar:: How to make and use a speedbar frame. * Multiple Displays:: How one Emacs job can talk to several displays. * Special Buffer Frames:: You can make certain buffers have their own frames. @@ -745,14 +746,16 @@ GDB Graphical Interface -* GDB-UI Layout:: Control the number of displayed buffers. -* Source Buffers:: Use the mouse in the fringe/margin to - control your program. -* Breakpoints Buffer:: A breakpoint control panel. -* Stack Buffer:: Select a frame from the call stack. -* Other GDB-UI Buffers::Input/output, locals, registers, - assembler, threads and memory buffers. -* Watch Expressions:: Monitor variable values in the speedbar. +* GDB User Interface Layout:: Control the number of displayed buffers. +* Source Buffers:: Use the mouse in the fringe/margin to + control your program. +* Breakpoints Buffer:: A breakpoint control panel. +* Threads Buffer:: Displays your threads. +* Stack Buffer:: Select a frame from the call stack. +* Other GDB Buffers:: Input/output, locals, registers, + assembler, threads and memory buffers. +* Watch Expressions:: Monitor variable values in the speedbar. +* Multithreaded Debugging:: Debugging programs with several threads. Maintaining Large Programs @@ -1371,8 +1374,8 @@ Henry Kautz, Taichi Kawabata, Howard Kaye, Michael Kifer, Richard King, Peter Kleiweg, Shuhei Kobayashi, Pavel Kobiakov, Larry K.@: Kolodney, David M.@: Koppelman, Koseki Yoshinori, Robert Krawitz, Sebastian -Kremer, Ryszard Kubiak, Geoff Kuenning, David K@aa{}gedal, Daniel -LaLiberte, Karl Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, +Kremer, Ryszard Kubiak, David K@aa{}gedal, Daniel LaLiberte, +Karl Landstrom, Mario Lang, Aaron Larson, James R.@: Larus, Vinicius Jose Latorre, Werner Lemberg, Frederic Lepied, Peter Liljenberg, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov, Francis Litterio, Emilio C. Lopes, K@'{a}roly L@H{o}rentey,
--- a/doc/emacs/frames.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/frames.texi Sun Mar 28 09:04:11 2010 -0400 @@ -39,6 +39,7 @@ * Mode Line Mouse:: Mouse clicks on the mode line. * Creating Frames:: Creating additional Emacs frames with various contents. * Frame Commands:: Iconifying, deleting, and switching frames. +* Fonts:: Changing the frame font. * Speedbar:: How to make and use a speedbar frame. * Multiple Displays:: How one Emacs job can talk to several displays. * Special Buffer Frames:: You can make certain buffers have their own frames. @@ -571,25 +572,19 @@ Lisp Reference Manual}, for more information. @cindex font (default) - For instance, one way to specify the principal font for all your -Emacs frames is to modify @code{default-frame-alist} to specify the -@code{font} parameter (@pxref{Font X}): + Here is an example of using @code{default-frame-alist} to specify +the default foreground color and font: @example (add-to-list 'default-frame-alist '(font . "10x20")) -@end example - -@noindent -Here's a similar example for specifying a foreground color: - -@example (add-to-list 'default-frame-alist '(foreground-color . "blue")) @end example @noindent By putting such customizations in your init file, you can control the -appearance of all the frames Emacs creates, including the initial one. -@xref{Init File}. +appearance of all the frames Emacs creates, including the initial one +(@pxref{Init File}). @xref{Fonts}, for other ways to set the default +font. @node Frame Commands @section Frame Commands @@ -645,6 +640,278 @@ a frame that raises, so this variable has no effect in the native MS-Windows build of Emacs. +@node Fonts +@section Fonts +@cindex fonts + + By default, Emacs displays text in X using a 12-point monospace +font. There are several different ways to specify a different font: + +@itemize +@item +Click on @samp{Set Default Font} in the @samp{Options} menu. To save +this for future sessions, click on @samp{Save Options} in the +@samp{Options} menu. + +@item +Add a line to your init file (@pxref{Init File}), modifying the +variable @code{default-frame-alist} to specify the @code{font} +parameter (@pxref{Creating Frames}), like this: + +@smallexample +(add-to-list 'default-frame-alist '(font . "DejaVu Sans Mono-12")) +@end smallexample + +@cindex X defaults file +@cindex X resources file +@item +Add an @samp{emacs.font} X resource setting to your X resource file, +like this: + +@smallexample +emacs.font: DejaVu Sans Mono-12 +@end smallexample + +@noindent +You must restart X, or use the @command{xrdb} command, for the X +resources file to take effect. @xref{Resources}. When specifying a +font in your X resources file, you should not quote it. + +@item +If you are running Emacs on the GNOME desktop, you can tell Emacs to +use the default system font by setting the variable +@code{font-use-system-font} to @code{t} (the default is @code{nil}). +For this to work, Emacs must be compiled with Gconf support; this is +done automatically if the libraries are present at compile time. + +@item +Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font +X}. +@end itemize + +@cindex fontconfig + On X, there are four different ways to express a ``font name''. The +first is to use a @dfn{Fontconfig pattern}. Fontconfig patterns have +the following form: + +@smallexample +@var{fontname}[-@var{fontsize}][:@var{name1}=@var{values1}][:@var{name2}=@var{values2}]... +@end smallexample + +@noindent +Within this format, any of the elements in braces may be omitted. +Here, @var{fontname} is the @dfn{family name} of the font, such as +@samp{Monospace} or @samp{DejaVu Serif}; @var{fontsize} is the +@dfn{point size} of the font (one @dfn{printer's point} is about 1/72 +of an inch); and the @samp{@var{name}=@var{values}} entries specify +settings such as the slant and weight of the font. Each @var{values} +may be a single value, or a list of values separated by commas. In +addition, some property values are valid with only one kind of +property name, in which case the @samp{@var{name}=} part may be +omitted. + +Here is a list of common font properties: + +@table @samp +@item slant +One of @samp{italic}, @samp{oblique} or @samp{roman}. + +@item weight +One of @samp{light}, @samp{medium}, @samp{demibold}, @samp{bold} or +@samp{black}. + +@item style +Some fonts define special styles which are a combination of slant and +weight. For instance, @samp{Dejavu Sans} defines the @samp{book} +style, which overrides the slant and weight properties. + +@item width +One of @samp{condensed}, @samp{normal}, or @samp{expanded}. + +@item spacing +One of @samp{monospace}, @samp{proportional}, @samp{dual-width}, or +@samp{charcell}. +@end table + +@noindent +Here are some examples of Fontconfig patterns: + +@smallexample +Monospace +Monospace-12 +Monospace-12:bold +DejaVu Sans Mono:bold:italic +Monospace-12:weight=bold:slant=italic +@end smallexample + +See the Fontconfig manual for a more detailed description of +Fontconfig patterns. This manual is located in the file +@file{fontconfig-user.html}, distributed with Fontconfig. It is also +available online at @url{http://fontconfig.org/fontconfig-user.html}. +In particular, that manual describes additional font properties that +influence how the font is hinted, antialiased, or scaled. + + The second way to specify a font is to use a @dfn{GTK font +description}. These have the syntax + +@smallexample +@var{fontname} [@var{properties}] [@var{fontsize}] +@end smallexample + +@noindent +where @var{fontname} is the family name, @var{properties} is a list of +property values separated by spaces, and @var{fontsize} is the point +size. The properties that you may specify are as follows: + +@table @samp +@item style +One of @samp{roman}, @samp{italic} or @samp{oblique}. If omitted, the +@samp{roman} style is used. +@item weight +One of @samp{medium}, @samp{ultra-light}, @samp{light}, +@samp{semi-bold}, or @samp{bold}. If omitted, @samp{medium} weight is +used. +@end table + +@noindent +Here are some examples of GTK font descriptions: + +@smallexample +Monospace 12 +Monospace Bold Italic 12 +@end smallexample + +@cindex XLFD +@cindex X Logical Font Description + The third way to specify a font is to use an @dfn{XLFD} (@dfn{X +Logical Font Description}). This is the traditional method for +specifying fonts under X. Each XLFD consists of fourteen words or +numbers, separated by dashes, like this: + +@smallexample +-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1 +@end smallexample + +@noindent +A wildcard character (@samp{*}) in an XLFD matches any sequence of +characters (including none), and @samp{?} matches any single +character. However, matching is implementation-dependent, and can be +inaccurate when wildcards match dashes in a long name. For reliable +results, supply all 14 dashes and use wildcards only within a field. +Case is insignificant in an XLFD. The syntax for an XLFD is as +follows: + +@smallexample +-@var{maker}-@var{family}-@var{weight}-@var{slant}-@var{widthtype}-@var{style}@dots{} +@dots{}-@var{pixels}-@var{height}-@var{horiz}-@var{vert}-@var{spacing}-@var{width}-@var{registry}-@var{encoding} +@end smallexample + +@noindent +The entries have the following meanings: + +@table @var +@item maker +The name of the font manufacturer. +@item family +The name of the font family (e.g. @samp{courier}). +@item weight +The font weight---normally either @samp{bold}, @samp{medium} or +@samp{light}. Some font names support other values. +@item slant +The font slant---normally @samp{r} (roman), @samp{i} (italic), +@samp{o} (oblique), @samp{ri} (reverse italic), or @samp{ot} (other). +Some font names support other values. +@item widthtype +The font width---normally @samp{condensed}, @samp{extended}, +@samp{semicondensed} or @samp{normal} (some font names support other +values). +@item style +An optional additional style name. Usually it is empty---most long +font names have two hyphens in a row at this point. +@item pixels +The font height, in pixels. +@item height +The font height on the screen, measured in tenths of a printer's +point. This is the point size of the font, times ten. For a given +vertical resolution, @var{height} and @var{pixels} are proportional; +therefore, it is common to specify just one of them and use @samp{*} +for the other. +@item horiz +The horizontal resolution, in pixels per inch, of the screen for which +the font is intended. +@item vert +The vertical resolution, in pixels per inch, of the screen for which +the font is intended. Normally the resolution of the fonts on your +system is the right value for your screen; therefore, you normally +specify @samp{*} for this and @var{horiz}. +@item spacing +This is @samp{m} (monospace), @samp{p} (proportional) or @samp{c} +(character cell). +@item width +The average character width, in pixels, multiplied by ten. +@item registry +@itemx encoding +The X font character set that the font depicts. (X font character +sets are not the same as Emacs character sets, but they are similar.) +You can use the @command{xfontsel} program to check which choices you +have. Normally you should use @samp{iso8859} for @var{registry} and +@samp{1} for @var{encoding}. +@end table + + The fourth and final method of specifying a font is to use a ``font +nickname''. Certain fonts have shorter nicknames, which you can use +instead of a normal font specification. For instance, @samp{6x13} is +equivalent to + +@smallexample +-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1 +@end smallexample + +@cindex client-side fonts +@cindex server-side fonts + On X, Emacs recognizes two types of fonts: @dfn{client-side} fonts, +which are provided by the Xft and Fontconfig libraries, and +@dfn{server-side} fonts, which are provided by the X server itself. +Most client-side fonts support advanced font features such as +antialiasing and subpixel hinting, while server-side fonts do not. +Fontconfig and GTK patterns match only client-side fonts. + +@cindex listing system fonts + You will probably want to use a fixed-width default font---that is, +a font in which all characters have the same width. For Xft and +Fontconfig fonts, you can use the @command{fc-list} command to list +the available fixed-width fonts, like this: + +@example +fc-list :spacing=mono fc-list :spacing=charcell +@end example + +@noindent +For server-side X fonts, you can use the @command{xlsfonts} program to +list the available fixed-width fonts, like this: + +@example +xlsfonts -fn '*x*' | egrep "^[0-9]+x[0-9]+" +xlsfonts -fn '*-*-*-*-*-*-*-*-*-*-*-m*' +xlsfonts -fn '*-*-*-*-*-*-*-*-*-*-*-c*' +@end example + +@noindent +Any font with @samp{m} or @samp{c} in the @var{spacing} field of the +XLFD is a fixed-width font. To see what a particular font looks like, +use the @command{xfd} command. For example: + +@example +xfd -fn 6x13 +@end example + +@noindent +displays the entire font @samp{6x13}. + + While running Emacs, you can also set the font of a specific kind of +text (@pxref{Faces}), or a particular frame (@pxref{Frame +Parameters}). + @node Speedbar @section Speedbar Frames @cindex speedbar @@ -957,7 +1224,7 @@ With no argument, this command toggles Menu Bar mode, a minor mode. With an argument, the command turns Menu Bar mode on if the argument is positive, off if the argument is not positive. You can use -the X resource @samp{menuBarLines} to control the initial setting of +the X resource @samp{menuBar} to control the initial setting of Menu Bar mode. @xref{Resources}. @kindex C-Mouse-3 @r{(when menu bar is disabled)}
--- a/doc/emacs/indent.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/indent.texi Sun Mar 28 09:04:11 2010 -0400 @@ -37,34 +37,38 @@ Indent from point to under an indentation point in the previous line. @end table - In most major modes, the @key{TAB} key runs the command -@code{indent-for-tab-command}, which either performs indentation or -inserts whitespace at point, depending on the situation. +@noindent +The @key{TAB} key runs @code{indent-for-tab-command} in most major +modes (in C and related modes, @key{TAB} runs a separate command, +@code{c-indent-line-or-region}, which behaves similarly). The major +mode determines just what this entails. - In programming modes such as Lisp mode and C mode, @key{TAB} indents -the current line if the region is inactive. If the region is active, -it indents every line in the region (@pxref{Mark}). Indentation means -adding or removing some combination of space and tab characters -(@dfn{whitespace characters}) at the start of the line, in a way that -makes sense given the text in the preceding lines. Exactly how -indentation is performed depends on the major mode. @xref{Program -Indent}. + In text modes, @key{TAB} inserts some combination of space and tab +characters to advance point to the next tab stop (@pxref{Tab Stops}). +If the region is active and spans multiple lines, it advances the +first character of each of those lines to the next tab stop +(@pxref{Using Region}). For the purposes of this command, the +position of the first non-whitespace character on the preceding line +is treated as an additional tab stop. Thus, you can use @key{TAB} to +``align'' point with the preceding line. - In text modes, @key{TAB} inserts some whitespace characters to -advance point to the next tab stop (@pxref{Tab Stops}). For the -purposes of this command, the position of the first non-whitespace -character on the preceding line is treated as an additional tab stop. -You can therefore use @key{TAB} to ``align'' point with the preceding -line. If the region is active, @key{TAB} performs this action on -every line in the region. + In programming modes, @key{TAB} adds or removes some combination of +space and tab characters at the start of the line, in a way that makes +sense given the text in the preceding lines. If the region is active +and spans multiple lines, all those lines are indented this way. If +point was initially within the current line's indentation, it is +positioned after that indentation; otherwise, it remains at same point +in the newly-indented text. @xref{Program Indent}. @vindex tab-width - Indentation is often performed with the help of @dfn{tab characters} -(@acronym{ASCII} code 9), which are displayed as a stretch of empty space -extending to the next @dfn{display tab stop}. By default, there is -one display tab stop every eight columns; the number of columns is -determined by the variable @code{tab-width}. You can insert a single -tab character by typing @kbd{C-q @key{TAB}}. @xref{Text Display}. + Normally, indentation commands insert (or remove) an optimal mix of +@dfn{tab characters} and spaces to align to the desired column. Tab +characters (@acronym{ASCII} code 9) are displayed as a stretch of +empty space extending to the next @dfn{display tab stop}. By default, +there is one display tab stop every eight columns; the number of +columns is determined by the variable @code{tab-width}. You can +insert a single tab character by typing @kbd{C-q @key{TAB}}. +@xref{Text Display}. @findex edit-tab-stops @findex tab-to-tab-stop @@ -74,11 +78,20 @@ to advance point up to the next tab stop. By default, this involves deleting the existing whitespace and inserting a single tab character. - Normally, most of these indentation commands insert an optimal mix -of tabs and spaces to align to the desired column. @xref{Just -Spaces}, for how to disable use of tabs. However, @kbd{C-q @key{TAB}} -always inserts a tab, even when tabs are disabled for the indentation -commands. + @xref{Just Spaces}, for how to disable use of tabs. However, +@kbd{C-q @key{TAB}} always inserts a tab, even when tabs are disabled +for the indentation commands. + +@vindex tab-always-indent + The variable @code{tab-always-indent} tweaks the behavior of the +@key{TAB} (@code{indent-for-tab-command}) command. The default value, +@code{t}, gives the behavior described above. If you change the value +to the symbol @code{complete}, then @key{TAB} first tries to indent +the current line, and if the line was already indented, it tries to +complete the text at point (@pxref{Symbol Completion}). If the value +is @code{nil}, then @key{TAB} indents the current line only if point +is at the left margin or in the line's indentation; otherwise, it +inserts a real tab character. @menu * Indentation Commands:: Various commands and techniques for indentation.
--- a/doc/emacs/mule.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/mule.texi Sun Mar 28 09:04:11 2010 -0400 @@ -1442,7 +1442,7 @@ fontset is called @code{create-fontset-from-fontset-spec}. You can also call this function explicitly to create a fontset. - @xref{Font X}, for more information about font naming in X. + @xref{Fonts}, for more information about font naming. @node Modifying Fontsets @section Modifying Fontsets @@ -1619,7 +1619,7 @@ that you don't have to worry about them. However, it is sometimes helpful to know some of the underlying details about charsets. - One example is font selection (@pxref{Font X}). Each language + One example is font selection (@pxref{Fonts}). Each language environment (@pxref{Language Environments}) defines a ``priority list'' for the various charsets. When searching for a font, Emacs initially attempts to find one that can display the highest-priority
--- a/doc/emacs/search.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/search.texi Sun Mar 28 09:04:11 2010 -0400 @@ -1294,13 +1294,25 @@ @findex keep-lines @table @kbd -@item M-x occur @key{RET} @var{regexp} @key{RET} -Display a list showing each line in the buffer that contains a match -for @var{regexp}. To limit the search to part of the buffer, narrow -to that part (@pxref{Narrowing}). A numeric argument @var{n} -specifies that @var{n} lines of context are to be displayed before and -after each matching line. Currently, @code{occur} can not correctly -handle multiline matches. +@item M-x multi-isearch-buffers +Prompt for one or more buffer names, ending with @key{RET}; then, +begin a multi-buffer incremental search in those buffers. (If the +search fails in one buffer, the next @kbd{C-s} tries searching the +next specified buffer, and so forth.) With a prefix argument, prompt +for a regexp and begin a multi-buffer incremental search in buffers +matching that regexp. + +@item M-x multi-isearch-buffers-regexp +This command is just like @code{multi-isearch-buffers}, except it +performs an incremental regexp search. + +@item M-x occur +Prompt for a regexp, and display a list showing each line in the +buffer that contains a match for it. To limit the search to part of +the buffer, narrow to that part (@pxref{Narrowing}). A numeric +argument @var{n} specifies that @var{n} lines of context are to be +displayed before and after each matching line. Currently, +@code{occur} can not correctly handle multiline matches. @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} @@ -1325,41 +1337,42 @@ @item M-x list-matching-lines Synonym for @kbd{M-x occur}. -@item M-x multi-occur @key{RET} @var{buffers} @key{RET} @var{regexp} @key{RET} -This function is just like @code{occur}, except it is able to search -through multiple buffers. It asks you to specify the buffer names one by one. +@item M-x multi-occur +This command is just like @code{occur}, except it is able to search +through multiple buffers. It asks you to specify the buffer names one +by one. -@item M-x multi-occur-in-matching-buffers @key{RET} @var{bufregexp} @key{RET} @var{regexp} @key{RET} -This function is similar to @code{multi-occur}, except the buffers to -search are specified by a regular expression that matches visited -file names. With a prefix argument, it uses the regular expression to match -buffer names instead. +@item M-x multi-occur-in-matching-buffers +This command is similar to @code{multi-occur}, except the buffers to +search are specified by a regular expression that matches visited file +names. With a prefix argument, it uses the regular expression to +match buffer names instead. -@item M-x how-many @key{RET} @var{regexp} @key{RET} -Print the number of matches for @var{regexp} that exist in the buffer -after point. If the region is active, this operates on the region -instead. +@item M-x how-many +Prompt for a regexp, and print the number of matches for it in the +buffer after point. If the region is active, this operates on the +region instead. -@item M-x flush-lines @key{RET} @var{regexp} @key{RET} -This command deletes each line that contains a match for @var{regexp}, -operating on the text after point; it deletes the current line if it -contains a match starting after point. If the region is active, it -operates on the region instead; if a line partially contained in the -region contains a match entirely contained in the region, it is -deleted. +@item M-x flush-lines +Prompt for a regexp, and delete each line that contains a match for +it, operating on the text after point. This command deletes the +current line if it contains a match starting after point. If the +region is active, it operates on the region instead; if a line +partially contained in the region contains a match entirely contained +in the region, it is deleted. If a match is split across lines, @code{flush-lines} deletes all those lines. It deletes the lines before starting to look for the next match; hence, it ignores a match starting on the same line at which another match ended. -@item M-x keep-lines @key{RET} @var{regexp} @key{RET} -This command deletes each line that @emph{does not} contain a match -for @var{regexp}, operating on the text after point; if point is not -at the beginning of a line, it always keeps the current line. If the -region is active, the command operates on the region instead; it never -deletes lines that are only partially contained in the region (a -newline that ends a line counts as part of that line). +@item M-x keep-lines +Prompt for a regexp, and delete each line that @emph{does not} contain +a match for it, operating on the text after point. If point is not at +the beginning of a line, this command always keeps the current line. +If the region is active, the command operates on the region instead; +it never deletes lines that are only partially contained in the region +(a newline that ends a line counts as part of that line). If a match is split across lines, this command keeps all those lines. @end table
--- a/doc/emacs/xresources.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/emacs/xresources.texi Sun Mar 28 09:04:11 2010 -0400 @@ -193,7 +193,7 @@ @end ifnottex @item @code{font} (class @code{Font}) -Font name for the @code{default} font. @xref{Font X}. You can also +Font name for the @code{default} font. @xref{Fonts}. You can also specify a fontset name (@pxref{Fontsets}). @item @code{fontBackend} (class @code{FontBackend}) @@ -307,12 +307,14 @@ @item @code{toolBar} (class @code{ToolBar}) @cindex tool bar Number of lines to reserve for the tool bar. A zero value suppresses -the tool bar. If the value is non-zero and -@code{auto-resize-tool-bars} is non-@code{nil}, the tool bar's size -will be changed automatically so that all tool bar items are visible. +the tool bar. For the Emacs tool bar (i.e. not Gtk+), if the value is +non-zero and @code{auto-resize-tool-bars} is non-@code{nil}, the tool bar's +size will be changed automatically so that all tool bar items are visible. If the value of @code{auto-resize-tool-bars} is @code{grow-only}, the tool bar expands automatically, but does not contract automatically. To contract the tool bar, you must redraw the frame by entering @kbd{C-l}. +For the Gtk+ tool bar, any non-zero value means on and +@code{auto-resize-tool-bars} has no effect. @item @code{useXIM} (class @code{UseXIM}) @cindex XIM
--- a/doc/lispref/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/lispref/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,11 @@ +2010-03-24 Arni Magnusson <arnima@hafro.is> (tiny change) + + * frames.texi (Cursor Parameters): Fix typo. (Bug#5760) + +2010-03-24 Chong Yidong <cyd@stupidchicken.com> + + * processes.texi (Network Processes): Document seqpacket type. + 2010-03-20 Dan Nicolaescu <dann@ics.uci.edu> * os.texi (System Environment): Do not mention lynxos.
--- a/doc/lispref/frames.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/lispref/frames.texi Sun Mar 28 09:04:11 2010 -0400 @@ -821,7 +821,7 @@ selected. It supports the same values as the @code{cursor-type} frame parameter; also, @code{nil} means don't display a cursor in nonselected windows, and @code{t} (the default) means use a standard -modificatoin of the usual cursor type (solid box becomes hollow box, +modification of the usual cursor type (solid box becomes hollow box, and bar becomes a narrower bar). @end defopt
--- a/doc/lispref/processes.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/lispref/processes.texi Sun Mar 28 09:04:11 2010 -0400 @@ -2059,7 +2059,8 @@ @item :type @var{type} Specify the communication type. A value of @code{nil} specifies a stream connection (the default); @code{datagram} specifies a datagram -connection. Both connections and servers can be of either type. +connection; @code{seqpacket} specifies a ``sequenced packet stream'' +connection. Both connections and servers can be of these types. @item :server @var{server-flag} If @var{server-flag} is non-@code{nil}, create a server. Otherwise,
--- a/doc/misc/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/misc/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,7 @@ +2010-03-24 Michael Albinus <michael.albinus@gmx.de> + + * trampver.texi: Update release number. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/doc/misc/trampver.texi Sat Mar 20 10:32:32 2010 -0400 +++ b/doc/misc/trampver.texi Sun Mar 28 09:04:11 2010 -0400 @@ -9,7 +9,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.1.18-pre +@set trampver 2.1.18-23.2 @c Other flags from configuration @set instprefix /usr/local
--- a/etc/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,14 @@ +2010-03-24 Francesc Rocher <rocher@member.fsf.org> + + * MORE.STUFF: Remove CEDET entry, now distributed as part of + Emacs. + +2010-03-22 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus/gnus-setup.ast: Add finish links to the top nodes. + + * gnus/news-server.ast: Add some trivial validation. + 2010-03-13 Michael Albinus <michael.albinus@gmx.de> * NEWS: Add secrets.el.
--- a/etc/MORE.STUFF Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/MORE.STUFF Sun Mar 28 09:04:11 2010 -0400 @@ -130,10 +130,6 @@ * Boxquote: <URL:http://www.davep.org/emacs/> - * CEDET: Collection of Emacs Development Environment Tools, including - EIEIO, Semantic, Speedbar, EDE, and COGRE: - <URL:http://cedet.sourceforge.net/> - * CJK-emacs: Converting MULE-encoded text to TeX: <URL:ftp://ctan.tug.org/tex-archive/language/chinese/CJK/> and mirrors of the `CTAN' TeX archives.
--- a/etc/NEWS Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/NEWS Sun Mar 28 09:04:11 2010 -0400 @@ -45,6 +45,7 @@ * Changes in Specialized Modes and Packages in Emacs 24.1 +** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags. ** Customize *** Customize buffers now contain a search field. @@ -81,6 +82,12 @@ ** s-region.el is now declared obsolete, superceded by shift-select-mode enabled by default in 23.1. +** gdb-mi + +*** GDB User Interface migrated to GDB Machine Interface and now +supports multithread non-stop debugging and debugging of several +threads simultaneously. + * New Modes and Packages in Emacs 24.1 @@ -94,6 +101,8 @@ * Lisp changes in Emacs 24.1 +** New completion style `substring'. + ** Image API *** When the image type is one of listed in `image-animated-types'
--- a/etc/NEWS.23 Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/NEWS.23 Sun Mar 28 09:04:11 2010 -0400 @@ -71,14 +71,14 @@ Customize `make-pointer-invisible' to disable this feature. ** Font changes - ++++ *** Emacs can use the system default monospaced font in Gnome. To enable this feature, set `font-use-system-font' to non-nil (it is nil by default). If the system default changes, Emacs changes also. This feature requires Gconf support, which is automatically included at compile-time if configure detects the gconf libraries (you can disable this with the configure option --without-gconf). - +--- *** On X11, Emacs reacts to Xft changes made by configuration tools, via the XSETTINGS mechanism. This includes antialias, hinting, hintstyle, RGBA, DPI and lcdfilter changes. @@ -143,7 +143,7 @@ ** Completion changes *** The new command `completion-at-point' provides mode-sensitive completion. - ++++ *** tab-always-indent set to `complete' lets TAB do completion as well. +++ *** The new completion-style `initials' is available. @@ -185,6 +185,7 @@ ** LaTeX mode now provides completion (via completion-at-point). +--- ** sym-comp.el is now declared obsolete, superceded by completion-at-point. ** lucid.el and levents.el are now declared obsolete. @@ -197,20 +198,16 @@ *** The Calc settings file is now a file named calc.el in user-emacs-directory; but the old location, ~/.calc.el, is used if that file exists. - --- *** Graphing commands (`g f' etc.) now work on MS-Windows, if you have the native Windows port of Gnuplot version 3.8 or later installed. ** Calendar and diary - +++ *** Fancy diary display is now the default. If you prefer the simple display, customize `diary-display-function'. - +++ *** The diary's fancy display now enables view-mode. - --- *** The command `calendar-current-date' accepts an optional argument giving an offset from today. @@ -225,9 +222,9 @@ `desktop-files-not-to-save' instead. ** Dired - -*** The new variable `dired-auto-revert-buffer' allows to revert -dired buffers automatically on revisiting. ++++ +*** The new variable `dired-auto-revert-buffer', if non-nil, causes +Dired buffers to be reverted automatically on revisiting them. ** DocView @@ -338,22 +335,17 @@ are stripped when copying text from the ChangeLog to the *VC-Log* buffer. ** Elint - --- *** Elint now uses compilation-mode. - --- *** Elint can now scan individual files and whole directories, and can be run in batch mode. - --- *** Elint does a more thorough initialization, and recognizes more built-in functions and variables. Customize `elint-scan-preloaded' if you want to sacrifice some accuracy for a faster startup. - --- *** Elint attempts some basic understanding of featurep and (f)boundp tests. - --- *** Customize `elint-ignored-warnings' to suppress some warnings. @@ -368,7 +360,7 @@ `comint-history-isearch' is non-nil. New commands `comint-history-isearch-backward' and `comint-history-isearch-backward-regexp' (bound to M-r) start Isearch in the input history regardless of the value of `comint-history-isearch'. - ++++ *** Interactively `multi-isearch-buffers' and `multi-isearch-buffers-regexp' read buffer names to search, one by one, ended with RET. With a prefix argument, they ask for a regexp, and search in buffers whose names match @@ -376,19 +368,16 @@ `multi-isearch-files-regexp' read file names to search, one by one, ended with RET. With a prefix argument, they ask for a wildcard, and search in file buffers whose file names match the specified wildcard. - +++ *** Autorevert Tail mode now works also for remote files. - +++ *** The new built-in commands `su' and `sudo' support Tramp. That means, they change `default-directory' to the new users value, and let commands run under that user permissions. It works even when `default-directory' is already remote. Calling the external commands is possible by `*su' or `*sudo', repectively. - --- -*** When running in a new enough xterm (newer than version 242), emacs +*** When running in a new enough xterm (newer than version 242), Emacs asks xterm what the background color is and it sets up faces accordingly for a dark background if needed (the current default is to consider the background light). @@ -468,70 +457,94 @@ * Lisp changes in Emacs 23.2 -** make-network-socket can now also create `seqpacket' Unix sockets. - -** New function `completion-in-region' to use the standard completion -facilities on a particular region of text. - -+++ -** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. - ---- -** read-file-name-predicate is obsolete. It was used to pass the predicate -to read-file-name-internal because read-file-name-internal abused its `pred' -argument to pass the current directory, but this hack is not needed -any more. +** All the default-FOO variables that hold the default value of the FOO +variable, are now declared obsolete. + +** read-key is a function halfway between read-event and read-key-sequence. +It reads a single key, but obeys input and escape sequence decoding. ** Frame parameter changes - +++ *** You can give the `fullscreen' frame parameter the value `maximized'. This maximizes the frame. - +++ *** The new frame parameter `sticky' makes Emacs frames sticky in virtual desktops. ---- -** completion-base-size is obsoleted by completion-base-position. +** Completion changes + +*** completion-base-size is obsoleted by completion-base-position. This change causes a few backward incompatibilities, mostly with choose-completion-string-functions where the `mini-p' argument has been replaced by a `base-position' argument, and where the `base-size' argument is now always nil. +*** New function `completion-in-region' to use the standard completion +facilities on a particular region of text. ++++ +*** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. + +*** completion-annotate-function specifies how to compute annotations +for completions displayed in *Completions*. + +** Minibuffer changes +--- +*** read-file-name-predicate is obsolete. It was used to pass the predicate +to read-file-name-internal because read-file-name-internal abused its `pred' +argument to pass the current directory, but this hack is not needed +any more. + +** Changes to file-manipulation functions ++++ +*** `delete-directory' has an optional parameter RECURSIVE. ++++ +*** New function `copy-directory', which copies a directory recursively. + ** called-interactively-p now takes one argument and replaces interactive-p which is now marked obsolete. + ** New function set-advertised-calling-convention makes it possible to obsolete arguments as well as make some arguments mandatory. -** eval-next-after-load is obsolete. -** New hook `after-load-functions' run after loading an Elisp file. ** You can control which binding is preferentially shown in menus and docstrings by adding a `:advertised-binding' property to the corresponding command's symbol. That property can hold a single binding or a list of bindings. +** Network and process changes ++++ +*** start-process-shell-command and start-file-process-shell-command +now only take a single `command' argument. ++++ +*** The new variable `process-file-side-effects' should be set to nil +if a `process-file' call does not change a remote file. This allows +file name handlers such as Tramp to optimizations. ++++ +*** make-network-process can now also create `seqpacket' Unix sockets. + +** Loading changes + +*** eval-next-after-load is obsolete. + +*** New hook `after-load-functions' run after loading an Elisp file. + +** Byte compilation changes +--- +*** Changing the file-names generated by byte-compilation by redefining +the function `byte-compile-dest-file' before loading bytecomp.el is obsolete. +Instead, customize byte-compile-dest-file-function. +--- +*** `byte-compile-warnings' has new members, `constants' and `suspicious'. + ** New macro with-silent-modifications to tweak text properties without affecting the buffer's modification state. -** All the default-FOO variables that hold the default value of the FOO -variable, are now declared obsolete. - -** read-key is a function halfway between read-event and read-key-sequence. -It reads a single key, but obeys input and escape sequence decoding. - -** start-process-shell-command and start-file-process-shell-command -now only take a single `command' argument. - -** The variable `process-file-side-effects' shall be bound to nil, if -a `process-file' call does not change a remote file. By this, file -name handlers like Tramp can apply optimizations. +++ ** Hash tables have a new printed representation that is readable. The feature `hashtable-print-readable' identifies this new functionality. -** New functions performing Unicode normalization are added: +** New functions for performing Unicode normalization: ucs-normalize-NFD-region, ucs-normalize-NFD-string, ucs-normalize-NFC-region, ucs-normalize-NFC-string, ucs-normalize-NFKD-region, ucs-normalize-NFKD-string, @@ -539,25 +552,10 @@ ucs-normalize-HFS-NFD-region, ucs-normalize-HFS-NFD-string, ucs-normalize-HFS-NFC-region, ucs-normalize-HFS-NFC-string. -** completion-annotate-function specifies how to compute annotations -for completions displayed in *Completions*. - +++ ** Face aliases can now be marked as obsolete, using the macro `define-obsolete-face-alias'. ---- -** Changing the file-names generated by byte-compilation by redefining -the function `byte-compile-dest-file' before loading bytecomp.el is obsolete. -Instead, customize byte-compile-dest-file-function. - ---- -** `byte-compile-warnings' has new members, `constants' and `suspicious'. - -** `delete-directory' has an optional parameter RECURSIVE. - -** New function `copy-directory', which copies a directory recursively. - +++ ** New function `window-full-height-p', analogous to the full-width version.
--- a/etc/PROBLEMS Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/PROBLEMS Sun Mar 28 09:04:11 2010 -0400 @@ -1418,6 +1418,21 @@ * Runtime problems on character terminals +** The meta key does not work on xterm. +Typing M-x rings the terminal bell, and inserts a string like ";120~". +For recent xterm versions (>= 216), Emacs uses xterm's modifyOtherKeys +feature to generate strings for key combinations that are not +otherwise usable. One circumstance in which this can cause problems +is if you have specified the X resource + + xterm*VT100.Translations + +to contain translations that use the meta key. Then xterm will not +use meta in modified function-keys, which confuses Emacs. To fix +this, you can remove the X resource or put this in your init file: + + (xterm-remove-modify-other-keys) + ** Emacs spontaneously displays "I-search: " at the bottom of the screen. This means that Control-S/Control-Q (XON/XOFF) "flow control" is being
--- a/etc/TODO Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/TODO Sun Mar 28 09:04:11 2010 -0400 @@ -105,9 +105,6 @@ ** erase-buffer should perhaps disregard read-only properties of text. -** Make occur correctly handle matches that span more than one line, - as well as overlapping matches. - ** Fix the kill/yank treatment of invisible text. At the moment, invisible text is placed in the kill-ring, so that the contents of the ring may not correspond to the text as displayed to the user.
--- a/etc/gnus/gnus-setup.ast Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/gnus/gnus-setup.ast Sun Mar 28 09:04:11 2010 -0400 @@ -33,6 +33,8 @@ @end text +@next 'finish + @node Setting up a NNTP server @text @@ -40,6 +42,8 @@ Run M-x assistant and use the news-server.ast file as input. @end text +@next 'finish + @c Local variables: @c mode: texinfo
--- a/etc/gnus/news-server.ast Sat Mar 20 10:32:32 2010 -0400 +++ b/etc/gnus/news-server.ast Sun Mar 28 09:04:11 2010 -0400 @@ -2,9 +2,9 @@ @node Setting up the news server name and port number -@variable server :string (gnus-getenv-nntpserver) +@variable server :string (or (gnus-getenv-nntpserver) "your-server-here") @variable port :number 119 -@validate (assistant-validate-connect-to-server server port) +@validate (or (assistant-validate-connect-to-server server port) (y-or-n-p "Do you want to use the server anyway, although you can't confirm it's valid?")) @result gnus-select-method (list 'nntp server (list 'nntp-server port)) @text Usenet news is usually read from your Internet service prodider's news @@ -14,10 +14,10 @@ Server name: @variable{server} Port number: @variable{port} + @end text @next t "User name and password" - @node User name and password @type interstitial @next
--- a/leim/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/leim/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,9 @@ +2010-03-27 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(TIT), $(MISC_DIC), leim-list.el): Enclose the + argument of "-l" in $(ARGQUOTE), in case it includes blanks or + other special characters. + 2010-03-18 Glenn Morris <rgm@gnu.org> * Makefile.in (maintainer-clean): Use bootstrap-clean.
--- a/leim/makefile.w32-in Sat Mar 20 10:32:32 2010 -0400 +++ b/leim/makefile.w32-in Sun Mar 28 09:04:11 2010 -0400 @@ -170,17 +170,21 @@ # WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as # this can break with GNU Make 3.81 and later if sh.exe is used. $(TIT): - $(RUN_EMACS) -l $(buildlisppath)/international/titdic-cnv \ + $(RUN_EMACS) -l \ + $(ARGQUOTE)$(buildlisppath)/international/titdic-cnv$(ARGQUOTE) \ --eval $(ARGQUOTE)(batch-titdic-convert t)$(ARGQUOTE) \ -dir quail $(srcdir)/CXTERM-DIC - $(RUN_EMACS) -l $(buildlisppath)/international/quail \ + $(RUN_EMACS) -l \ + $(ARGQUOTE)$(buildlisppath)/international/quail$(ARGQUOTE) \ -f batch-byte-compile $(TIT:.elc=.el) # Rule to generate quail/*.el from MISC_DIC/*.tit. $(MISC_DIC): - $(RUN_EMACS) -l $(buildlisppath)/international/titdic-cnv \ + $(RUN_EMACS) -l \ + $(ARGQUOTE)$(buildlisppath)/international/titdic-cnv$(ARGQUOTE) \ -f batch-miscdic-convert -dir quail $(srcdir)/MISC-DIC - $(RUN_EMACS) -l $(buildlisppath)/international/quail \ + $(RUN_EMACS) -l \ + $(ARGQUOTE)$(buildlisppath)/international/quail$(ARGQUOTE) \ -f batch-byte-compile $(MISC_DIC:.elc=.el) # @@ -188,7 +192,8 @@ # this can break with GNU Make 3.81 and later if sh.exe is used. leim-list.el: $(SUBDIRS) $(WORLD) $(srcdir)/leim-ext.el - $(DEL) leim-list.el - $(RUN_EMACS) -l $(buildlisppath)/international/quail \ + $(RUN_EMACS) -l \ + $(ARGQUOTE)$(buildlisppath)/international/quail$(ARGQUOTE) \ --eval $(ARGQUOTE)(update-leim-list-file $(DQUOTE).$(DQUOTE))$(ARGQUOTE) $(RUN_EMACS) --eval $(ARGQUOTE)(w32-append-code-lines $(DQUOTE)$@$(DQUOTE) $(DQUOTE)$(srcdir)/leim-ext.el$(DQUOTE))$(ARGQUOTE)
--- a/lib-src/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/lib-src/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,11 @@ +2010-03-20 Glenn Morris <rgm@gnu.org> + + * Makefile.in (KRB4LIB, DESLIB, KRB5LIB, CRYPTOLIB, COM_ERRLIB) + (LIBHESIOD, LIBRESOLV): Make previous change a bit more friendly by + defining these as Makefile variables. + (LIBS_MOVE): Add LIBS_MAIL into this. + (movemail${EXEEXT}): Just use LIBS_MOVE, not LIBS_MAIL as well. + 2010-03-18 Glenn Morris <rgm@gnu.org> * Makefile.in (KRB4LIB, DESLIB, KRB5LIB, CRYPTOLIB, COM_ERRLIB)
--- a/lib-src/Makefile.in Sat Mar 20 10:32:32 2010 -0400 +++ b/lib-src/Makefile.in Sun Mar 28 09:04:11 2010 -0400 @@ -130,6 +130,27 @@ # If neither flag is set, blessmail is used. MOVE_FLAGS= +## -lkrb if HAVE_LIBKRB or -lkrb4 if HAVE_LIBKRB4 +KRB4LIB=@KRB4LIB@ +## -ldes if HAVE_LIBDES or -ldes425 if HAVE_LIBDES425 +DESLIB=@DESLIB@ +## -lkrb5 if HAVE_LIBKRB5 +KRB5LIB=@KRB5LIB@ +## -lk5crypto if HAVE_LIBK5CRYPTO or -lcrypto if HAVE_LIBCRYPTO +CRYPTOLIB=@CRYPTOLIB@ +## -lcom_err if HAVE_LIBCOM_ERR +COM_ERRLIB=@COM_ERRLIB@ +## -lhesiod if HAVE_LIBHESIOD +LIBHESIOD=@LIBHESIOD@ +## -lresolv if HAVE_LIBRESOLV +LIBRESOLV=@LIBRESOLV@ +## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL +LIBS_MAIL=@LIBS_MAIL@ + +## Extra libraries to use when linking movemail. +LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) + + # ========================== start of cpp stuff ======================= /* From here on, comments must be done in C syntax. */ @@ -168,10 +189,6 @@ #define BLESSMAIL #endif -LIBS_MOVE=@KRB4LIB@ @DESLIB@ @KRB5LIB@ @CRYPTOLIB@ @COM_ERRLIB@ @LIBHESIOD@ @LIBRESOLV@ - -LIBS_MAIL=@LIBS_MAIL@ - LOADLIBES=LIBS_SYSTEM LIBS_MACHINE /* Those files shared with other GNU utilities need HAVE_CONFIG_H @@ -365,7 +382,7 @@ $(GETOPTOBJS) $(LOADLIBES) -o b2m movemail${EXEEXT}: movemail.o pop.o $(GETOPTDEPS) - $(CC) ${LINK_CFLAGS} ${MOVE_FLAGS} movemail.o pop.o $(GETOPTOBJS) $(LOADLIBES) $(LIBS_MAIL) $(LIBS_MOVE) -o movemail + $(CC) ${LINK_CFLAGS} ${MOVE_FLAGS} movemail.o pop.o $(GETOPTOBJS) $(LOADLIBES) $(LIBS_MOVE) -o movemail /* We need to define emacs to get the right version of something (what?). */ movemail.o: ${srcdir}/movemail.c ../src/config.h $(GETOPT_H)
--- a/lisp/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,280 @@ +2010-03-25 Glenn Morris <rgm@gnu.org> + + * desktop.el (desktop-save-buffer-p): Don't mistakenly include + all dired buffers, even tramp ones. (Bug#5755) + +2010-03-25 Stefan Monnier <monnier@iro.umontreal.ca> + + Add "union tags" in mpc.el. + * mpc.el: Remove backward compatibility code. + (mpc-browser-tags): Change default. + (mpc--find-memoize-union-tags): New var. + (mpc-cmd-flush, mpc-cmd-special-tag-p): New fun. + (mpc-cmd-find): Handle the case where the playlist does not exist. + Handle union-tags. + (mpc-cmd-list): Use mpc-cmd-special-tag-p. Handle union-tags. + (mpc-cmd-add): Use mpc-cmd-flush. + (mpc-tagbrowser-tag-name): New fun. + (mpc-tagbrowser-buf): Use it. + (mpc-songs-refresh): Use cond. Move to point-min as a fallback. + +2010-03-24 Stefan Monnier <monnier@iro.umontreal.ca> + + Misc cleanup. + * progmodes/make-mode.el (makefile-bsdmake-rule-action-regex): + Use replace-regexp-in-string. + (makefile-mode-abbrev-table): Merge defvar and define-abbrev-table. + (makefile-imake-mode-syntax-table): Move init into defvar. + (makefile-mode): Use define-derived-mode. + + * progmodes/make-mode.el (makefile-rule-action-regex): Backtrack less. + (makefile-make-font-lock-keywords): Adjust rule since submatch 1 may + not be present any more. + +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * faces.el (set-face-attribute): Fix typo in docstring. + (face-valid-attribute-values): Reflow docstring. + + * cedet/srecode/table.el (srecode-template-table): Fix docstring typo. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * textmodes/flyspell.el (sgml-lexical-context): Autoload it (Bug#5752). + +2010-03-24 Chong Yidong <cyd@stupidchicken.com> + + * indent.el (indent-for-tab-command): Doc fix. + +2010-03-24 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-remove-stale-state-cache): + Fix off-by-one error. Fixes bug #5747. + +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * image-dired.el (image-dired-display-thumbs): Fix typo in docstring. + (image-dired-read-comment): Doc fix. + + * json.el (json-object-type, json-array-type, json-key-type) + (json-false, json-null, json-read-number): + * minibuffer.el (completion-in-region-functions): + * calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks) + (cal-tex-cursor-week): + * emacs-lisp/trace.el (trace-function): + * eshell/em-basic.el (eshell/printnl): + * eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter) + (eshell-read-last-dir-ring, eshell-write-last-dir-ring): + * obsolete/levents.el (allocate-event, event-key, event-object) + (event-point, event-process, event-timestamp, event-to-character) + (event-window, event-x, event-x-pixel, event-y, event-y-pixel): + * textmodes/reftex-vars.el (reftex-index-macros-builtin) + (reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook) + (reftex-cite-punctuation, reftex-search-unrecursed-path-first) + (reftex-highlight-selection): Fix typos in docstrings. + +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * minibuffer.el (completion-in-region-functions): Fix docstring typos. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * mail/rmail.el (rmail-highlight-face): Restore option deleted + 2008-02-13 without comment; mark it obsolete. + (rmail-highlight-headers): Use rmail-highlight-face once more. + +2010-03-24 Chong Yidong <cyd@stupidchicken.com> + + * woman.el (woman2-process-escapes): Only consume the newline if + the filler character is on a line by itself (Bug#5729). + +2010-03-24 Kenichi Handa <handa@m17n.org> + + * language/indian.el (devanagari-composable-pattern): Add more + consonants. + +2010-03-24 Michael Albinus <michael.albinus@gmx.de> + + * net/trampver.el: Update release number. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * Makefile.in (ELCFILES): Add cedet/semantic/imenu.el. + +2010-03-24 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-find-executable): + Use `tramp-get-connection-buffer'. Make the regexp for checking + output of "wc -l" more robust. + (tramp-find-shell): Use another shell but /bin/sh on OpenSolaris. + (tramp-open-connection-setup-interactive-shell): Remove workaround + for OpenSolaris bug, it is not needed anymore. + +2010-03-24 Eric M. Ludlam <zappo@gnu.org> + + * cedet/semantic/imenu.el: New file, from the CEDET repository + (Bug#5412). + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-macs.el (defsubst*): Add autoload cookie. (Bug#4427) + +2010-03-24 Wilson Snyder <wsnyder@wsnyder.org> + + * files.el (auto-mode-alist): Accept more verilog file patterns. + +2010-03-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-dir.el (vc-dir-headers): Abbreviate the working dir. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * vc-bzr.el (vc-bzr-log-edit-mode): Add --fixes support to + log-edit-before-checkin-process. + + * vc.el (vc-modify-change-comment): Pass MODE to vc-start-logentry. + + * vc.el, vc-bzr.el, vc-hg.el (log-edit-mode): Declare. + + * vc-dispatcher.el (vc-start-logentry): Doc fix. + (log-view-process-buffer, log-edit-extra-flags): Declare. + + * log-edit.el (log-edit-before-checkin-process): Doc fix. + + * cedet/semantic/bovine/c.el (semantic-c-describe-environment): + Consistently check ede-object is bound throughout. + + * cedet/ede/project-am.el (ede-shell-run-something): Declare. + +2010-03-23 Sam Steingold <sds@gnu.org> + + Fix bug#5620: recalculate all markers on compilation buffer + modifications, not on file modifications. + * progmodes/compile.el (buffer-modtime): New buffer-local variable: + the buffer modification time, for buffers not associated with files. + (compilation-mode): Create it. + (compilation-filter): Update it. + (compilation-next-error-function): Use it instead of + `visited-file-modtime' for timestamp. + +2010-03-23 Juri Linkov <juri@jurta.org> + + Implement Occur multi-line matches. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01044.html + + * replace.el (occur): Doc fix. + (occur-engine): Set `begpt' to the beginning of the first line. + Set `endpt' to the end of the last match line. At first, count + line numbers between `origpt' and `begpt'. Split out code from + `out-line' variable to new let-bindings `match-prefix' and + `match-str'. In `out-line' add non-numeric prefix to all + non-first lines of multi-line matches. Finally, count lines + between `begpt' and `endpt' and add to `lines'. + +2010-03-23 Juri Linkov <juri@jurta.org> + + * replace.el (occur-accumulate-lines, occur-engine): + Use `occur-engine-line' instead of duplicate code. + (occur-engine-line): New function created from duplicate code + in `occur-accumulate-lines' and `occur-engine'. + + * replace.el (occur-engine-line): Add optional arg `keep-props'. + (occur-accumulate-lines, occur-engine): Add arg `keep-props'. + +2010-03-23 Juri Linkov <juri@jurta.org> + + * finder.el: Remove TODO tasks. + + * info.el (Info-finder-find-node): Add node "all" + with all package info. Handle a list of multiple keywords + separated by comma. + (info-finder): In interactive use with a prefix argument, + use `completing-read-multiple' to read a list of keywords + separated by comma. + +2010-03-23 Stefan Monnier <monnier@iro.umontreal.ca> + + Add a new completion style `substring'. + * minibuffer.el (completion-basic--pattern): New function. + (completion-basic-try-completion, completion-basic-all-completions): + Use it. + (completion-substring--all-completions) + (completion-substring-try-completion) + (completion-substring-all-completions): New functions. + (completion-styles-alist): New style `substring'. + +2010-03-22 Stefan Monnier <monnier@iro.umontreal.ca> + + Get rid of .elc files after removal of the corresponding .el. + * Makefile.in (compile-clean): New target. + (compile-main): Use it. + +2010-03-22 Jan Djärv <jan.h.d@swipnet.se> + + * Makefile.in (compile-main): cd to $(lisp) in a sub-shell, so we + don't do make there. When compiling with separate object dir, there + is no Makefile there. + +2010-03-22 Stefan Monnier <monnier@iro.umontreal.ca> + + Get rid of the ELCFILES abomination, again. + * Makefile.in (update-elclist, ELCFILES, compile-last): Remove. + (all, compile): Don't call compile-last. + (compile-main): Build the "elcfiles" list dynamically. + (compile-targets): New (internal) target. + +2010-03-21 Andreas Schwab <schwab@linux-m68k.org> + + * Makefile.in (top_srcdir): Define. + (abs_top_builddir): Define. + (srcdir): Don't append `/..'. + (EMACS): Use ${abs_top_builddir}. + (all, compile, compile-always, compile-last): Don't set emacswd. + (update-subdirs, update-authors): Use $(top_srcdir) instead of + $(srcdir). + (lisp): Use $(srcdir) instead of @srcdir@. + +2010-03-21 Juri Linkov <juri@jurta.org> + + Fix message of multi-line occur regexps and multi-buffer header lines. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00457.html + + * replace.el (occur-1): Don't display regexp if it is longer + than window-width. Use `query-replace-descr' to display regexp. + (occur-engine): Don't display regexp in the buffer header for + multi-buffer occur. Display a separate header line with total + match count and regexp for multi-buffer occur. + Use `query-replace-descr' to display regexp. + +2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> + + * net/secrets.el: Fix parenthesis. + (secrets-enabled): Fix parenthesis. + +2010-03-20 Stefan Monnier <monnier@iro.umontreal.ca> + + Use more relative file and directory names. + * Makefile.in (EMACS): Arrange for it to work when we chdir. + (setwins, setwins_almost, setwins_for_subdirs): + Don't `cd'; output relative names. + (all, compile, compile-always, compile-last): Set emacswd. + (custom-deps, finder-data, autoloads, update-subdirs, compile-last): + Just cd to the lisp source dir so we can use relative file names. + + * outline.el (hide-sublevels): Unfix the paren non-typo! (bug#5738). + +2010-03-20 Glenn Morris <rgm@gnu.org> + + * textmodes/rst.el: Use faces for font-lock customization, and make the + old -face variables obsolete. + (rst-block, rst-external, rst-definition, rst-directive, rst-comment) + (rst-emphasis1, rst-emphasis2, rst-literal, rst-reference): New faces. + (rst-block-face, rst-external-face, rst-definition-face) + (rst-directive-face, rst-comment-face, rst-emphasis1-face) + (rst-emphasis2-face, rst-literal-face, rst-reference-face): + Make obsolete. + (rst-font-lock-keywords-function): Update for above changes. + 2010-03-20 Juri Linkov <juri@jurta.org> * s-region.el:
--- a/lisp/Makefile.in Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/Makefile.in Sun Mar 28 09:04:11 2010 -0400 @@ -19,14 +19,19 @@ SHELL = /bin/sh -lisp=@srcdir@ -VPATH=@srcdir@ -srcdir=@srcdir@/.. +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +abs_top_builddir = @abs_top_builddir@ +lisp = $(srcdir) +VPATH = $(srcdir) # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". -EMACS = ../src/emacs +# We sometimes change directory before running Emacs (typically when +# building out-of-tree, we chdir to the source directory), so we need +# to use an absolute file name. +EMACS = ${abs_top_builddir}/src/emacs # Command line flags for Emacs. This must include --multibyte, # otherwise some files will not compile. @@ -80,28 +85,28 @@ # Common command to find subdirectories -setwins=subdirs=`(cd $$wd; find . -type d -print)`; \ +setwins=subdirs=`(find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* ) ;; \ - *) wins="$$wins $$wd/$$file" ;; \ + *) wins="$$wins $$file" ;; \ esac; \ done # Find all subdirectories except `obsolete' and `term'. -setwins_almost=subdirs=`(cd $$wd; find . -type d -print)`; \ +setwins_almost=subdirs=`(find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */obsolete | */term ) ;; \ - *) wins="$$wins $$wd/$$file" ;; \ + *) wins="$$wins $$file" ;; \ esac; \ done # Find all subdirectories in which we might want to create subdirs.el -setwins_for_subdirs=subdirs=`(cd $$wd; find . -type d -print)`; \ +setwins_for_subdirs=subdirs=`(find . -type d -print)`; \ for file in $$subdirs; do \ case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */cedet* ) ;; \ - *) wins="$$wins $$wd/$$file" ;; \ + *) wins="$$wins $$file" ;; \ esac; \ done @@ -110,8 +115,6 @@ # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el - @: Let us check that we byte-compiled all the files. - $(MAKE) $(MFLAGS) compile-last EMACS=$(EMACS) doit: @@ -132,14 +135,14 @@ $(lisp)/cus-load.el: $(MAKE) $(MFLAGS) custom-deps custom-deps: doit - wd=$(lisp); $(setwins_almost); \ + cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins $(lisp)/finder-inf.el: $(MAKE) $(MFLAGS) finder-data finder-data: doit - wd=$(lisp); $(setwins_almost); \ + cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins @@ -149,7 +152,7 @@ chmod +w $(lisp)/ps-print.el $(lisp)/emulation/tpu-edt.el \ $(lisp)/emacs-lisp/cl-loaddefs.el $(lisp)/mail/rmail.el \ $(lisp)/dired.el $(lisp)/ibuffer.el - wd=$(lisp); $(setwins_almost); \ + cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins @@ -158,9 +161,9 @@ $(lisp)/subdirs.el: $(MAKE) $(MFLAGS) update-subdirs update-subdirs: doit - wd=$(lisp); $(setwins_for_subdirs); \ + cd $(lisp); $(setwins_for_subdirs); \ for file in $$wins; do \ - $(srcdir)/update-subdirs $$file; \ + $(top_srcdir)/update-subdirs $$file; \ done; updates: update-subdirs autoloads finder-data custom-deps @@ -174,1290 +177,12 @@ # Update the AUTHORS file. update-authors: - $(emacs) -l authors -f batch-update-authors $(srcdir)/etc/AUTHORS $(srcdir) + $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) els=`echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,,"`; \ ${ETAGS} -o $@ $$els -.PHONY: update-elclist - -## Post-bootstrap, find the list of .elc files and use sed to update -## ELCFILES in Makefile.in. -## Errors in the final sed are non-fatal, since they have no effect on -## building Emacs. chmod +w is for CVSREAD=1. -## "echo" is non-portable with regards to backslashes, eg between zsh -## and bash. Hence the use of sed on line 2 below (line 1 seems to be OK). -## http://lists.gnu.org/archive/html/emacs-devel/2008-05/msg01535.html -update-elclist: - echo "/^ELCFILES/,/^$$/c\\" > temp.sed - echo "ELCFILES =" | sed -e 's/$$/ \\\\\\/' >> temp.sed - LC_COLLATE=C ls $(lisp)/*.elc $(lisp)/*/*.elc $(lisp)/*/*/*.elc $(lisp)/*/*/*/*.elc | sed -e "s|^$(lisp)| \$$(lisp)|" -e 's/$$/ \\\\\\/' -e '$$ s/ \\\\//' >> temp.sed - echo "" >> temp.sed - -sed -f temp.sed $(lisp)/Makefile.in > temp-elcfiles || rm temp-elcfiles - rm temp.sed - @test -f temp-elcfiles || echo "Maintainer warning: failed to update Makefile.in. You can ignore this if you are not an Emacs developer." - if test -f temp-elcfiles; then \ - chmod +w $(lisp)/Makefile.in; \ - mv -f temp-elcfiles $(lisp)/Makefile.in; \ - fi - -(LC_COLLATE=C ls $(lisp)/*.elc $(lisp)/*/*.elc $(lisp)/*/*/*.elc $(lisp)/*/*/*/*.elc | sed 's/elc$$/el/'; \ - LC_COLLATE=C ls $(lisp)/*.el $(lisp)/*/*.el $(lisp)/*/*/*.el $(lisp)/*/*/*/*.el; \ - LC_COLLATE=C ls $(lisp)/*.el $(lisp)/*/*.el $(lisp)/*/*/*.el $(lisp)/*/*/*/*.el) | \ - sort | uniq -u | while read extra; do \ - echo "Found left over byte-compiled file: $${extra}c !!" ;\ - done - -## Explicitly list the .elc files, for the sake of parallel builds. -## http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-05/msg00016.html -## This can probably be done more elegantly, but needs to be portable. -ELCFILES = \ - $(lisp)/abbrev.elc \ - $(lisp)/abbrevlist.elc \ - $(lisp)/add-log.elc \ - $(lisp)/align.elc \ - $(lisp)/allout.elc \ - $(lisp)/ansi-color.elc \ - $(lisp)/apropos.elc \ - $(lisp)/arc-mode.elc \ - $(lisp)/array.elc \ - $(lisp)/autoarg.elc \ - $(lisp)/autoinsert.elc \ - $(lisp)/autorevert.elc \ - $(lisp)/avoid.elc \ - $(lisp)/battery.elc \ - $(lisp)/bindings.elc \ - $(lisp)/bookmark.elc \ - $(lisp)/bs.elc \ - $(lisp)/buff-menu.elc \ - $(lisp)/button.elc \ - $(lisp)/calc/calc-aent.elc \ - $(lisp)/calc/calc-alg.elc \ - $(lisp)/calc/calc-arith.elc \ - $(lisp)/calc/calc-bin.elc \ - $(lisp)/calc/calc-comb.elc \ - $(lisp)/calc/calc-cplx.elc \ - $(lisp)/calc/calc-embed.elc \ - $(lisp)/calc/calc-ext.elc \ - $(lisp)/calc/calc-fin.elc \ - $(lisp)/calc/calc-forms.elc \ - $(lisp)/calc/calc-frac.elc \ - $(lisp)/calc/calc-funcs.elc \ - $(lisp)/calc/calc-graph.elc \ - $(lisp)/calc/calc-help.elc \ - $(lisp)/calc/calc-incom.elc \ - $(lisp)/calc/calc-keypd.elc \ - $(lisp)/calc/calc-lang.elc \ - $(lisp)/calc/calc-macs.elc \ - $(lisp)/calc/calc-map.elc \ - $(lisp)/calc/calc-math.elc \ - $(lisp)/calc/calc-menu.elc \ - $(lisp)/calc/calc-misc.elc \ - $(lisp)/calc/calc-mode.elc \ - $(lisp)/calc/calc-mtx.elc \ - $(lisp)/calc/calc-nlfit.elc \ - $(lisp)/calc/calc-poly.elc \ - $(lisp)/calc/calc-prog.elc \ - $(lisp)/calc/calc-rewr.elc \ - $(lisp)/calc/calc-rules.elc \ - $(lisp)/calc/calc-sel.elc \ - $(lisp)/calc/calc-stat.elc \ - $(lisp)/calc/calc-store.elc \ - $(lisp)/calc/calc-stuff.elc \ - $(lisp)/calc/calc-trail.elc \ - $(lisp)/calc/calc-undo.elc \ - $(lisp)/calc/calc-units.elc \ - $(lisp)/calc/calc-vec.elc \ - $(lisp)/calc/calc-yank.elc \ - $(lisp)/calc/calc.elc \ - $(lisp)/calc/calcalg2.elc \ - $(lisp)/calc/calcalg3.elc \ - $(lisp)/calc/calccomp.elc \ - $(lisp)/calc/calcsel2.elc \ - $(lisp)/calculator.elc \ - $(lisp)/calendar/appt.elc \ - $(lisp)/calendar/cal-bahai.elc \ - $(lisp)/calendar/cal-china.elc \ - $(lisp)/calendar/cal-coptic.elc \ - $(lisp)/calendar/cal-dst.elc \ - $(lisp)/calendar/cal-french.elc \ - $(lisp)/calendar/cal-hebrew.elc \ - $(lisp)/calendar/cal-html.elc \ - $(lisp)/calendar/cal-islam.elc \ - $(lisp)/calendar/cal-iso.elc \ - $(lisp)/calendar/cal-julian.elc \ - $(lisp)/calendar/cal-mayan.elc \ - $(lisp)/calendar/cal-menu.elc \ - $(lisp)/calendar/cal-move.elc \ - $(lisp)/calendar/cal-persia.elc \ - $(lisp)/calendar/cal-tex.elc \ - $(lisp)/calendar/cal-x.elc \ - $(lisp)/calendar/calendar.elc \ - $(lisp)/calendar/diary-lib.elc \ - $(lisp)/calendar/holidays.elc \ - $(lisp)/calendar/icalendar.elc \ - $(lisp)/calendar/lunar.elc \ - $(lisp)/calendar/parse-time.elc \ - $(lisp)/calendar/solar.elc \ - $(lisp)/calendar/time-date.elc \ - $(lisp)/calendar/timeclock.elc \ - $(lisp)/calendar/todo-mode.elc \ - $(lisp)/case-table.elc \ - $(lisp)/cdl.elc \ - $(lisp)/cedet/cedet-cscope.elc \ - $(lisp)/cedet/cedet-files.elc \ - $(lisp)/cedet/cedet-global.elc \ - $(lisp)/cedet/cedet-idutils.elc \ - $(lisp)/cedet/cedet.elc \ - $(lisp)/cedet/data-debug.elc \ - $(lisp)/cedet/ede.elc \ - $(lisp)/cedet/ede/autoconf-edit.elc \ - $(lisp)/cedet/ede/cpp-root.elc \ - $(lisp)/cedet/ede/dired.elc \ - $(lisp)/cedet/ede/emacs.elc \ - $(lisp)/cedet/ede/files.elc \ - $(lisp)/cedet/ede/linux.elc \ - $(lisp)/cedet/ede/locate.elc \ - $(lisp)/cedet/ede/make.elc \ - $(lisp)/cedet/ede/makefile-edit.elc \ - $(lisp)/cedet/ede/pconf.elc \ - $(lisp)/cedet/ede/pmake.elc \ - $(lisp)/cedet/ede/proj-archive.elc \ - $(lisp)/cedet/ede/proj-aux.elc \ - $(lisp)/cedet/ede/proj-comp.elc \ - $(lisp)/cedet/ede/proj-elisp.elc \ - $(lisp)/cedet/ede/proj-info.elc \ - $(lisp)/cedet/ede/proj-misc.elc \ - $(lisp)/cedet/ede/proj-obj.elc \ - $(lisp)/cedet/ede/proj-prog.elc \ - $(lisp)/cedet/ede/proj-scheme.elc \ - $(lisp)/cedet/ede/proj-shared.elc \ - $(lisp)/cedet/ede/proj.elc \ - $(lisp)/cedet/ede/project-am.elc \ - $(lisp)/cedet/ede/shell.elc \ - $(lisp)/cedet/ede/simple.elc \ - $(lisp)/cedet/ede/source.elc \ - $(lisp)/cedet/ede/speedbar.elc \ - $(lisp)/cedet/ede/srecode.elc \ - $(lisp)/cedet/ede/system.elc \ - $(lisp)/cedet/ede/util.elc \ - $(lisp)/cedet/inversion.elc \ - $(lisp)/cedet/mode-local.elc \ - $(lisp)/cedet/pulse.elc \ - $(lisp)/cedet/semantic.elc \ - $(lisp)/cedet/semantic/analyze.elc \ - $(lisp)/cedet/semantic/analyze/complete.elc \ - $(lisp)/cedet/semantic/analyze/debug.elc \ - $(lisp)/cedet/semantic/analyze/fcn.elc \ - $(lisp)/cedet/semantic/analyze/refs.elc \ - $(lisp)/cedet/semantic/bovine.elc \ - $(lisp)/cedet/semantic/bovine/c-by.elc \ - $(lisp)/cedet/semantic/bovine/c.elc \ - $(lisp)/cedet/semantic/bovine/debug.elc \ - $(lisp)/cedet/semantic/bovine/el.elc \ - $(lisp)/cedet/semantic/bovine/gcc.elc \ - $(lisp)/cedet/semantic/bovine/make-by.elc \ - $(lisp)/cedet/semantic/bovine/make.elc \ - $(lisp)/cedet/semantic/bovine/scm-by.elc \ - $(lisp)/cedet/semantic/bovine/scm.elc \ - $(lisp)/cedet/semantic/chart.elc \ - $(lisp)/cedet/semantic/complete.elc \ - $(lisp)/cedet/semantic/ctxt.elc \ - $(lisp)/cedet/semantic/db-debug.elc \ - $(lisp)/cedet/semantic/db-ebrowse.elc \ - $(lisp)/cedet/semantic/db-el.elc \ - $(lisp)/cedet/semantic/db-file.elc \ - $(lisp)/cedet/semantic/db-find.elc \ - $(lisp)/cedet/semantic/db-global.elc \ - $(lisp)/cedet/semantic/db-javascript.elc \ - $(lisp)/cedet/semantic/db-mode.elc \ - $(lisp)/cedet/semantic/db-ref.elc \ - $(lisp)/cedet/semantic/db-typecache.elc \ - $(lisp)/cedet/semantic/db.elc \ - $(lisp)/cedet/semantic/debug.elc \ - $(lisp)/cedet/semantic/decorate.elc \ - $(lisp)/cedet/semantic/decorate/include.elc \ - $(lisp)/cedet/semantic/decorate/mode.elc \ - $(lisp)/cedet/semantic/dep.elc \ - $(lisp)/cedet/semantic/doc.elc \ - $(lisp)/cedet/semantic/ede-grammar.elc \ - $(lisp)/cedet/semantic/edit.elc \ - $(lisp)/cedet/semantic/find.elc \ - $(lisp)/cedet/semantic/format.elc \ - $(lisp)/cedet/semantic/fw.elc \ - $(lisp)/cedet/semantic/grammar-wy.elc \ - $(lisp)/cedet/semantic/grammar.elc \ - $(lisp)/cedet/semantic/html.elc \ - $(lisp)/cedet/semantic/ia-sb.elc \ - $(lisp)/cedet/semantic/ia.elc \ - $(lisp)/cedet/semantic/idle.elc \ - $(lisp)/cedet/semantic/java.elc \ - $(lisp)/cedet/semantic/lex-spp.elc \ - $(lisp)/cedet/semantic/lex.elc \ - $(lisp)/cedet/semantic/mru-bookmark.elc \ - $(lisp)/cedet/semantic/sb.elc \ - $(lisp)/cedet/semantic/scope.elc \ - $(lisp)/cedet/semantic/senator.elc \ - $(lisp)/cedet/semantic/sort.elc \ - $(lisp)/cedet/semantic/symref.elc \ - $(lisp)/cedet/semantic/symref/cscope.elc \ - $(lisp)/cedet/semantic/symref/filter.elc \ - $(lisp)/cedet/semantic/symref/global.elc \ - $(lisp)/cedet/semantic/symref/grep.elc \ - $(lisp)/cedet/semantic/symref/idutils.elc \ - $(lisp)/cedet/semantic/symref/list.elc \ - $(lisp)/cedet/semantic/tag-file.elc \ - $(lisp)/cedet/semantic/tag-ls.elc \ - $(lisp)/cedet/semantic/tag-write.elc \ - $(lisp)/cedet/semantic/tag.elc \ - $(lisp)/cedet/semantic/texi.elc \ - $(lisp)/cedet/semantic/util-modes.elc \ - $(lisp)/cedet/semantic/util.elc \ - $(lisp)/cedet/semantic/wisent.elc \ - $(lisp)/cedet/semantic/wisent/comp.elc \ - $(lisp)/cedet/semantic/wisent/java-tags.elc \ - $(lisp)/cedet/semantic/wisent/javascript.elc \ - $(lisp)/cedet/semantic/wisent/javat-wy.elc \ - $(lisp)/cedet/semantic/wisent/js-wy.elc \ - $(lisp)/cedet/semantic/wisent/python-wy.elc \ - $(lisp)/cedet/semantic/wisent/python.elc \ - $(lisp)/cedet/semantic/wisent/wisent.elc \ - $(lisp)/cedet/srecode.elc \ - $(lisp)/cedet/srecode/args.elc \ - $(lisp)/cedet/srecode/compile.elc \ - $(lisp)/cedet/srecode/cpp.elc \ - $(lisp)/cedet/srecode/ctxt.elc \ - $(lisp)/cedet/srecode/dictionary.elc \ - $(lisp)/cedet/srecode/document.elc \ - $(lisp)/cedet/srecode/el.elc \ - $(lisp)/cedet/srecode/expandproto.elc \ - $(lisp)/cedet/srecode/extract.elc \ - $(lisp)/cedet/srecode/fields.elc \ - $(lisp)/cedet/srecode/filters.elc \ - $(lisp)/cedet/srecode/find.elc \ - $(lisp)/cedet/srecode/getset.elc \ - $(lisp)/cedet/srecode/insert.elc \ - $(lisp)/cedet/srecode/java.elc \ - $(lisp)/cedet/srecode/map.elc \ - $(lisp)/cedet/srecode/mode.elc \ - $(lisp)/cedet/srecode/semantic.elc \ - $(lisp)/cedet/srecode/srt-mode.elc \ - $(lisp)/cedet/srecode/srt-wy.elc \ - $(lisp)/cedet/srecode/srt.elc \ - $(lisp)/cedet/srecode/table.elc \ - $(lisp)/cedet/srecode/template.elc \ - $(lisp)/cedet/srecode/texi.elc \ - $(lisp)/chistory.elc \ - $(lisp)/cmuscheme.elc \ - $(lisp)/comint.elc \ - $(lisp)/compare-w.elc \ - $(lisp)/complete.elc \ - $(lisp)/completion.elc \ - $(lisp)/composite.elc \ - $(lisp)/cus-dep.elc \ - $(lisp)/cus-edit.elc \ - $(lisp)/cus-face.elc \ - $(lisp)/cus-start.elc \ - $(lisp)/cus-theme.elc \ - $(lisp)/custom.elc \ - $(lisp)/cvs-status.elc \ - $(lisp)/dabbrev.elc \ - $(lisp)/delim-col.elc \ - $(lisp)/delsel.elc \ - $(lisp)/descr-text.elc \ - $(lisp)/desktop.elc \ - $(lisp)/dframe.elc \ - $(lisp)/diff-mode.elc \ - $(lisp)/diff.elc \ - $(lisp)/dired-aux.elc \ - $(lisp)/dired-x.elc \ - $(lisp)/dired.elc \ - $(lisp)/dirtrack.elc \ - $(lisp)/disp-table.elc \ - $(lisp)/dnd.elc \ - $(lisp)/doc-view.elc \ - $(lisp)/dos-fns.elc \ - $(lisp)/dos-vars.elc \ - $(lisp)/dos-w32.elc \ - $(lisp)/double.elc \ - $(lisp)/ebuff-menu.elc \ - $(lisp)/echistory.elc \ - $(lisp)/ediff-diff.elc \ - $(lisp)/ediff-help.elc \ - $(lisp)/ediff-hook.elc \ - $(lisp)/ediff-init.elc \ - $(lisp)/ediff-merg.elc \ - $(lisp)/ediff-mult.elc \ - $(lisp)/ediff-ptch.elc \ - $(lisp)/ediff-util.elc \ - $(lisp)/ediff-vers.elc \ - $(lisp)/ediff-wind.elc \ - $(lisp)/ediff.elc \ - $(lisp)/edmacro.elc \ - $(lisp)/ehelp.elc \ - $(lisp)/electric.elc \ - $(lisp)/elide-head.elc \ - $(lisp)/emacs-lisp/advice.elc \ - $(lisp)/emacs-lisp/assoc.elc \ - $(lisp)/emacs-lisp/authors.elc \ - $(lisp)/emacs-lisp/autoload.elc \ - $(lisp)/emacs-lisp/avl-tree.elc \ - $(lisp)/emacs-lisp/backquote.elc \ - $(lisp)/emacs-lisp/benchmark.elc \ - $(lisp)/emacs-lisp/bindat.elc \ - $(lisp)/emacs-lisp/byte-opt.elc \ - $(lisp)/emacs-lisp/byte-run.elc \ - $(lisp)/emacs-lisp/bytecomp.elc \ - $(lisp)/emacs-lisp/chart.elc \ - $(lisp)/emacs-lisp/check-declare.elc \ - $(lisp)/emacs-lisp/checkdoc.elc \ - $(lisp)/emacs-lisp/cl-compat.elc \ - $(lisp)/emacs-lisp/cl-extra.elc \ - $(lisp)/emacs-lisp/cl-indent.elc \ - $(lisp)/emacs-lisp/cl-macs.elc \ - $(lisp)/emacs-lisp/cl-seq.elc \ - $(lisp)/emacs-lisp/cl.elc \ - $(lisp)/emacs-lisp/copyright.elc \ - $(lisp)/emacs-lisp/crm.elc \ - $(lisp)/emacs-lisp/cust-print.elc \ - $(lisp)/emacs-lisp/debug.elc \ - $(lisp)/emacs-lisp/derived.elc \ - $(lisp)/emacs-lisp/disass.elc \ - $(lisp)/emacs-lisp/easy-mmode.elc \ - $(lisp)/emacs-lisp/easymenu.elc \ - $(lisp)/emacs-lisp/edebug.elc \ - $(lisp)/emacs-lisp/eieio-base.elc \ - $(lisp)/emacs-lisp/eieio-comp.elc \ - $(lisp)/emacs-lisp/eieio-custom.elc \ - $(lisp)/emacs-lisp/eieio-datadebug.elc \ - $(lisp)/emacs-lisp/eieio-opt.elc \ - $(lisp)/emacs-lisp/eieio-speedbar.elc \ - $(lisp)/emacs-lisp/eieio.elc \ - $(lisp)/emacs-lisp/eldoc.elc \ - $(lisp)/emacs-lisp/elint.elc \ - $(lisp)/emacs-lisp/elp.elc \ - $(lisp)/emacs-lisp/ewoc.elc \ - $(lisp)/emacs-lisp/find-func.elc \ - $(lisp)/emacs-lisp/find-gc.elc \ - $(lisp)/emacs-lisp/float-sup.elc \ - $(lisp)/emacs-lisp/generic.elc \ - $(lisp)/emacs-lisp/gulp.elc \ - $(lisp)/emacs-lisp/helper.elc \ - $(lisp)/emacs-lisp/lisp-mnt.elc \ - $(lisp)/emacs-lisp/lisp-mode.elc \ - $(lisp)/emacs-lisp/lisp.elc \ - $(lisp)/emacs-lisp/lmenu.elc \ - $(lisp)/emacs-lisp/macroexp.elc \ - $(lisp)/emacs-lisp/map-ynp.elc \ - $(lisp)/emacs-lisp/pp.elc \ - $(lisp)/emacs-lisp/re-builder.elc \ - $(lisp)/emacs-lisp/regexp-opt.elc \ - $(lisp)/emacs-lisp/regi.elc \ - $(lisp)/emacs-lisp/ring.elc \ - $(lisp)/emacs-lisp/rx.elc \ - $(lisp)/emacs-lisp/shadow.elc \ - $(lisp)/emacs-lisp/sregex.elc \ - $(lisp)/emacs-lisp/syntax.elc \ - $(lisp)/emacs-lisp/tcover-ses.elc \ - $(lisp)/emacs-lisp/tcover-unsafep.elc \ - $(lisp)/emacs-lisp/testcover.elc \ - $(lisp)/emacs-lisp/timer.elc \ - $(lisp)/emacs-lisp/tq.elc \ - $(lisp)/emacs-lisp/trace.elc \ - $(lisp)/emacs-lisp/unsafep.elc \ - $(lisp)/emacs-lisp/warnings.elc \ - $(lisp)/emacs-lock.elc \ - $(lisp)/emerge.elc \ - $(lisp)/emulation/crisp.elc \ - $(lisp)/emulation/cua-base.elc \ - $(lisp)/emulation/cua-gmrk.elc \ - $(lisp)/emulation/cua-rect.elc \ - $(lisp)/emulation/edt-lk201.elc \ - $(lisp)/emulation/edt-mapper.elc \ - $(lisp)/emulation/edt-pc.elc \ - $(lisp)/emulation/edt-vt100.elc \ - $(lisp)/emulation/edt.elc \ - $(lisp)/emulation/keypad.elc \ - $(lisp)/emulation/pc-mode.elc \ - $(lisp)/emulation/pc-select.elc \ - $(lisp)/emulation/tpu-edt.elc \ - $(lisp)/emulation/tpu-extras.elc \ - $(lisp)/emulation/tpu-mapper.elc \ - $(lisp)/emulation/vi.elc \ - $(lisp)/emulation/vip.elc \ - $(lisp)/emulation/viper-cmd.elc \ - $(lisp)/emulation/viper-ex.elc \ - $(lisp)/emulation/viper-init.elc \ - $(lisp)/emulation/viper-keym.elc \ - $(lisp)/emulation/viper-macs.elc \ - $(lisp)/emulation/viper-mous.elc \ - $(lisp)/emulation/viper-util.elc \ - $(lisp)/emulation/viper.elc \ - $(lisp)/emulation/ws-mode.elc \ - $(lisp)/env.elc \ - $(lisp)/epa-dired.elc \ - $(lisp)/epa-file.elc \ - $(lisp)/epa-hook.elc \ - $(lisp)/epa-mail.elc \ - $(lisp)/epa.elc \ - $(lisp)/epg-config.elc \ - $(lisp)/epg.elc \ - $(lisp)/erc/erc-autoaway.elc \ - $(lisp)/erc/erc-backend.elc \ - $(lisp)/erc/erc-button.elc \ - $(lisp)/erc/erc-capab.elc \ - $(lisp)/erc/erc-compat.elc \ - $(lisp)/erc/erc-dcc.elc \ - $(lisp)/erc/erc-ezbounce.elc \ - $(lisp)/erc/erc-fill.elc \ - $(lisp)/erc/erc-goodies.elc \ - $(lisp)/erc/erc-hecomplete.elc \ - $(lisp)/erc/erc-ibuffer.elc \ - $(lisp)/erc/erc-identd.elc \ - $(lisp)/erc/erc-imenu.elc \ - $(lisp)/erc/erc-join.elc \ - $(lisp)/erc/erc-lang.elc \ - $(lisp)/erc/erc-list.elc \ - $(lisp)/erc/erc-log.elc \ - $(lisp)/erc/erc-match.elc \ - $(lisp)/erc/erc-menu.elc \ - $(lisp)/erc/erc-netsplit.elc \ - $(lisp)/erc/erc-networks.elc \ - $(lisp)/erc/erc-notify.elc \ - $(lisp)/erc/erc-page.elc \ - $(lisp)/erc/erc-pcomplete.elc \ - $(lisp)/erc/erc-replace.elc \ - $(lisp)/erc/erc-ring.elc \ - $(lisp)/erc/erc-services.elc \ - $(lisp)/erc/erc-sound.elc \ - $(lisp)/erc/erc-speedbar.elc \ - $(lisp)/erc/erc-spelling.elc \ - $(lisp)/erc/erc-stamp.elc \ - $(lisp)/erc/erc-track.elc \ - $(lisp)/erc/erc-truncate.elc \ - $(lisp)/erc/erc-xdcc.elc \ - $(lisp)/erc/erc.elc \ - $(lisp)/eshell/em-alias.elc \ - $(lisp)/eshell/em-banner.elc \ - $(lisp)/eshell/em-basic.elc \ - $(lisp)/eshell/em-cmpl.elc \ - $(lisp)/eshell/em-dirs.elc \ - $(lisp)/eshell/em-glob.elc \ - $(lisp)/eshell/em-hist.elc \ - $(lisp)/eshell/em-ls.elc \ - $(lisp)/eshell/em-pred.elc \ - $(lisp)/eshell/em-prompt.elc \ - $(lisp)/eshell/em-rebind.elc \ - $(lisp)/eshell/em-script.elc \ - $(lisp)/eshell/em-smart.elc \ - $(lisp)/eshell/em-term.elc \ - $(lisp)/eshell/em-unix.elc \ - $(lisp)/eshell/em-xtra.elc \ - $(lisp)/eshell/esh-arg.elc \ - $(lisp)/eshell/esh-cmd.elc \ - $(lisp)/eshell/esh-ext.elc \ - $(lisp)/eshell/esh-io.elc \ - $(lisp)/eshell/esh-mode.elc \ - $(lisp)/eshell/esh-module.elc \ - $(lisp)/eshell/esh-opt.elc \ - $(lisp)/eshell/esh-proc.elc \ - $(lisp)/eshell/esh-test.elc \ - $(lisp)/eshell/esh-util.elc \ - $(lisp)/eshell/esh-var.elc \ - $(lisp)/eshell/eshell.elc \ - $(lisp)/expand.elc \ - $(lisp)/ezimage.elc \ - $(lisp)/face-remap.elc \ - $(lisp)/facemenu.elc \ - $(lisp)/faces.elc \ - $(lisp)/ffap.elc \ - $(lisp)/filecache.elc \ - $(lisp)/files-x.elc \ - $(lisp)/files.elc \ - $(lisp)/filesets.elc \ - $(lisp)/find-cmd.elc \ - $(lisp)/find-dired.elc \ - $(lisp)/find-file.elc \ - $(lisp)/find-lisp.elc \ - $(lisp)/finder.elc \ - $(lisp)/flow-ctrl.elc \ - $(lisp)/foldout.elc \ - $(lisp)/follow.elc \ - $(lisp)/font-core.elc \ - $(lisp)/font-lock.elc \ - $(lisp)/font-setting.elc \ - $(lisp)/format-spec.elc \ - $(lisp)/format.elc \ - $(lisp)/forms.elc \ - $(lisp)/frame.elc \ - $(lisp)/fringe.elc \ - $(lisp)/generic-x.elc \ - $(lisp)/gnus/auth-source.elc \ - $(lisp)/gnus/canlock.elc \ - $(lisp)/gnus/compface.elc \ - $(lisp)/gnus/deuglify.elc \ - $(lisp)/gnus/earcon.elc \ - $(lisp)/gnus/ecomplete.elc \ - $(lisp)/gnus/flow-fill.elc \ - $(lisp)/gnus/gmm-utils.elc \ - $(lisp)/gnus/gnus-agent.elc \ - $(lisp)/gnus/gnus-art.elc \ - $(lisp)/gnus/gnus-async.elc \ - $(lisp)/gnus/gnus-audio.elc \ - $(lisp)/gnus/gnus-bcklg.elc \ - $(lisp)/gnus/gnus-bookmark.elc \ - $(lisp)/gnus/gnus-cache.elc \ - $(lisp)/gnus/gnus-cite.elc \ - $(lisp)/gnus/gnus-cus.elc \ - $(lisp)/gnus/gnus-delay.elc \ - $(lisp)/gnus/gnus-demon.elc \ - $(lisp)/gnus/gnus-diary.elc \ - $(lisp)/gnus/gnus-dired.elc \ - $(lisp)/gnus/gnus-draft.elc \ - $(lisp)/gnus/gnus-dup.elc \ - $(lisp)/gnus/gnus-eform.elc \ - $(lisp)/gnus/gnus-ems.elc \ - $(lisp)/gnus/gnus-fun.elc \ - $(lisp)/gnus/gnus-group.elc \ - $(lisp)/gnus/gnus-int.elc \ - $(lisp)/gnus/gnus-kill.elc \ - $(lisp)/gnus/gnus-logic.elc \ - $(lisp)/gnus/gnus-mh.elc \ - $(lisp)/gnus/gnus-ml.elc \ - $(lisp)/gnus/gnus-mlspl.elc \ - $(lisp)/gnus/gnus-move.elc \ - $(lisp)/gnus/gnus-msg.elc \ - $(lisp)/gnus/gnus-nocem.elc \ - $(lisp)/gnus/gnus-picon.elc \ - $(lisp)/gnus/gnus-range.elc \ - $(lisp)/gnus/gnus-registry.elc \ - $(lisp)/gnus/gnus-salt.elc \ - $(lisp)/gnus/gnus-score.elc \ - $(lisp)/gnus/gnus-setup.elc \ - $(lisp)/gnus/gnus-sieve.elc \ - $(lisp)/gnus/gnus-soup.elc \ - $(lisp)/gnus/gnus-spec.elc \ - $(lisp)/gnus/gnus-srvr.elc \ - $(lisp)/gnus/gnus-start.elc \ - $(lisp)/gnus/gnus-sum.elc \ - $(lisp)/gnus/gnus-topic.elc \ - $(lisp)/gnus/gnus-undo.elc \ - $(lisp)/gnus/gnus-util.elc \ - $(lisp)/gnus/gnus-uu.elc \ - $(lisp)/gnus/gnus-vm.elc \ - $(lisp)/gnus/gnus-win.elc \ - $(lisp)/gnus/gnus.elc \ - $(lisp)/gnus/html2text.elc \ - $(lisp)/gnus/ietf-drums.elc \ - $(lisp)/gnus/legacy-gnus-agent.elc \ - $(lisp)/gnus/mail-parse.elc \ - $(lisp)/gnus/mail-prsvr.elc \ - $(lisp)/gnus/mail-source.elc \ - $(lisp)/gnus/mailcap.elc \ - $(lisp)/gnus/message.elc \ - $(lisp)/gnus/messcompat.elc \ - $(lisp)/gnus/mm-bodies.elc \ - $(lisp)/gnus/mm-decode.elc \ - $(lisp)/gnus/mm-encode.elc \ - $(lisp)/gnus/mm-extern.elc \ - $(lisp)/gnus/mm-partial.elc \ - $(lisp)/gnus/mm-url.elc \ - $(lisp)/gnus/mm-util.elc \ - $(lisp)/gnus/mm-uu.elc \ - $(lisp)/gnus/mm-view.elc \ - $(lisp)/gnus/mml-sec.elc \ - $(lisp)/gnus/mml-smime.elc \ - $(lisp)/gnus/mml.elc \ - $(lisp)/gnus/mml1991.elc \ - $(lisp)/gnus/mml2015.elc \ - $(lisp)/gnus/nnagent.elc \ - $(lisp)/gnus/nnbabyl.elc \ - $(lisp)/gnus/nndb.elc \ - $(lisp)/gnus/nndiary.elc \ - $(lisp)/gnus/nndir.elc \ - $(lisp)/gnus/nndoc.elc \ - $(lisp)/gnus/nndraft.elc \ - $(lisp)/gnus/nneething.elc \ - $(lisp)/gnus/nnfolder.elc \ - $(lisp)/gnus/nngateway.elc \ - $(lisp)/gnus/nnheader.elc \ - $(lisp)/gnus/nnimap.elc \ - $(lisp)/gnus/nnir.elc \ - $(lisp)/gnus/nnkiboze.elc \ - $(lisp)/gnus/nnlistserv.elc \ - $(lisp)/gnus/nnmail.elc \ - $(lisp)/gnus/nnmaildir.elc \ - $(lisp)/gnus/nnmairix.elc \ - $(lisp)/gnus/nnmbox.elc \ - $(lisp)/gnus/nnmh.elc \ - $(lisp)/gnus/nnml.elc \ - $(lisp)/gnus/nnnil.elc \ - $(lisp)/gnus/nnoo.elc \ - $(lisp)/gnus/nnrss.elc \ - $(lisp)/gnus/nnslashdot.elc \ - $(lisp)/gnus/nnsoup.elc \ - $(lisp)/gnus/nnspool.elc \ - $(lisp)/gnus/nntp.elc \ - $(lisp)/gnus/nnultimate.elc \ - $(lisp)/gnus/nnvirtual.elc \ - $(lisp)/gnus/nnwarchive.elc \ - $(lisp)/gnus/nnweb.elc \ - $(lisp)/gnus/nnwfm.elc \ - $(lisp)/gnus/pop3.elc \ - $(lisp)/gnus/qp.elc \ - $(lisp)/gnus/rfc1843.elc \ - $(lisp)/gnus/rfc2045.elc \ - $(lisp)/gnus/rfc2047.elc \ - $(lisp)/gnus/rfc2104.elc \ - $(lisp)/gnus/rfc2231.elc \ - $(lisp)/gnus/score-mode.elc \ - $(lisp)/gnus/sieve-manage.elc \ - $(lisp)/gnus/sieve-mode.elc \ - $(lisp)/gnus/sieve.elc \ - $(lisp)/gnus/smiley.elc \ - $(lisp)/gnus/smime.elc \ - $(lisp)/gnus/spam-report.elc \ - $(lisp)/gnus/spam-stat.elc \ - $(lisp)/gnus/spam-wash.elc \ - $(lisp)/gnus/spam.elc \ - $(lisp)/gnus/starttls.elc \ - $(lisp)/gnus/utf7.elc \ - $(lisp)/gnus/webmail.elc \ - $(lisp)/gnus/yenc.elc \ - $(lisp)/gs.elc \ - $(lisp)/help-at-pt.elc \ - $(lisp)/help-fns.elc \ - $(lisp)/help-macro.elc \ - $(lisp)/help-mode.elc \ - $(lisp)/help.elc \ - $(lisp)/hex-util.elc \ - $(lisp)/hexl.elc \ - $(lisp)/hfy-cmap.elc \ - $(lisp)/hi-lock.elc \ - $(lisp)/hilit-chg.elc \ - $(lisp)/hippie-exp.elc \ - $(lisp)/hl-line.elc \ - $(lisp)/htmlfontify.elc \ - $(lisp)/ibuf-ext.elc \ - $(lisp)/ibuf-macs.elc \ - $(lisp)/ibuffer.elc \ - $(lisp)/icomplete.elc \ - $(lisp)/ido.elc \ - $(lisp)/ielm.elc \ - $(lisp)/iimage.elc \ - $(lisp)/image-dired.elc \ - $(lisp)/image-file.elc \ - $(lisp)/image-mode.elc \ - $(lisp)/image.elc \ - $(lisp)/imenu.elc \ - $(lisp)/indent.elc \ - $(lisp)/info-look.elc \ - $(lisp)/info-xref.elc \ - $(lisp)/info.elc \ - $(lisp)/informat.elc \ - $(lisp)/international/ccl.elc \ - $(lisp)/international/characters.elc \ - $(lisp)/international/fontset.elc \ - $(lisp)/international/isearch-x.elc \ - $(lisp)/international/iso-ascii.elc \ - $(lisp)/international/iso-cvt.elc \ - $(lisp)/international/iso-transl.elc \ - $(lisp)/international/ja-dic-cnv.elc \ - $(lisp)/international/ja-dic-utl.elc \ - $(lisp)/international/kinsoku.elc \ - $(lisp)/international/kkc.elc \ - $(lisp)/international/latexenc.elc \ - $(lisp)/international/latin1-disp.elc \ - $(lisp)/international/mule-cmds.elc \ - $(lisp)/international/mule-conf.elc \ - $(lisp)/international/mule-diag.elc \ - $(lisp)/international/mule-util.elc \ - $(lisp)/international/mule.elc \ - $(lisp)/international/ogonek.elc \ - $(lisp)/international/quail.elc \ - $(lisp)/international/robin.elc \ - $(lisp)/international/titdic-cnv.elc \ - $(lisp)/international/ucs-normalize.elc \ - $(lisp)/international/utf-7.elc \ - $(lisp)/isearch.elc \ - $(lisp)/isearchb.elc \ - $(lisp)/iswitchb.elc \ - $(lisp)/jit-lock.elc \ - $(lisp)/jka-cmpr-hook.elc \ - $(lisp)/jka-compr.elc \ - $(lisp)/json.elc \ - $(lisp)/kermit.elc \ - $(lisp)/kmacro.elc \ - $(lisp)/language/china-util.elc \ - $(lisp)/language/chinese.elc \ - $(lisp)/language/cyril-util.elc \ - $(lisp)/language/cyrillic.elc \ - $(lisp)/language/ethio-util.elc \ - $(lisp)/language/ethiopic.elc \ - $(lisp)/language/european.elc \ - $(lisp)/language/hanja-util.elc \ - $(lisp)/language/ind-util.elc \ - $(lisp)/language/indian.elc \ - $(lisp)/language/japan-util.elc \ - $(lisp)/language/korea-util.elc \ - $(lisp)/language/lao-util.elc \ - $(lisp)/language/thai-util.elc \ - $(lisp)/language/thai-word.elc \ - $(lisp)/language/tibet-util.elc \ - $(lisp)/language/tibetan.elc \ - $(lisp)/language/tv-util.elc \ - $(lisp)/language/viet-util.elc \ - $(lisp)/language/vietnamese.elc \ - $(lisp)/ledit.elc \ - $(lisp)/linum.elc \ - $(lisp)/loadhist.elc \ - $(lisp)/locate.elc \ - $(lisp)/log-edit.elc \ - $(lisp)/log-view.elc \ - $(lisp)/longlines.elc \ - $(lisp)/lpr.elc \ - $(lisp)/ls-lisp.elc \ - $(lisp)/macros.elc \ - $(lisp)/mail/binhex.elc \ - $(lisp)/mail/emacsbug.elc \ - $(lisp)/mail/feedmail.elc \ - $(lisp)/mail/footnote.elc \ - $(lisp)/mail/hashcash.elc \ - $(lisp)/mail/mail-extr.elc \ - $(lisp)/mail/mail-hist.elc \ - $(lisp)/mail/mail-utils.elc \ - $(lisp)/mail/mailabbrev.elc \ - $(lisp)/mail/mailalias.elc \ - $(lisp)/mail/mailclient.elc \ - $(lisp)/mail/mailheader.elc \ - $(lisp)/mail/mailpost.elc \ - $(lisp)/mail/metamail.elc \ - $(lisp)/mail/mspools.elc \ - $(lisp)/mail/reporter.elc \ - $(lisp)/mail/rfc2368.elc \ - $(lisp)/mail/rfc822.elc \ - $(lisp)/mail/rmail-spam-filter.elc \ - $(lisp)/mail/rmail.elc \ - $(lisp)/mail/rmailedit.elc \ - $(lisp)/mail/rmailkwd.elc \ - $(lisp)/mail/rmailmm.elc \ - $(lisp)/mail/rmailmsc.elc \ - $(lisp)/mail/rmailout.elc \ - $(lisp)/mail/rmailsort.elc \ - $(lisp)/mail/rmailsum.elc \ - $(lisp)/mail/sendmail.elc \ - $(lisp)/mail/smtpmail.elc \ - $(lisp)/mail/supercite.elc \ - $(lisp)/mail/uce.elc \ - $(lisp)/mail/undigest.elc \ - $(lisp)/mail/unrmail.elc \ - $(lisp)/mail/uudecode.elc \ - $(lisp)/makesum.elc \ - $(lisp)/man.elc \ - $(lisp)/master.elc \ - $(lisp)/mb-depth.elc \ - $(lisp)/md4.elc \ - $(lisp)/menu-bar.elc \ - $(lisp)/mh-e/mh-alias.elc \ - $(lisp)/mh-e/mh-buffers.elc \ - $(lisp)/mh-e/mh-comp.elc \ - $(lisp)/mh-e/mh-e.elc \ - $(lisp)/mh-e/mh-folder.elc \ - $(lisp)/mh-e/mh-funcs.elc \ - $(lisp)/mh-e/mh-identity.elc \ - $(lisp)/mh-e/mh-inc.elc \ - $(lisp)/mh-e/mh-junk.elc \ - $(lisp)/mh-e/mh-letter.elc \ - $(lisp)/mh-e/mh-limit.elc \ - $(lisp)/mh-e/mh-mime.elc \ - $(lisp)/mh-e/mh-print.elc \ - $(lisp)/mh-e/mh-scan.elc \ - $(lisp)/mh-e/mh-search.elc \ - $(lisp)/mh-e/mh-seq.elc \ - $(lisp)/mh-e/mh-show.elc \ - $(lisp)/mh-e/mh-speed.elc \ - $(lisp)/mh-e/mh-thread.elc \ - $(lisp)/mh-e/mh-tool-bar.elc \ - $(lisp)/mh-e/mh-utils.elc \ - $(lisp)/mh-e/mh-xface.elc \ - $(lisp)/midnight.elc \ - $(lisp)/minibuf-eldef.elc \ - $(lisp)/minibuffer.elc \ - $(lisp)/misc.elc \ - $(lisp)/misearch.elc \ - $(lisp)/mouse-copy.elc \ - $(lisp)/mouse-drag.elc \ - $(lisp)/mouse-sel.elc \ - $(lisp)/mouse.elc \ - $(lisp)/mpc.elc \ - $(lisp)/msb.elc \ - $(lisp)/mwheel.elc \ - $(lisp)/net/ange-ftp.elc \ - $(lisp)/net/browse-url.elc \ - $(lisp)/net/dbus.elc \ - $(lisp)/net/dig.elc \ - $(lisp)/net/dns.elc \ - $(lisp)/net/eudc-bob.elc \ - $(lisp)/net/eudc-export.elc \ - $(lisp)/net/eudc-hotlist.elc \ - $(lisp)/net/eudc-vars.elc \ - $(lisp)/net/eudc.elc \ - $(lisp)/net/eudcb-bbdb.elc \ - $(lisp)/net/eudcb-ldap.elc \ - $(lisp)/net/eudcb-mab.elc \ - $(lisp)/net/eudcb-ph.elc \ - $(lisp)/net/goto-addr.elc \ - $(lisp)/net/hmac-def.elc \ - $(lisp)/net/hmac-md5.elc \ - $(lisp)/net/imap-hash.elc \ - $(lisp)/net/imap.elc \ - $(lisp)/net/ldap.elc \ - $(lisp)/net/mairix.elc \ - $(lisp)/net/net-utils.elc \ - $(lisp)/net/netrc.elc \ - $(lisp)/net/newst-backend.elc \ - $(lisp)/net/newst-plainview.elc \ - $(lisp)/net/newst-reader.elc \ - $(lisp)/net/newst-ticker.elc \ - $(lisp)/net/newst-treeview.elc \ - $(lisp)/net/newsticker.elc \ - $(lisp)/net/ntlm.elc \ - $(lisp)/net/quickurl.elc \ - $(lisp)/net/rcirc.elc \ - $(lisp)/net/rcompile.elc \ - $(lisp)/net/rlogin.elc \ - $(lisp)/net/sasl-cram.elc \ - $(lisp)/net/sasl-digest.elc \ - $(lisp)/net/sasl-ntlm.elc \ - $(lisp)/net/sasl.elc \ - $(lisp)/net/secrets.elc \ - $(lisp)/net/snmp-mode.elc \ - $(lisp)/net/socks.elc \ - $(lisp)/net/telnet.elc \ - $(lisp)/net/tls.elc \ - $(lisp)/net/tramp-cache.elc \ - $(lisp)/net/tramp-cmds.elc \ - $(lisp)/net/tramp-compat.elc \ - $(lisp)/net/tramp-fish.elc \ - $(lisp)/net/tramp-ftp.elc \ - $(lisp)/net/tramp-gvfs.elc \ - $(lisp)/net/tramp-gw.elc \ - $(lisp)/net/tramp-imap.elc \ - $(lisp)/net/tramp-smb.elc \ - $(lisp)/net/tramp-uu.elc \ - $(lisp)/net/tramp.elc \ - $(lisp)/net/trampver.elc \ - $(lisp)/net/webjump.elc \ - $(lisp)/net/xesam.elc \ - $(lisp)/net/zeroconf.elc \ - $(lisp)/newcomment.elc \ - $(lisp)/novice.elc \ - $(lisp)/nxml/nxml-enc.elc \ - $(lisp)/nxml/nxml-glyph.elc \ - $(lisp)/nxml/nxml-maint.elc \ - $(lisp)/nxml/nxml-mode.elc \ - $(lisp)/nxml/nxml-ns.elc \ - $(lisp)/nxml/nxml-outln.elc \ - $(lisp)/nxml/nxml-parse.elc \ - $(lisp)/nxml/nxml-rap.elc \ - $(lisp)/nxml/nxml-uchnm.elc \ - $(lisp)/nxml/nxml-util.elc \ - $(lisp)/nxml/rng-cmpct.elc \ - $(lisp)/nxml/rng-dt.elc \ - $(lisp)/nxml/rng-loc.elc \ - $(lisp)/nxml/rng-maint.elc \ - $(lisp)/nxml/rng-match.elc \ - $(lisp)/nxml/rng-nxml.elc \ - $(lisp)/nxml/rng-parse.elc \ - $(lisp)/nxml/rng-pttrn.elc \ - $(lisp)/nxml/rng-uri.elc \ - $(lisp)/nxml/rng-util.elc \ - $(lisp)/nxml/rng-valid.elc \ - $(lisp)/nxml/rng-xsd.elc \ - $(lisp)/nxml/xmltok.elc \ - $(lisp)/nxml/xsd-regexp.elc \ - $(lisp)/obsolete/awk-mode.elc \ - $(lisp)/obsolete/fast-lock.elc \ - $(lisp)/obsolete/iso-acc.elc \ - $(lisp)/obsolete/iso-insert.elc \ - $(lisp)/obsolete/iso-swed.elc \ - $(lisp)/obsolete/lazy-lock.elc \ - $(lisp)/obsolete/levents.elc \ - $(lisp)/obsolete/lucid.elc \ - $(lisp)/obsolete/old-whitespace.elc \ - $(lisp)/obsolete/options.elc \ - $(lisp)/obsolete/resume.elc \ - $(lisp)/obsolete/rnews.elc \ - $(lisp)/obsolete/rnewspost.elc \ - $(lisp)/obsolete/sc.elc \ - $(lisp)/obsolete/scribe.elc \ - $(lisp)/obsolete/s-region.elc \ - $(lisp)/obsolete/swedish.elc \ - $(lisp)/obsolete/sym-comp.elc \ - $(lisp)/obsolete/vc-mcvs.elc \ - $(lisp)/obsolete/x-menu.elc \ - $(lisp)/org/org-agenda.elc \ - $(lisp)/org/org-archive.elc \ - $(lisp)/org/org-ascii.elc \ - $(lisp)/org/org-attach.elc \ - $(lisp)/org/org-bbdb.elc \ - $(lisp)/org/org-bibtex.elc \ - $(lisp)/org/org-clock.elc \ - $(lisp)/org/org-colview.elc \ - $(lisp)/org/org-compat.elc \ - $(lisp)/org/org-crypt.elc \ - $(lisp)/org/org-datetree.elc \ - $(lisp)/org/org-docbook.elc \ - $(lisp)/org/org-exp-blocks.elc \ - $(lisp)/org/org-exp.elc \ - $(lisp)/org/org-faces.elc \ - $(lisp)/org/org-feed.elc \ - $(lisp)/org/org-footnote.elc \ - $(lisp)/org/org-freemind.elc \ - $(lisp)/org/org-gnus.elc \ - $(lisp)/org/org-habit.elc \ - $(lisp)/org/org-html.elc \ - $(lisp)/org/org-icalendar.elc \ - $(lisp)/org/org-id.elc \ - $(lisp)/org/org-indent.elc \ - $(lisp)/org/org-info.elc \ - $(lisp)/org/org-inlinetask.elc \ - $(lisp)/org/org-install.elc \ - $(lisp)/org/org-irc.elc \ - $(lisp)/org/org-jsinfo.elc \ - $(lisp)/org/org-latex.elc \ - $(lisp)/org/org-list.elc \ - $(lisp)/org/org-mac-message.elc \ - $(lisp)/org/org-macs.elc \ - $(lisp)/org/org-mew.elc \ - $(lisp)/org/org-mhe.elc \ - $(lisp)/org/org-mobile.elc \ - $(lisp)/org/org-mouse.elc \ - $(lisp)/org/org-plot.elc \ - $(lisp)/org/org-protocol.elc \ - $(lisp)/org/org-publish.elc \ - $(lisp)/org/org-remember.elc \ - $(lisp)/org/org-rmail.elc \ - $(lisp)/org/org-src.elc \ - $(lisp)/org/org-table.elc \ - $(lisp)/org/org-timer.elc \ - $(lisp)/org/org-vm.elc \ - $(lisp)/org/org-w3m.elc \ - $(lisp)/org/org-wl.elc \ - $(lisp)/org/org-xoxo.elc \ - $(lisp)/org/org.elc \ - $(lisp)/outline.elc \ - $(lisp)/paren.elc \ - $(lisp)/password-cache.elc \ - $(lisp)/pcmpl-cvs.elc \ - $(lisp)/pcmpl-gnu.elc \ - $(lisp)/pcmpl-linux.elc \ - $(lisp)/pcmpl-rpm.elc \ - $(lisp)/pcmpl-unix.elc \ - $(lisp)/pcomplete.elc \ - $(lisp)/pcvs-defs.elc \ - $(lisp)/pcvs-info.elc \ - $(lisp)/pcvs-parse.elc \ - $(lisp)/pcvs-util.elc \ - $(lisp)/pcvs.elc \ - $(lisp)/pgg-def.elc \ - $(lisp)/pgg-gpg.elc \ - $(lisp)/pgg-parse.elc \ - $(lisp)/pgg-pgp.elc \ - $(lisp)/pgg-pgp5.elc \ - $(lisp)/pgg.elc \ - $(lisp)/play/5x5.elc \ - $(lisp)/play/animate.elc \ - $(lisp)/play/blackbox.elc \ - $(lisp)/play/bubbles.elc \ - $(lisp)/play/cookie1.elc \ - $(lisp)/play/decipher.elc \ - $(lisp)/play/dissociate.elc \ - $(lisp)/play/doctor.elc \ - $(lisp)/play/dunnet.elc \ - $(lisp)/play/fortune.elc \ - $(lisp)/play/gamegrid.elc \ - $(lisp)/play/gametree.elc \ - $(lisp)/play/gomoku.elc \ - $(lisp)/play/handwrite.elc \ - $(lisp)/play/hanoi.elc \ - $(lisp)/play/landmark.elc \ - $(lisp)/play/life.elc \ - $(lisp)/play/meese.elc \ - $(lisp)/play/morse.elc \ - $(lisp)/play/mpuz.elc \ - $(lisp)/play/pong.elc \ - $(lisp)/play/snake.elc \ - $(lisp)/play/solitaire.elc \ - $(lisp)/play/spook.elc \ - $(lisp)/play/studly.elc \ - $(lisp)/play/tetris.elc \ - $(lisp)/play/yow.elc \ - $(lisp)/play/zone.elc \ - $(lisp)/printing.elc \ - $(lisp)/proced.elc \ - $(lisp)/progmodes/ada-mode.elc \ - $(lisp)/progmodes/ada-prj.elc \ - $(lisp)/progmodes/ada-stmt.elc \ - $(lisp)/progmodes/ada-xref.elc \ - $(lisp)/progmodes/antlr-mode.elc \ - $(lisp)/progmodes/asm-mode.elc \ - $(lisp)/progmodes/autoconf.elc \ - $(lisp)/progmodes/bug-reference.elc \ - $(lisp)/progmodes/cap-words.elc \ - $(lisp)/progmodes/cc-align.elc \ - $(lisp)/progmodes/cc-awk.elc \ - $(lisp)/progmodes/cc-bytecomp.elc \ - $(lisp)/progmodes/cc-cmds.elc \ - $(lisp)/progmodes/cc-compat.elc \ - $(lisp)/progmodes/cc-defs.elc \ - $(lisp)/progmodes/cc-engine.elc \ - $(lisp)/progmodes/cc-fonts.elc \ - $(lisp)/progmodes/cc-langs.elc \ - $(lisp)/progmodes/cc-menus.elc \ - $(lisp)/progmodes/cc-mode.elc \ - $(lisp)/progmodes/cc-styles.elc \ - $(lisp)/progmodes/cc-vars.elc \ - $(lisp)/progmodes/cfengine.elc \ - $(lisp)/progmodes/cmacexp.elc \ - $(lisp)/progmodes/compile.elc \ - $(lisp)/progmodes/cperl-mode.elc \ - $(lisp)/progmodes/cpp.elc \ - $(lisp)/progmodes/cwarn.elc \ - $(lisp)/progmodes/dcl-mode.elc \ - $(lisp)/progmodes/delphi.elc \ - $(lisp)/progmodes/ebnf-abn.elc \ - $(lisp)/progmodes/ebnf-bnf.elc \ - $(lisp)/progmodes/ebnf-dtd.elc \ - $(lisp)/progmodes/ebnf-ebx.elc \ - $(lisp)/progmodes/ebnf-iso.elc \ - $(lisp)/progmodes/ebnf-otz.elc \ - $(lisp)/progmodes/ebnf-yac.elc \ - $(lisp)/progmodes/ebnf2ps.elc \ - $(lisp)/progmodes/ebrowse.elc \ - $(lisp)/progmodes/etags.elc \ - $(lisp)/progmodes/executable.elc \ - $(lisp)/progmodes/f90.elc \ - $(lisp)/progmodes/flymake.elc \ - $(lisp)/progmodes/fortran.elc \ - $(lisp)/progmodes/gdb-ui.elc \ - $(lisp)/progmodes/glasses.elc \ - $(lisp)/progmodes/grep.elc \ - $(lisp)/progmodes/gud.elc \ - $(lisp)/progmodes/hideif.elc \ - $(lisp)/progmodes/hideshow.elc \ - $(lisp)/progmodes/icon.elc \ - $(lisp)/progmodes/idlw-complete-structtag.elc \ - $(lisp)/progmodes/idlw-help.elc \ - $(lisp)/progmodes/idlw-shell.elc \ - $(lisp)/progmodes/idlw-toolbar.elc \ - $(lisp)/progmodes/idlwave.elc \ - $(lisp)/progmodes/inf-lisp.elc \ - $(lisp)/progmodes/js.elc \ - $(lisp)/progmodes/ld-script.elc \ - $(lisp)/progmodes/m4-mode.elc \ - $(lisp)/progmodes/make-mode.elc \ - $(lisp)/progmodes/mantemp.elc \ - $(lisp)/progmodes/meta-mode.elc \ - $(lisp)/progmodes/mixal-mode.elc \ - $(lisp)/progmodes/modula2.elc \ - $(lisp)/progmodes/octave-inf.elc \ - $(lisp)/progmodes/octave-mod.elc \ - $(lisp)/progmodes/pascal.elc \ - $(lisp)/progmodes/perl-mode.elc \ - $(lisp)/progmodes/prolog.elc \ - $(lisp)/progmodes/ps-mode.elc \ - $(lisp)/progmodes/python.elc \ - $(lisp)/progmodes/ruby-mode.elc \ - $(lisp)/progmodes/scheme.elc \ - $(lisp)/progmodes/sh-script.elc \ - $(lisp)/progmodes/simula.elc \ - $(lisp)/progmodes/sql.elc \ - $(lisp)/progmodes/subword.elc \ - $(lisp)/progmodes/tcl.elc \ - $(lisp)/progmodes/vera-mode.elc \ - $(lisp)/progmodes/verilog-mode.elc \ - $(lisp)/progmodes/vhdl-mode.elc \ - $(lisp)/progmodes/which-func.elc \ - $(lisp)/progmodes/xscheme.elc \ - $(lisp)/ps-bdf.elc \ - $(lisp)/ps-def.elc \ - $(lisp)/ps-mule.elc \ - $(lisp)/ps-print.elc \ - $(lisp)/ps-samp.elc \ - $(lisp)/recentf.elc \ - $(lisp)/rect.elc \ - $(lisp)/register.elc \ - $(lisp)/repeat.elc \ - $(lisp)/replace.elc \ - $(lisp)/reposition.elc \ - $(lisp)/reveal.elc \ - $(lisp)/rfn-eshadow.elc \ - $(lisp)/rot13.elc \ - $(lisp)/ruler-mode.elc \ - $(lisp)/savehist.elc \ - $(lisp)/saveplace.elc \ - $(lisp)/sb-image.elc \ - $(lisp)/scroll-all.elc \ - $(lisp)/scroll-bar.elc \ - $(lisp)/scroll-lock.elc \ - $(lisp)/select.elc \ - $(lisp)/server.elc \ - $(lisp)/ses.elc \ - $(lisp)/sha1.elc \ - $(lisp)/shadowfile.elc \ - $(lisp)/shell.elc \ - $(lisp)/simple.elc \ - $(lisp)/skeleton.elc \ - $(lisp)/smerge-mode.elc \ - $(lisp)/sort.elc \ - $(lisp)/soundex.elc \ - $(lisp)/speedbar.elc \ - $(lisp)/startup.elc \ - $(lisp)/strokes.elc \ - $(lisp)/subr.elc \ - $(lisp)/t-mouse.elc \ - $(lisp)/tabify.elc \ - $(lisp)/talk.elc \ - $(lisp)/tar-mode.elc \ - $(lisp)/tempo.elc \ - $(lisp)/term.elc \ - $(lisp)/term/common-win.elc \ - $(lisp)/term/internal.elc \ - $(lisp)/term/ns-win.elc \ - $(lisp)/term/pc-win.elc \ - $(lisp)/term/rxvt.elc \ - $(lisp)/term/sun.elc \ - $(lisp)/term/sup-mouse.elc \ - $(lisp)/term/tty-colors.elc \ - $(lisp)/term/tvi970.elc \ - $(lisp)/term/vt100.elc \ - $(lisp)/term/w32-win.elc \ - $(lisp)/term/w32console.elc \ - $(lisp)/term/x-win.elc \ - $(lisp)/term/xterm.elc \ - $(lisp)/terminal.elc \ - $(lisp)/textmodes/artist.elc \ - $(lisp)/textmodes/bib-mode.elc \ - $(lisp)/textmodes/bibtex-style.elc \ - $(lisp)/textmodes/bibtex.elc \ - $(lisp)/textmodes/conf-mode.elc \ - $(lisp)/textmodes/css-mode.elc \ - $(lisp)/textmodes/dns-mode.elc \ - $(lisp)/textmodes/enriched.elc \ - $(lisp)/textmodes/fill.elc \ - $(lisp)/textmodes/flyspell.elc \ - $(lisp)/textmodes/ispell.elc \ - $(lisp)/textmodes/makeinfo.elc \ - $(lisp)/textmodes/nroff-mode.elc \ - $(lisp)/textmodes/page-ext.elc \ - $(lisp)/textmodes/page.elc \ - $(lisp)/textmodes/paragraphs.elc \ - $(lisp)/textmodes/picture.elc \ - $(lisp)/textmodes/po.elc \ - $(lisp)/textmodes/refbib.elc \ - $(lisp)/textmodes/refer.elc \ - $(lisp)/textmodes/refill.elc \ - $(lisp)/textmodes/reftex-auc.elc \ - $(lisp)/textmodes/reftex-cite.elc \ - $(lisp)/textmodes/reftex-dcr.elc \ - $(lisp)/textmodes/reftex-global.elc \ - $(lisp)/textmodes/reftex-index.elc \ - $(lisp)/textmodes/reftex-parse.elc \ - $(lisp)/textmodes/reftex-ref.elc \ - $(lisp)/textmodes/reftex-sel.elc \ - $(lisp)/textmodes/reftex-toc.elc \ - $(lisp)/textmodes/reftex-vars.elc \ - $(lisp)/textmodes/reftex.elc \ - $(lisp)/textmodes/remember.elc \ - $(lisp)/textmodes/rst.elc \ - $(lisp)/textmodes/sgml-mode.elc \ - $(lisp)/textmodes/spell.elc \ - $(lisp)/textmodes/table.elc \ - $(lisp)/textmodes/tex-mode.elc \ - $(lisp)/textmodes/texinfmt.elc \ - $(lisp)/textmodes/texinfo.elc \ - $(lisp)/textmodes/texnfo-upd.elc \ - $(lisp)/textmodes/text-mode.elc \ - $(lisp)/textmodes/tildify.elc \ - $(lisp)/textmodes/two-column.elc \ - $(lisp)/textmodes/underline.elc \ - $(lisp)/thingatpt.elc \ - $(lisp)/thumbs.elc \ - $(lisp)/time-stamp.elc \ - $(lisp)/time.elc \ - $(lisp)/timezone.elc \ - $(lisp)/tmm.elc \ - $(lisp)/tool-bar.elc \ - $(lisp)/tooltip.elc \ - $(lisp)/tree-widget.elc \ - $(lisp)/tutorial.elc \ - $(lisp)/type-break.elc \ - $(lisp)/uniquify.elc \ - $(lisp)/url/url-about.elc \ - $(lisp)/url/url-auth.elc \ - $(lisp)/url/url-cache.elc \ - $(lisp)/url/url-cid.elc \ - $(lisp)/url/url-cookie.elc \ - $(lisp)/url/url-dav.elc \ - $(lisp)/url/url-dired.elc \ - $(lisp)/url/url-expand.elc \ - $(lisp)/url/url-file.elc \ - $(lisp)/url/url-ftp.elc \ - $(lisp)/url/url-gw.elc \ - $(lisp)/url/url-handlers.elc \ - $(lisp)/url/url-history.elc \ - $(lisp)/url/url-http.elc \ - $(lisp)/url/url-imap.elc \ - $(lisp)/url/url-irc.elc \ - $(lisp)/url/url-ldap.elc \ - $(lisp)/url/url-mailto.elc \ - $(lisp)/url/url-methods.elc \ - $(lisp)/url/url-misc.elc \ - $(lisp)/url/url-news.elc \ - $(lisp)/url/url-nfs.elc \ - $(lisp)/url/url-ns.elc \ - $(lisp)/url/url-parse.elc \ - $(lisp)/url/url-privacy.elc \ - $(lisp)/url/url-proxy.elc \ - $(lisp)/url/url-util.elc \ - $(lisp)/url/url-vars.elc \ - $(lisp)/url/url.elc \ - $(lisp)/userlock.elc \ - $(lisp)/vc-annotate.elc \ - $(lisp)/vc-arch.elc \ - $(lisp)/vc-bzr.elc \ - $(lisp)/vc-cvs.elc \ - $(lisp)/vc-dav.elc \ - $(lisp)/vc-dir.elc \ - $(lisp)/vc-dispatcher.elc \ - $(lisp)/vc-git.elc \ - $(lisp)/vc-hg.elc \ - $(lisp)/vc-hooks.elc \ - $(lisp)/vc-mtn.elc \ - $(lisp)/vc-rcs.elc \ - $(lisp)/vc-sccs.elc \ - $(lisp)/vc-svn.elc \ - $(lisp)/vc.elc \ - $(lisp)/vcursor.elc \ - $(lisp)/view.elc \ - $(lisp)/vt-control.elc \ - $(lisp)/vt100-led.elc \ - $(lisp)/w32-fns.elc \ - $(lisp)/w32-vars.elc \ - $(lisp)/wdired.elc \ - $(lisp)/whitespace.elc \ - $(lisp)/wid-browse.elc \ - $(lisp)/wid-edit.elc \ - $(lisp)/widget.elc \ - $(lisp)/windmove.elc \ - $(lisp)/window.elc \ - $(lisp)/winner.elc \ - $(lisp)/woman.elc \ - $(lisp)/x-dnd.elc \ - $(lisp)/xml.elc \ - $(lisp)/xt-mouse.elc - # The src/Makefile.in has its own set of dependencies and when they decide # that one Lisp file needs to be re-compiled, we had better recompile it as # well, otherwise every subsequent make will again call us, until we finally @@ -1486,17 +211,53 @@ # An old-fashioned suffix rule, which, according to the GNU Make manual, # cannot have prerequisites. -# Note that if a .el file is removed from the repository without -# updating ELCFILES, make will abort. .el.elc: @echo Compiling $< @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< -.PHONY: compile-first compile-main compile-last compile compile-always +.PHONY: compile-first compile-main compile compile-always compile-first: $(COMPILE_FIRST) -compile-main: $(ELCFILES) +# In `compile-main' we could directly do +# ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)" +# and it works, but it generates a lot of messages like +# make[2]: « gnus/gnus-mlspl.elc » is up to date. +# so instead, we use "xargs echo" to split the list of file into manageable +# chunks and then use an intermediate `compile-targets' target so the +# actual targets (the .elc files) are not mentioned as targets on the +# make command line. + + +.PHONY: compile-targets +# TARGETS is set dynamically in the recursive call from `compile-main'. +compile-targets: $(TARGETS) + +# Compile all the Elisp files that need it. Beware: it approximates +# `no-byte-compile', so watch out for false-positives! +compile-main: compile-clean + @(cd $(lisp); $(setwins); \ + els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ + for el in $$els; do \ + test -f $$el || continue; \ + test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \ + echo "$${el}c"; \ + done | xargs echo) | \ + while read chunk; do \ + $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ + done + +.PHONY: compile-clean +# Erase left-over .elc files that do not have a corresponding .el file. +compile-clean: + @cd $(lisp); $(setwins); \ + elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \ + for el in $$(echo $$elcs | sed -e 's/\.elc/\.el/g'); do \ + if test -f "$$el" -o \! -f "$${el}c"; then :; else \ + echo rm "$${el}c"; \ + rm "$${el}c"; \ + fi \ + done # Compile all Lisp files, but don't recompile those that are up to # date. Some .el files don't get compiled because they set the @@ -1506,10 +267,6 @@ # sub-makes that run rules that use it, for the sake of some non-GNU makes. compile: $(LOADDEFS) autoloads compile-first $(MAKE) $(MFLAGS) compile-main EMACS=$(EMACS) - $(MAKE) $(MFLAGS) compile-last EMACS=$(EMACS) - -## Doing this causes make install to dump another emacs. -# $(MAKE) $(MFLAGS) update-elclist # Compile all Lisp files. This is like `compile' but compiles files # unconditionally. Some files don't actually get compiled because they @@ -1518,20 +275,6 @@ cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(MAKE) $(MFLAGS) compile EMACS=$(EMACS) -## In case any files are missing from ELCFILES. -compile-last: - @wd=$(lisp); $(setwins); \ - els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ - for el in $$els; do \ - test -f $$el || continue; \ - test -f $${el}c && continue; \ - GREP_OPTIONS= grep 'no-byte-compile: t' $$el > /dev/null && continue; \ - sel=`echo $$el | sed "s|^$(lisp)|\\$$(lisp)|"`; \ - echo "Maintainer warning: $$sel missing from \$$ELCFILES?"; \ - echo "Compiling $$el"; \ - $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ - done - compile-calc: for el in $(lisp)/calc/*.el; do \ echo Compiling $$el; \ @@ -1551,8 +294,7 @@ # Recompile all Lisp files which are newer than their .elc files and compile # new ones. -# This has the same effect as compile-main (followed up with compile-last, -# if ELCFILES is out of date). recompile has some advantages: +# This has the same effect as compile-main. recompile has some advantages: # i) It is faster (on a single processor), since it only has to start # Emacs once. It was 33% faster on a test with a random 10% of the .el # files needing recompilation.
--- a/lisp/calendar/cal-tex.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/calendar/cal-tex.el Sun Mar 28 09:04:11 2010 -0400 @@ -134,7 +134,7 @@ (defcustom cal-tex-daily-end 20 "The last hour of the daily LaTeX calendar page. -At present, this only affects `cal-tex-cursor-day'" +At present, this only affects `cal-tex-cursor-day'." :type 'integer :group 'calendar-tex) @@ -654,7 +654,7 @@ (defun cal-tex-number-weeks (month year n) "Determine the number of weeks in a range of dates. -Compute the number of weeks in the calendar starting with MONTH and YEAR, +Compute the number of weeks in the calendar starting with MONTH and YEAR, and lasting N months, including only the days in WHICH-DAYS. As it stands, this is only an upper bound." (let ((d (list month 1 year))) @@ -683,7 +683,7 @@ (defun cal-tex-cursor-week (&optional n event) "Make a LaTeX calendar buffer for a two-page one-week calendar. It applies to the week that point is in. The optional prefix -argument N specifies the number of weeks (default 1). The calendar +argument N specifies number of weeks (default 1). The calendar shows holidays if `cal-tex-holidays' is non-nil (note that diary entries are not shown). The calendar shows the hours 8-12am, 1-5pm." (interactive (list (prefix-numeric-value current-prefix-arg) @@ -1778,7 +1778,7 @@ (cal-tex-comment "end framebox")) -(defun cal-tex-b-makebox ( width position ) +(defun cal-tex-b-makebox (width position) "Insert makebox with parameters WIDTH and POSITION (clr)." (insert "\\makebox[" width "][" position "]{" ) (cal-tex-comment))
--- a/lisp/cedet/ede/project-am.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/cedet/ede/project-am.el Sun Mar 28 09:04:11 2010 -0400 @@ -402,6 +402,8 @@ (funcall project-am-debug-target-function cmd)) (kill-buffer tb)))) +(declare-function ede-shell-run-something "ede/shell") + (defmethod project-run-target ((obj project-am-objectcode)) "Run the current project target in comint buffer." (let ((tb (get-buffer-create " *padt*"))
--- a/lisp/cedet/semantic/bovine/c.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/cedet/semantic/bovine/c.el Sun Mar 28 09:04:11 2010 -0400 @@ -1761,8 +1761,9 @@ (when (arrayp semantic-lex-spp-project-macro-symbol-obarray) (princ "\n Project symbol map:\n") - (princ " Your project symbol map is derived from the EDE object:\n ") - (princ (object-print ede-object)) + (when (and (boundp 'ede-object) ede-object) + (princ " Your project symbol map is derived from the EDE object:\n ") + (princ (object-print ede-object))) (princ "\n\n") (let ((macros nil)) (mapatoms
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/imenu.el Sun Mar 28 09:04:11 2010 -0400 @@ -0,0 +1,537 @@ +;;; semantic/imenu.el --- Use Semantic as an imenu tag generator + +;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2010 +;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Maintainer: Eric Ludlam + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This support function can be used in any buffer which supports +;; the bovinator to create the imenu index. +;; +;; To use this in a buffer, do this in a hook. +;; +;; (add-hook 'mode-hook +;; (lambda () +;; (setq imenu-create-index-function 'semantic-create-imenu-index) +;; )) + +(require 'semantic) +(require 'semantic/format) +(require 'semantic/db) +(require 'semantic/db-file) +(require 'semantic/sort) +(require 'imenu) + +(declare-function pulse-momentary-highlight-one-line "pulse" (o &optional face)) +(declare-function semanticdb-semantic-init-hook-fcn "db-mode") + +;; Because semantic imenu tags will hose the current imenu handling +;; code in speedbar, force semantic/sb in. +(if (featurep 'speedbar) + (require 'semantic/sb) + (add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb)))) + +(defgroup semantic-imenu nil + "Semantic interface to Imenu." + :group 'semantic + :group 'imenu + ) + +;;;###autoload +(defcustom semantic-imenu-summary-function 'semantic-format-tag-abbreviate + "*Function to use when creating items in Imenu. +Some useful functions are found in `semantic-format-tag-functions'." + :group 'semantic-imenu + :type semantic-format-tag-custom-list) +(make-variable-buffer-local 'semantic-imenu-summary-function) + +;;;###autoload +(defcustom semantic-imenu-bucketize-file t + "*Non-nil if tags in a file are to be grouped into buckets." + :group 'semantic-imenu + :type 'boolean) +(make-variable-buffer-local 'semantic-imenu-bucketize-file) + +(defcustom semantic-imenu-adopt-external-members t + "*Non-nil if types in a file should adopt externally defined members. +C++ and CLOS can define methods that are not in the body of a class +definition." + :group 'semantic-imenu + :type 'boolean) + +(defcustom semantic-imenu-buckets-to-submenu t + "*Non-nil if buckets of tags are to be turned into submenus. +This option is ignored if `semantic-imenu-bucketize-file' is nil." + :group 'semantic-imenu + :type 'boolean) +(make-variable-buffer-local 'semantic-imenu-buckets-to-submenu) + +;;;###autoload +(defcustom semantic-imenu-expand-type-members t + "*Non-nil if types should have submenus with members in them." + :group 'semantic-imenu + :type 'boolean) +(make-variable-buffer-local 'semantic-imenu-expand-type-members) +(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts + 'semantic-imenu-expand-type-members "23.2") + +(defcustom semantic-imenu-bucketize-type-members t + "*Non-nil if members of a type should be grouped into buckets. +nil means to keep them in the same order. +Overriden to nil if `semantic-imenu-bucketize-file' is nil." + :group 'semantic-imenu + :type 'boolean) +(make-variable-buffer-local 'semantic-imenu-bucketize-type-parts) +(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts + 'semantic-imenu-bucketize-type-members "23.2") + +(defcustom semantic-imenu-sort-bucket-function nil + "*Function to use when sorting tags in the buckets of functions. +See `semantic-bucketize' and the FILTER argument for more details on this function." + :group 'semantic-imenu + :type '(radio (const :tag "No Sorting" nil) + (const semantic-sort-tags-by-name-increasing) + (const semantic-sort-tags-by-name-decreasing) + (const semantic-sort-tags-by-type-increasing) + (const semantic-sort-tags-by-type-decreasing) + (const semantic-sort-tags-by-name-increasing-ci) + (const semantic-sort-tags-by-name-decreasing-ci) + (const semantic-sort-tags-by-type-increasing-ci) + (const semantic-sort-tags-by-type-decreasing-ci) + (function))) +(make-variable-buffer-local 'semantic-imenu-sort-bucket-function) + +(defcustom semantic-imenu-index-directory nil + "*Non nil to index the entire directory for tags. +Doesn't actually parse the entire directory, but displays tags for all files +currently listed in the current Semantic database. +This variable has no meaning if semanticdb is not active." + :group 'semantic-imenu + :type 'boolean) + +(defcustom semantic-imenu-auto-rebuild-directory-indexes nil + "*If non-nil automatically rebuild directory index imenus. +That is when a directory index imenu is updated, automatically rebuild +other buffer local ones based on the same semanticdb." + :group 'semantic-imenu + :type 'boolean) + +(defvar semantic-imenu-directory-current-file nil + "When building a file index, this is the file name currently being built.") + +(defvar semantic-imenu-auto-rebuild-running nil + "Non-nil if `semantic-imenu-rebuild-directory-indexes' is running.") + +;;;###autoload +(defvar semantic-imenu-expandable-tag-classes '(type) + "List of expandable tag classes. +Tags of those classes will be given submenu with children. +By default, a `type' has interesting children. In Texinfo, however, a +`section' has interesting children.") +(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes) +(semantic-varalias-obsolete 'semantic-imenu-expandable-token + 'semantic-imenu-expandable-tag-classes "23.2") + +;;; Code: +(defun semantic-imenu-tag-overlay (tag) + "Return the overlay belonging to tag. +If TAG doesn't have an overlay, and instead as a vector of positions, +concoct a combination of file name, and position." + (let ((o (semantic-tag-overlay tag))) + (if (not (semantic-overlay-p o)) + (let ((v (make-vector 3 nil))) + (aset v 0 semantic-imenu-directory-current-file) + (aset v 1 (aref o 0)) + (aset v 2 (aref o 1)) + v) + o))) + + +(defun semantic-imenu-goto-function (name position &optional rest) + "Move point associated with NAME to POSITION. +Used to override function `imenu-default-goto-function' so that we can continue +to use overlays to maintain the current position. +Optional argument REST is some extra stuff." + (require 'pulse) + (if (semantic-overlay-p position) + (let ((os (semantic-overlay-start position)) + (ob (semantic-overlay-buffer position))) + (if os + (progn + (if (not (eq ob (current-buffer))) + (switch-to-buffer ob)) + (imenu-default-goto-function name os rest) + (pulse-momentary-highlight-one-line (point)) + ) + ;; This should never happen, but check anyway. + (message "Imenu is out of date, try again. (internal bug)") + (setq imenu--index-alist nil))) + ;; When the POSITION is actually a pair of numbers in an array, then + ;; the file isn't loaded into the current buffer. + (if (vectorp position) + (let ((file (aref position 0)) + (pos (aref position 1))) + (and file (find-file file)) + (imenu-default-goto-function name pos rest) + (pulse-momentary-highlight-one-line (point)) + ) + ;; When the POSITION is the symbol 'file-only' it means that this + ;; is a directory index entry and there is no tags in this + ;; file. So just jump to the beginning of the file. + (if (eq position 'file-only) + (progn + (find-file name) + (imenu-default-goto-function name (point-min) rest) + (pulse-momentary-highlight-one-line (point)) + ) + ;; Probably POSITION don't came from a semantic imenu. Try + ;; the default imenu goto function. + (condition-case nil + (progn + (imenu-default-goto-function name position rest) + (pulse-momentary-highlight-one-line (point)) + ) + (error + (message "Semantic Imenu override problem. (Internal bug)") + (setq imenu--index-alist nil))))) + )) + +(defun semantic-imenu-flush-fcn (&optional ignore) + "This function is called as a hook to clear the imenu cache. +It is cleared after any parsing. +IGNORE arguments." + (if (eq imenu-create-index-function 'semantic-create-imenu-index) + (setq imenu--index-alist nil + imenu-menubar-modified-tick 0)) + (remove-hook 'semantic-after-toplevel-cache-change-hook + 'semantic-imenu-flush-fcn t) + (remove-hook 'semantic-after-partial-cache-change-hook + 'semantic-imenu-flush-fcn t) + ) + +;;;###autoload +(defun semantic-create-imenu-index (&optional stream) + "Create an imenu index for any buffer which supports Semantic. +Uses the output of the Semantic parser to create the index. +Optional argument STREAM is an optional stream of tags used to create menus." + (setq imenu-default-goto-function 'semantic-imenu-goto-function) + (prog1 + (if (and semantic-imenu-index-directory + (featurep 'semanticdb) + (semanticdb-minor-mode-p)) + (semantic-create-imenu-directory-index + (or stream (semantic-fetch-tags-fast))) + (semantic-create-imenu-index-1 + (or stream (semantic-fetch-tags-fast)) nil)) + (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook) + (add-hook 'semantic-after-toplevel-cache-change-hook + 'semantic-imenu-flush-fcn nil t) + (semantic-make-local-hook 'semantic-after-partial-cache-change-hook) + (add-hook 'semantic-after-partial-cache-change-hook + 'semantic-imenu-flush-fcn nil t))) + +(defun semantic-create-imenu-directory-index (&optional stream) + "Create an IMENU tag index based on all files active in semanticdb. +Optional argument STREAM is the stream of tags for the current buffer." + (if (not semanticdb-current-database) + (semantic-create-imenu-index-1 stream nil) + ;; We have a database, list all files, with the current file on top. + (let ((index (list + (cons (oref semanticdb-current-table file) + (or (semantic-create-imenu-index-1 stream nil) + ;; No tags in this file + 'file-only)))) + (tables (semanticdb-get-database-tables semanticdb-current-database))) + (while tables + (let ((semantic-imenu-directory-current-file + (oref (car tables) file)) + tags) + (when (and (not (eq (car tables) semanticdb-current-table)) + (semanticdb-live-p (car tables)) + (semanticdb-equivalent-mode (car tables)) + ) + (setq tags (oref (car tables) tags) + index (cons (cons semantic-imenu-directory-current-file + (or (and tags + ;; don't pass nil stream because + ;; it will use the current + ;; buffer + (semantic-create-imenu-index-1 + (oref (car tables) tags) + nil)) + ;; no tags in the file + 'file-only)) + index))) + (setq tables (cdr tables)))) + + ;; If enabled automatically rebuild other imenu directory + ;; indexes based on the same Semantic database + (or (not semantic-imenu-auto-rebuild-directory-indexes) + ;; If auto rebuild already in progress does nothing + semantic-imenu-auto-rebuild-running + (unwind-protect + (progn + (setq semantic-imenu-auto-rebuild-running t) + (semantic-imenu-rebuild-directory-indexes + semanticdb-current-database)) + (setq semantic-imenu-auto-rebuild-running nil))) + + (nreverse index)))) + +(defun semantic-create-imenu-index-1 (stream &optional parent) + "Create an imenu index for any buffer which supports Semantic. +Uses the output of the Semantic parser to create the index. +STREAM is a stream of tags used to create menus. +Optional argument PARENT is a tag parent of STREAM." + (let ((tags stream) + (semantic-imenu-adopt-external-members + semantic-imenu-adopt-external-members)) + ;; If we should regroup, do so. + (if semantic-imenu-adopt-external-members + (setq tags (semantic-adopt-external-members tags) + ;; Don't allow recursion here. + semantic-imenu-adopt-external-members nil)) + ;; Test for bucketing vs not. + (if semantic-imenu-bucketize-file + (let ((buckets (semantic-bucketize + tags parent + semantic-imenu-sort-bucket-function)) + item name + index) + (cond + ((null buckets) + nil) + ((or (cdr-safe buckets) ;; if buckets has more than one item in it. + (not semantic-imenu-buckets-to-submenu)) ;; to force separators between buckets + (while buckets + (setq name (car (car buckets)) + item (cdr (car buckets))) + (if semantic-imenu-buckets-to-submenu + (progn + ;; Make submenus + (if item + (setq index + (cons (cons name + (semantic-create-imenu-subindex item)) + index)))) + ;; Glom everything together with "---" between + (if item + (setq index + (append index + ;; do not create a menu separator in the parent menu + ;; when creating a sub-menu + (if (memq (semantic-tag-class (car item)) + semantic-imenu-expandable-tag-classes) + (semantic-create-imenu-subindex item) + (cons + '("---") + (semantic-create-imenu-subindex item))))) + )) + (setq buckets (cdr buckets))) + (if semantic-imenu-buckets-to-submenu + (nreverse index) + index)) + (t + (setq name (car (car buckets)) + item (cdr (car buckets))) + (semantic-create-imenu-subindex item)))) + ;; Else, group everything together + (semantic-create-imenu-subindex tags)))) + +(defun semantic-create-imenu-subindex (tags) + "From TAGS, create an imenu index of interesting things." + (let ((notypecheck (not semantic-imenu-expand-type-members)) + children index tag parts) + (while tags + (setq tag (car tags) + children (semantic-tag-components-with-overlays tag)) + (if (and (not notypecheck) + (memq (semantic-tag-class tag) + semantic-imenu-expandable-tag-classes) + children + ) + ;; to keep an homogeneous menu organisation, type menu items + ;; always have a sub-menu with at least the *definition* + ;; item (even if the tag has no type components) + (progn + (setq parts children) + ;; There is options which create the submenu + ;; * Type has an overlay, but children do. + ;; The type doesn't have to have it's own overlay, + ;; but a type with no overlay and no children should be + ;; invalid. + (setq index + (cons + (cons + (funcall semantic-imenu-summary-function tag) + ;; Add a menu for getting at the type definitions + (if (and parts + ;; Note to self: enable menu items for + ;; sub parts even if they are not proper + ;; tags. + (semantic-tag-p (car parts))) + (let ((submenu + (if (and semantic-imenu-bucketize-type-members + semantic-imenu-bucketize-file) + (semantic-create-imenu-index-1 parts tag) + (semantic-create-imenu-subindex parts)))) + ;; Only add a *definition* if we have a postion + ;; in that type tag. + (if (semantic-tag-with-position-p tag) + (cons + (cons "*definition*" + (semantic-imenu-tag-overlay tag)) + submenu) + submenu)) + ;; There were no parts, or something like that, so + ;; instead just put the definition here. + (if (semantic-tag-with-position-p tag) + (semantic-imenu-tag-overlay tag) + nil) + )) + index))) + (if (semantic-tag-with-position-p tag) + (setq index (cons + (cons + (funcall semantic-imenu-summary-function tag) + (semantic-imenu-tag-overlay tag)) + index)))) + (setq tags (cdr tags))) + ;; `imenu--split-submenus' sort submenus according to + ;; `imenu-sort-function' setting and split them up if they are + ;; longer than `imenu-max-items'. + (imenu--split-submenus (nreverse index)))) + +;;; directory imenu rebuilding. +;; +(defun semantic-imenu-rebuild-directory-indexes (db) + "Rebuild directory index imenus based on Semantic database DB." + (let ((l (buffer-list)) + b) + (while l + (setq b (car l) + l (cdr l)) + (if (and (not (eq b (current-buffer))) + (buffer-live-p b)) + (with-current-buffer b + ;; If there is a buffer local Semantic index directory + ;; imenu + (when (and (eq imenu-create-index-function + 'semantic-create-imenu-index) + semanticdb-current-database + (eq semanticdb-current-database db)) + ;; Rebuild the imenu + (imenu--cleanup) + (setq imenu--index-alist nil) + (funcall + (if (fboundp 'imenu-menu-filter) + ;; XEmacs imenu + 'imenu-menu-filter + ;; Emacs imenu + 'imenu-update-menubar)))))))) + +(defun semantic-imenu-semanticdb-hook () + "Function to be called from `semanticdb-mode-hook'. +Clears all imenu menus that may be depending on the database." + (require 'semantic/db-mode) + (semantic-map-buffers + #'(lambda () + ;; Set up semanticdb environment if enabled. + (if (semanticdb-minor-mode-p) + (semanticdb-semantic-init-hook-fcn)) + ;; Clear imenu cache to redraw the imenu. + (semantic-imenu-flush-fcn)))) + +(add-hook 'semanticdb-mode-hook 'semantic-imenu-semanticdb-hook) + +;;; Interactive Utilities +;; +(defun semantic-imenu-toggle-bucketize-file () + "Toggle the ability of imenu to bucketize the current file." + (interactive) + (setq semantic-imenu-bucketize-file (not semantic-imenu-bucketize-file)) + ;; Force a rescan + (setq imenu--index-alist nil)) + +(defun semantic-imenu-toggle-buckets-to-submenu () + "Toggle the ability of imenu to turn buckets into submenus." + (interactive) + (setq semantic-imenu-buckets-to-submenu (not semantic-imenu-buckets-to-submenu)) + ;; Force a rescan + (setq imenu--index-alist nil)) + +(defun semantic-imenu-toggle-bucketize-type-parts () + "Toggle the ability of imenu to bucketize the current file." + (interactive) + (setq semantic-imenu-bucketize-type-members (not semantic-imenu-bucketize-type-members)) + ;; Force a rescan + (setq imenu--index-alist nil)) + +;;; Which function support +;; +;; The which-function library will display the current function in the +;; mode line. It tries do do this through imenu. With a semantic parsed +;; buffer, there is a much more efficient way of doing this. +;; Advise `which-function' so that we optionally use semantic tags +;; instead, and get better stuff. +(require 'advice) + +(defvar semantic-which-function 'semantic-default-which-function + "Function to convert semantic tags into `which-function' text.") + +(defcustom semantic-which-function-use-color nil + "*Use color when displaying the current function with `which-function'." + :group 'semantic-imenu + :type 'boolean) + +(defun semantic-default-which-function (taglist) + "Convert TAGLIST into a string usable by `which-function'. +Returns the first tag name in the list, unless it is a type, +in which case it concatenates them together." + (cond ((eq (length taglist) 1) + (semantic-format-tag-abbreviate + (car taglist) nil semantic-which-function-use-color)) + ((memq (semantic-tag-class (car taglist)) + semantic-imenu-expandable-tag-classes) + (concat (semantic-format-tag-name + (car taglist) nil semantic-which-function-use-color) + (car semantic-type-relation-separator-character) + ;; recurse until we no longer have a type + ;; or any tags left. + (semantic-default-which-function (cdr taglist)))) + (t (semantic-format-tag-abbreviate + (car taglist) nil semantic-which-function-use-color)))) + +;; (defadvice which-function (around semantic-which activate) +;; "Choose the function to display via semantic if it is currently active." +;; (if (and (featurep 'semantic) semantic--buffer-cache) +;; (let ((ol (semantic-find-tag-by-overlay))) +;; (setq ad-return-value (funcall semantic-which-function ol))) +;; ad-do-it)) + +(provide 'semantic/imenu) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "semantic/imenu" +;; End: + +;;; semantic/imenu.el ends here
--- a/lisp/cedet/srecode/table.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/cedet/srecode/table.el Sun Mar 28 09:04:11 2010 -0400 @@ -66,7 +66,7 @@ If this is nil, then this template table belongs to a set of generic templates that can be used with no additional dictionary values. When it is non-nil, it is assumed the template macros need specialized -Emacs Lisp code to fill in the dictoinary.") +Emacs Lisp code to fill in the dictionary.") (priority :initarg :priority :type number :documentation
--- a/lisp/desktop.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/desktop.el Sun Mar 28 09:04:11 2010 -0400 @@ -1,7 +1,8 @@ ;;; desktop.el --- save partial status of Emacs when killed ;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Morten Welinder <terra@diku.dk> ;; Keywords: convenience @@ -811,19 +812,23 @@ FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode. \n\(fn FILENAME BUFNAME MODE)" - (let ((case-fold-search nil)) + (let ((case-fold-search nil) + dired-skip) (and (not (and (stringp desktop-buffers-not-to-save) (not filename) (string-match desktop-buffers-not-to-save bufname))) (not (memq mode desktop-modes-not-to-save)) + ;; FIXME this is broken if desktop-files-not-to-save is nil. (or (and filename (stringp desktop-files-not-to-save) (not (string-match desktop-files-not-to-save filename))) (and (eq mode 'dired-mode) (with-current-buffer bufname - (not (string-match desktop-files-not-to-save - default-directory)))) + (not (setq dired-skip + (string-match desktop-files-not-to-save + default-directory))))) (and (null filename) + (null dired-skip) ; bug#5755 (with-current-buffer bufname desktop-save-buffer)))))) ;; ----------------------------------------------------------------------------
--- a/lisp/emacs-lisp/cl-loaddefs.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/emacs-lisp/cl-loaddefs.el Sun Mar 28 09:04:11 2010 -0400 @@ -273,8 +273,8 @@ ;;;*** -;;;### (autoloads (compiler-macroexpand define-compiler-macro assert -;;;;;; check-type typep deftype cl-struct-setf-expander defstruct +;;;### (autoloads (defsubst* compiler-macroexpand define-compiler-macro +;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct ;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf ;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method ;;;;;; declare the locally multiple-value-setq multiple-value-bind @@ -282,7 +282,7 @@ ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "e10a7e42199c08dc39460f67dd2d424b") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "273ba25f4a116c61a464dbe55f1f8c63") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -739,6 +739,14 @@ \(fn FORM)" nil nil) +(autoload 'defsubst* "cl-macs" "\ +Define NAME as a function. +Like `defun', except the function is automatically declared `inline', +ARGLIST allows full Common Lisp conventions, and BODY is implicitly +surrounded by (block NAME ...). + +\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) + ;;;*** ;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if
--- a/lisp/emacs-lisp/cl-macs.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/emacs-lisp/cl-macs.el Sun Mar 28 09:04:11 2010 -0400 @@ -1,7 +1,7 @@ ;;; cl-macs.el --- Common Lisp macros -;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 @@ -2596,6 +2596,7 @@ (byte-compile-normal-call form) (byte-compile-form form))) +;;;###autoload (defmacro defsubst* (name args &rest body) "Define NAME as a function. Like `defun', except the function is automatically declared `inline',
--- a/lisp/emacs-lisp/trace.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/emacs-lisp/trace.el Sun Mar 28 09:04:11 2010 -0400 @@ -253,7 +253,7 @@ For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the trace advice for FUNCTION and activates it together with any other advice -there might be!! The trace BUFFER will popup whenever FUNCTION is called. +there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead." (interactive
--- a/lisp/eshell/em-basic.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/eshell/em-basic.el Sun Mar 28 09:04:11 2010 -0400 @@ -125,7 +125,7 @@ (eshell-echo args output-newline))) (defun eshell/printnl (&rest args) - "Print out each of the argument, separated by newlines." + "Print out each of the arguments, separated by newlines." (let ((elems (eshell-flatten-list args))) (while elems (eshell-printn (eshell-echo (list (car elems))))
--- a/lisp/eshell/em-dirs.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/eshell/em-dirs.el Sun Mar 28 09:04:11 2010 -0400 @@ -178,7 +178,7 @@ Thus, this does not include the current directory.") (defvar eshell-last-dir-ring nil - "The last directory that eshell was in.") + "The last directory that Eshell was in.") ;;; Functions: @@ -267,7 +267,7 @@ (char-to-string (char-before)))) (defun eshell-parse-drive-letter () - "An argument beginning X:[^/] is a drive letter reference." + "An argument beginning with X:[^/] is a drive letter reference." (when (and (not eshell-current-argument) (looking-at "\\([A-Za-z]:\\)\\([^/\\\\]\\|\\'\\)")) (goto-char (match-end 1)) @@ -517,7 +517,7 @@ msg))) (defun eshell-read-last-dir-ring () - "Sets the buffer's `eshell-last-dir-ring' from a history file." + "Set the buffer's `eshell-last-dir-ring' from a history file." (let ((file eshell-last-dir-ring-file-name)) (cond ((or (null file) @@ -545,7 +545,7 @@ (setq eshell-last-dir-ring ring)))))) (defun eshell-write-last-dir-ring () - "Writes the buffer's `eshell-last-dir-ring' to a history file." + "Write the buffer's `eshell-last-dir-ring' to a history file." (let ((file eshell-last-dir-ring-file-name)) (cond ((or (null file)
--- a/lisp/faces.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/faces.el Sun Mar 28 09:04:11 2010 -0400 @@ -590,7 +590,7 @@ attribute is changed on all frames). ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid -face attribute name. All attributes can be set to `unspecified'; +face attribute name. All attributes can be set to `unspecified'; this fact is not further mentioned below. The following attributes are recognized: @@ -988,9 +988,9 @@ (defun face-valid-attribute-values (attribute &optional frame) "Return valid values for face attribute ATTRIBUTE. The optional argument FRAME is used to determine available fonts -and colors. If it is nil or not specified, the selected frame is -used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value -out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects +and colors. If it is nil or not specified, the selected frame is used. +Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out +of a set of discrete values. Value is `integerp' if ATTRIBUTE expects an integer value." (let ((valid (case attribute
--- a/lisp/finder.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/finder.el Sun Mar 28 09:04:11 2010 -0400 @@ -27,12 +27,6 @@ ;; This mode uses the Keywords library header to provide code-finding ;; services by keyword. -;; -;; Things to do: -;; 1. Support multiple keywords per search. This could be extremely hairy; -;; there doesn't seem to be any way to get completing-read to exit on -;; an EOL with no substring pending, which is what we'd want to end the loop. -;; 2. Search by string in synopsis line? ;;; Code:
--- a/lisp/gnus/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,103 @@ +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * message.el (message-interactive): Doc fix. + (message-qmail-inject-args): Reflow. + (message-kill-to-signature): Fix typo in docstring. + + * smiley.el (smiley-buffer): Fix typo in docstring. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * mail-source.el (gnus-message): Declare. + (mail-source-delete-old-incoming): Require gnus-util. + +2010-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (canlock-verify): Autoload it for Emacs 21. + + * message.el (ecomplete-setup): Autoload it for Emacs <23. + + * mml-sec.el (mml-secure-cache-passphrase): Default to t that is + password-cache's default if it is not bound. + (mml-secure-passphrase-cache-expiry): Default to 16 that is + password-cache-expiry's default if it is not bound. + + * pop3.el (pop3-list): Don't use 3rd arg of `split-string' which is not + available in Emacs 21. + +2010-03-23 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-sources): Fix up definition so extra parameters + are always inline. + +2010-03-22 Martin Stjernholm <mast@lysator.liu.se> + + * nnimap.el (nnimap-verify-uidvalidity): Fixed bug where uidvalidity + wasn't updated after mismatch. Clear cached mailbox info correctly + when uidvalidity changes. + (nnimap-group-prefixed-name): New function to avoid some code + duplication. + (nnimap-verify-uidvalidity, nnimap-group-overview-filename) + (nnimap-request-group): Use it. + (nnimap-retrieve-groups, nnimap-verify-uidvalidity) + (nnimap-update-unseen): Significantly improved speed of Gnus startup + with many imap folders. This is done by caching the group status from + the imap server persistently in a group parameter `imap-status'. (This + was cached before too if `nnimap-retrieve-groups-asynchronous' was set, + but not persistently, so every Gnus startup was still very slow.) + +2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el: Set up autoloads. Bump to 23.2 because of the + secrets.el dependency. + (auth-sources): Add optional user name. Add secrets.el configuration + choice (unused right now). + +2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-sum.el (gnus-summary-make-menu-bar): Let + `gnus-registry-install-shortcuts' fill in the functions. + + * gnus-registry.el (gnus-summary-misc-menu): Declare to avoid + warnings. + (gnus-registry-misc-menus): Variable to hold registry mark menus. + (gnus-registry-install-shortcuts): Populate and use it in a + `gnus-summary-menu-hook' lambda, under "Gnus"->"Registry Marks". + +2010-03-20 Martin Stjernholm <mast@lysator.liu.se> + + * nnimap.el (nnimap-decode-group-name, nnimap-encode-group-name): + In-place substitutions for the group name encoding/decoding. + (nnimap-find-minmax-uid, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-request-article-part) + (nnimap-update-unseen, nnimap-request-list) + (nnimap-retrieve-groups, nnimap-request-update-info-internal) + (nnimap-request-set-mark, nnimap-split-to-groups) + (nnimap-split-articles, nnimap-request-newgroups) + (nnimap-request-create-group, nnimap-request-accept-article) + (nnimap-request-delete-group, nnimap-request-rename-group) + (nnimap-acl-get, nnimap-acl-edit): Use them. Replace `mbx' with + `encoded-mbx' for consistency. + (nnimap-close-group): Call `imap-current-mailbox' instead of using the + variable `imap-current-mailbox'. + + * gnus-agent.el (gnus-agent-fetch-articles, gnus-agent-fetch-headers) + (gnus-agent-regenerate-group): Use `gnus-agent-decoded-group-name'. + +2010-03-20 Bojan Petrovic <bpetrovi@f.bg.ac.rs> + + * pop3.el (pop3-display-message-size-flag): Display message size byte + counts during POP3 download. + (pop3-movemail): Use it. + (pop3-list): Implement listing of available messages. + +2010-03-20 Mark Triggs <mst@dishevelled.net> (tiny change) + + * nnir.el (nnir-get-article-nov-override-function): New function to + override the normal NOV retrieval. + (nnir-retrieve-headers): Use it. + 2010-03-19 Michael Albinus <michael.albinus@gmx.de> * auth-source.el (netrc-machine-user-or-password): Autoload.
--- a/lisp/gnus/auth-source.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/auth-source.el Sun Mar 28 09:04:11 2010 -0400 @@ -35,6 +35,9 @@ (eval-when-compile (require 'cl)) (autoload 'netrc-machine-user-or-password "netrc") +(autoload 'secrets-search-items "secrets") +(autoload 'secrets-get-alias "secrets") +(autoload 'secrets-get-attribute "secrets") (defgroup auth-source nil "Authentication sources." @@ -49,7 +52,7 @@ "List of authentication protocols and their names" :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type '(repeat :tag "Authentication Protocols" (cons :tag "Protocol Entry" (symbol :tag "Protocol") @@ -71,7 +74,7 @@ (defcustom auth-source-do-cache t "Whether auth-source should cache information." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-source-debug nil @@ -85,7 +88,7 @@ If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(choice :tag "auth-source debugging mode" (const :tag "Log using `message' to the *Messages* buffer" t) @@ -96,19 +99,32 @@ "Whether auth-source should hide passwords in log messages. Only relevant if `auth-source-debug' is not nil." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)) "List of authentication sources. -Each entry is the authentication type with optional properties." +Each entry is the authentication type with optional properties. + +It's best to customize this with `M-x customize-variable' because the choices +can get pretty complex." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(repeat :tag "Authentication Sources" (list :tag "Source definition" (const :format "" :value :source) - (string :tag "Authentication Source") + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list :tag "secrets.el (Secret Service API/KWallet/GNOME KeyRing)" + (const :format "" :value :secrets) + (choice :tag "Collection to use" + (string :tag "Collection name") + (const :tag "Default" 'default) + (const :tag "Any" t) + (const :tag "Temporary" "session") + (string :tag "Specific session name") + (const :tag "Fallback" nil)))) (const :format "" :value :host) (choice :tag "Host (machine) choice" (const :tag "Any" t) @@ -118,7 +134,15 @@ (choice :tag "Protocol" (const :tag "Any" t) (const :tag "Fallback" nil) - ,@auth-source-protocols-customize)))) + ,@auth-source-protocols-customize) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list :tag "Preferred username" :inline t + (const :format "" :value :preferred-username) + (choice :tag "Personality or username" + (const :tag "Any" t) + (const :tag "Fallback" nil) + (string :tag "Specific user name")))))))) ;; temp for debugging ;; (unintern 'auth-source-protocols)
--- a/lisp/gnus/gnus-agent.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/gnus-agent.el Sun Mar 28 09:04:11 2010 -0400 @@ -1583,7 +1583,8 @@ (setq selected-sets (nreverse selected-sets)) (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) + (gnus-message 7 "Fetching articles for %s..." + (gnus-agent-decoded-group-name group)) (unwind-protect (while (setq articles (pop selected-sets)) @@ -1594,7 +1595,8 @@ (let (article) (while (setq article (pop articles)) (gnus-message 10 "Fetching article %s for %s..." - article group) + article + (gnus-agent-decoded-group-name group)) (when (or (gnus-backlog-request-article group article nntp-server-buffer) @@ -1942,7 +1944,8 @@ (if articles (progn - (gnus-message 7 "Fetching headers for %s..." group) + (gnus-message 7 "Fetching headers for %s..." + (gnus-agent-decoded-group-name group)) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars @@ -3904,7 +3907,7 @@ (sit-for 1) t))))) (when group - (gnus-message 5 "Regenerating in %s" group) + (gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group)) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) (file (gnus-agent-article-name ".overview" group)) @@ -3981,7 +3984,8 @@ (or (not nov-arts) (> (car downloaded) (car nov-arts)))) ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group + (gnus-message 3 "Regenerating NOV %s %d..." + (gnus-agent-decoded-group-name group) (car downloaded)) (let ((file (concat dir (number-to-string (car downloaded))))) (mm-with-unibyte-buffer
--- a/lisp/gnus/gnus-art.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/gnus-art.el Sun Mar 28 09:04:11 2010 -0400 @@ -4192,6 +4192,8 @@ (put-text-property (match-end 0) (point-max) 'face eface))))))))) +(autoload 'canlock-verify "canlock" nil t) ;; for Emacs 21. + (defun article-verify-cancel-lock () "Verify Cancel-Lock header." (interactive)
--- a/lisp/gnus/gnus-registry.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/gnus-registry.el Sun Mar 28 09:04:11 2010 -0400 @@ -60,6 +60,7 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnmail) +(require 'easymenu) (defvar gnus-adaptive-word-syntax-table) @@ -137,6 +138,10 @@ (const :tag "Always Install" t) (const :tag "Ask Me" ask))) +(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. + +(defvar gnus-registry-misc-menus nil) ; ugly way to keep the menus + (defcustom gnus-registry-clean-empty t "Whether the empty registry entries should be deleted. Registry entries are considered empty when they have no groups @@ -764,7 +769,8 @@ "Install the keyboard shortcuts and menus for the registry. Uses `gnus-registry-marks' to find what shortcuts to install." (let (keys-plist) - (gnus-registry-do-marks + (setq gnus-registry-misc-menus nil) + (gnus-registry-do-marks :char (lambda (mark data) (let ((function-format @@ -813,19 +819,34 @@ ;; all this just to get the mark, I must be doing it wrong (intern ,(symbol-name mark)) articles ,remove t) + (gnus-message + 9 + "Applying mark %s to %d articles" + ,(symbol-name mark) (length articles)) (dolist (article articles) (gnus-summary-update-article - article + article (assoc article (gnus-data-list nil))))))) (push (intern function-name) keys-plist) - (push shortcut keys-plist) - (gnus-message + (push shortcut keys-plist) + (push (vector (format "%s %s" + (upcase-initials variant-name) + (symbol-name mark)) + (intern function-name) t) + gnus-registry-misc-menus) + (gnus-message 9 "Defined mark handling function %s" function-name)))))) (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist))) + '(gnus-registry-mark-map "M" gnus-summary-mark-map) + keys-plist) + (add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item + gnus-summary-misc-menu + nil + (cons "Registry Marks" gnus-registry-misc-menus)))))) ;;; use like this: ;;; (defalias 'gnus-user-format-function-M
--- a/lisp/gnus/gnus-sum.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/gnus-sum.el Sun Mar 28 09:04:11 2010 -0400 @@ -2635,17 +2635,6 @@ ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Registry Mark" - ["Important" gnus-registry-set-article-Important-mark t] - ["Not Important" gnus-registry-remove-article-Important-mark t] - ["Work" gnus-registry-set-article-Work-mark t] - ["Not Work" gnus-registry-remove-article-Work-mark t] - ["Later" gnus-registry-set-article-Later-mark t] - ["Not Later" gnus-registry-remove-article-Later-mark t] - ["Personal" gnus-registry-set-article-Personal-mark t] - ["Not Personal" gnus-registry-remove-article-Personal-mark t] - ["To Do" gnus-registry-set-article-To-Do-mark t] - ["Not To Do" gnus-registry-remove-article-To-Do-mark t]) ("Limit to" ["Marks..." gnus-summary-limit-to-marks t] ["Subject..." gnus-summary-limit-to-subject t] @@ -2691,6 +2680,7 @@ gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t] ["Run command on marked..." gnus-summary-universal-argument t])) + ("Registry Marks") ("Scroll article" ["Page forward" gnus-summary-next-page ,@(if (featurep 'xemacs) '(t)
--- a/lisp/gnus/mail-source.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/mail-source.el Sun Mar 28 09:04:11 2010 -0400 @@ -1,7 +1,7 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail @@ -574,10 +574,13 @@ (error "Cannot get new mail")) 0))))))))) +(declare-function gnus-message "gnus-util" (level &rest args)) + (defun mail-source-delete-old-incoming (&optional age confirm) "Remove incoming files older than AGE days. If CONFIRM is non-nil, ask for confirmation before removing a file." (interactive "P") + (require 'gnus-util) (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days (low2days (/ 1.0 65536.0)) ;; convert low bits to days (diff (if (natnump age) age 30));; fallback, if no valid AGE given
--- a/lisp/gnus/message.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/message.el Sun Mar 28 09:04:11 2010 -0400 @@ -440,7 +440,7 @@ ;; Default to the value of `mail-interactive', available in all Emacsen ;; that Gnus supports. "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors." +A value of nil means let mailer mail back a message to report errors." :version "23.2" :group 'message-sending :group 'message-mail @@ -861,8 +861,8 @@ (defcustom message-qmail-inject-args nil "Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. It -may also be a function. +This should be a list of strings, one string for each argument. +It may also be a function. For e.g., if you wish to set the envelope sender address so that bounces go to the right place or to deal with listserv's usage of that address, you @@ -2850,6 +2850,8 @@ (inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) +(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. + ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent. @@ -3252,7 +3254,7 @@ (defun message-kill-to-signature (&optional arg) "Kill all text up to the signature. -If a numberic argument or prefix arg is given, leave that number +If a numeric argument or prefix arg is given, leave that number of lines before the signature intact." (interactive "P") (save-excursion
--- a/lisp/gnus/mml-sec.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/mml-sec.el Sun Mar 28 09:04:11 2010 -0400 @@ -105,12 +105,18 @@ :group 'message :type 'boolean) -(defcustom mml-secure-cache-passphrase password-cache +(defcustom mml-secure-cache-passphrase + (if (boundp 'password-cache) + password-cache + t) "If t, cache passphrase." :group 'message :type 'boolean) -(defcustom mml-secure-passphrase-cache-expiry password-cache-expiry +(defcustom mml-secure-passphrase-cache-expiry + (if (boundp 'password-cache-expiry) + password-cache-expiry + 16) "How many seconds the passphrase is cached. Whether the passphrase is cached at all is controlled by `mml-secure-cache-passphrase'."
--- a/lisp/gnus/nnimap.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/nnimap.el Sun Mar 28 09:04:11 2010 -0400 @@ -501,6 +501,20 @@ ;; Utility functions: +(defsubst nnimap-decode-group-name (group) + (and group + (gnus-group-decoded-name group))) + +(defsubst nnimap-encode-group-name (group) + (and group + (mm-encode-coding-string group (gnus-group-name-charset nil group)))) + +(defun nnimap-group-prefixed-name (group &optional server) + (gnus-group-prefixed-name group + (gnus-server-to-method + (format "nnimap:%s" + (or server nnimap-current-server))))) + (defsubst nnimap-get-server-buffer (server) "Return buffer for SERVER, if nil use current server." (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) @@ -521,9 +535,7 @@ (defun nnimap-verify-uidvalidity (group server) "Verify stored uidvalidity match current one in GROUP on SERVER." - (let* ((gnusgroup (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server)))) + (let* ((gnusgroup (nnimap-group-prefixed-name group server)) (new-uidvalidity (imap-mailbox-get 'uidvalidity)) (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) (dir (file-name-as-directory (expand-file-name nnimap-directory))) @@ -544,10 +556,18 @@ (if old-uidvalidity (if (not (equal old-uidvalidity new-uidvalidity)) ;; uidvalidity clash - (gnus-delete-file file) - (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) + (progn + (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) + (gnus-group-remove-parameter gnusgroup 'imap-status) + (gnus-sethash (gnus-group-prefixed-name group server) + nil nnimap-mailbox-info) + (gnus-delete-file file)) t) (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity)) + (gnus-group-remove-parameter gnusgroup 'imap-status) + (gnus-sethash ; Maybe not necessary here. + (gnus-group-prefixed-name group server) + nil nnimap-mailbox-info) t))) (defun nnimap-before-find-minmax-bugworkaround () @@ -563,36 +583,39 @@ "Find lowest and highest active article number in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (or (string= group (imap-current-mailbox)) - (imap-mailbox-select group examine)) - (let (minuid maxuid) - (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) - (imap-message-map (lambda (uid Uid) - (setq minuid (if minuid (min minuid uid) uid) - maxuid (if maxuid (max maxuid uid) uid))) - 'UID)) - (list (imap-mailbox-get 'exists) minuid maxuid))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (when (or (string= decoded-group (imap-current-mailbox)) + (imap-mailbox-select decoded-group examine)) + (let (minuid maxuid) + (when (> (imap-mailbox-get 'exists) 0) + (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) + (imap-message-map (lambda (uid Uid) + (setq minuid (if minuid (min minuid uid) uid) + maxuid (if maxuid (max maxuid uid) uid))) + 'UID)) + (list (imap-mailbox-get 'exists) minuid maxuid)))))) (defun nnimap-possibly-change-group (group &optional server) "Make GROUP the current group, and SERVER the current server." (when (nnimap-possibly-change-server server) - (with-current-buffer nnimap-server-buffer - (if (or (null group) (imap-current-mailbox-p group)) - imap-current-mailbox - (if (imap-mailbox-select group) - (if (or (nnimap-verify-uidvalidity - group (or server nnimap-current-server)) - (zerop (imap-mailbox-get 'exists group)) - t ;; for OGnus to see if ignoring uidvalidity - ;; changes has any bad effects. - (yes-or-no-p - (format - "nnimap: Group %s is not uidvalid. Continue? " group))) - imap-current-mailbox - (imap-mailbox-unselect) - (error "nnimap: Group %s is not uid-valid" group)) - (nnheader-report 'nnimap (imap-error-text))))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (with-current-buffer nnimap-server-buffer + (if (or (null group) (imap-current-mailbox-p decoded-group)) + imap-current-mailbox ; Note: utf-7 encoded. + (if (imap-mailbox-select decoded-group) + (if (or (nnimap-verify-uidvalidity + group (or server nnimap-current-server)) + (zerop (imap-mailbox-get 'exists decoded-group)) + t ;; for OGnus to see if ignoring uidvalidity + ;; changes has any bad effects. + (yes-or-no-p + (format + "nnimap: Group %s is not uidvalid. Continue? " + decoded-group))) + imap-current-mailbox ; Note: utf-7 encoded. + (imap-mailbox-unselect) + (error "nnimap: Group %s is not uid-valid" decoded-group)) + (nnheader-report 'nnimap (imap-error-text)))))))) (defun nnimap-replace-whitespace (string) "Return STRING with all whitespace replaced with space." @@ -618,7 +641,7 @@ (let (headers lines chars uid mbx) (with-current-buffer nnimap-server-buffer (setq uid imap-current-message - mbx imap-current-mailbox + mbx (nnimap-encode-group-name (imap-current-mailbox)) headers (if (imap-capability 'IMAP4rev1) ;; xxx don't just use car? alist doesn't contain ;; anything else now, but it might... @@ -665,9 +688,7 @@ "Make file name for GROUP on SERVER." (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) (uidvalidity (gnus-group-get-parameter - (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server))) + (nnimap-group-prefixed-name group server) 'uidvalidity)) (name (nnheader-translate-file-chars (concat nnimap-nov-file-name @@ -964,8 +985,10 @@ article))) (when article (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." - article (or group imap-current-mailbox - gnus-newsgroup-name)) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name + gnus-newsgroup-name))) (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) @@ -979,11 +1002,15 @@ (nnheader-ms-strip-cr) (gnus-message 10 "nnimap: Fetching (part of) article %d from %s...done" - article (or group imap-current-mailbox gnus-newsgroup-name)) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name gnus-newsgroup-name))) (if (bobp) (nnheader-report 'nnimap "No such article %d in %s: %s" - article (or group imap-current-mailbox - gnus-newsgroup-name) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name + gnus-newsgroup-name)) (imap-error-text nnimap-server-buffer)) (cons group article))) (add-hook 'imap-fetch-data-hook @@ -1020,8 +1047,7 @@ (deffoo nnimap-request-group (group &optional server fast) (nnimap-request-update-info-internal group - (gnus-get-info (gnus-group-prefixed-name - group (gnus-server-to-method (format "nnimap:%s" server)))) + (gnus-get-info (nnimap-group-prefixed-name group server)) server) (when (nnimap-possibly-change-group group server) (nnimap-before-find-minmax-bugworkaround) @@ -1044,8 +1070,8 @@ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) nnimap-mailbox-info))) (list (nth 0 old) (nth 1 old) - (imap-mailbox-status group 'unseen nnimap-server-buffer) - (nth 3 old))) + (imap-mailbox-status (nnimap-decode-group-name group) + 'unseen nnimap-server-buffer))) nnimap-mailbox-info)) (defun nnimap-close-group (group &optional server) @@ -1060,7 +1086,7 @@ (imap-mailbox-close nnimap-close-asynchronous)))) (ask (if (and (imap-search "DELETED") (gnus-y-or-n-p (format "Expunge articles in group `%s'? " - imap-current-mailbox))) + (imap-current-mailbox)))) (progn (imap-mailbox-expunge nnimap-close-asynchronous) (unless nnimap-dont-close @@ -1089,11 +1115,12 @@ (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern))) (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) (when info (with-current-buffer nntp-server-buffer (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) + encoded-mbx (or (nth 2 info) 0) (max 1 (or (nth 1 info) 1))))))))))) (gnus-message 5 "nnimap: Generating active list%s...done" (if (> (length server) 0) (concat " for " server) "")) @@ -1143,73 +1170,88 @@ (with-current-buffer nntp-server-buffer (erase-buffer) (nnimap-before-find-minmax-bugworkaround) - (let (asyncgroups slowgroups) + (let (asyncgroups slowgroups decoded-group) (if (null nnimap-retrieve-groups-asynchronous) (setq slowgroups groups) (dolist (group groups) - (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) - (add-to-list (if (gnus-gethash-safe - (gnus-group-prefixed-name group server) - nnimap-mailbox-info) + (setq decoded-group (nnimap-decode-group-name group)) + (gnus-message 9 "nnimap: Quickly checking mailbox %s" + decoded-group) + (add-to-list (if (gnus-group-get-parameter + (nnimap-group-prefixed-name group) + 'imap-status) 'asyncgroups 'slowgroups) (list group (imap-mailbox-status-asynch - group '(uidvalidity uidnext unseen) + decoded-group + '(uidvalidity uidnext unseen) nnimap-server-buffer)))) (dolist (asyncgroup asyncgroups) - (let ((group (nth 0 asyncgroup)) - (tag (nth 1 asyncgroup)) - new old) + (let* ((group (nth 0 asyncgroup)) + (tag (nth 1 asyncgroup)) + (gnusgroup (nnimap-group-prefixed-name group)) + (saved-uidvalidity (gnus-group-get-parameter gnusgroup + 'uidvalidity)) + (saved-imap-status (gnus-group-get-parameter gnusgroup + 'imap-status)) + (saved-info (and saved-imap-status + (split-string saved-imap-status " ")))) + (setq decoded-group (nnimap-decode-group-name group)) (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) - (if (or (not (string= - (nth 0 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidvalidity group + (if (or (not (equal + saved-uidvalidity + (imap-mailbox-get 'uidvalidity decoded-group nnimap-server-buffer))) - (not (string= - (nth 1 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidnext group + (not (equal + (nth 0 saved-info) + (imap-mailbox-get 'uidnext decoded-group nnimap-server-buffer)))) (push (list group) slowgroups) - (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)))))))) + (gnus-sethash + (gnus-group-prefixed-name group server) + (list (imap-mailbox-get 'uidvalidity + decoded-group nnimap-server-buffer) + (imap-mailbox-get 'uidnext + decoded-group nnimap-server-buffer) + (imap-mailbox-get 'unseen + decoded-group nnimap-server-buffer)) + nnimap-mailbox-info) + (insert (format "\"%s\" %s %s y\n" group + (nth 2 saved-info) + (nth 1 saved-info)))))))) (dolist (group slowgroups) (if nnimap-retrieve-groups-asynchronous (setq group (car group))) - (gnus-message 7 "nnimap: Mailbox %s modified" group) - (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group + (setq decoded-group (nnimap-decode-group-name group)) + (gnus-message 7 "nnimap: Mailbox %s modified" decoded-group) + (or (member "\\NoSelect" (imap-mailbox-get 'list-flags decoded-group nnimap-server-buffer)) - (let* ((info (nnimap-find-minmax-uid group 'examine)) - (str (format "\"%s\" %d %d y\n" group - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))) - (when (> (or (imap-mailbox-get 'recent group + (let* ((gnusgroup (nnimap-group-prefixed-name group)) + (status (imap-mailbox-status + decoded-group '(uidvalidity uidnext unseen) + nnimap-server-buffer)) + (info (nnimap-find-minmax-uid group 'examine)) + (min-uid (max 1 (or (nth 1 info) 1))) + (max-uid (or (nth 2 info) 0))) + (when (> (or (imap-mailbox-get 'recent decoded-group nnimap-server-buffer) 0) 0) - (push (list (cons group 0)) nnmail-split-history)) - (insert str) - (when nnimap-retrieve-groups-asynchronous - (gnus-sethash - (gnus-group-prefixed-name group server) - (list (or (imap-mailbox-get - 'uidvalidity group nnimap-server-buffer) - (imap-mailbox-status - group 'uidvalidity nnimap-server-buffer)) - (or (imap-mailbox-get - 'uidnext group nnimap-server-buffer) - (imap-mailbox-status - group 'uidnext nnimap-server-buffer)) - (or (imap-mailbox-get - 'unseen group nnimap-server-buffer) - (imap-mailbox-status - group 'unseen nnimap-server-buffer)) - str) - nnimap-mailbox-info))))))) + (push (list (cons decoded-group 0)) nnmail-split-history)) + (insert (format "\"%s\" %d %d y\n" group max-uid min-uid)) + (gnus-sethash + (gnus-group-prefixed-name group server) + status + nnimap-mailbox-info) + (if (not (equal (nth 0 status) + (gnus-group-get-parameter gnusgroup + 'uidvalidity))) + (nnimap-verify-uidvalidity group nnimap-current-server)) + ;; The imap-status parameter is a string on the form + ;; "<uidnext> <min-uid> <max-uid>". + (gnus-group-add-parameter + gnusgroup + (cons 'imap-status + (format "%s %s %s" (nth 1 status) min-uid max-uid)))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") 'active)) @@ -1218,7 +1260,7 @@ (when info ;; xxx what does this mean? should we create a info? (with-current-buffer nnimap-server-buffer (gnus-message 5 "nnimap: Updating info for %s..." - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) (when (nnimap-mark-permanent-p 'read) (let (seen unseen) @@ -1264,7 +1306,7 @@ t)) (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) info)))) @@ -1277,7 +1319,8 @@ (when (nnimap-possibly-change-group group server) (with-current-buffer nnimap-server-buffer (let (action) - (gnus-message 7 "nnimap: Setting marks in %s..." group) + (gnus-message 7 "nnimap: Setting marks in %s..." + (nnimap-decode-group-name group)) (while (setq action (pop actions)) (let ((range (nth 0 action)) (what (nth 1 action)) @@ -1318,7 +1361,8 @@ (imap-message-flags-set (imap-range-to-message-set range) (nnimap-mark-to-flag marks nil t))))))) - (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) + (gnus-message 7 "nnimap: Setting marks in %s...done" + (nnimap-decode-group-name group))))) nil) (defun nnimap-split-fancy () @@ -1329,6 +1373,7 @@ (defun nnimap-split-to-groups (rules) ;; tries to match all rules in nnimap-split-rule against content of ;; nntp-server-buffer, returns a list of groups that matched. + ;; Note: This function takes and returns decoded group names. (with-current-buffer nntp-server-buffer ;; Fold continuation lines. (goto-char (point-min)) @@ -1381,12 +1426,16 @@ (list nnimap-split-inbox))) (defun nnimap-split-articles (&optional group server) + ;; Note: Assumes decoded group names in nnimap-split-inbox, + ;; nnimap-split-rule, nnimap-split-fancy, and nnmail-split-history. (when (nnimap-possibly-change-server server) (with-current-buffer nnimap-server-buffer - (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) + (let (rule inbox removeorig + (inboxes (nnimap-split-find-inbox server))) ;; iterate over inboxes (while (and (setq inbox (pop inboxes)) - (nnimap-possibly-change-group inbox)) ;; SELECT + (nnimap-possibly-change-group + (nnimap-encode-group-name inbox))) ;; SELECT ;; find split rule for this server / inbox (when (setq rule (nnimap-split-find-rule server inbox)) ;; iterate over articles @@ -1415,7 +1464,7 @@ (and (setq msgid (nnmail-fetch-field "message-id")) (nnmail-cache-insert msgid - to-group + (nnimap-encode-group-name to-group) (nnmail-fetch-field "subject")))))) ;; Add the group-art list to the history list. (push (list (cons to-group 0)) nnmail-split-history)) @@ -1458,10 +1507,11 @@ (if (string= (downcase mailbox) "\\noselect") (throw 'found t))) nil) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) (when info (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) + encoded-mbx (or (nth 2 info) 0) (max 1 (or (nth 1 info) 1))))))))) (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" (if (> (length server) 0) " on " "") server)) @@ -1469,10 +1519,11 @@ (deffoo nnimap-request-create-group (group &optional server args) (when (nnimap-possibly-change-server server) - (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) - (imap-mailbox-create group nnimap-server-buffer) - (nnheader-report 'nnimap "%S" - (imap-error-text nnimap-server-buffer))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (or (imap-mailbox-status decoded-group 'uidvalidity nnimap-server-buffer) + (imap-mailbox-create decoded-group nnimap-server-buffer) + (nnheader-report 'nnimap "%S" + (imap-error-text nnimap-server-buffer)))))) (defun nnimap-time-substract (time1 time2) "Return TIME for TIME1 - TIME2." @@ -1603,7 +1654,8 @@ nnimap-current-move-group) (imap-message-copy (number-to-string nnimap-current-move-article) - group 'dontcreate nil + (nnimap-decode-group-name group) + 'dontcreate nil nnimap-server-buffer)) (with-current-buffer (current-buffer) (goto-char (point-min)) @@ -1623,13 +1675,15 @@ ;; this 'or' is for Cyrus server bug (or (null (imap-current-mailbox nnimap-server-buffer)) (imap-mailbox-unselect nnimap-server-buffer)) - (imap-message-append group (current-buffer) nil nil + (imap-message-append (nnimap-decode-group-name group) + (current-buffer) nil nil nnimap-server-buffer))) (cons group (nth 1 uid)) (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) (deffoo nnimap-request-delete-group (group force &optional server) (when (nnimap-possibly-change-server server) + (setq group (nnimap-decode-group-name group)) (when (string= group (imap-current-mailbox nnimap-server-buffer)) (imap-mailbox-unselect nnimap-server-buffer)) (with-current-buffer nnimap-server-buffer @@ -1641,7 +1695,9 @@ (deffoo nnimap-request-rename-group (group new-name &optional server) (when (nnimap-possibly-change-server server) - (imap-mailbox-rename group new-name nnimap-server-buffer))) + (imap-mailbox-rename (nnimap-decode-group-name group) + (nnimap-decode-group-name new-name) + nnimap-server-buffer))) (defun nnimap-expunge (mailbox server) (when (nnimap-possibly-change-group mailbox server) @@ -1650,7 +1706,8 @@ (defun nnimap-acl-get (mailbox server) (when (nnimap-possibly-change-server server) (and (imap-capability 'ACL nnimap-server-buffer) - (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) + (imap-mailbox-acl-get (nnimap-decode-group-name mailbox) + nnimap-server-buffer)))) (defun nnimap-acl-edit (mailbox method old-acls new-acls) (when (nnimap-possibly-change-server (cadr method)) @@ -1660,7 +1717,8 @@ ;; delete all removed identifiers (mapc (lambda (old-acl) (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) + (or (imap-mailbox-acl-delete (car old-acl) + (nnimap-decode-group-name mailbox)) (error "Can't delete ACL for %s" (car old-acl))))) old-acls) ;; set all changed acl's @@ -1669,7 +1727,8 @@ (old-rights (cdr (assoc (car new-acl) old-acls)))) (unless (and old-rights new-rights (string= old-rights new-rights)) - (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) + (or (imap-mailbox-acl-set (car new-acl) new-rights + (nnimap-decode-group-name mailbox)) (error "Can't set ACL for %s to %s" (car new-acl) new-rights))))) new-acls)
--- a/lisp/gnus/nnir.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/nnir.el Sun Mar 28 09:04:11 2010 -0400 @@ -358,6 +358,14 @@ (defvar nnir-imap-search-argument-history () "The history for querying search options in nnir") +(defvar nnir-get-article-nov-override-function nil + "If non-nil, a function that will be passed each search result. This +should return a message's headers in NOV format. + +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead.") + + ;;; Developer Extension Variable: (defvar nnir-engines @@ -779,25 +787,31 @@ (nnir-possibly-change-server server) (let ((gnus-override-method (gnus-server-to-method server))) - (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) - (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-nov returned nil for article %s in group %s" - artno artfullgroup))) - (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-head returned nil for article %s in group %s" - artno artfullgroup))) - (t (error "Unknown header type %s while requesting article %s of group %s" - foo artno artfullgroup)))) + ;; if nnir-get-article-nov-override-function is set, use it + (if nnir-get-article-nov-override-function + (setq novitem (funcall nnir-get-article-nov-override-function + artitem)) + ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head + (case (setq foo (gnus-retrieve-headers (list artno) + artfullgroup nil)) + (nov + (goto-char (point-min)) + (setq novitem (nnheader-parse-nov)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-nov returned nil for article %s in group %s" + artno artfullgroup))) + (headers + (goto-char (point-min)) + (setq novitem (nnheader-parse-head)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-head returned nil for article %s in group %s" + artno artfullgroup))) + (t (error "Unknown header type %s while requesting article %s of group %s" + foo artno artfullgroup))))) ;; replace article number in original group with article number ;; in nnir group (mail-header-set-number novitem art)
--- a/lisp/gnus/pop3.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/pop3.el Sun Mar 28 09:04:11 2010 -0400 @@ -98,6 +98,12 @@ :type 'boolean :group 'pop3) +(defcustom pop3-display-message-size-flag t + "*If non-nil, display the size of the message that is being fetched." + :version "22.1" ;; Oort Gnus + :type 'boolean + :group 'pop3) + (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") @@ -135,6 +141,7 @@ (crashbuf (get-buffer-create " *pop3-retr*")) (n 1) message-count + message-sizes (pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) @@ -149,10 +156,18 @@ (pop3-pass process)) (t (error "Invalid POP3 authentication scheme"))) (setq message-count (car (pop3-stat process))) + (when (and pop3-display-message-size-flag + (> message-count 0)) + (setq message-sizes (pop3-list process))) (unwind-protect (while (<= n message-count) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost) + (if pop3-display-message-size-flag + (message "Retrieving message %d of %d from %s... (%.1fk)" + n message-count pop3-mailhost + (/ (cdr (assoc n message-sizes)) + 1024.0)) + (message "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) @@ -451,8 +466,28 @@ )) (defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") + "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. +Otherwise, return the size of the message-id MSG" + (pop3-send-command process (if msg + (format "LIST %d" msg) + "LIST")) + (let ((response (pop3-read-response process t))) + (if msg + (string-to-number (nth 2 (split-string response " "))) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (pop3-accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker)) + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (mapcar #'(lambda (s) (let ((split (split-string s " "))) + (cons (string-to-number (nth 0 split)) + (string-to-number (nth 1 split))))) + (delete "" (split-string (buffer-substring start end) + "\r\n")))))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF."
--- a/lisp/gnus/smiley.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/gnus/smiley.el Sun Mar 28 09:04:11 2010 -0400 @@ -196,8 +196,8 @@ ;;;###autoload (defun smiley-buffer (&optional buffer) - "Run `smiley-region' at the buffer, specified in the argument or -interactively. If there's no argument, do it at the current buffer" + "Run `smiley-region' at the BUFFER, specified in the argument or +interactively. If there's no argument, do it at the current buffer." (interactive "bBuffer to run smiley-region: ") (save-excursion (if buffer
--- a/lisp/image-dired.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/image-dired.el Sun Mar 28 09:04:11 2010 -0400 @@ -801,7 +801,7 @@ With optional argument APPEND, append thumbnail to thumbnail buffer instead of erasing it first. -Option argument DO-NOT-POP controls if `pop-to-buffer' should be +Optional argument DO-NOT-POP controls if `pop-to-buffer' should be used or not. If non-nil, use `display-buffer' instead of `pop-to-buffer'. This is used from functions like `image-dired-next-line-and-display' and @@ -2113,8 +2113,7 @@ (defun image-dired-read-comment (&optional file) "Read comment for an image. -Read comment for an image, optionally using old comment from FILE -as initial value." +Optionally use old comment from FILE as initial value." (let ((comment (read-string "Comment: "
--- a/lisp/indent.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/indent.el Sun Mar 28 09:04:11 2010 -0400 @@ -85,8 +85,10 @@ (defun indent-for-tab-command (&optional arg) "Indent line or region in proper way for current major mode or insert a tab. Depending on `tab-always-indent', either insert a tab or indent. -If initial point was within line's indentation, position after -the indentation. Else stay at same point in text. + +In most major modes, if point was in the current line's indentation, +it is moved to the first non-whitespace character after indenting; +otherwise it stays at the same position in the text. If a prefix argument is given, also rigidly indent the entire balanced expression which starts at the beginning of the current
--- a/lisp/info.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/info.el Sun Mar 28 09:04:11 2010 -0400 @@ -3362,7 +3362,8 @@ (insert (format "* %-14s %s.\n" (concat (symbol-name keyword) "::") (cdr assoc))))) - (cons '(unknown . "unknown keywords") + (append '((all . "All package info") + (unknown . "unknown keywords")) finder-known-keywords))) ((equal nodename "unknown") ;; Display unknown keywords @@ -3377,6 +3378,22 @@ (concat (symbol-name (car assoc)) "::") (cdr assoc)))) (finder-unknown-keywords))) + ((equal nodename "all") + ;; Display all package info. + (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" + Info-finder-file nodename)) + (insert "Finder Package Info\n") + (insert "*******************\n\n") + (mapc (lambda (package) + (insert (format "%s - %s\n" + (format "*Note %s::" (nth 0 package)) + (nth 1 package))) + (insert "Keywords: " + (mapconcat (lambda (keyword) + (format "*Note %s::" (symbol-name keyword))) + (nth 2 package) ", ") + "\n\n")) + finder-package-info)) ((string-match-p "\\.el\\'" nodename) ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" @@ -3401,6 +3418,7 @@ (buffer-string)))))) (t ;; Display packages that match the keyword + ;; or the list of keywords separated by comma. (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-finder-file nodename)) (insert "Finder Packages\n") @@ -3408,21 +3426,39 @@ (insert "The following packages match the keyword `" nodename "':\n\n") (insert "* Menu:\n\n") - (let ((id (intern nodename))) + (let ((keywords + (mapcar 'intern (if (string-match-p "," nodename) + (split-string nodename ",[ \t\n]*" t) + (list nodename))))) (mapc - (lambda (x) - (when (memq id (cadr (cdr x))) + (lambda (package) + (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package))) + keywords)) (insert (format "* %-16s %s.\n" - (concat (car x) "::") - (cadr x))))) + (concat (nth 0 package) "::") + (nth 1 package))))) finder-package-info))))) ;;;###autoload -(defun info-finder () - "Display descriptions of the keywords in the Finder virtual manual." - (interactive) +(defun info-finder (&optional keywords) + "Display descriptions of the keywords in the Finder virtual manual. +In interactive use, a prefix argument directs this command to read +a list of keywords separated by comma. After that, it displays a node +with a list packages that contain all specified keywords." + (interactive + (when current-prefix-arg + (require 'finder) + (list + (completing-read-multiple + "Keywords (separated by comma): " + (mapcar 'symbol-name (mapcar 'car (append finder-known-keywords + (finder-unknown-keywords)))) + nil t)))) (require 'finder) - (Info-find-node Info-finder-file "Top")) + (if keywords + (Info-find-node Info-finder-file (mapconcat 'identity keywords ", ")) + (Info-find-node Info-finder-file "Top"))) + (defun Info-undefined () "Make command be undefined in Info."
--- a/lisp/json.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/json.el Sun Mar 28 09:04:11 2010 -0400 @@ -62,12 +62,12 @@ (defvar json-object-type 'alist "Type to convert JSON objects to. -Must be one of `alist', `plist', or `hash-table'. Consider let-binding +Must be one of `alist', `plist', or `hash-table'. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") (defvar json-array-type 'vector "Type to convert JSON arrays to. -Must be one of `vector' or `list'. Consider let-binding this around +Must be one of `vector' or `list'. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") (defvar json-key-type nil @@ -83,19 +83,19 @@ `plist' `keyword' Note that values other than `string' might behave strangely for -Sufficiently Weird keys. Consider let-binding this around your call to +Sufficiently Weird keys. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") (defvar json-false :json-false "Value to use when reading JSON `false'. If this has the same value as `json-null', you might not be able to tell -the difference between `false' and `null'. Consider let-binding this +the difference between `false' and `null'. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") (defvar json-null nil "Value to use when reading JSON `null'. If this has the same value as `json-false', you might not be able to -tell the difference between `false' and `null'. Consider let-binding +tell the difference between `false' and `null'. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") @@ -218,7 +218,7 @@ (defun json-read-number (&optional sign) "Read the JSON number following point. -The optional SIGN argument is for internal use. +The optional SIGN argument is for internal use. N.B.: Only numbers which can fit in Emacs Lisp's native number representation will be parsed correctly."
--- a/lisp/language/indian.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/language/indian.el Sun Mar 28 09:04:11 2010 -0400 @@ -141,7 +141,7 @@ (defconst devanagari-composable-pattern (let ((table '(("V" . "[\u0904-\u0914\u0960-\u0961\u0972]") ; independent vowel - ("C" . "[\u0915-\u0939]") ; consonant + ("C" . "[\u0915-\u0939\u0958-\u095F\u097B-\u097C\u097E-\u097F]") ; consonant ("R" . "\u0930") ; RA ("n" . "\u093C") ; NUKTA ("H" . "\u094D") ; HALANT
--- a/lisp/log-edit.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/log-edit.el Sun Mar 28 09:04:11 2010 -0400 @@ -191,22 +191,20 @@ (defvar log-edit-extra-flags nil "List of extra flags to pass to the check in command.") (defvar log-edit-before-checkin-process nil - "Alist that contains instructions for processing the commit message before check in. - + "Alist with instructions for processing the commit message before check in. The format is: (REGEXP . INSTRUCTIONS). +All lines matching REGEXP are removed. For example: -All lines matching REGEXP are removed. +\(\"^#.*\" . nil) -For example: - -(\"^#.*\" . nil) means: just remove all lines starting with #. This can be used to insert lines in the commit buffer that contain, for example, the list of files to be committed. -(\"Author: \\(.*\\)\" . (list \"--author\" (match-string 1))) -means: append (list \"--author\" (match-string 1)) to -`log-edit-extra-flags'.") +\(\"Author: \\\\(.*\\\\)\" . (list \"--author\" (match-string 1))) + +means: append (list \"--author\" (match-string 1)) to `log-edit-extra-flags'.") + (defvar log-edit-parent-buffer nil) ;;; Originally taken from VC-Log mode
--- a/lisp/mail/rmail.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/mail/rmail.el Sun Mar 28 09:04:11 2010 -0400 @@ -381,6 +381,20 @@ :group 'rmail-headers :version "22.1") +;; This was removed in Emacs 23.1 with no notification, an unnecessary +;; incompatible change. +(defcustom rmail-highlight-face 'rmail-highlight + "Face used by Rmail for highlighting headers." + ;; Note that nil doesn't actually mean use the default face, it + ;; means use either bold or highlight. It's not worth fixing this + ;; now that this is obsolete. + :type '(choice (const :tag "Default" nil) + face) + :group 'rmail-headers) +(make-obsolete-variable 'rmail-highlight-face + "customize the face `rmail-highlight' instead." + "23.2") + (defface rmail-header-name '((t (:inherit font-lock-function-name-face))) "Face to use for highlighting the header names. @@ -2883,7 +2897,7 @@ (defun rmail-highlight-headers () "Highlight the headers specified by `rmail-highlighted-headers'. -Uses the face `rmail-highlight'." +Uses the face specified by `rmail-highlight-face'." (if rmail-highlighted-headers (save-excursion (search-forward "\n\n" nil 'move) @@ -2891,6 +2905,11 @@ (narrow-to-region (point-min) (point)) (let ((case-fold-search t) (inhibit-read-only t) + ;; When rmail-highlight-face is removed, just + ;; use 'rmail-highlight here. + (face (or rmail-highlight-face + (if (face-differs-from-default-p 'bold) + 'bold 'highlight))) ;; List of overlays to reuse. (overlays rmail-overlay-list)) (goto-char (point-min)) @@ -2909,12 +2928,12 @@ (progn (setq overlay (car overlays) overlays (cdr overlays)) - (overlay-put overlay 'face 'rmail-highlight) + (overlay-put overlay 'face face) (move-overlay overlay beg (point))) ;; Make a new overlay and add it to ;; rmail-overlay-list. (setq overlay (make-overlay beg (point))) - (overlay-put overlay 'face 'rmail-highlight) + (overlay-put overlay 'face face) (setq rmail-overlay-list (cons overlay rmail-overlay-list))))))))))
--- a/lisp/mh-e/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/mh-e/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,15 @@ +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * mh-scan.el (mh-scan-cmd-note-width): Doc fix. + (mh-scan-format-mh, mh-scan-body-regexp, mh-scan-cur-msg-number-regexp) + (mh-scan-cur-msg-number-regexp, mh-scan-date-regexp) + (mh-scan-deleted-msg-regexp, mh-scan-good-msg-regexp) + (mh-scan-msg-format-regexp, mh-scan-msg-format-string) + (mh-scan-msg-number-regexp, mh-scan-rcpt-regexp) + (mh-scan-refiled-msg-regexp, mh-scan-sent-to-me-sender-regexp) + (mh-scan-subject-regexp, mh-update-scan-format) + (mh-msg-num-width-to-column): Fix typos in docstrings. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/lisp/mh-e/mh-scan.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/mh-e/mh-scan.el Sun Mar 28 09:04:11 2010 -0400 @@ -61,7 +61,7 @@ "%{subject}%<{body}<<%{body}%>") "*Scan format string for MH. This string is passed to the scan program via the -format -argument. This format is identical to the default except that +argument. This format is identical to the default except that additional hints for fontification have been added to the fifth column (remember that in Emacs, the first column is 0). @@ -109,14 +109,14 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the body text as in the default of -\"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is +\"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is not correct, the body fragment will not be highlighted with the face `mh-folder-body'.") (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" "This regular expression matches the current message. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of @@ -125,9 +125,9 @@ This expression includes the leading space and current message marker \"+\" within the parenthesis since it looks better to -highlight these items as well. The highlighting is done with the -face `mh-folder-cur-msg-number'. This regular expression should -be correct as it is needed by non-fontification functions. See +highlight these items as well. The highlighting is done with the +face `mh-folder-cur-msg-number'. This regular expression should +be correct as it is needed by non-fontification functions. See also `mh-note-cur'.") (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" @@ -137,14 +137,14 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain only one parenthesized expression which matches the date field as in the default of -\"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression +\"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression is not correct, the date will not be highlighted with the face `mh-folder-date'.") (defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D" "This regular expression matches deleted messages. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of @@ -152,15 +152,15 @@ \"^\\\\( *[0-9]+\\\\)D\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. The highlighting -is done with the face `mh-folder-deleted'. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-deleted'. This regular expression should be correct as it is needed by non-fontification -functions. See also `mh-note-deleted'.") +functions. See also `mh-note-deleted'.") (defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" "This regular expression matches \"good\" messages. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of @@ -168,8 +168,8 @@ \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. The highlighting -is done with the face `mh-folder-msg-number'. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-msg-number'. This regular expression should be correct as it is needed by non-fontification functions.") @@ -177,21 +177,21 @@ "This regular expression finds the message number width in a scan format. Note that the message number must be placed in a parenthesized -expression as in the default of \"%\\\\([0-9]*\\\\)(msg)\". This +expression as in the default of \"%\\\\([0-9]*\\\\)(msg)\". This variable is only consulted if `mh-scan-format-file' is set to \"Use MH-E scan Format\".") (defvar mh-scan-msg-format-string "%d" "This is a format string for width of the message number in a scan format. -Use \"0%d\" for zero-filled message numbers. This variable is only +Use \"0%d\" for zero-filled message numbers. This variable is only consulted if `mh-scan-format-file' is set to \"Use MH-E scan Format\".") (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" "This regular expression extracts the message number. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the message number must be placed in a parenthesized expression as in the default of \"^ *\\\\([0-9]+\\\\)\".") @@ -211,9 +211,9 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain two parenthesized expressions. The first is expected to match the \"To:\" that the default scan -format file generates. The second is expected to match the +format file generates. The second is expected to match the recipient's name as in the default of -\"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular +\"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular expression is not correct, the \"To:\" string will not be highlighted with the face `mh-folder-to' and the recipient will not be highlighted with the face `mh-folder-address'") @@ -221,7 +221,7 @@ (defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^" "This regular expression matches refiled messages. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of @@ -229,10 +229,10 @@ \"^\\\\( *[0-9]+\\\\)\\\\^\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. The highlighting -is done with the face `mh-folder-refiled'. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-refiled'. This regular expression should be correct as it is needed by non-fontification -functions. See also `mh-note-refiled'.") +functions. See also `mh-note-refiled'.") (defvar mh-scan-sent-to-me-sender-regexp "^ *[0-9]+.\\([bct]\\).....[ ]*\\(..................\\)" @@ -240,7 +240,7 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least two parenthesized -expressions. The first should match the fontification hint (see +expressions. The first should match the fontification hint (see `mh-scan-format-nmh') and the second should match the user name as in the default of @@ -255,15 +255,15 @@ "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" "This regular expression matches the subject. -It must match from the beginning of the line. Note that the +It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least three parenthesized expressions. The first is expected to match the \"Re:\" string, if any, and is -highlighted with the face `mh-folder-followup'. The second +highlighted with the face `mh-folder-followup'. The second matches an optional bracketed number after \"Re:\", such as in \"Re[2]:\" (and is thus a sub-expression of the first expression) and the third is expected to match the subject line itself which -is highlighted with the face `mh-folder-subject'. For example, +is highlighted with the face `mh-folder-subject'. For example, the default (broken on multiple lines for readability) is ^ *[0-9]+........[ ]*................... @@ -296,9 +296,9 @@ (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. -This column will have one of the values: \" \", \"D\", \"^\", \"+\" and -where \" \" is the default value, +This column will have one of the values: \" \", \"D\", \"^\", \"+\", where + \" \" is the default value, \"D\" is the `mh-note-deleted' character, \"^\" is the `mh-note-refiled' character, and \"+\" is the `mh-note-cur' character.") @@ -434,7 +434,7 @@ "Return a scan format with the (msg) width in the FMT replaced with WIDTH. The message number width portion of the format is discovered -using `mh-scan-msg-format-regexp'. Its replacement is controlled +using `mh-scan-msg-format-regexp'. Its replacement is controlled with `mh-scan-msg-format-string'." (or (and (string-match mh-scan-msg-format-regexp fmt) @@ -469,7 +469,7 @@ If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are -in use. This function therefore assumes that the first column is +in use. This function therefore assumes that the first column is empty (to provide room for the cursor), the following WIDTH columns contain the message number, and the column for notations comes after that."
--- a/lisp/midnight.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/midnight.el Sun Mar 28 09:04:11 2010 -0400 @@ -3,8 +3,8 @@ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Sam Steingold <sds@usa.net> -;; Maintainer: Sam Steingold <sds@usa.net> +;; Author: Sam Steingold <sds@gnu.org> +;; Maintainer: Sam Steingold <sds@gnu.org> ;; Created: 1998-05-18 ;; Keywords: utilities @@ -205,7 +205,7 @@ (defun midnight-next () "Return the number of seconds till the next midnight." - (multiple-value-bind (sec min hrs) + (multiple-value-bind (sec min hrs) (values-list (decode-time)) (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec)))
--- a/lisp/minibuffer.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/minibuffer.el Sun Mar 28 09:04:11 2010 -0400 @@ -393,6 +393,9 @@ "Completion of multiple words, each one taken as a prefix. E.g. M-x l-c-h can complete to list-command-history and C-x C-f /u/m/s to /usr/monnier/src.") + (substring + completion-substring-try-completion completion-substring-all-completions + "Completion of the string taken as a substring.") (initials completion-initials-try-completion completion-initials-all-completions "Completion of acronyms and initialisms. @@ -1099,12 +1102,12 @@ (exit-minibuffer)) (defvar completion-in-region-functions nil - "Wrapper hook around `complete-in-region'. + "Wrapper hook around `completion-in-region'. The functions on this special hook are called with 5 arguments: NEXT-FUN START END COLLECTION PREDICATE. NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE) -that performs the default operation. The other four argument are like -the ones passed to `complete-in-region'. The functions on this hook +that performs the default operation. The other four arguments are like +the ones passed to `completion-in-region'. The functions on this hook are expected to perform completion on START..END using COLLECTION and PREDICATE, either by calling NEXT-FUN or by doing it themselves.") @@ -1658,6 +1661,12 @@ ;; Nothing to merge. suffix)) +(defun completion-basic--pattern (beforepoint afterpoint bounds) + (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (defun completion-basic-try-completion (string table pred point) (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) @@ -1674,10 +1683,8 @@ (length completion)))) (let* ((suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) + (pattern (completion-basic--pattern + beforepoint afterpoint bounds)) (all (completion-pcm--all-completions prefix pattern table pred))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) @@ -1687,12 +1694,8 @@ (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) + (pattern (completion-basic--pattern beforepoint afterpoint bounds)) (all (completion-pcm--all-completions prefix pattern table pred))) (completion-hilit-commonality all point (car bounds)))) @@ -2069,7 +2072,38 @@ 'completion-pcm--filename-try-filter)) (completion-pcm--merge-try pattern all prefix suffix))) -;;; Initials completion +;;; Substring completion +;; Mostly derived from the code of `basic' completion. + +(defun completion-substring--all-completions (string table pred point) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (basic-pattern (completion-basic--pattern + beforepoint afterpoint bounds)) + (pattern (if (not (stringp (car basic-pattern))) + basic-pattern + (cons 'any basic-pattern))) + (all (completion-pcm--all-completions prefix pattern table pred))) + (list all pattern prefix suffix (car bounds)))) + +(defun completion-substring-try-completion (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (if minibuffer-completing-file-name + (setq all (completion-pcm--filename-try-filter all))) + (completion-pcm--merge-try pattern all prefix suffix))) + +(defun completion-substring-all-completions (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (when all + (nconc (completion-pcm--hilit-commonality pattern all) + (length prefix))))) + +;; Initials completion ;; Complete /ums to /usr/monnier/src or lch to list-command-history. (defun completion-initials-expand (str table pred)
--- a/lisp/mpc.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/mpc.el Sun Mar 28 09:04:11 2010 -0400 @@ -94,54 +94,17 @@ (eval-when-compile (require 'cl)) -;;; Backward compatibility. -;; This code is meant for Emacs-CVS, so to get it to run on anything else, -;; we need to define some more things. - -(unless (fboundp 'tool-bar-local-item) - (defun tool-bar-local-item (icon def key map &rest props) - (define-key-after map (vector key) - `(menu-item ,(symbol-name key) ,def - :image ,(find-image - `((:type xpm :file ,(concat icon ".xpm")))) - ,@props)))) - -(unless (fboundp 'process-put) - (defconst mpc-process-hash (make-hash-table :weakness 'key)) - (defun process-put (proc prop val) - (let ((sym (gethash proc mpc-process-hash))) - (unless sym - (setq sym (puthash proc (make-symbol "mpc-proc-sym") mpc-process-hash))) - (put sym prop val))) - (defun process-get (proc prop) - (let ((sym (gethash proc mpc-process-hash))) - (when sym (get sym prop)))) - (defun process-plist (proc) - (let ((sym (gethash proc mpc-process-hash))) - (when sym (symbol-plist sym))))) -(unless (fboundp 'with-local-quit) - (defmacro with-local-quit (&rest body) - `(condition-case nil (let ((inhibit-quit nil)) ,@body) - (quit (setq quit-flag t) nil)))) -(unless (fboundp 'balance-windows-area) - (defalias 'balance-windows-area 'balance-windows)) -(unless (fboundp 'posn-object) (defalias 'posn-object 'ignore)) -(unless (fboundp 'buffer-local-value) - (defun buffer-local-value (var buf) - (with-current-buffer buf (symbol-value var)))) - - -;;; Main code starts here. - (defgroup mpc () "A Client for the Music Player Daemon." :prefix "mpc-" :group 'multimedia :group 'applications) -(defcustom mpc-browser-tags '(Genre Artist Album Playlist) +(defcustom mpc-browser-tags '(Genre Artist|Composer|Performer + Album|Playlist) "Tags for which a browser buffer should be created by default." - :type '(repeat string)) + ;; FIXME: provide a list of tags, for completion. + :type '(repeat symbol)) ;;; Misc utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -620,6 +583,19 @@ ;; (mpc--queue-head))) ;; (message "MPC's queue is out of sync")))))) +(defvar mpc--find-memoize-union-tags nil) + +(defun mpc-cmd-flush (tag value) + (puthash (cons tag value) nil mpc--find-memoize) + (dolist (uniontag mpc--find-memoize-union-tags) + (if (member (symbol-name tag) (split-string (symbol-name uniontag) "|")) + (puthash (cons uniontag value) nil mpc--find-memoize)))) + + +(defun mpc-cmd-special-tag-p (tag) + (or (memq tag '(Playlist Search Directory)) + (string-match "|" (symbol-name tag)))) + (defun mpc-cmd-find (tag value) "Return a list of all songs whose tag TAG has value VALUE. The songs are returned as alists." @@ -628,8 +604,12 @@ (cond ((eq tag 'Playlist) ;; Special case for pseudo-tag playlist. - (let ((l (mpc-proc-buf-to-alists - (mpc-proc-cmd (list "listplaylistinfo" value)))) + (let ((l (condition-case err + (mpc-proc-buf-to-alists + (mpc-proc-cmd (list "listplaylistinfo" value))) + (mpc-proc-error + ;; "[50@0] {listplaylistinfo} No such playlist" + nil))) (i 0)) (mapcar (lambda (s) (prog1 (cons (cons 'Pos (number-to-string i)) s) @@ -648,6 +628,14 @@ (if (eq (car pair) 'directory) nil pair)) pairs))))) + ((string-match "|" (symbol-name tag)) + (add-to-list 'mpc--find-memoize-union-tags tag) + (let ((tag1 (intern (substring (symbol-name tag) + 0 (match-beginning 0)))) + (tag2 (intern (substring (symbol-name tag) + (match-end 0))))) + (mpc-union (mpc-cmd-find tag1 value) + (mpc-cmd-find tag2 value)))) (t (condition-case err (mpc-proc-buf-to-alists @@ -675,7 +663,7 @@ (when other-tag (dolist (pl (prog1 pls (setq pls nil))) (let ((plsongs (mpc-cmd-find 'Playlist pl))) - (if (not (member other-tag '(Playlist Search Directory))) + (if (not (mpc-cmd-special-tag-p other-tag)) (when (member (cons other-tag value) (apply 'append plsongs)) (push pl pls)) @@ -743,6 +731,14 @@ ;; useful that would be tho. ((eq tag 'Search) (error "Not supported")) + ((string-match "|" (symbol-name tag)) + (let ((tag1 (intern (substring (symbol-name tag) + 0 (match-beginning 0)))) + (tag2 (intern (substring (symbol-name tag) + (match-end 0))))) + (mpc-union (mpc-cmd-list tag1 other-tag value) + (mpc-cmd-list tag2 other-tag value)))) + ((null other-tag) (condition-case nil (mapcar 'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag)))) @@ -754,7 +750,7 @@ (mpc-assq-all tag (mpc-proc-cmd-to-alist "listallinfo"))))) (t (condition-case nil - (if (member other-tag '(Search Playlist Directory)) + (if (mpc-cmd-special-tag-p other-tag) (signal 'mpc-proc-error "Not implemented") (mapcar 'cdr (mpc-proc-cmd-to-alist @@ -801,7 +797,7 @@ (list "add" file))) files))) (if (stringp playlist) - (puthash (cons 'Playlist playlist) nil mpc--find-memoize))) + (mpc-cmd-flush 'Playlist playlist))) (defun mpc-cmd-delete (song-poss &optional playlist) "Delete the songs at positions SONG-POSS from PLAYLIST. @@ -928,6 +924,10 @@ ;;; Formatter ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mpc-secs-to-time (secs) + ;; We could use `format-seconds', but it doesn't seem worth the trouble + ;; because we'd still need to check (>= secs (* 60 100)) since the special + ;; %z only allows us to drop the large units for small values but + ;; not to drop the small units for large values. (if (stringp secs) (setq secs (string-to-number secs))) (if (>= secs (* 60 100)) ;More than 100 minutes. (format "%dh%02d" ;"%d:%02d:%02d" @@ -1432,6 +1432,20 @@ (with-current-buffer buf (with-local-quit (mpc-tagbrowser-refresh))))) (with-local-quit (mpc-songs-refresh)))) +(defun mpc-tagbrowser-tag-name (tag) + (cond + ((string-match "|" (symbol-name tag)) + (let ((tag1 (intern (substring (symbol-name tag) + 0 (match-beginning 0)))) + (tag2 (intern (substring (symbol-name tag) + (match-end 0))))) + (concat (mpc-tagbrowser-tag-name tag1) + " | " + (mpc-tagbrowser-tag-name tag2)))) + ((string-match "y\\'" (symbol-name tag)) + (concat (substring (symbol-name tag) 0 -1) "ies")) + (t (concat (symbol-name tag) "s")))) + (defun mpc-tagbrowser-buf (tag) (let ((buf (mpc-proc-buffer (mpc-proc) tag))) (if (buffer-live-p buf) buf @@ -1446,10 +1460,7 @@ (insert mpc-tagbrowser-all-name "\n")) (forward-line -1) (setq mpc-tag tag) - (setq mpc-tag-name - (if (string-match "y\\'" (symbol-name tag)) - (concat (substring (symbol-name tag) 0 -1) "ies") - (concat (symbol-name tag) "s"))) + (setq mpc-tag-name (mpc-tagbrowser-tag-name tag)) (mpc-tagbrowser-all-select) (mpc-tagbrowser-refresh) buf)))) @@ -1858,20 +1869,22 @@ (mapcar (lambda (val) (mpc-cmd-find (car cst) val)) (cdr cst))))) - (setq active (if (null active) - (progn + (setq active (cond + ((null active) (if (eq (car cst) 'Playlist) (setq dontsort t)) vals) - (if (or dontsort + ((or dontsort ;; Try to preserve ordering and ;; repetitions from playlists. (not (eq (car cst) 'Playlist))) (mpc-intersection active vals - (lambda (x) (assq 'file x))) + (lambda (x) (assq 'file x)))) + (t (setq dontsort t) (mpc-intersection vals active - (lambda (x) (assq 'file x))))))))) + (lambda (x) + (assq 'file x))))))))) (mpc-select-save (erase-buffer) ;; Sorting songs is surprisingly difficult: when comparing two @@ -1902,9 +1915,10 @@ )) (goto-char (point-min)) (forward-line (car curline)) - (when (or (search-forward (cdr curline) nil t) + (if (or (search-forward (cdr curline) nil t) (search-backward (cdr curline) nil t)) - (beginning-of-line)) + (beginning-of-line) + (goto-char (point-min))) (set (make-local-variable 'mpc-songs-totaltime) (unless (zerop totaltime) (list " " (mpc-secs-to-time totaltime))))
--- a/lisp/net/secrets.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/net/secrets.el Sun Mar 28 09:04:11 2010 -0400 @@ -149,7 +149,7 @@ (require 'dbus) (defvar secrets-enabled nil - "Whether there is a daemon offering the Secret Service API." + "Whether there is a daemon offering the Secret Service API.") (defvar secrets-debug t "Write debug messages") @@ -693,7 +693,7 @@ ;; We shall inform, whether the secret service is enabled on this ;; machine. - (setq secrets-enabled t))) + (setq secrets-enabled t)) (provide 'secrets)
--- a/lisp/net/tramp.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/net/tramp.el Sun Mar 28 09:04:11 2010 -0400 @@ -6295,7 +6295,7 @@ Returns the absolute file name of PROGNAME, if found, and nil otherwise. This function expects to be in the right *tramp* buffer." - (with-current-buffer (tramp-get-buffer vec) + (with-current-buffer (tramp-get-connection-buffer vec) (let (result) ;; Check whether the executable is in $PATH. "which(1)" does not ;; report always a correct error code; therefore we check the @@ -6303,7 +6303,7 @@ (unless ignore-path (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) - (if (looking-at "^1$") + (if (looking-at "^\\s-*1$") (setq result (concat "\\" progname)))) (unless result (when ignore-tilde @@ -6404,12 +6404,15 @@ (with-current-buffer (tramp-get-buffer vec) (tramp-send-command vec "echo ~root" t) (cond - ((string-match "^~root$" (buffer-string)) + ((or (string-match "^~root$" (buffer-string)) + ;; The default shell (ksh93) of OpenSolaris is buggy. + (string-equal (tramp-get-connection-property vec "uname" "") + "SunOS 5.11")) (setq shell (or (tramp-find-executable - vec "bash" (tramp-get-remote-path vec) t) + vec "bash" (tramp-get-remote-path vec) t t) (tramp-find-executable - vec "ksh" (tramp-get-remote-path vec) t))) + vec "ksh" (tramp-get-remote-path vec) t t))) (unless shell (tramp-error vec 'file-error @@ -6838,9 +6841,11 @@ ;; "test foo; echo $?" to check if various conditions hold, and ;; there are buggy /bin/sh implementations which don't execute the ;; "echo $?" part if the "test" part has an error. In particular, - ;; the Solaris /bin/sh is a problem. I'm betting that all systems - ;; with buggy /bin/sh implementations will have a working bash or - ;; ksh. Whee... + ;; the OpenSolaris /bin/sh is a problem. There are also other + ;; problems with /bin/sh of OpenSolaris, like redirection of stderr + ;; in in function declarations, or changing HISTFILE in place. + ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when + ;; detected. (tramp-find-shell vec) ;; Disable unexpected output. @@ -6849,12 +6854,6 @@ ;; Set the environment. (tramp-message vec 5 "Setting default environment") - ;; On OpenSolaris, there is a bug when HISTFILE is changed in place - ;; <http://bugs.opensolaris.org/view_bug.do?bug_id=6834184>. We - ;; apply the workaround. - (if (string-equal (tramp-get-connection-property vec "uname" "") "SunOS 5.11") - (tramp-send-command vec "unset HISTFILE" t)) - (let ((env (copy-sequence tramp-remote-process-environment)) unset item) (while env
--- a/lisp/net/trampver.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/net/trampver.el Sun Mar 28 09:04:11 2010 -0400 @@ -29,7 +29,7 @@ ;; "autoconf && ./configure" to change them. (X)Emacs version check is defined ;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. -(defconst tramp-version "2.1.18-pre" +(defconst tramp-version "2.1.18-23.2" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org"
--- a/lisp/obsolete/levents.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/obsolete/levents.el Sun Mar 28 09:04:11 2010 -0400 @@ -61,7 +61,7 @@ (put 'timeout 'event-symbol-elements '(eval)) (defun allocate-event () - "Returns an empty event structure. + "Return an empty event structure. In this emulation, it returns nil." nil) @@ -142,7 +142,7 @@ (nth 1 event)) (defun event-key (event) - "Returns the KeySym of the given key-press event. + "Return the KeySym of the given key-press event. The value is an ASCII printing character (not upper case) or a symbol." (if (symbolp event) (car (get event 'event-symbol-elements)) @@ -150,11 +150,11 @@ (downcase (if (< base 32) (logior base 64) base))))) (defun event-object (event) - "Returns the function argument of the given timeout, menu, or eval event." + "Return the function argument of the given timeout, menu, or eval event." (nth 2 event)) (defun event-point (event) - "Returns the character position of the given mouse-related event. + "Return the character position of the given mouse-related event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." @@ -201,18 +201,18 @@ (window-start start-window))))) (defun event-process (event) - "Returns the process of the given process-output event." + "Return the process of the given process-output event." (nth 1 event)) (defun event-timestamp (event) - "Returns the timestamp of the given event object. + "Return the timestamp of the given event object. In Lucid Emacs, this works for any kind of event. In this emulation, it returns nil for non-mouse-related events." (and (listp event) (posn-timestamp (event-end event)))) (defun event-to-character (event &optional lenient) - "Returns the closest ASCII approximation to the given event object. + "Return the closest ASCII approximation to the given event object. If the event isn't a keypress, this returns nil. If the second argument is non-nil, then this is lenient in its translation; it will ignore modifier keys other than control and meta, @@ -229,25 +229,25 @@ event nil))) (defun event-window (event) - "Returns the window of the given mouse-related event object." + "Return the window of the given mouse-related event object." (posn-window (event-end event))) (defun event-x (event) - "Returns the X position in characters of the given mouse-related event." + "Return the X position in characters of the given mouse-related event." (/ (car (posn-col-row (event-end event))) (frame-char-width (window-frame (event-window event))))) (defun event-x-pixel (event) - "Returns the X position in pixels of the given mouse-related event." + "Return the X position in pixels of the given mouse-related event." (car (posn-col-row (event-end event)))) (defun event-y (event) - "Returns the Y position in characters of the given mouse-related event." + "Return the Y position in characters of the given mouse-related event." (/ (cdr (posn-col-row (event-end event))) (frame-char-height (window-frame (event-window event))))) (defun event-y-pixel (event) - "Returns the Y position in pixels of the given mouse-related event." + "Return the Y position in pixels of the given mouse-related event." (cdr (posn-col-row (event-end event)))) (defun key-press-event-p (obj)
--- a/lisp/outline.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/outline.el Sun Mar 28 09:04:11 2010 -0400 @@ -914,12 +914,12 @@ (outline-map-region (lambda () (if (<= (funcall outline-level) levels) - (outline-show-heading) - beg end)) - ;; Finally unhide any trailing newline. - (goto-char (point-max)) - (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point)))) - (outline-flag-region (1- (point)) (point) nil))))) + (outline-show-heading))) + beg end) + ;; Finally unhide any trailing newline. + (goto-char (point-max)) + (if (and (bolp) (not (bobp)) (outline-invisible-p (1- (point)))) + (outline-flag-region (1- (point)) (point) nil)))) (run-hooks 'outline-view-change-hook)) (defun hide-other ()
--- a/lisp/progmodes/cc-engine.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/progmodes/cc-engine.el Sun Mar 28 09:04:11 2010 -0400 @@ -2624,7 +2624,7 @@ (< (point-max) c-state-old-cpp-end))) (point-max) (min (point-max) c-state-old-cpp-beg))) - (while (and c-state-cache (> (c-state-cache-top-lparen) upper-lim)) + (while (and c-state-cache (>= (c-state-cache-top-lparen) upper-lim)) (setq c-state-cache (cdr c-state-cache))) ;; If `upper-lim' is inside the last recorded brace pair, remove its ;; RBrace and indicate we'll need to search backwards for a previous
--- a/lisp/progmodes/compile.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/progmodes/compile.el Sun Mar 28 09:04:11 2010 -0400 @@ -733,6 +733,9 @@ "If non-nil, automatically jump to the next error encountered.") (make-variable-buffer-local 'compilation-auto-jump-to-next) +(defvar buffer-modtime nil + "The buffer modification time, for buffers not associated with files.") +(make-variable-buffer-local 'buffer-modtime) (defvar compilation-skip-to-next-location t "*If non-nil, skip multiple error messages for the same source location.") @@ -1566,6 +1569,7 @@ mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) + (set (make-local-variable 'buffer-modtime) nil) (compilation-setup) (setq buffer-read-only t) (run-mode-hooks 'compilation-mode-hook)) @@ -1781,6 +1785,7 @@ (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) + (set (make-local-variable 'buffer-modtime) (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) @@ -1954,9 +1959,7 @@ ;; There may be no timestamp info if the loc is a `fake-loc', ;; but we just checked that the file has been visited before! (equal (nth 4 loc) - (setq timestamp - (with-current-buffer (marker-buffer (nth 3 loc)) - (visited-file-modtime))))) + (setq timestamp buffer-modtime))) (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) (cadr (car (nth 2 loc)))) (save-restriction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/gdb-mi.el Sun Mar 28 09:04:11 2010 -0400 @@ -0,0 +1,4192 @@ +;;; gdb-mi.el --- User Interface for running GDB + +;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Nick Roberts <nickrob@gnu.org> +;; Maintainer: FSF +;; Keywords: unix, tools + +;; This file is part of GNU Emacs. + +;; Homepage: http://www.emacswiki.org/emacs/GDB-MI + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Credits: + +;; This file was written by by Nick Roberts following the general design +;; used in gdb-ui.el for Emacs 22.1 - 23.1. It is currently being developed +;; by Dmitry Dzhus <dima@sphinx.net.ru> as part of the Google Summer +;; of Code 2009 Project "Emacs GDB/MI migration". + +;;; 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 fringe/display margin for breakpoints, and +;; the toolbar (see the GDB Graphical Interface section in the Emacs info +;; manual). + +;; M-x gdb will start the debugger. + +;; This file uses GDB/MI as the primary interface to GDB. It is still under +;; development and is part of a process to migrate Emacs from annotations (as +;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and +;; access CLI using "-interpreter-exec console cli-command". This code works +;; without gdb-ui.el and uses MI tokens instead of queues. Eventually MI +;; should be asynchronous. + +;; This mode will PARTLY WORK WITH RECENT GDB RELEASES (status in modeline +;; doesn't update properly when execution commands are issued from GUD buffer) +;; and WORKS BEST when GDB runs asynchronously: maint set linux-async on. +;; +;; You need development version of GDB 7.0 for the thread buffer to work. + +;; This file replaces gdb-ui.el and is for development with GDB. Use the +;; release branch of Emacs 22 for the latest version of gdb-ui.el. + +;; Windows Platforms: + +;; If you are using Emacs and GDB on Windows you will need to flush the buffer +;; explicitly in your program if you want timely display of I/O in Emacs. +;; Alternatively you can make the output stream unbuffered, for example, by +;; using a macro: + +;; #ifdef UNBUFFERED +;; setvbuf (stdout, (char *) NULL, _IONBF, 0); +;; #endif + +;; and compiling with -DUNBUFFERED while debugging. + +;; If you are using Cygwin GDB and find that the source is not being displayed +;; in Emacs when you step through it, possible solutions are to: + +;; 1) Use Cygwin X Windows and Cygwin Emacs. +;; (Since 22.1 Emacs builds under Cygwin.) +;; 2) Use MinGW GDB instead. +;; 3) Use cygwin-mount.el + +;;; Mac OSX: + +;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made +;; some changes to the version that they include as part of Mac OSX. +;; This requires GDB version 7.0 or later (estimated release date Aug 2009) +;; as earlier versions don not compile on Mac OSX. + +;;; Known Bugs: + +;; 1) Stack buffer doesn't parse MI output if you stop in a routine without +;; line information, e.g., a routine in libc (just a TODO item). + +;; TODO: +;; 2) Watch windows to work with threads. +;; 3) Use treebuffer.el instead of the speedbar for watch-expressions? +;; 4) Mark breakpoint locations on scroll-bar of source buffer? + +;;; Code: + +(require 'gud) +(require 'json) +(require 'bindat) +(eval-when-compile (require 'cl)) + +(defvar tool-bar-map) +(defvar speedbar-initial-expansion-list-name) +(defvar speedbar-frame) + +(defvar gdb-memory-address "main") +(defvar gdb-memory-last-address nil + "Last successfully accessed memory address.") +(defvar gdb-memory-next-page nil + "Address of next memory page for program memory buffer.") +(defvar gdb-memory-prev-page nil + "Address of previous memory page for program memory buffer.") + +(defvar gdb-thread-number nil + "Main current thread. + +Invalidation triggers use this variable to query GDB for +information on the specified thread by wrapping GDB/MI commands +in `gdb-current-context-command'. + +This variable may be updated implicitly by GDB via `gdb-stopped' +or explicitly by `gdb-select-thread'. + +Only `gdb-setq-thread-number' should be used to change this +value.") + +(defvar gdb-frame-number nil + "Selected frame level for main current thread. + +Updated according to the following rules: + +When a thread is selected or current thread stops, set to \"0\". + +When current thread goes running (and possibly exits eventually), +set to nil. + +May be manually changed by user with `gdb-select-frame'.") + +(defvar gdb-frame-address nil "Identity of frame for watch expression.") + +;; Used to show overlay arrow in source buffer. All set in +;; gdb-get-main-selected-frame. Disassembly buffer should not use +;; these but rely on buffer-local thread information instead. +(defvar gdb-selected-frame nil + "Name of selected function for main current thread.") +(defvar gdb-selected-file nil + "Name of selected file for main current thread.") +(defvar gdb-selected-line nil + "Number of selected line for main current thread.") + +(defvar gdb-threads-list nil + "Associative list of threads provided by \"-thread-info\" MI command. + +Keys are thread numbers (in strings) and values are structures as +returned from -thread-info by `gdb-json-partial-output'. Updated in +`gdb-thread-list-handler-custom'.") + +(defvar gdb-running-threads-count nil + "Number of currently running threads. + +Nil means that no information is available. + +Updated in `gdb-thread-list-handler-custom'.") + +(defvar gdb-stopped-threads-count nil + "Number of currently stopped threads. + +See also `gdb-running-threads-count'.") + +(defvar gdb-breakpoints-list nil + "Associative list of breakpoints provided by \"-break-list\" MI command. + +Keys are breakpoint numbers (in string) and values are structures +as returned from \"-break-list\" by `gdb-json-partial-output' +\(\"body\" field is used). Updated in +`gdb-breakpoints-list-handler-custom'.") + +(defvar gdb-current-language nil) +(defvar gdb-var-list nil + "List of variables in watch window. +Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP) +where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame +address for root variables.") +(defvar gdb-main-file nil "Source file from which program execution begins.") + +;; Overlay arrow markers +(defvar gdb-stack-position nil) +(defvar gdb-thread-position nil) +(defvar gdb-disassembly-position nil) + +(defvar gdb-location-alist nil + "Alist of breakpoint numbers and full filenames. Only used for files that +Emacs can't find.") +(defvar gdb-active-process nil + "GUD tooltips display variable values when t, and macro definitions otherwise.") +(defvar gdb-error "Non-nil when GDB is reporting an error.") +(defvar gdb-macro-info nil + "Non-nil if GDB knows that the inferior includes preprocessor macro info.") +(defvar gdb-register-names nil "List of register names.") +(defvar gdb-changed-registers nil + "List of changed register numbers (strings).") +(defvar gdb-buffer-fringe-width nil) +(defvar gdb-last-command nil) +(defvar gdb-prompt-name nil) +(defvar gdb-token-number 0) +(defvar gdb-handler-alist '()) +(defvar gdb-handler-number nil) +(defvar gdb-source-file-list nil + "List of source files for the current executable.") +(defvar gdb-first-done-or-error t) +(defvar gdb-source-window nil) +(defvar gdb-inferior-status nil) +(defvar gdb-continuation nil) +(defvar gdb-version nil) +(defvar gdb-filter-output nil + "Message to be shown in GUD console. + +This variable is updated in `gdb-done-or-error' and returned by +`gud-gdbmi-marker-filter'.") + +(defvar gdb-non-stop nil + "Indicates whether current GDB session is using non-stop mode. + +It is initialized to `gdb-non-stop-setting' at the beginning of +every GDB session.") + +(defvar gdb-buffer-type nil + "One of the symbols bound in `gdb-buffer-rules'.") +(make-variable-buffer-local 'gdb-buffer-type) + +(defvar gdb-output-sink 'nil + "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. + + `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.") + +;; Pending triggers prevent congestion: Emacs won't send two similar +;; consecutive requests. + +(defvar gdb-pending-triggers '() + "A list of trigger functions which have not yet been handled. + +Elements are either function names or pairs (buffer . function)") + +(defmacro gdb-add-pending (item) + `(push ,item gdb-pending-triggers)) +(defmacro gdb-pending-p (item) + `(member ,item gdb-pending-triggers)) +(defmacro gdb-delete-pending (item) + `(setq gdb-pending-triggers + (delete ,item gdb-pending-triggers))) + +(defmacro gdb-wait-for-pending (&rest body) + "Wait until `gdb-pending-triggers' is empty and evaluate FORM. + +This function checks `gdb-pending-triggers' value every +`gdb-wait-for-pending' seconds." + (run-with-timer + 0.5 nil + `(lambda () + (if (not gdb-pending-triggers) + (progn ,@body) + (gdb-wait-for-pending ,@body))))) + +;; Publish-subscribe + +(defmacro gdb-add-subscriber (publisher subscriber) + "Register new PUBLISHER's SUBSCRIBER. + +SUBSCRIBER must be a pair, where cdr is a function of one +argument (see `gdb-emit-signal')." + `(add-to-list ',publisher ,subscriber t)) + +(defmacro gdb-delete-subscriber (publisher subscriber) + "Unregister SUBSCRIBER from PUBLISHER." + `(setq ,publisher (delete ,subscriber + ,publisher))) + +(defun gdb-get-subscribers (publisher) + publisher) + +(defun gdb-emit-signal (publisher &optional signal) + "Call cdr for each subscriber of PUBLISHER with SIGNAL as argument." + (dolist (subscriber (gdb-get-subscribers publisher)) + (funcall (cdr subscriber) signal))) + +(defvar gdb-buf-publisher '() + "Used to invalidate GDB buffers by emitting a signal in +`gdb-update'. + +Must be a list of pairs with cars being buffers and cdr's being +valid signal handlers.") + +(defgroup gdb nil + "GDB graphical interface" + :group 'tools + :link '(info-link "(emacs)GDB Graphical Interface") + :version "23.2") + +(defgroup gdb-non-stop nil + "GDB non-stop debugging settings" + :group 'gdb + :version "23.2") + +(defgroup gdb-buffers nil + "GDB buffers" + :group 'gdb + :version "23.2") + +(defcustom gdb-debug-log-max 128 + "Maximum size of `gdb-debug-log'. If nil, size is unlimited." + :group 'gdb + :type '(choice (integer :tag "Number of elements") + (const :tag "Unlimited" nil)) + :version "22.1") + +(defcustom gdb-non-stop-setting t + "When in non-stop mode, stopped threads can be examined while +other threads continue to execute. + +GDB session needs to be restarted for this setting to take +effect." + :type 'boolean + :group 'gdb-non-stop + :version "23.2") + +;; TODO Some commands can't be called with --all (give a notice about +;; it in setting doc) +(defcustom gdb-gud-control-all-threads t + "When enabled, GUD execution commands affect all threads when +in non-stop mode. Otherwise, only current thread is affected." + :type 'boolean + :group 'gdb-non-stop + :version "23.2") + +(defcustom gdb-switch-reasons t + "List of stop reasons which cause Emacs to switch to the thread +which caused the stop. When t, switch to stopped thread no matter +what the reason was. When nil, never switch to stopped thread +automatically. + +This setting is used in non-stop mode only. In all-stop mode, +Emacs always switches to the thread which caused the stop." + ;; exited, exited-normally and exited-signalled are not + ;; thread-specific stop reasons and therefore are not included in + ;; this list + :type '(choice + (const :tag "All reasons" t) + (set :tag "Selection of reasons..." + (const :tag "A breakpoint was reached." "breakpoint-hit") + (const :tag "A watchpoint was triggered." "watchpoint-trigger") + (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger") + (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger") + (const :tag "Function finished execution." "function-finished") + (const :tag "Location reached." "location-reached") + (const :tag "Watchpoint has gone out of scope" "watchpoint-scope") + (const :tag "End of stepping range reached." "end-stepping-range") + (const :tag "Signal received (like interruption)." "signal-received")) + (const :tag "None" nil)) + :group 'gdb-non-stop + :version "23.2" + :link '(info-link "(gdb)GDB/MI Async Records")) + +(defcustom gdb-stopped-hooks nil + "This variable holds a list of functions to be called whenever +GDB stops. + +Each function takes one argument, a parsed MI response, which +contains fields of corresponding MI *stopped async record: + + ((stopped-threads . \"all\") + (thread-id . \"1\") + (frame (line . \"38\") + (fullname . \"/home/sphinx/projects/gsoc/server.c\") + (file . \"server.c\") + (args ((value . \"0x804b038\") + (name . \"arg\"))) + (func . \"hello\") + (addr . \"0x0804869e\")) + (reason . \"end-stepping-range\")) + +Note that \"reason\" is only present in non-stop debugging mode. + +`bindat-get-field' may be used to access the fields of response. + +Each function is called after the new current thread was selected +and GDB buffers were updated in `gdb-stopped'." + :type '(repeat function) + :group 'gdb + :version "23.2" + :link '(info-link "(gdb)GDB/MI Async Records")) + +(defcustom gdb-switch-when-another-stopped t + "When nil, Emacs won't switch to stopped thread if some other +stopped thread is already selected." + :type 'boolean + :group 'gdb-non-stop + :version "23.2") + +(defcustom gdb-stack-buffer-locations t + "Show file information or library names in stack buffers." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-stack-buffer-addresses nil + "Show frame addresses in stack buffers." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-verbose-names t + "Show long thread names in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-arguments t + "Show function arguments in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-locations t + "Show file information or library names in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-thread-buffer-addresses nil + "Show addresses for thread frames in threads buffer." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defcustom gdb-show-threads-by-default nil + "Show threads list buffer instead of breakpoints list by +default." + :type 'boolean + :group 'gdb-buffers + :version "23.2") + +(defvar gdb-debug-log nil + "List of commands sent to and replies received from GDB. +Most recent commands are listed first. This list stores only the last +`gdb-debug-log-max' values. This variable is used to debug GDB-MI.") + +;;;###autoload +(defcustom gdb-enable-debug nil + "Non-nil means record the process input and output in `gdb-debug-log'." + :type 'boolean + :group 'gdb + :version "22.1") + +(defcustom gdb-cpp-define-alist-program "gcc -E -dM -" + "Shell command for generating a list of defined macros in a source file. +This list is used to display the #define directive associated +with an identifier as a tooltip. It works in a debug session with +GDB, when `gud-tooltip-mode' is t. + +Set `gdb-cpp-define-alist-flags' for any include paths or +predefined macros." + :type 'string + :group 'gdb + :version "22.1") + +(defcustom gdb-cpp-define-alist-flags "" + "Preprocessor flags for `gdb-cpp-define-alist-program'." + :type 'string + :group 'gdb + :version "22.1") + + (defcustom gdb-create-source-file-list t + "Non-nil means create a list of files from which the executable was built. + Set this to nil if the GUD buffer displays \"initializing...\" in the mode + line for a long time when starting, possibly because your executable was + built from a large number of files. This allows quicker initialization + but means that these files are not automatically enabled for debugging, + e.g., you won't be able to click in the fringe to set a breakpoint until + execution has already stopped there." + :type 'boolean + :group 'gdb + :version "23.1") + +(defcustom gdb-show-main nil + "Non-nil means display source file containing the main routine at startup. +Also display the main routine in the disassembly buffer if present." + :type 'boolean + :group 'gdb + :version "22.1") + +(defun gdb-force-mode-line-update (status) + (let ((buffer gud-comint-buffer)) + (if (and buffer (buffer-name buffer)) + (with-current-buffer buffer + (setq mode-line-process + (format ":%s [%s]" + (process-status (get-buffer-process buffer)) status)) + ;; Force mode line redisplay soon. + (force-mode-line-update))))) + +(defun gdb-enable-debug (arg) + "Toggle logging of transaction between Emacs and Gdb. +The log is stored in `gdb-debug-log' as an alist with elements +whose cons is send, send-item or recv and whose cdr is the string +being transferred. This list may grow up to a size of +`gdb-debug-log-max' after which the oldest element (at the end of +the list) is deleted every time a new one is added (at the front)." + (interactive "P") + (setq gdb-enable-debug + (if (null arg) + (not gdb-enable-debug) + (> (prefix-numeric-value arg) 0))) + (message (format "Logging of transaction %sabled" + (if gdb-enable-debug "en" "dis")))) + +;; These two are used for menu and toolbar +(defun gdb-control-all-threads () + "Switch to non-stop/A mode." + (interactive) + (setq gdb-gud-control-all-threads t) + ;; Actually forcing the tool-bar to update. + (force-mode-line-update) + (message "Now in non-stop/A mode.")) + +(defun gdb-control-current-thread () + "Switch to non-stop/T mode." + (interactive) + (setq gdb-gud-control-all-threads nil) + ;; Actually forcing the tool-bar to update. + (force-mode-line-update) + (message "Now in non-stop/T mode.")) + +(defun gdb-find-watch-expression () + (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) + (varnum (car var)) expr array) + (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) + (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet + (component-list (split-string (match-string 2 varnum) "\\." t))) + (setq expr (nth 1 var1)) + (setq varnumlet (car var1)) + (dolist (component component-list) + (setq var2 (assoc varnumlet gdb-var-list)) + (setq expr (concat expr + (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2)) + (concat "[" component "]") + (concat "." component)))) + (setq varnumlet (concat varnumlet "." component))) + expr))) + +;; noall is used for commands which don't take --all, but only +;; --thread. +(defun gdb-gud-context-command (command &optional noall) + "When `gdb-non-stop' is t, add --thread option to COMMAND if +`gdb-gud-control-all-threads' is nil and --all option otherwise. +If NOALL is t, always add --thread option no matter what +`gdb-gud-control-all-threads' value is. + +When `gdb-non-stop' is nil, return COMMAND unchanged." + (if gdb-non-stop + (if (and gdb-gud-control-all-threads + (not noall) + (string-equal gdb-version "7.0+")) + (concat command " --all ") + (gdb-current-context-command command)) + command)) + +(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg) + "`gud-call' wrapper which adds --thread/--all options between +CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'. + +NOARG must be t when this macro is used outside `gud-def'" + `(gud-call + (concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2) + ,(when (not noarg) 'arg))) + +;;;###autoload +(defun gdb (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 just +pops up the GUD buffer unless `gdb-show-main' is t. In this case +it starts with two windows: one displaying the GUD buffer and the +other with the source file with the main routine of the inferior. + +If `gdb-many-windows' is t, regardless of the value of +`gdb-show-main', the layout below will appear. Keybindings are +shown in some of the buffers. + +Watch expressions appear in the speedbar/slowbar. + +The following commands help control operation : + +`gdb-many-windows' - Toggle the number of windows gdb uses. +`gdb-restore-windows' - To restore the window layout. + +See Info node `(emacs)GDB Graphical Interface' for a more +detailed description of this mode. + + ++----------------------------------------------------------------------+ +| GDB Toolbar | ++-----------------------------------+----------------------------------+ +| GUD buffer (I/O of GDB) | Locals buffer | +| | | +| | | +| | | ++-----------------------------------+----------------------------------+ +| Source buffer | I/O buffer (of debugged program) | +| | (comint-mode) | +| | | +| | | +| | | +| | | +| | | +| | | ++-----------------------------------+----------------------------------+ +| Stack buffer | Breakpoints buffer | +| RET gdb-select-frame | SPC gdb-toggle-breakpoint | +| | RET gdb-goto-breakpoint | +| | D gdb-delete-breakpoint | ++-----------------------------------+----------------------------------+" + ;; + (interactive (list (gud-query-cmdline 'gdb))) + + (when (and gud-comint-buffer + (buffer-name gud-comint-buffer) + (get-buffer-process gud-comint-buffer) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) + (gdb-restore-windows) + (error + "Multiple debugging requires restarting in text command mode")) + ;; + (gud-common-init command-line nil 'gud-gdbmi-marker-filter) + (set (make-local-variable 'gud-minor-mode) 'gdbmi) + (setq comint-input-sender 'gdb-send) + + (gud-def gud-tbreak "tbreak %f:%l" "\C-t" + "Set temporary breakpoint at current line.") + (gud-def gud-jump + (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) + "\C-j" "Set execution address to current line.") + + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") + (gud-def gud-pstar "print* %e" nil + "Evaluate C dereferenced pointer expression at point.") + + (gud-def gud-step (gdb-gud-context-call "-exec-step" "%p" t) + "\C-s" + "Step one source line with display.") + (gud-def gud-stepi (gdb-gud-context-call "-exec-step-instruction" "%p" t) + "\C-i" + "Step one instruction with display.") + (gud-def gud-next (gdb-gud-context-call "-exec-next" "%p" t) + "\C-n" + "Step one line (skip functions).") + (gud-def gud-nexti (gdb-gud-context-call "-exec-next-instruction" "%p" t) + nil + "Step one instruction (skip functions).") + (gud-def gud-cont (gdb-gud-context-call "-exec-continue") + "\C-r" + "Continue with display.") + (gud-def gud-finish (gdb-gud-context-call "-exec-finish" nil t) + "\C-f" + "Finish executing current function.") + (gud-def gud-run "-exec-run" + nil + "Run the program.") + + (gud-def gud-break (if (not (string-match "Disassembly" mode-name)) + (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-match "Disassembly" mode-name)) + (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.") + + ;; -exec-until doesn't support --all yet + (gud-def gud-until (if (not (string-match "Disassembly" mode-name)) + (gud-call "-exec-until %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "-exec-until *%a" arg))) + "\C-u" "Continue to current line or address.") + ;; TODO Why arg here? + (gud-def + gud-go (gud-call (if gdb-active-process + (gdb-gud-context-command "-exec-continue") + "-exec-run") arg) + nil "Start or continue execution.") + + ;; For debugging Emacs only. + (gud-def gud-pp + (gud-call + (concat + "pp1 " (if (eq (buffer-local-value + 'major-mode (window-buffer)) 'speedbar-mode) + (gdb-find-watch-expression) "%e")) arg) + nil "Print the Emacs s-expression.") + + (define-key gud-minor-mode-map [left-margin mouse-1] + 'gdb-mouse-set-clear-breakpoint) + (define-key gud-minor-mode-map [left-fringe mouse-1] + 'gdb-mouse-set-clear-breakpoint) + (define-key gud-minor-mode-map [left-margin C-mouse-1] + 'gdb-mouse-toggle-breakpoint-margin) + (define-key gud-minor-mode-map [left-fringe C-mouse-1] + 'gdb-mouse-toggle-breakpoint-fringe) + + (define-key gud-minor-mode-map [left-margin drag-mouse-1] + 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-fringe drag-mouse-1] + 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin mouse-3] + 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-fringe mouse-3] + 'gdb-mouse-until) + + (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] + 'gdb-mouse-jump) + (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] + 'gdb-mouse-jump) + (define-key gud-minor-mode-map [left-fringe C-mouse-3] + 'gdb-mouse-jump) + (define-key gud-minor-mode-map [left-margin C-mouse-3] + 'gdb-mouse-jump) + + (local-set-key "\C-i" 'gud-gdb-complete-command) + (setq gdb-first-prompt t) + (setq gud-running nil) + + (gdb-update) + + (run-hooks 'gdb-mode-hook)) + +(defun gdb-init-1 () + ;; (re-)initialise + (setq gdb-selected-frame nil + gdb-frame-number nil + gdb-thread-number nil + gdb-var-list nil + gdb-pending-triggers nil + gdb-output-sink 'user + gdb-location-alist nil + gdb-source-file-list nil + gdb-last-command nil + gdb-token-number 0 + gdb-handler-alist '() + gdb-handler-number nil + gdb-prompt-name nil + gdb-first-done-or-error t + gdb-buffer-fringe-width (car (window-fringes)) + gdb-debug-log nil + gdb-source-window nil + gdb-inferior-status nil + gdb-continuation nil + gdb-buf-publisher '() + gdb-threads-list '() + gdb-breakpoints-list '() + gdb-register-names '() + gdb-non-stop gdb-non-stop-setting) + ;; + (setq gdb-buffer-type 'gdbmi) + ;; + (gdb-force-mode-line-update + (propertize "initializing..." 'face font-lock-variable-name-face)) + + (gdb-get-buffer-create 'gdb-inferior-io) + (gdb-clear-inferior-io) + (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter) + (gdb-input + ;; Needs GDB 6.4 onwards + (list (concat "-inferior-tty-set " + (process-tty-name (get-process "gdb-inferior"))) + 'ignore)) + (if (eq window-system 'w32) + (gdb-input (list "-gdb-set new-console off" 'ignore))) + (gdb-input (list "-gdb-set height 0" 'ignore)) + + (when gdb-non-stop + (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler))) + + ;; find source file and compilation directory here + (gdb-input + ; Needs GDB 6.2 onwards. + (list "-file-list-exec-source-files" 'gdb-get-source-file-list)) + (if gdb-create-source-file-list + (gdb-input + ; Needs GDB 6.0 onwards. + (list "-file-list-exec-source-file" 'gdb-get-source-file))) + (gdb-input + (list "-gdb-show prompt" 'gdb-get-prompt))) + +(defun gdb-non-stop-handler () + (goto-char (point-min)) + (if (re-search-forward "No symbol" nil t) + (progn + (message "This version of GDB doesn't support non-stop mode. Turning it off.") + (setq gdb-non-stop nil) + (setq gdb-version "pre-7.0")) + (setq gdb-version "7.0+") + (gdb-input (list "-gdb-set target-async 1" 'ignore)) + (gdb-input (list "-enable-pretty-printing" 'ignore)))) + +(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") + +(defun gdb-create-define-alist () + "Create an alist of #define directives for GUD tooltips." + (let* ((file (buffer-file-name)) + (output + (with-output-to-string + (with-current-buffer standard-output + (and file + (file-exists-p file) + ;; call-process doesn't work with remote file names. + (not (file-remote-p default-directory)) + (call-process shell-file-name file + (list t nil) nil "-c" + (concat gdb-cpp-define-alist-program " " + gdb-cpp-define-alist-flags)))))) + (define-list (split-string output "\n" t)) + (name)) + (setq gdb-define-alist nil) + (dolist (define define-list) + (setq name (nth 1 (split-string define "[( ]"))) + (push (cons name define) gdb-define-alist)))) + +(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) +(defvar tooltip-use-echo-area) + +(defun gdb-tooltip-print (expr) + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (re-search-forward ".*value=\\(\".*\"\\)" nil t) + (tooltip-show + (concat expr " = " (read (match-string 1))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not (display-graphic-p))))))) + +;; If expr is a macro for a function don't print because of possible dangerous +;; side-effects. Also printing a function within a tooltip generates an +;; unexpected starting annotation (phase error). +(defun gdb-tooltip-print-1 (expr) + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (search-forward "expands to: " nil t) + (unless (looking-at "\\S-+.*(.*).*") + (gdb-input + (list (concat "-data-evaluate-expression " expr) + `(lambda () (gdb-tooltip-print ,expr)))))))) + +(defun gdb-init-buffer () + (set (make-local-variable 'gud-minor-mode) 'gdbmi) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (when gud-tooltip-mode + (make-local-variable 'gdb-define-alist) + (gdb-create-define-alist) + (add-hook 'after-save-hook 'gdb-create-define-alist nil t))) + +(defmacro gdb-if-arrow (arrow-position &rest body) + `(if ,arrow-position + (let ((buffer (marker-buffer ,arrow-position)) (line)) + (if (equal buffer (window-buffer (posn-window end))) + (with-current-buffer buffer + (when (or (equal start end) + (equal (posn-point start) + (marker-position ,arrow-position))) + ,@body)))))) + +(defun gdb-mouse-until (event) + "Continue running until a source line past the current line. +The destination source line can be selected either by clicking +with mouse-3 on the fringe/margin or dragging the arrow +with mouse-1 (default bindings)." + (interactive "e") + (let ((start (event-start event)) + (end (event-end event))) + (gdb-if-arrow gud-overlay-arrow-position + (setq line (line-number-at-pos (posn-point end))) + (gud-call (concat "until " (number-to-string line)))) + (gdb-if-arrow gdb-disassembly-position + (save-excursion + (goto-char (point-min)) + (forward-line (1- (line-number-at-pos (posn-point end)))) + (forward-char 2) + (gud-call (concat "until *%a")))))) + +(defun gdb-mouse-jump (event) + "Set execution address/line. +The destination source line can be selected either by clicking with C-mouse-3 +on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings). +Unlike `gdb-mouse-until' the destination address can be before the current +line, and no execution takes place." + (interactive "e") + (let ((start (event-start event)) + (end (event-end event))) + (gdb-if-arrow gud-overlay-arrow-position + (setq line (line-number-at-pos (posn-point end))) + (progn + (gud-call (concat "tbreak " (number-to-string line))) + (gud-call (concat "jump " (number-to-string line))))) + (gdb-if-arrow gdb-disassembly-position + (save-excursion + (goto-char (point-min)) + (forward-line (1- (line-number-at-pos (posn-point end)))) + (forward-char 2) + (progn + (gud-call (concat "tbreak *%a")) + (gud-call (concat "jump *%a"))))))) + +(defcustom gdb-show-changed-values t + "If non-nil change the face of out of scope variables and changed values. +Out of scope variables are suppressed with `shadow' face. +Changed values are highlighted with the face `font-lock-warning-face'." + :type 'boolean + :group 'gdb + :version "22.1") + +(defcustom gdb-max-children 40 + "Maximum number of children before expansion requires confirmation." + :type 'integer + :group 'gdb + :version "22.1") + +(defcustom gdb-delete-out-of-scope t + "If non-nil delete watch expressions automatically when they go out of scope." + :type 'boolean + :group 'gdb + :version "22.2") + +(defcustom gdb-speedbar-auto-raise nil + "If non-nil raise speedbar every time display of watch expressions is\ + updated." + :type 'boolean + :group 'gdb + :version "22.1") + +(defcustom gdb-use-colon-colon-notation nil + "If non-nil use FUN::VAR format to display variables in the speedbar." + :type 'boolean + :group 'gdb + :version "22.1") + +(defun gdb-speedbar-auto-raise (arg) + "Toggle automatic raising of the speedbar for watch expressions. +With prefix argument ARG, automatically raise speedbar if ARG is +positive, otherwise don't automatically raise it." + (interactive "P") + (setq gdb-speedbar-auto-raise + (if (null arg) + (not gdb-speedbar-auto-raise) + (> (prefix-numeric-value arg) 0))) + (message (format "Auto raising %sabled" + (if gdb-speedbar-auto-raise "en" "dis")))) + +(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) +(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch) + +(declare-function tooltip-identifier-from-point "tooltip" (point)) + +(defun gud-watch (&optional arg event) + "Watch expression at point. +With arg, enter name of variable to be watched in the minibuffer." + (interactive (list current-prefix-arg last-input-event)) + (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer))) + (if (eq minor-mode 'gdbmi) + (progn + (if event (posn-set-point (event-end event))) + (require 'tooltip) + (save-selected-window + (let ((expr + (if arg + (completing-read "Name of variable: " + 'gud-gdb-complete-command) + (if (and transient-mark-mode mark-active) + (buffer-substring (region-beginning) (region-end)) + (concat (if (eq major-mode 'gdb-registers-mode) "$") + (tooltip-identifier-from-point (point))))))) + (set-text-properties 0 (length expr) nil expr) + (gdb-input + (list (concat"-var-create - * " expr "") + `(lambda () (gdb-var-create-handler ,expr))))))) + (message "gud-watch is a no-op in this mode.")))) + +(defun gdb-var-create-handler (expr) + (let* ((result (gdb-json-partial-output))) + (if (not (bindat-get-field result 'msg)) + (let ((var + (list (bindat-get-field result 'name) + (if (and (string-equal gdb-current-language "c") + gdb-use-colon-colon-notation gdb-selected-frame) + (setq expr (concat gdb-selected-frame "::" expr)) + expr) + (bindat-get-field result 'numchild) + (bindat-get-field result 'type) + (bindat-get-field result 'value) + nil + (bindat-get-field result 'has_more) + gdb-frame-address))) + (push var gdb-var-list) + (speedbar 1) + (unless (string-equal + speedbar-initial-expansion-list-name "GUD") + (speedbar-change-initial-expansion-list "GUD"))) + (message-box "No symbol \"%s\" in current context." expr)))) + +(defun gdb-speedbar-update () + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) + (not (gdb-pending-p 'gdb-speedbar-timer))) + ;; Dummy command to update speedbar even when idle. + (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn)) + ;; Keep gdb-pending-triggers non-nil till end. + (gdb-add-pending 'gdb-speedbar-timer))) + +(defun gdb-speedbar-timer-fn () + (if gdb-speedbar-auto-raise + (raise-frame speedbar-frame)) + (gdb-delete-pending 'gdb-speedbar-timer) + (speedbar-timer-fn)) + +(defun gdb-var-evaluate-expression-handler (varnum changed) + (goto-char (point-min)) + (re-search-forward ".*value=\\(\".*\"\\)" nil t) + (let ((var (assoc varnum gdb-var-list))) + (when var + (if changed (setcar (nthcdr 5 var) 'changed)) + (setcar (nthcdr 4 var) (read (match-string 1))))) + (gdb-speedbar-update)) + +; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. +(defun gdb-var-list-children (varnum) + (gdb-input + (list (concat "-var-update " varnum) 'ignore)) + (gdb-input + (list (concat "-var-list-children --all-values " + varnum) + `(lambda () (gdb-var-list-children-handler ,varnum))))) + +(defun gdb-var-list-children-handler (varnum) + (let* ((var-list nil) + (output (bindat-get-field (gdb-json-partial-output "child"))) + (children (bindat-get-field output 'children))) + (catch 'child-already-watched + (dolist (var gdb-var-list) + (if (string-equal varnum (car var)) + (progn + ;; With dynamic varobjs numchild may have increased. + (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) + (push var var-list) + (dolist (child children) + (let ((varchild (list (bindat-get-field child 'name) + (bindat-get-field child 'exp) + (bindat-get-field child 'numchild) + (bindat-get-field child 'type) + (bindat-get-field child 'value) + nil + (bindat-get-field child 'has_more)))) + (if (assoc (car varchild) gdb-var-list) + (throw 'child-already-watched nil)) + (push varchild var-list)))) + (push var var-list))) + (setq gdb-var-list (nreverse var-list)))) + (gdb-speedbar-update)) + +(defun gdb-var-set-format (format) + "Set the output format for a variable displayed in the speedbar." + (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) + (varnum (car var))) + (gdb-input + (list (concat "-var-set-format " varnum " " format) 'ignore)) + (gdb-var-update))) + +(defun gdb-var-delete-1 (var varnum) + (gdb-input + (list (concat "-var-delete " varnum) 'ignore)) + (setq gdb-var-list (delq var gdb-var-list)) + (dolist (varchild gdb-var-list) + (if (string-match (concat (car var) "\\.") (car varchild)) + (setq gdb-var-list (delq varchild gdb-var-list))))) + +(defun gdb-var-delete () + "Delete watch expression at point from the speedbar." + (interactive) + (let ((text (speedbar-line-text))) + (string-match "\\(\\S-+\\)" text) + (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) + (varnum (car var))) + (if (string-match "\\." (car var)) + (message-box "Can only delete a root expression") + (gdb-var-delete-1 var varnum))))) + +(defun gdb-var-delete-children (varnum) + "Delete children of variable object at point from the speedbar." + (gdb-input + (list (concat "-var-delete -c " varnum) 'ignore))) + +(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 (car var)) (value)) + (setq value (read-string "New value: ")) + (gdb-input + (list (concat "-var-assign " varnum " " value) + `(lambda () (gdb-edit-value-handler ,value)))))) + +(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)") + +(defun gdb-edit-value-handler (value) + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (message-box "Invalid number or expression (%s)" value))) + +; Uses "-var-update --all-values". Needs GDB 6.4 onwards. +(defun gdb-var-update () + (if (not (gdb-pending-p 'gdb-var-update)) + (gdb-input + (list "-var-update --all-values *" 'gdb-var-update-handler))) + (gdb-add-pending 'gdb-var-update)) + +(defun gdb-var-update-handler () + (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)) + (let ((temp-var-list gdb-var-list)) + (dolist (change changelist) + (let* ((varnum (bindat-get-field change 'name)) + (var (assoc varnum gdb-var-list)) + (new-num (bindat-get-field change 'new_num_children))) + (when var + (let ((scope (bindat-get-field change 'in_scope)) + (has-more (bindat-get-field change 'has_more))) + (cond ((string-equal scope "false") + (if gdb-delete-out-of-scope + (gdb-var-delete-1 var varnum) + (setcar (nthcdr 5 var) 'out-of-scope))) + ((string-equal scope "true") + (setcar (nthcdr 6 var) has-more) + (when (and (or (not has-more) + (string-equal has-more "0")) + (not new-num) + (string-equal (nth 2 var) "0")) + (setcar (nthcdr 4 var) + (bindat-get-field change 'value)) + (setcar (nthcdr 5 var) 'changed))) + ((string-equal scope "invalid") + (gdb-var-delete-1 var varnum))))) + (let ((var-list nil) var1 + (children (bindat-get-field change 'new_children))) + (if new-num + (progn + (setq var1 (pop temp-var-list)) + (while var1 + (if (string-equal varnum (car var1)) + (let ((new (string-to-number new-num)) + (previous (string-to-number (nth 2 var1)))) + (setcar (nthcdr 2 var1) new-num) + (push var1 var-list) + (cond ((> new previous) + ;; Add new children to list. + (dotimes (dummy previous) + (push (pop temp-var-list) var-list)) + (dolist (child children) + (let ((varchild + (list (bindat-get-field child 'name) + (bindat-get-field child 'exp) + (bindat-get-field child 'numchild) + (bindat-get-field child 'type) + (bindat-get-field child 'value) + 'changed + (bindat-get-field child 'has_more)))) + (push varchild var-list)))) + ;; Remove deleted children from list. + ((< new previous) + (dotimes (dummy new) + (push (pop temp-var-list) var-list)) + (dotimes (dummy (- previous new)) + (pop temp-var-list))))) + (push var1 var-list)) + (setq var1 (pop temp-var-list))) + (setq gdb-var-list (nreverse var-list))))))))) + (setq gdb-pending-triggers + (delq 'gdb-var-update gdb-pending-triggers)) + (gdb-speedbar-update)) + +(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 + (let* ((var (assoc token gdb-var-list)) + (expr (nth 1 var)) (children (nth 2 var))) + (if (or (<= (string-to-number children) gdb-max-children) + (y-or-n-p + (format "%s has %s children. Continue? " expr children))) + (gdb-var-list-children token)))) + ((string-match "-" text) ;contract this node + (dolist (var gdb-var-list) + (if (string-match (concat token "\\.") (car var)) + (setq gdb-var-list (delq var gdb-var-list)))) + (gdb-var-delete-children token) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + +(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 `gdbmi' and +;; is constructed specially. +;; +;; Others are constructed by gdb-get-buffer-create and +;; named according to the rules set forth in the gdb-buffer-rules + +(defvar gdb-buffer-rules '()) + +(defun gdb-rules-name-maker (rules-entry) + (cadr rules-entry)) +(defun gdb-rules-buffer-mode (rules-entry) + (nth 2 rules-entry)) +(defun gdb-rules-update-trigger (rules-entry) + (nth 3 rules-entry)) + +(defun gdb-update-buffer-name () + "Rename current buffer according to name-maker associated with +it in `gdb-buffer-rules'." + (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type + gdb-buffer-rules)))) + (when f (rename-buffer (funcall f))))) + +(defun gdb-current-buffer-rules () + "Get `gdb-buffer-rules' entry for current buffer type." + (assoc gdb-buffer-type gdb-buffer-rules)) + +(defun gdb-current-buffer-thread () + "Get thread object of current buffer from `gdb-threads-list'. + +When current buffer is not bound to any thread, return main +thread." + (cdr (assoc gdb-thread-number gdb-threads-list))) + +(defun gdb-current-buffer-frame () + "Get current stack frame object for thread of current buffer." + (bindat-get-field (gdb-current-buffer-thread) 'frame)) + +(defun gdb-buffer-type (buffer) + "Get value of `gdb-buffer-type' for BUFFER." + (with-current-buffer buffer + gdb-buffer-type)) + +(defun gdb-buffer-shows-main-thread-p () + "Return t if current GDB buffer shows main selected thread and +is not bound to it." + (current-buffer) + (not (local-variable-p 'gdb-thread-number))) + +(defun gdb-get-buffer (buffer-type &optional thread) + "Get a specific GDB buffer. + +In that buffer, `gdb-buffer-type' must be equal to BUFFER-TYPE +and `gdb-thread-number' (if provided) must be equal to THREAD." + (catch 'found + (dolist (buffer (buffer-list) nil) + (with-current-buffer buffer + (when (and (eq gdb-buffer-type buffer-type) + (or (not thread) + (equal gdb-thread-number thread))) + (throw 'found buffer)))))) + +(defun gdb-get-buffer-create (buffer-type &optional thread) + "Create a new GDB buffer of the type specified by BUFFER-TYPE. +The buffer-type should be one of the cars in `gdb-buffer-rules'. + +If THREAD is non-nil, it is assigned to `gdb-thread-number' +buffer-local variable of the new buffer. + +Buffer mode and name are selected according to buffer type. + +If buffer has trigger associated with it in `gdb-buffer-rules', +this trigger is subscribed to `gdb-buf-publisher' and called with +'update argument." + (or (gdb-get-buffer buffer-type thread) + (let ((rules (assoc buffer-type gdb-buffer-rules)) + (new (generate-new-buffer "limbo"))) + (with-current-buffer new + (let ((mode (gdb-rules-buffer-mode rules)) + (trigger (gdb-rules-update-trigger rules))) + (when mode (funcall mode)) + (setq gdb-buffer-type buffer-type) + (when thread + (set (make-local-variable 'gdb-thread-number) thread)) + (set (make-local-variable 'gud-minor-mode) + (buffer-local-value 'gud-minor-mode gud-comint-buffer)) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (rename-buffer (funcall (gdb-rules-name-maker rules))) + (when trigger + (gdb-add-subscriber gdb-buf-publisher + (cons (current-buffer) + (gdb-bind-function-to-buffer trigger (current-buffer)))) + (funcall trigger 'start)) + (current-buffer)))))) + +(defun gdb-bind-function-to-buffer (expr buffer) + "Return a function which will evaluate EXPR in BUFFER." + `(lambda (&rest args) + (with-current-buffer ,buffer + (apply ',expr args)))) + +;; Used to define all gdb-frame-*-buffer functions except +;; `gdb-frame-io-buffer' +(defmacro def-gdb-frame-for-buffer (name buffer &optional doc) + "Define a function NAME which shows gdb BUFFER in a separate frame. + +DOC is an optional documentation string." + `(defun ,name (&optional thread) + ,(when doc doc) + (interactive) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-buffer-create ,buffer thread))))) + +(defmacro def-gdb-display-buffer (name buffer &optional doc) + "Define a function NAME which shows gdb BUFFER. + +DOC is an optional documentation string." + `(defun ,name (&optional thread) + ,(when doc doc) + (interactive) + (gdb-display-buffer + (gdb-get-buffer-create ,buffer thread) t))) + +;; Used to display windows with thread-bound buffers +(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc + split-horizontal) + `(defun ,name (&optional thread) + ,(when doc doc) + (message thread) + (gdb-preempt-existing-or-display-buffer + (gdb-get-buffer-create ,buffer thread) + ,split-horizontal))) + +;; 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))) + (if binding + (setcdr binding rules) + (push (cons buffer-type rules) + gdb-buffer-rules)))) + +(defun gdb-parent-mode () + "Generic mode to derive all other GDB buffer modes from." + (kill-all-local-variables) + (setq buffer-read-only t) + (buffer-disable-undo) + ;; Delete buffer from gdb-buf-publisher when it's killed + ;; (if it has an associated update trigger) + (add-hook + 'kill-buffer-hook + (function + (lambda () + (let ((trigger (gdb-rules-update-trigger + (gdb-current-buffer-rules)))) + (when trigger + (gdb-delete-subscriber + gdb-buf-publisher + ;; This should match gdb-add-subscriber done in + ;; gdb-get-buffer-create + (cons (current-buffer) + (gdb-bind-function-to-buffer trigger (current-buffer)))))))) + nil t)) + +;; 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) + "*")) + +(defun gdb-display-io-buffer () + "Display IO of debugged program in a separate window." + (interactive) + (gdb-display-buffer + (gdb-get-buffer-create 'gdb-inferior-io) t)) + +(defconst gdb-frame-parameters + '((height . 14) (width . 80) + (unsplittable . t) + (tool-bar-lines . nil) + (menu-bar-lines . nil) + (minibuffer . nil))) + +(defun gdb-frame-io-buffer () + "Display IO of debugged program in a new frame." + (interactive) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters)) + (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))) + +(defvar gdb-inferior-io-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'gdb-io-interrupt) + (define-key map "\C-c\C-z" 'gdb-io-stop) + (define-key map "\C-c\C-\\" 'gdb-io-quit) + (define-key map "\C-c\C-d" 'gdb-io-eof) + (define-key map "\C-d" 'gdb-io-eof) + map)) + +;; We want to use comint because it has various nifty and familiar features. +(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" + "Major mode for gdb inferior-io. + +The following commands are available: +\\{gdb-inferior-io-mode-map}" + + :syntax-table nil :abbrev-table nil + +(make-comint-in-buffer "gdb-inferior" (current-buffer) nil)) + +(defun gdb-inferior-filter (proc string) + (unless (string-equal string "") + (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)) + (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) + (comint-output-filter proc string))) + +(defun gdb-io-interrupt () + "Interrupt the program being debugged." + (interactive) + (interrupt-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-io-quit () + "Send quit signal to the program being debugged." + (interactive) + (quit-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-io-stop () + "Stop the program being debugged." + (interactive) + (stop-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-io-eof () + "Send end-of-file to the program being debugged." + (interactive) + (process-send-eof + (get-buffer-process gud-comint-buffer))) + +(defun gdb-clear-inferior-io () + (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) + (erase-buffer))) + + +(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.") + +(declare-function define-fringe-bitmap "fringe.c" + (bitmap bits &optional height width align)) + +(and (display-images-p) + ;; Bitmap for breakpoint in fringe + (define-fringe-bitmap 'breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") + ;; Bitmap for gud-overlay-arrow in fringe + (define-fringe-bitmap 'hollow-right-triangle + "\xe0\x90\x88\x84\x84\x88\x90\xe0")) + +(defface breakpoint-enabled + '((t + :foreground "red1" + :weight bold)) + "Face for enabled breakpoint icon in fringe." + :group 'gdb) + +(defface breakpoint-disabled + '((((class color) (min-colors 88)) :foreground "grey70") + ;; Ensure that on low-color displays that we end up something visible. + (((class color) (min-colors 8) (background light)) + :foreground "black") + (((class color) (min-colors 8) (background dark)) + :foreground "white") + (((type tty) (class mono)) + :inverse-video t) + (t :background "gray")) + "Face for disabled breakpoint icon in fringe." + :group 'gdb) + + +(defun gdb-send (proc string) + "A comint send filter for gdb." + (with-current-buffer gud-comint-buffer + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(face)))) + ;; mimic <RET> key to repeat previous command in GDB + (if (not (string= "" string)) + (setq gdb-last-command string) + (if gdb-last-command (setq string gdb-last-command))) + (if gdb-enable-debug + (push (cons 'mi-send (concat string "\n")) gdb-debug-log)) + (if (string-match "^-" string) + ;; MI command + (progn + (setq gdb-first-done-or-error t) + (process-send-string proc (concat string "\n"))) + ;; CLI command + (if (string-match "\\\\$" string) + (setq gdb-continuation (concat gdb-continuation string "\n")) + (setq gdb-first-done-or-error t) + (process-send-string proc (concat "-interpreter-exec console \"" + gdb-continuation string "\"\n")) + (setq gdb-continuation nil)))) + +(defun gdb-input (item) + (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log)) + (setq gdb-token-number (1+ gdb-token-number)) + (setcar item (concat (number-to-string gdb-token-number) (car item))) + (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist) + (process-send-string (get-buffer-process gud-comint-buffer) + (concat (car item) "\n"))) + +;; NOFRAME is used for gud execution control commands +(defun gdb-current-context-command (command) + "Add --thread to gdb COMMAND when needed." + (if (and gdb-thread-number + (string-equal gdb-version "7.0+")) + (concat command " --thread " gdb-thread-number) + command)) + +(defun gdb-current-context-buffer-name (name) + "Add thread information and asterisks to string NAME. + +If `gdb-thread-number' is nil, just wrap NAME in asterisks." + (concat "*" name + (if (local-variable-p 'gdb-thread-number) + (format " (bound to thread %s)" gdb-thread-number) + "") + "*")) + +(defun gdb-current-context-mode-name (mode) + "Add thread information to MODE which is to be used as +`mode-name'." + (concat mode + (if gdb-thread-number + (format " [thread %s]" gdb-thread-number) + ""))) + + +(defcustom gud-gdb-command-name "gdb -i=mi" + "Default command to execute an executable under the GDB debugger." + :type 'string + :group 'gdb) + +(defun gdb-resync() + (setq gud-running nil) + (setq gdb-output-sink 'user) + (setq gdb-pending-triggers nil)) + +(defun gdb-update () + "Update buffers showing status of debug session." + (when gdb-first-prompt + (gdb-force-mode-line-update + (propertize "initializing..." 'face font-lock-variable-name-face)) + (gdb-init-1) + (setq gdb-first-prompt nil)) + + (gdb-get-main-selected-frame) + ;; We may need to update gdb-threads-list so we can use + (gdb-get-buffer-create 'gdb-threads-buffer) + ;; gdb-break-list is maintained in breakpoints handler + (gdb-get-buffer-create 'gdb-breakpoints-buffer) + + (gdb-emit-signal gdb-buf-publisher 'update) + + (gdb-get-changed-registers) + + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)) + (gdb-var-update))) + +;; gdb-setq-thread-number and gdb-update-gud-running are decoupled +;; because we may need to update current gud-running value without +;; changing current thread (see gdb-running) +(defun gdb-setq-thread-number (number) + "Only this function must be used to change `gdb-thread-number' +value to NUMBER, because `gud-running' and `gdb-frame-number' +need to be updated appropriately when current thread changes." + ;; GDB 6.8 and earlier always output thread-id="0" when stopping. + (unless (string-equal number "0") (setq gdb-thread-number number)) + (setq gdb-frame-number "0") + (gdb-update-gud-running)) + +(defun gdb-update-gud-running () + "Set `gud-running' according to the state of current thread. + +`gdb-frame-number' is set to 0 if current thread is now stopped. + +Note that when `gdb-gud-control-all-threads' is t, `gud-running' +cannot be reliably used to determine whether or not execution +control buttons should be shown in menu or toolbar. Use +`gdb-running-threads-count' and `gdb-stopped-threads-count' +instead. + +For all-stop mode, thread information is unavailable while target +is running." + (let ((old-value gud-running)) + (setq gud-running + (string= (bindat-get-field (gdb-current-buffer-thread) 'state) + "running")) + ;; Set frame number to "0" when _current_ threads stops + (when (and (gdb-current-buffer-thread) + (not (eq gud-running old-value))) + (setq gdb-frame-number "0")))) + +(defun gdb-show-run-p () + "Return t if \"Run/continue\" should be shown on the toolbar." + (or (not gdb-active-process) + (and (or + (not gdb-gud-control-all-threads) + (not gdb-non-stop)) + (not gud-running)) + (and gdb-gud-control-all-threads + (> gdb-stopped-threads-count 0)))) + +(defun gdb-show-stop-p () + "Return t if \"Stop\" should be shown on the toolbar." + (or (and (or + (not gdb-gud-control-all-threads) + (not gdb-non-stop)) + gud-running) + (and gdb-gud-control-all-threads + (> gdb-running-threads-count 0)))) + +;; GUD displays the selected GDB frame. This might might not be the current +;; GDB frame (after up, down etc). If no GDB frame is visible but the last +;; visited breakpoint is, use that window. +(defun gdb-display-source-buffer (buffer) + (let* ((last-window (if gud-last-last-frame + (get-buffer-window + (gud-find-file (car gud-last-last-frame))))) + (source-window (or last-window + (if (and gdb-source-window + (window-live-p gdb-source-window)) + gdb-source-window)))) + (when source-window + (setq gdb-source-window source-window) + (set-window-buffer source-window buffer)) + source-window)) + +(defun gdb-car< (a b) + (< (car a) (car b))) + +(defvar gdbmi-record-list + '((gdb-gdb . "(gdb) \n") + (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n") + (gdb-starting . "\\([0-9]*\\)\\^running\n") + (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n") + (gdb-console . "~\\(\".*?\"\\)\n") + (gdb-internals . "&\\(\".*?\"\\)\n") + (gdb-stopped . "\\*stopped,?\\(.*?\\)\n") + (gdb-running . "\\*running,\\(.*?\n\\)") + (gdb-thread-created . "=thread-created,\\(.*?\n\\)") + (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n") + (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)") + (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n") + (gdb-shell . "\\(\\(?:^.+\n\\)+\\)"))) + +(defun gud-gdbmi-marker-filter (string) + "Filter GDB/MI output." + + ;; Record transactions if logging is enabled. + (when gdb-enable-debug + (push (cons 'recv string) gdb-debug-log) + (if (and gdb-debug-log-max + (> (length gdb-debug-log) gdb-debug-log-max)) + (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) + + ;; 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 + (setq gdb-filter-output "") + (let ((output-record) (output-record-list)) + + ;; Process all the complete markers in this chunk. + (dolist (gdbmi-record gdbmi-record-list) + (while (string-match (cdr gdbmi-record) gud-marker-acc) + (push (list (match-beginning 0) + (car gdbmi-record) + (match-string 1 gud-marker-acc) + (match-string 2 gud-marker-acc) + (match-end 0)) + output-record-list) + (setq gud-marker-acc + (concat (substring gud-marker-acc 0 (match-beginning 0)) + ;; Pad with spaces to preserve position. + (make-string (length (match-string 0 gud-marker-acc)) 32) + (substring gud-marker-acc (match-end 0)))))) + + (setq output-record-list (sort output-record-list 'gdb-car<)) + + (dolist (output-record output-record-list) + (let ((record-type (cadr output-record)) + (arg1 (nth 2 output-record)) + (arg2 (nth 3 output-record))) + (if (eq record-type 'gdb-error) + (gdb-done-or-error arg2 arg1 'error) + (if (eq record-type 'gdb-done) + (gdb-done-or-error arg2 arg1 'done) + ;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI + ;; error message on internal stream. Don't print to GUD buffer. + (unless (and (eq record-type 'gdb-internals) + (string-equal (read arg1) "No registers.\n")) + (funcall record-type arg1)))))) + + (setq gdb-output-sink 'user) + ;; Remove padding. + (string-match "^ *" gud-marker-acc) + (setq gud-marker-acc (substring gud-marker-acc (match-end 0))) + + gdb-filter-output)) + +(defun gdb-gdb (output-field)) + +(defun gdb-shell (output-field) + (let ((gdb-output-sink gdb-output-sink)) + (setq gdb-filter-output + (concat output-field gdb-filter-output)))) + +(defun gdb-ignored-notification (output-field)) + +;; gdb-invalidate-threads is defined to accept 'update-threads signal +(defun gdb-thread-created (output-field)) +(defun gdb-thread-exited (output-field) + "Handle =thread-exited async record: unset `gdb-thread-number' + if current thread exited and update threads list." + (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) + (if (string= gdb-thread-number thread-id) + (gdb-setq-thread-number nil)) + ;; When we continue current thread and it quickly exits, + ;; gdb-pending-triggers left after gdb-running disallow us to + ;; properly call -thread-info without --thread option. Thus we + ;; need to use gdb-wait-for-pending. + (gdb-wait-for-pending + (gdb-emit-signal gdb-buf-publisher 'update-threads)))) + +(defun gdb-thread-selected (output-field) + "Handler for =thread-selected MI output record. + +Sets `gdb-thread-number' to new id." + (let* ((result (gdb-json-string output-field)) + (thread-id (bindat-get-field result 'id))) + (gdb-setq-thread-number thread-id) + ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed + ;; by `=thread-selected` notification. `^done` causes `gdb-update` + ;; as usually. Things happen to fast and second call (from + ;; gdb-thread-selected handler) gets cut off by our beloved + ;; gdb-pending-triggers. + ;; Solution is `gdb-wait-for-pending` macro: it guarantees that its + ;; body will get executed when `gdb-pending-triggers` is empty. + (gdb-wait-for-pending + (gdb-update)))) + +(defun gdb-running (output-field) + (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id))) + ;; We reset gdb-frame-number to nil if current thread has gone + ;; running. This can't be done in gdb-thread-list-handler-custom + ;; because we need correct gdb-frame-number by the time + ;; -thread-info command is sent. + (when (or (string-equal thread-id "all") + (string-equal thread-id gdb-thread-number)) + (setq gdb-frame-number nil))) + (setq gdb-inferior-status "running") + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-type-face)) + (when (not gdb-non-stop) + (setq gud-running t)) + (setq gdb-active-process t) + (gdb-emit-signal gdb-buf-publisher 'update-threads)) + +(defun gdb-starting (output-field) + ;; CLI commands don't emit ^running at the moment so use gdb-running too. + (setq gdb-inferior-status "running") + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-type-face)) + (setq gdb-active-process t) + (setq gud-running t) + ;; GDB doesn't seem to respond to -thread-info before first stop or + ;; thread exit (even in non-stop mode), so this is useless. + ;; Behaviour may change in the future. + (gdb-emit-signal gdb-buf-publisher 'update-threads)) + +;; -break-insert -t didn't give a reason before gdb 6.9 + +(defun gdb-stopped (output-field) + "Given the contents of *stopped MI async record, select new +current thread and update GDB buffers." + ;; Reason is available with target-async only + (let* ((result (gdb-json-string output-field)) + (reason (bindat-get-field result 'reason)) + (thread-id (bindat-get-field result 'thread-id))) + + ;; -data-list-register-names needs to be issued for any stopped + ;; thread + (when (not gdb-register-names) + (gdb-input + (list (concat "-data-list-register-names" + (if (string-equal gdb-version "7.0+") + (concat" --thread " thread-id))) + 'gdb-register-names-handler))) + +;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler +;;; because synchronous GDB doesn't give these fields with CLI. +;;; (when file +;;; (setq +;;; ;; Extract the frame position from the marker. +;;; gud-last-frame (cons file +;;; (string-to-number +;;; (match-string 6 gud-marker-acc))))) + + (setq gdb-inferior-status (or reason "unknown")) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face)) + (if (string-equal reason "exited-normally") + (setq gdb-active-process nil)) + + ;; Select new current thread. + + ;; Don't switch if we have no reasons selected + (when gdb-switch-reasons + ;; Switch from another stopped thread only if we have + ;; gdb-switch-when-another-stopped: + (when (or gdb-switch-when-another-stopped + (not (string= "stopped" + (bindat-get-field (gdb-current-buffer-thread) 'state)))) + ;; Switch if current reason has been selected or we have no + ;; reasons + (if (or (eq gdb-switch-reasons t) + (member reason gdb-switch-reasons)) + (when (not (string-equal gdb-thread-number thread-id)) + (message (concat "Switched to thread " thread-id)) + (gdb-setq-thread-number thread-id)) + (message (format "Thread %s stopped" thread-id))))) + + ;; Print "(gdb)" to GUD console + (when gdb-first-done-or-error + (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) + + ;; In non-stop, we update information as soon as another thread gets + ;; stopped + (when (or gdb-first-done-or-error + gdb-non-stop) + ;; In all-stop this updates gud-running properly as well. + (gdb-update) + (setq gdb-first-done-or-error nil)) + (run-hook-with-args 'gdb-stopped-hooks result))) + +;; Remove the trimmings from log stream containing debugging messages +;; being produced by GDB's internals, use warning face and send to GUD +;; buffer. +(defun gdb-internals (output-field) + (setq gdb-filter-output + (gdb-concat-output + gdb-filter-output + (let ((error-message + (read output-field))) + (put-text-property + 0 (length error-message) + 'face font-lock-warning-face + error-message) + error-message)))) + +;; Remove the trimmings from the console stream and send to GUD buffer +;; (frontend MI commands should not print to this stream) +(defun gdb-console (output-field) + (setq gdb-filter-output + (gdb-concat-output + gdb-filter-output + (read output-field)))) + +(defun gdb-done-or-error (output-field token-number type) + (if (string-equal token-number "") + ;; Output from command entered by user + (progn + (setq gdb-output-sink 'user) + (setq token-number nil) + ;; MI error - send to minibuffer + (when (eq type 'error) + ;; Skip "msg=" from `output-field' + (message (read (substring output-field 4))) + ;; Don't send to the console twice. (If it is a console error + ;; it is also in the console stream.) + (setq output-field nil))) + ;; Output from command from frontend. + (setq gdb-output-sink 'emacs)) + + (gdb-clear-partial-output) + (when gdb-first-done-or-error + (unless (or token-number gud-running) + (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) + (gdb-update) + (setq gdb-first-done-or-error nil)) + + (setq gdb-filter-output + (gdb-concat-output gdb-filter-output output-field)) + + (if token-number + (progn + (with-current-buffer + (gdb-get-buffer-create 'gdb-partial-output-buffer) + (funcall + (cdr (assoc (string-to-number token-number) gdb-handler-alist)))) + (setq gdb-handler-alist + (assq-delete-all token-number gdb-handler-alist))))) + +(defun gdb-concat-output (so-far new) + (let ((sink gdb-output-sink)) + (cond + ((eq sink 'user) (concat so-far new)) + ((eq sink 'emacs) + (gdb-append-to-partial-output new) + so-far)))) + +(defun gdb-append-to-partial-output (string) + (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert string))) + +(defun gdb-clear-partial-output () + (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) + (erase-buffer))) + +(defun gdb-jsonify-buffer (&optional fix-key fix-list) + "Prepare GDB/MI output in current buffer for parsing with `json-read'. + +Field names are wrapped in double quotes and equal signs are +replaced with semicolons. + +If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from +partial output. This is used to get rid of useless keys in lists +in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and +-break-info are examples of MI commands which issue such +responses. + +If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with +\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken +-break-info output when it contains breakpoint script field +incompatible with GDB/MI output syntax." + (save-excursion + (goto-char (point-min)) + (when fix-key + (save-excursion + (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) + (replace-match "" nil nil nil 1)))) + (when fix-list + (save-excursion + ;; Find positions of braces which enclose broken list + (while (re-search-forward (concat fix-list "={\"") nil t) + (let ((p1 (goto-char (- (point) 2))) + (p2 (progn (forward-sexp) + (1- (point))))) + ;; Replace braces with brackets + (save-excursion + (goto-char p1) + (delete-char 1) + (insert "[") + (goto-char p2) + (delete-char 1) + (insert "]")))))) + (goto-char (point-min)) + (insert "{") + (while (re-search-forward + "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t) + (replace-match "\"\\1\":\\2" nil nil)) + (goto-char (point-max)) + (insert "}"))) + +(defun gdb-json-read-buffer (&optional fix-key fix-list) + "Prepare and parse GDB/MI output in current buffer with `json-read'. + +FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." + (gdb-jsonify-buffer fix-key fix-list) + (save-excursion + (goto-char (point-min)) + (let ((json-array-type 'list)) + (json-read)))) + +(defun gdb-json-string (string &optional fix-key fix-list) + "Prepare and parse STRING containing GDB/MI output with `json-read'. + +FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." + (with-temp-buffer + (insert string) + (gdb-json-read-buffer fix-key fix-list))) + +(defun gdb-json-partial-output (&optional fix-key fix-list) + "Prepare and parse gdb-partial-output-buffer with `json-read'. + +FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." + (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) + (gdb-json-read-buffer fix-key fix-list))) + +(defun gdb-line-posns (line) + "Return a pair of LINE beginning and end positions." + (let ((offset (1+ (- line (line-number-at-pos))))) + (cons + (line-beginning-position offset) + (line-end-position offset)))) + +(defmacro gdb-mark-line (line variable) + "Set VARIABLE marker to point at beginning of LINE. + +If current window has no fringes, inverse colors on LINE. + +Return position where LINE begins." + `(save-excursion + (let* ((posns (gdb-line-posns ,line)) + (start-posn (car posns)) + (end-posn (cdr posns))) + (set-marker ,variable (copy-marker start-posn)) + (when (not (> (car (window-fringes)) 0)) + (put-text-property start-posn end-posn + 'font-lock-face '(:inverse-video t))) + start-posn))) + +(defun gdb-pad-string (string padding) + (format (concat "%" (number-to-string padding) "s") string)) + +;; gdb-table struct is a way to programmatically construct simple +;; tables. It help to reliably align columns of data in GDB buffers +;; and provides +(defstruct + gdb-table + (column-sizes nil) + (rows nil) + (row-properties nil) + (right-align nil)) + +(defun gdb-mapcar* (function &rest seqs) + "Apply FUNCTION to each element of SEQS, and make a list of the results. +If there are several SEQS, FUNCTION is called with that many +arugments, and mapping stops as sson as the shortest list runs +out." + (let ((shortest (apply #'min (mapcar #'length seqs)))) + (mapcar (lambda (i) + (apply function + (mapcar + (lambda (seq) + (nth i seq)) + seqs))) + (number-sequence 0 (1- shortest))))) + +(defun gdb-table-add-row (table row &optional properties) + "Add ROW of string to TABLE and recalculate column sizes. + +When non-nil, PROPERTIES will be added to the whole row when +calling `gdb-table-string'." + (let ((rows (gdb-table-rows table)) + (row-properties (gdb-table-row-properties table)) + (column-sizes (gdb-table-column-sizes table)) + (right-align (gdb-table-right-align table))) + (when (not column-sizes) + (setf (gdb-table-column-sizes table) + (make-list (length row) 0))) + (setf (gdb-table-rows table) + (append rows (list row))) + (setf (gdb-table-row-properties table) + (append row-properties (list properties))) + (setf (gdb-table-column-sizes table) + (gdb-mapcar* (lambda (x s) + (let ((new-x + (max (abs x) (string-width (or s ""))))) + (if right-align new-x (- new-x)))) + (gdb-table-column-sizes table) + row)) + ;; Avoid trailing whitespace at eol + (if (not (gdb-table-right-align table)) + (setcar (last (gdb-table-column-sizes table)) 0)))) + +(defun gdb-table-string (table &optional sep) + "Return TABLE as a string with columns separated with SEP." + (let ((column-sizes (gdb-table-column-sizes table)) + (res "")) + (mapconcat + 'identity + (gdb-mapcar* + (lambda (row properties) + (apply 'propertize + (mapconcat 'identity + (gdb-mapcar* (lambda (s x) (gdb-pad-string s x)) + row column-sizes) + sep) + properties)) + (gdb-table-rows table) + (gdb-table-row-properties table)) + "\n"))) + +;; bindat-get-field goes deep, gdb-get-many-fields goes wide +(defun gdb-get-many-fields (struct &rest fields) + "Return a list of FIELDS values from STRUCT." + (let ((values)) + (dolist (field fields values) + (setq values (append values (list (bindat-get-field struct field))))))) + +(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command + handler-name + &optional signal-list) + "Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets +HANDLER-NAME as its handler. HANDLER-NAME is bound to current +buffer with `gdb-bind-function-to-buffer'. + +If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the +defined trigger is called with an argument from SIGNAL-LIST. It's +not recommended to define triggers with empty SIGNAL-LIST. +Normally triggers should respond at least to 'update signal. + +Normally the trigger defined by this command must be called from +the buffer where HANDLER-NAME must work. This should be done so +that buffer-local thread number may be used in GDB-COMMAND (by +calling `gdb-current-context-command'). +`gdb-bind-function-to-buffer' is used to achieve this, see +`gdb-get-buffer-create'. + +Triggers defined by this command are meant to be used as a +trigger argument when describing buffer types with +`gdb-set-buffer-rules'." + `(defun ,trigger-name (&optional signal) + (when + (or (not ,signal-list) + (memq signal ,signal-list)) + (when (not (gdb-pending-p + (cons (current-buffer) ',trigger-name))) + (gdb-input + (list ,gdb-command + (gdb-bind-function-to-buffer ',handler-name (current-buffer)))) + (gdb-add-pending (cons (current-buffer) ',trigger-name)))))) + +;; Used by disassembly buffer only, the rest use +;; def-gdb-trigger-and-handler +(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun + &optional nopreserve) + "Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN. + +Handlers are normally called from the buffers they put output in. + +Delete ((current-buffer) . TRIGGER-NAME) from +`gdb-pending-triggers', erase current buffer and evaluate +CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. + +If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." + `(defun ,handler-name () + (gdb-delete-pending (cons (current-buffer) ',trigger-name)) + (let* ((buffer-read-only nil) + (window (get-buffer-window (current-buffer) 0)) + (start (window-start window)) + (p (window-point window))) + (erase-buffer) + (,custom-defun) + (gdb-update-buffer-name) + ,(when (not nopreserve) + '(set-window-start window start) + '(set-window-point window p))))) + +(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command + handler-name custom-defun + &optional signal-list) + "Define trigger and handler. + +TRIGGER-NAME trigger is defined to send GDB-COMMAND. See +`def-gdb-auto-update-trigger'. + +HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See +`def-gdb-auto-update-handler'." + `(progn + (def-gdb-auto-update-trigger ,trigger-name + ,gdb-command + ,handler-name ,signal-list) + (def-gdb-auto-update-handler ,handler-name + ,trigger-name ,custom-defun))) + + + +;; Breakpoint buffer : This displays the output of `-break-list'. +(def-gdb-trigger-and-handler + gdb-invalidate-breakpoints "-break-list" + gdb-breakpoints-list-handler gdb-breakpoints-list-handler-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-breakpoints-buffer + 'gdb-breakpoints-buffer-name + 'gdb-breakpoints-mode + 'gdb-invalidate-breakpoints) + +(defun gdb-breakpoints-list-handler-custom () + (let ((breakpoints-list (bindat-get-field + (gdb-json-partial-output "bkpt" "script") + 'BreakpointTable 'body)) + (table (make-gdb-table))) + (setq gdb-breakpoints-list nil) + (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What")) + (dolist (breakpoint breakpoints-list) + (add-to-list 'gdb-breakpoints-list + (cons (bindat-get-field breakpoint 'number) + breakpoint)) + (let ((at (bindat-get-field breakpoint 'at)) + (pending (bindat-get-field breakpoint 'pending)) + (func (bindat-get-field breakpoint 'func)) + (type (bindat-get-field breakpoint 'type))) + (gdb-table-add-row table + (list + (bindat-get-field breakpoint 'number) + type + (bindat-get-field breakpoint 'disp) + (let ((flag (bindat-get-field breakpoint 'enabled))) + (if (string-equal flag "y") + (propertize "y" 'font-lock-face font-lock-warning-face) + (propertize "n" 'font-lock-face font-lock-comment-face))) + (bindat-get-field breakpoint 'addr) + (bindat-get-field breakpoint 'times) + (if (string-match ".*watchpoint" type) + (bindat-get-field breakpoint 'what) + (or pending at + (concat "in " + (propertize func 'font-lock-face font-lock-function-name-face) + (gdb-frame-location breakpoint))))) + ;; Add clickable properties only for breakpoints with file:line + ;; information + (append (list 'gdb-breakpoint breakpoint) + (when func '(help-echo "mouse-2, RET: visit breakpoint" + mouse-face highlight)))))) + (insert (gdb-table-string table " ")) + (gdb-place-breakpoints))) + +;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). +(defun gdb-place-breakpoints () + (let ((flag) (bptno)) + ;; 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 'gdbmi) + (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) + (gdb-remove-breakpoint-icons (point-min) (point-max))))) + (dolist (breakpoint gdb-breakpoints-list) + (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is + ; an associative list + (line (bindat-get-field breakpoint 'line))) + (when line + (let ((file (bindat-get-field breakpoint 'fullname)) + (flag (bindat-get-field breakpoint 'enabled)) + (bptno (bindat-get-field breakpoint 'number))) + (unless (file-exists-p file) + (setq file (cdr (assoc bptno gdb-location-alist)))) + (if (and file + (not (string-equal file "File not found"))) + (with-current-buffer + (find-file-noselect file 'nowarn) + (gdb-init-buffer) + ;; Only want one breakpoint icon at each location. + (gdb-put-breakpoint-icon (string-equal flag "y") bptno + (string-to-number line))) + (gdb-input + (list (concat "list " file ":1") + 'ignore)) + (gdb-input + (list "-file-list-exec-source-file" + `(lambda () (gdb-get-location + ,bptno ,line ,flag))))))))))) + +(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") + +(defun gdb-get-location (bptno line flag) + "Find the directory containing the relevant source file. +Put in buffer and place breakpoint icon." + (goto-char (point-min)) + (catch 'file-not-found + (if (re-search-forward gdb-source-file-regexp nil t) + (delete (cons bptno "File not found") gdb-location-alist) + (push (cons bptno (match-string 1)) gdb-location-alist) + (gdb-resync) + (unless (assoc bptno gdb-location-alist) + (push (cons bptno "File not found") gdb-location-alist) + (message-box "Cannot find source file for breakpoint location. +Add directory to search path for source files using the GDB command, dir.")) + (throw 'file-not-found nil)) + (with-current-buffer (find-file-noselect (match-string 1)) + (gdb-init-buffer) + ;; only want one breakpoint icon at each location + (gdb-put-breakpoint-icon (eq flag ?y) bptno (string-to-number line))))) + +(add-hook 'find-file-hook 'gdb-find-file-hook) + +(defun gdb-find-file-hook () + "Set up buffer for debugging if file is part of the source code +of the current session." + (if (and (buffer-name gud-comint-buffer) + ;; in case gud or gdb-ui is just loaded + gud-comint-buffer + (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)) + (if (member buffer-file-name gdb-source-file-list) + (with-current-buffer (find-buffer-visiting buffer-file-name) + (gdb-init-buffer))))) + +(declare-function gud-remove "gdb-mi" t t) ; gud-def +(declare-function gud-break "gdb-mi" t t) ; gud-def +(declare-function fringe-bitmaps-at-pos "fringe.c" (&optional pos window)) + +(defun gdb-mouse-set-clear-breakpoint (event) + "Set/clear breakpoint in left fringe/margin at mouse click. +If not in a source or disassembly buffer just set point." + (interactive "e") + (mouse-minibuffer-check event) + (let ((posn (event-end event))) + (with-selected-window (posn-window posn) + (if (or (buffer-file-name) (eq major-mode 'gdb-disassembly-mode)) + (if (numberp (posn-point posn)) + (save-excursion + (goto-char (posn-point posn)) + (if (or (posn-object posn) + (eq (car (fringe-bitmaps-at-pos (posn-point posn))) + 'breakpoint)) + (gud-remove nil) + (gud-break nil))))) + (posn-set-point posn)))) + +(defun gdb-mouse-toggle-breakpoint-margin (event) + "Enable/disable breakpoint in left margin with mouse click." + (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 (posn-object posn) + (gud-basic-call + (let ((bptno (get-text-property + 0 'gdb-bptno (car (posn-string posn))))) + (concat + (if (get-text-property + 0 'gdb-enabled (car (posn-string posn))) + "-break-disable " + "-break-enable ") + bptno))))))))) + +(defun gdb-mouse-toggle-breakpoint-fringe (event) + "Enable/disable breakpoint in left fringe with mouse click." + (interactive "e") + (mouse-minibuffer-check event) + (let* ((posn (event-end event)) + (pos (posn-point posn)) + obj) + (when (numberp pos) + (with-selected-window (posn-window posn) + (with-current-buffer (window-buffer (selected-window)) + (goto-char pos) + (dolist (overlay (overlays-in pos pos)) + (when (overlay-get overlay 'put-break) + (setq obj (overlay-get overlay 'before-string)))) + (when (stringp obj) + (gud-basic-call + (concat + (if (get-text-property 0 'gdb-enabled obj) + "-break-disable " + "-break-enable ") + (get-text-property 0 'gdb-bptno obj))))))))) + +(defun gdb-breakpoints-buffer-name () + (concat "*breakpoints of " (gdb-get-target-string) "*")) + +(def-gdb-display-buffer + gdb-display-breakpoints-buffer + 'gdb-breakpoints-buffer + "Display status of user-settable breakpoints.") + +(def-gdb-frame-for-buffer + gdb-frame-breakpoints-buffer + 'gdb-breakpoints-buffer + "Display status of user-settable breakpoints in a new frame.") + +(defvar gdb-breakpoints-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "Breakpoints"))) + (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window)) + (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) + (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) + (define-key menu [toggle] '("Toggle" . gdb-toggle-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) + ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. + (define-key map "q" 'gdb-delete-frame-or-window) + (define-key map "\r" 'gdb-goto-breakpoint) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-threads-buffer) t))) + (define-key map [mouse-2] 'gdb-goto-breakpoint) + (define-key map [follow-link] 'mouse-face) + map)) + +(defun gdb-delete-frame-or-window () + "Delete frame if there is only one window. Otherwise delete the window." + (interactive) + (if (one-window-p) (delete-frame) + (delete-window))) + +;;from make-mode-line-mouse-map +(defun gdb-make-header-line-mouse-map (mouse function) "\ +Return a keymap with single entry for mouse key MOUSE on the header line. +MOUSE is defined to run function FUNCTION with no args in the buffer +corresponding to the mode line clicked." + (let ((map (make-sparse-keymap))) + (define-key map (vector 'header-line mouse) function) + (define-key map (vector 'header-line 'down-mouse-1) 'ignore) + map)) + +(defmacro gdb-propertize-header (name buffer help-echo mouse-face face) + `(propertize ,name + 'help-echo ,help-echo + 'mouse-face ',mouse-face + 'face ',face + 'local-map + (gdb-make-header-line-mouse-map + 'mouse-1 + (lambda (event) (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (gdb-set-window-buffer + (gdb-get-buffer-create ',buffer) t) ))))) + + +;; uses "-thread-info". Needs GDB 7.0 onwards. +;;; Threads view + +(defun gdb-threads-buffer-name () + (concat "*threads of " (gdb-get-target-string) "*")) + +(def-gdb-display-buffer + gdb-display-threads-buffer + 'gdb-threads-buffer + "Display GDB threads.") + +(def-gdb-frame-for-buffer + gdb-frame-threads-buffer + 'gdb-threads-buffer + "Display GDB threads in a new frame.") + +(def-gdb-trigger-and-handler + gdb-invalidate-threads (gdb-current-context-command "-thread-info") + gdb-thread-list-handler gdb-thread-list-handler-custom + '(start update update-threads)) + +(gdb-set-buffer-rules + 'gdb-threads-buffer + 'gdb-threads-buffer-name + 'gdb-threads-mode + 'gdb-invalidate-threads) + +(defvar gdb-threads-font-lock-keywords + '(("in \\([^ ]+\\)" (1 font-lock-function-name-face)) + (" \\(stopped\\)" (1 font-lock-warning-face)) + (" \\(running\\)" (1 font-lock-string-face)) + ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) + "Font lock keywords used in `gdb-threads-mode'.") + +(defvar gdb-threads-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'gdb-select-thread) + (define-key map "f" 'gdb-display-stack-for-thread) + (define-key map "F" 'gdb-frame-stack-for-thread) + (define-key map "l" 'gdb-display-locals-for-thread) + (define-key map "L" 'gdb-frame-locals-for-thread) + (define-key map "r" 'gdb-display-registers-for-thread) + (define-key map "R" 'gdb-frame-registers-for-thread) + (define-key map "d" 'gdb-display-disassembly-for-thread) + (define-key map "D" 'gdb-frame-disassembly-for-thread) + (define-key map "i" 'gdb-interrupt-thread) + (define-key map "c" 'gdb-continue-thread) + (define-key map "s" 'gdb-step-thread) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))) + (define-key map [mouse-2] 'gdb-select-thread) + (define-key map [follow-link] 'mouse-face) + map)) + +(defvar gdb-threads-header + (list + (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer + "mouse-1: select" mode-line-highlight mode-line-inactive) + " " + (gdb-propertize-header "Threads" gdb-threads-buffer + nil nil mode-line))) + +(define-derived-mode gdb-threads-mode gdb-parent-mode "Threads" + "Major mode for GDB threads. + +\\{gdb-threads-mode-map}" + (setq gdb-thread-position (make-marker)) + (add-to-list 'overlay-arrow-variable-list 'gdb-thread-position) + (setq header-line-format gdb-threads-header) + (set (make-local-variable 'font-lock-defaults) + '(gdb-threads-font-lock-keywords)) + (run-mode-hooks 'gdb-threads-mode-hook) + 'gdb-invalidate-threads) + +(defun gdb-thread-list-handler-custom () + (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads)) + (table (make-gdb-table)) + (marked-line nil)) + (setq gdb-threads-list nil) + (setq gdb-running-threads-count 0) + (setq gdb-stopped-threads-count 0) + (set-marker gdb-thread-position nil) + + (dolist (thread (reverse threads-list)) + (let ((running (string-equal (bindat-get-field thread 'state) "running"))) + (add-to-list 'gdb-threads-list + (cons (bindat-get-field thread 'id) + thread)) + (if running + (incf gdb-running-threads-count) + (incf gdb-stopped-threads-count)) + + (gdb-table-add-row table + (list + (bindat-get-field thread 'id) + (concat + (if gdb-thread-buffer-verbose-names + (concat (bindat-get-field thread 'target-id) " ") "") + (bindat-get-field thread 'state) + ;; Include frame information for stopped threads + (if (not running) + (concat + " in " (bindat-get-field thread 'frame 'func) + (if gdb-thread-buffer-arguments + (concat + " (" + (let ((args (bindat-get-field thread 'frame 'args))) + (mapconcat + (lambda (arg) + (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))) + args ",")) + ")") + "") + (if gdb-thread-buffer-locations + (gdb-frame-location (bindat-get-field thread 'frame)) "") + (if gdb-thread-buffer-addresses + (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + ""))) + (list + 'gdb-thread thread + 'mouse-face 'highlight + 'help-echo "mouse-2, RET: select thread"))) + (when (string-equal gdb-thread-number + (bindat-get-field thread 'id)) + (setq marked-line (length gdb-threads-list)))) + (insert (gdb-table-string table " ")) + (when marked-line + (gdb-mark-line marked-line gdb-thread-position))) + ;; We update gud-running here because we need to make sure that + ;; gdb-threads-list is up-to-date + (gdb-update-gud-running) + (gdb-emit-signal gdb-buf-publisher 'update-disassembly)) + +(defmacro def-gdb-thread-buffer-command (name custom-defun &optional doc) + "Define a NAME command which will act upon thread on the current line. + +CUSTOM-DEFUN may use locally bound `thread' variable, which will +be the value of 'gdb-thread property of the current line. If +'gdb-thread is nil, error is signaled." + `(defun ,name (&optional event) + ,(when doc doc) + (interactive (list last-input-event)) + (if event (posn-set-point (event-end event))) + (save-excursion + (beginning-of-line) + (let ((thread (get-text-property (point) 'gdb-thread))) + (if thread + ,custom-defun + (error "Not recognized as thread line")))))) + +(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc) + "Define a NAME which will call BUFFER-COMMAND with id of thread +on the current line." + `(def-gdb-thread-buffer-command ,name + (,buffer-command (bindat-get-field thread 'id)) + ,doc)) + +(def-gdb-thread-buffer-command gdb-select-thread + (let ((new-id (bindat-get-field thread 'id))) + (gdb-setq-thread-number new-id) + (gdb-input (list (concat "-thread-select " new-id) 'ignore)) + (gdb-update)) + "Select the thread at current line of threads buffer.") + +(def-gdb-thread-buffer-simple-command + gdb-display-stack-for-thread + gdb-preemptively-display-stack-buffer + "Display stack buffer for the thread at current line.") + +(def-gdb-thread-buffer-simple-command + gdb-display-locals-for-thread + gdb-preemptively-display-locals-buffer + "Display locals buffer for the thread at current line.") + +(def-gdb-thread-buffer-simple-command + gdb-display-registers-for-thread + gdb-preemptively-display-registers-buffer + "Display registers buffer for the thread at current line.") + +(def-gdb-thread-buffer-simple-command + gdb-display-disassembly-for-thread + gdb-preemptively-display-disassembly-buffer + "Display disassembly buffer for the thread at current line.") + +(def-gdb-thread-buffer-simple-command + gdb-frame-stack-for-thread + gdb-frame-stack-buffer + "Display a new frame with stack buffer for the thread at +current line.") + +(def-gdb-thread-buffer-simple-command + gdb-frame-locals-for-thread + gdb-frame-locals-buffer + "Display a new frame with locals buffer for the thread at +current line.") + +(def-gdb-thread-buffer-simple-command + gdb-frame-registers-for-thread + gdb-frame-registers-buffer + "Display a new frame with registers buffer for the thread at +current line.") + +(def-gdb-thread-buffer-simple-command + gdb-frame-disassembly-for-thread + gdb-frame-disassembly-buffer + "Display a new frame with disassembly buffer for the thread at +current line.") + +(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc) + "Define a NAME which will execute GUD-COMMAND with +`gdb-thread-number' locally bound to id of thread on the current +line." + `(def-gdb-thread-buffer-command ,name + (if gdb-non-stop + (let ((gdb-thread-number (bindat-get-field thread 'id)) + (gdb-gud-control-all-threads nil)) + (call-interactively #',gud-command)) + (error "Available in non-stop mode only, customize `gdb-non-stop-setting'")) + ,doc)) + +(def-gdb-thread-buffer-gud-command + gdb-interrupt-thread + gud-stop-subjob + "Interrupt thread at current line.") + +(def-gdb-thread-buffer-gud-command + gdb-continue-thread + gud-cont + "Continue thread at current line.") + +(def-gdb-thread-buffer-gud-command + gdb-step-thread + gud-step + "Step thread at current line.") + + +;;; Memory view + +(defcustom gdb-memory-rows 8 + "Number of data rows in memory window." + :type 'integer + :group 'gud + :version "23.2") + +(defcustom gdb-memory-columns 4 + "Number of data columns in memory window." + :type 'integer + :group 'gud + :version "23.2") + +(defcustom gdb-memory-format "x" + "Display format of data items in memory window." + :type '(choice (const :tag "Hexadecimal" "x") + (const :tag "Signed decimal" "d") + (const :tag "Unsigned decimal" "u") + (const :tag "Octal" "o") + (const :tag "Binary" "t")) + :group 'gud + :version "22.1") + +(defcustom gdb-memory-unit 4 + "Unit size of data items in memory window." + :type '(choice (const :tag "Byte" 1) + (const :tag "Halfword" 2) + (const :tag "Word" 4) + (const :tag "Giant word" 8)) + :group 'gud + :version "23.2") + +(def-gdb-trigger-and-handler + gdb-invalidate-memory + (format "-data-read-memory %s %s %d %d %d" + gdb-memory-address + gdb-memory-format + gdb-memory-unit + gdb-memory-rows + gdb-memory-columns) + gdb-read-memory-handler + gdb-read-memory-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-memory-buffer + 'gdb-memory-buffer-name + 'gdb-memory-mode + 'gdb-invalidate-memory) + +(defun gdb-memory-column-width (size format) + "Return length of string with memory unit of SIZE in FORMAT. + +SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as +in `gdb-memory-format'." + (let ((format-base (cdr (assoc format + '(("x" . 16) + ("d" . 10) ("u" . 10) + ("o" . 8) + ("t" . 2)))))) + (if format-base + (let ((res (ceiling (log (expt 2.0 (* size 8)) format-base)))) + (cond ((string-equal format "x") + (+ 2 res)) ; hexadecimal numbers have 0x in front + ((or (string-equal format "d") + (string-equal format "o")) + (1+ res)) + (t res))) + (error "Unknown format")))) + +(defun gdb-read-memory-custom () + (let* ((res (gdb-json-partial-output)) + (err-msg (bindat-get-field res 'msg))) + (if (not err-msg) + (let ((memory (bindat-get-field res 'memory))) + (setq gdb-memory-address (bindat-get-field res 'addr)) + (setq gdb-memory-next-page (bindat-get-field res 'next-page)) + (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) + (setq gdb-memory-last-address gdb-memory-address) + (dolist (row memory) + (insert (concat (bindat-get-field row 'addr) ":")) + (dolist (column (bindat-get-field row 'data)) + (insert (gdb-pad-string column + (+ 2 (gdb-memory-column-width + gdb-memory-unit + gdb-memory-format))))) + (newline))) + ;; Show last page instead of empty buffer when out of bounds + (progn + (let ((gdb-memory-address gdb-memory-last-address)) + (gdb-invalidate-memory 'update) + (error err-msg)))))) + +(defvar gdb-memory-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map t) + (define-key map "q" 'kill-this-buffer) + (define-key map "n" 'gdb-memory-show-next-page) + (define-key map "p" 'gdb-memory-show-previous-page) + (define-key map "a" 'gdb-memory-set-address) + (define-key map "t" 'gdb-memory-format-binary) + (define-key map "o" 'gdb-memory-format-octal) + (define-key map "u" 'gdb-memory-format-unsigned) + (define-key map "d" 'gdb-memory-format-signed) + (define-key map "x" 'gdb-memory-format-hexadecimal) + (define-key map "b" 'gdb-memory-unit-byte) + (define-key map "h" 'gdb-memory-unit-halfword) + (define-key map "w" 'gdb-memory-unit-word) + (define-key map "g" 'gdb-memory-unit-giant) + (define-key map "R" 'gdb-memory-set-rows) + (define-key map "C" 'gdb-memory-set-columns) + map)) + +(defun gdb-memory-set-address-event (event) + "Handle a click on address field in memory buffer header." + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (gdb-memory-set-address))) + +;; Non-event version for use within keymap +(defun gdb-memory-set-address () + "Set the start memory address." + (interactive) + (let ((arg (read-from-minibuffer "Memory address: "))) + (setq gdb-memory-address arg)) + (gdb-invalidate-memory 'update)) + +(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) + "Define a function NAME which reads new VAR value from minibuffer." + `(defun ,name (event) + ,(when doc doc) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((arg (read-from-minibuffer ,echo-string)) + (count (string-to-number arg))) + (if (<= count 0) + (error "Positive number only") + (customize-set-variable ',variable count) + (gdb-invalidate-memory 'update)))))) + +(def-gdb-set-positive-number + gdb-memory-set-rows + gdb-memory-rows + "Rows: " + "Set the number of data rows in memory window.") + +(def-gdb-set-positive-number + gdb-memory-set-columns + gdb-memory-columns + "Columns: " + "Set the number of data columns in memory window.") + +(defmacro def-gdb-memory-format (name format doc) + "Define a function NAME to switch memory buffer to use FORMAT. + +DOC is an optional documentation string." + `(defun ,name () ,(when doc doc) + (interactive) + (customize-set-variable 'gdb-memory-format ,format) + (gdb-invalidate-memory 'update))) + +(def-gdb-memory-format + gdb-memory-format-binary "t" + "Set the display format to binary.") + +(def-gdb-memory-format + gdb-memory-format-octal "o" + "Set the display format to octal.") + +(def-gdb-memory-format + gdb-memory-format-unsigned "u" + "Set the display format to unsigned decimal.") + +(def-gdb-memory-format + gdb-memory-format-signed "d" + "Set the display format to decimal.") + +(def-gdb-memory-format + gdb-memory-format-hexadecimal "x" + "Set the display format to hexadecimal.") + +(defvar gdb-memory-format-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) + map) + "Keymap to select format in the header line.") + +(defvar gdb-memory-format-menu (make-sparse-keymap "Format") + "Menu of display formats in the header line.") + +(define-key gdb-memory-format-menu [binary] + '(menu-item "Binary" gdb-memory-format-binary + :button (:radio . (equal gdb-memory-format "t")))) +(define-key gdb-memory-format-menu [octal] + '(menu-item "Octal" gdb-memory-format-octal + :button (:radio . (equal gdb-memory-format "o")))) +(define-key gdb-memory-format-menu [unsigned] + '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned + :button (:radio . (equal gdb-memory-format "u")))) +(define-key gdb-memory-format-menu [signed] + '(menu-item "Signed Decimal" gdb-memory-format-signed + :button (:radio . (equal gdb-memory-format "d")))) +(define-key gdb-memory-format-menu [hexadecimal] + '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal + :button (:radio . (equal gdb-memory-format "x")))) + +(defun gdb-memory-format-menu (event) + (interactive "@e") + (x-popup-menu event gdb-memory-format-menu)) + +(defun gdb-memory-format-menu-1 (event) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((selection (gdb-memory-format-menu event)) + (binding (and selection (lookup-key gdb-memory-format-menu + (vector (car selection)))))) + (if binding (call-interactively binding))))) + +(defmacro def-gdb-memory-unit (name unit-size doc) + "Define a function NAME to switch memory unit size to UNIT-SIZE. + +DOC is an optional documentation string." + `(defun ,name () ,(when doc doc) + (interactive) + (customize-set-variable 'gdb-memory-unit ,unit-size) + (gdb-invalidate-memory 'update))) + +(def-gdb-memory-unit gdb-memory-unit-giant 8 + "Set the unit size to giant words (eight bytes).") + +(def-gdb-memory-unit gdb-memory-unit-word 4 + "Set the unit size to words (four bytes).") + +(def-gdb-memory-unit gdb-memory-unit-halfword 2 + "Set the unit size to halfwords (two bytes).") + +(def-gdb-memory-unit gdb-memory-unit-byte 1 + "Set the unit size to bytes.") + +(defmacro def-gdb-memory-show-page (name address-var &optional doc) + "Define a function NAME which show new address in memory buffer. + +The defined function switches Memory buffer to show address +stored in ADDRESS-VAR variable. + +DOC is an optional documentation string." + `(defun ,name + ,(when doc doc) + (interactive) + (let ((gdb-memory-address ,address-var)) + (gdb-invalidate-memory)))) + +(def-gdb-memory-show-page gdb-memory-show-previous-page + gdb-memory-prev-page) + +(def-gdb-memory-show-page gdb-memory-show-next-page + gdb-memory-next-page) + +(defvar gdb-memory-unit-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) + map) + "Keymap to select units in the header line.") + +(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit") + "Menu of units in the header line.") + +(define-key gdb-memory-unit-menu [giantwords] + '(menu-item "Giant words" gdb-memory-unit-giant + :button (:radio . (equal gdb-memory-unit 8)))) +(define-key gdb-memory-unit-menu [words] + '(menu-item "Words" gdb-memory-unit-word + :button (:radio . (equal gdb-memory-unit 4)))) +(define-key gdb-memory-unit-menu [halfwords] + '(menu-item "Halfwords" gdb-memory-unit-halfword + :button (:radio . (equal gdb-memory-unit 2)))) +(define-key gdb-memory-unit-menu [bytes] + '(menu-item "Bytes" gdb-memory-unit-byte + :button (:radio . (equal gdb-memory-unit 1)))) + +(defun gdb-memory-unit-menu (event) + (interactive "@e") + (x-popup-menu event gdb-memory-unit-menu)) + +(defun gdb-memory-unit-menu-1 (event) + (interactive "e") + (save-selected-window + (select-window (posn-window (event-start event))) + (let* ((selection (gdb-memory-unit-menu event)) + (binding (and selection (lookup-key gdb-memory-unit-menu + (vector (car selection)))))) + (if binding (call-interactively binding))))) + +(defvar gdb-memory-font-lock-keywords + '(;; <__function.name+n> + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face)) + ) + "Font lock keywords used in `gdb-memory-mode'.") + +(defvar gdb-memory-header + '(:eval + (concat + "Start address[" + (propertize "-" + 'face font-lock-warning-face + 'help-echo "mouse-1: decrement address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-show-previous-page)) + "|" + (propertize "+" + 'face font-lock-warning-face + 'help-echo "mouse-1: increment address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-show-next-page)) + "]: " + (propertize gdb-memory-address + 'face font-lock-warning-face + 'help-echo "mouse-1: set start address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-address-event)) + " Rows: " + (propertize (number-to-string gdb-memory-rows) + 'face font-lock-warning-face + 'help-echo "mouse-1: set number of columns" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-rows)) + " Columns: " + (propertize (number-to-string gdb-memory-columns) + 'face font-lock-warning-face + 'help-echo "mouse-1: set number of columns" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-columns)) + " Display Format: " + (propertize gdb-memory-format + 'face font-lock-warning-face + 'help-echo "mouse-3: select display format" + 'mouse-face 'mode-line-highlight + 'local-map gdb-memory-format-map) + " Unit Size: " + (propertize (number-to-string gdb-memory-unit) + 'face font-lock-warning-face + 'help-echo "mouse-3: select unit size" + 'mouse-face 'mode-line-highlight + 'local-map gdb-memory-unit-map))) + "Header line used in `gdb-memory-mode'.") + +(define-derived-mode gdb-memory-mode gdb-parent-mode "Memory" + "Major mode for examining memory. + +\\{gdb-memory-mode-map}" + (setq header-line-format gdb-memory-header) + (set (make-local-variable 'font-lock-defaults) + '(gdb-memory-font-lock-keywords)) + (run-mode-hooks 'gdb-memory-mode-hook) + 'gdb-invalidate-memory) + +(defun gdb-memory-buffer-name () + (concat "*memory of " (gdb-get-target-string) "*")) + +(def-gdb-display-buffer + gdb-display-memory-buffer + 'gdb-memory-buffer + "Display memory contents.") + +(defun gdb-frame-memory-buffer () + "Display memory contents in a new frame." + (interactive) + (let* ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist + `((left-fringe . 0) + (right-fringe . 0) + (width . 83) + ,@gdb-frame-parameters))) + (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) + + +;;; Disassembly view + +(defun gdb-disassembly-buffer-name () + (gdb-current-context-buffer-name + (concat "disassembly of " (gdb-get-target-string)))) + +(def-gdb-display-buffer + gdb-display-disassembly-buffer + 'gdb-disassembly-buffer + "Display disassembly for current stack frame.") + +(def-gdb-preempt-display-buffer + gdb-preemptively-display-disassembly-buffer + 'gdb-disassembly-buffer) + +(def-gdb-frame-for-buffer + gdb-frame-disassembly-buffer + 'gdb-disassembly-buffer + "Display disassembly in a new frame.") + +(def-gdb-auto-update-trigger gdb-invalidate-disassembly + (let* ((frame (gdb-current-buffer-frame)) + (file (bindat-get-field frame 'fullname)) + (line (bindat-get-field frame 'line))) + (when file + (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line))) + gdb-disassembly-handler + ;; We update disassembly only after we have actual frame information + ;; about all threads, so no there's `update' signal in this list + '(start update-disassembly)) + +(def-gdb-auto-update-handler + gdb-disassembly-handler + gdb-invalidate-disassembly + gdb-disassembly-handler-custom + t) + +(gdb-set-buffer-rules + 'gdb-disassembly-buffer + 'gdb-disassembly-buffer-name + 'gdb-disassembly-mode + 'gdb-invalidate-disassembly) + +(defvar gdb-disassembly-font-lock-keywords + '(;; <__function.name+n> + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + (1 font-lock-function-name-face)) + ;; 0xNNNNNNNN <__function.name+n>: opcode + ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)" + (4 font-lock-keyword-face)) + ;; %register(at least i386) + ("%\\sw+" . font-lock-variable-name-face) + ("^\\(Dump of assembler code for function\\) \\(.+\\):" + (1 font-lock-comment-face) + (2 font-lock-function-name-face)) + ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face)) + "Font lock keywords used in `gdb-disassembly-mode'.") + +(defvar gdb-disassembly-mode-map + ;; TODO + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'kill-this-buffer) + map)) + +(define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly" + "Major mode for GDB disassembly information. + +\\{gdb-disassembly-mode-map}" + ;; TODO Rename overlay variable for disassembly mode + (add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position) + (setq fringes-outside-margins t) + (set (make-local-variable 'gdb-disassembly-position) (make-marker)) + (set (make-local-variable 'font-lock-defaults) + '(gdb-disassembly-font-lock-keywords)) + (run-mode-hooks 'gdb-disassembly-mode-hook) + 'gdb-invalidate-disassembly) + +(defun gdb-disassembly-handler-custom () + (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) + (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) + (pos 1) + (table (make-gdb-table)) + (marked-line nil)) + (dolist (instr instructions) + (gdb-table-add-row table + (list + (bindat-get-field instr 'address) + (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) + (bindat-get-field instr 'inst))) + (when (string-equal (bindat-get-field instr 'address) + address) + (progn + (setq marked-line (length (gdb-table-rows table))) + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle))))))) + (insert (gdb-table-string table " ")) + (gdb-disassembly-place-breakpoints) + ;; Mark current position with overlay arrow and scroll window to + ;; that point + (when marked-line + (let ((window (get-buffer-window (current-buffer) 0))) + (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position)))) + (setq mode-name + (gdb-current-context-mode-name + (concat "Disassembly: " + (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + +(defun gdb-disassembly-place-breakpoints () + (gdb-remove-breakpoint-icons (point-min) (point-max)) + (dolist (breakpoint gdb-breakpoints-list) + (let* ((breakpoint (cdr breakpoint)) + (bptno (bindat-get-field breakpoint 'number)) + (flag (bindat-get-field breakpoint 'enabled)) + (address (bindat-get-field breakpoint 'addr))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" address) nil t) + (gdb-put-breakpoint-icon (string-equal flag "y") bptno)))))) + + +(defvar gdb-breakpoints-header + (list + (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer + nil nil mode-line) + " " + (gdb-propertize-header "Threads" gdb-threads-buffer + "mouse-1: select" mode-line-highlight mode-line-inactive))) + +;;; Breakpoints view +(define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" + "Major mode for gdb breakpoints. + +\\{gdb-breakpoints-mode-map}" + (setq header-line-format gdb-breakpoints-header) + (run-mode-hooks 'gdb-breakpoints-mode-hook) + 'gdb-invalidate-breakpoints) + +(defun gdb-toggle-breakpoint () + "Enable/disable breakpoint at current line of breakpoints buffer." + (interactive) + (save-excursion + (beginning-of-line) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (gud-basic-call + (concat (if (string-equal "y" (bindat-get-field breakpoint 'enabled)) + "-break-disable " + "-break-enable ") + (bindat-get-field breakpoint 'number))) + (error "Not recognized as break/watchpoint line"))))) + +(defun gdb-delete-breakpoint () + "Delete the breakpoint at current line of breakpoints buffer." + (interactive) + (save-excursion + (beginning-of-line) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (gud-basic-call (concat "-break-delete " (bindat-get-field breakpoint 'number))) + (error "Not recognized as break/watchpoint line"))))) + +(defun gdb-goto-breakpoint (&optional event) + "Go to the location of breakpoint at current line of +breakpoints buffer." + (interactive (list last-input-event)) + (if event (posn-set-point (event-end event))) + ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer. + (let ((window (get-buffer-window gud-comint-buffer))) + (if window (save-selected-window (select-window window)))) + (save-excursion + (beginning-of-line) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (let ((bptno (bindat-get-field breakpoint 'number)) + (file (bindat-get-field breakpoint 'fullname)) + (line (bindat-get-field breakpoint 'line))) + (save-selected-window + (let* ((buffer (find-file-noselect + (if (file-exists-p file) file + (cdr (assoc bptno gdb-location-alist))))) + (window (or (gdb-display-source-buffer buffer) + (display-buffer buffer)))) + (setq gdb-source-window window) + (with-current-buffer buffer + (goto-char (point-min)) + (forward-line (1- (string-to-number line))) + (set-window-point window (point)))))) + (error "Not recognized as break/watchpoint line"))))) + + +;; Frames buffer. This displays a perpetually correct bactrack trace. +;; +(def-gdb-trigger-and-handler + gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames") + gdb-stack-list-frames-handler gdb-stack-list-frames-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-stack-buffer + 'gdb-stack-buffer-name + 'gdb-frames-mode + 'gdb-invalidate-frames) + +(defun gdb-frame-location (frame) + "Return \" of file:line\" or \" of library\" for structure FRAME. + +FRAME must have either \"file\" and \"line\" members or \"from\" +member." + (let ((file (bindat-get-field frame 'file)) + (line (bindat-get-field frame 'line)) + (from (bindat-get-field frame 'from))) + (let ((res (or (and file line (concat file ":" line)) + from))) + (if res (concat " of " res) "")))) + +(defun gdb-stack-list-frames-custom () + (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) + (table (make-gdb-table))) + (set-marker gdb-stack-position nil) + (dolist (frame stack) + (gdb-table-add-row table + (list + (bindat-get-field frame 'level) + "in" + (concat + (bindat-get-field frame 'func) + (if gdb-stack-buffer-locations + (gdb-frame-location frame) "") + (if gdb-stack-buffer-addresses + (concat " at " (bindat-get-field frame 'addr)) ""))) + `(mouse-face highlight + help-echo "mouse-2, RET: Select frame" + gdb-frame ,frame))) + (insert (gdb-table-string table " "))) + (when (and gdb-frame-number + (gdb-buffer-shows-main-thread-p)) + (gdb-mark-line (1+ (string-to-number gdb-frame-number)) + gdb-stack-position)) + (setq mode-name + (gdb-current-context-mode-name "Frames"))) + +(defun gdb-stack-buffer-name () + (gdb-current-context-buffer-name + (concat "stack frames of " (gdb-get-target-string)))) + +(def-gdb-display-buffer + gdb-display-stack-buffer + 'gdb-stack-buffer + "Display backtrace of current stack.") + +(def-gdb-preempt-display-buffer + gdb-preemptively-display-stack-buffer + 'gdb-stack-buffer nil t) + +(def-gdb-frame-for-buffer + gdb-frame-stack-buffer + 'gdb-stack-buffer + "Display backtrace of current stack in a new frame.") + +(defvar gdb-frames-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'kill-this-buffer) + (define-key map "\r" 'gdb-select-frame) + (define-key map [mouse-2] 'gdb-select-frame) + (define-key map [follow-link] 'mouse-face) + map)) + +(defvar gdb-frames-font-lock-keywords + '(("in \\([^ ]+\\)" (1 font-lock-function-name-face))) + "Font lock keywords used in `gdb-frames-mode'.") + +(define-derived-mode gdb-frames-mode gdb-parent-mode "Frames" + "Major mode for gdb call stack. + +\\{gdb-frames-mode-map}" + (setq gdb-stack-position (make-marker)) + (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) + (setq truncate-lines t) ;; Make it easier to see overlay arrow. + (set (make-local-variable 'font-lock-defaults) + '(gdb-frames-font-lock-keywords)) + (run-mode-hooks 'gdb-frames-mode-hook) + 'gdb-invalidate-frames) + +(defun gdb-select-frame (&optional event) + "Select the frame and display the relevant source." + (interactive (list last-input-event)) + (if event (posn-set-point (event-end event))) + (let ((frame (get-text-property (point) 'gdb-frame))) + (if frame + (if (gdb-buffer-shows-main-thread-p) + (let ((new-level (bindat-get-field frame 'level))) + (setq gdb-frame-number new-level) + (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore)) + (gdb-update)) + (error "Could not select frame for non-current thread")) + (error "Not recognized as frame line")))) + + +;; Locals buffer. +;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. +(def-gdb-trigger-and-handler + gdb-invalidate-locals + (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") + gdb-locals-handler gdb-locals-handler-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-locals-buffer + 'gdb-locals-buffer-name + 'gdb-locals-mode + 'gdb-invalidate-locals) + +(defvar gdb-locals-watch-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gud-watch) + (define-key map [mouse-2] 'gud-watch) + map) + "Keymap to create watch expression of a complex data type local variable.") + +(defvar gdb-edit-locals-map-1 + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-edit-locals-value) + (define-key map [mouse-2] 'gdb-edit-locals-value) + map) + "Keymap to edit value of a simple data type local variable.") + +(defun gdb-edit-locals-value (&optional event) + "Assign a value to a variable displayed in the locals buffer." + (interactive (list last-input-event)) + (save-excursion + (if event (posn-set-point (event-end event))) + (beginning-of-line) + (let* ((var (bindat-get-field + (get-text-property (point) 'gdb-local-variable) 'name)) + (value (read-string (format "New value (%s): " var)))) + (gud-basic-call + (concat "-gdb-set variable " var " = " value))))) + +;; Dont display values of arrays or structures. +;; These can be expanded using gud-watch. +(defun gdb-locals-handler-custom () + (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals)) + (table (make-gdb-table))) + (dolist (local locals-list) + (let ((name (bindat-get-field local 'name)) + (value (bindat-get-field local 'value)) + (type (bindat-get-field local 'type))) + (if (or (not value) + (string-match "\\0x" value)) + (add-text-properties 0 (length name) + `(mouse-face highlight + help-echo "mouse-2: create watch expression" + local-map ,gdb-locals-watch-map) + name) + (add-text-properties 0 (length value) + `(mouse-face highlight + help-echo "mouse-2: edit value" + local-map ,gdb-edit-locals-map-1) + value)) + (gdb-table-add-row + table + (list + (propertize type 'font-lock-face font-lock-type-face) + (propertize name 'font-lock-face font-lock-variable-name-face) + value) + `(gdb-local-variable ,local)))) + (insert (gdb-table-string table " ")) + (setq mode-name + (gdb-current-context-mode-name + (concat "Locals: " (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + +(defvar gdb-locals-header + (list + (gdb-propertize-header "Locals" gdb-locals-buffer + nil nil mode-line) + " " + (gdb-propertize-header "Registers" gdb-registers-buffer + "mouse-1: select" mode-line-highlight mode-line-inactive))) + +(defvar gdb-locals-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'kill-this-buffer) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create + 'gdb-registers-buffer + gdb-thread-number) t))) + map)) + +(define-derived-mode gdb-locals-mode gdb-parent-mode "Locals" + "Major mode for gdb locals. + +\\{gdb-locals-mode-map}" + (setq header-line-format gdb-locals-header) + (run-mode-hooks 'gdb-locals-mode-hook) + 'gdb-invalidate-locals) + +(defun gdb-locals-buffer-name () + (gdb-current-context-buffer-name + (concat "locals of " (gdb-get-target-string)))) + +(def-gdb-display-buffer + gdb-display-locals-buffer + 'gdb-locals-buffer + "Display local variables of current stack and their values.") + +(def-gdb-preempt-display-buffer + gdb-preemptively-display-locals-buffer + 'gdb-locals-buffer nil t) + +(def-gdb-frame-for-buffer + gdb-frame-locals-buffer + 'gdb-locals-buffer + "Display local variables of current stack and their values in a new frame.") + + +;; Registers buffer. + +(def-gdb-trigger-and-handler + gdb-invalidate-registers + (concat (gdb-current-context-command "-data-list-register-values") " x") + gdb-registers-handler + gdb-registers-handler-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-registers-buffer + 'gdb-registers-buffer-name + 'gdb-registers-mode + 'gdb-invalidate-registers) + +(defun gdb-registers-handler-custom () + (when gdb-register-names + (let ((register-values (bindat-get-field (gdb-json-partial-output) 'register-values)) + (table (make-gdb-table))) + (dolist (register register-values) + (let* ((register-number (bindat-get-field register 'number)) + (value (bindat-get-field register 'value)) + (register-name (nth (string-to-number register-number) + gdb-register-names))) + (gdb-table-add-row + table + (list + (propertize register-name 'font-lock-face font-lock-variable-name-face) + (if (member register-number gdb-changed-registers) + (propertize value 'font-lock-face font-lock-warning-face) + value)) + `(mouse-face highlight + help-echo "mouse-2: edit value" + gdb-register-name ,register-name)))) + (insert (gdb-table-string table " "))) + (setq mode-name + (gdb-current-context-mode-name "Registers")))) + +(defun gdb-edit-register-value (&optional event) + "Assign a value to a register displayed in the registers buffer." + (interactive (list last-input-event)) + (save-excursion + (if event (posn-set-point (event-end event))) + (beginning-of-line) + (let* ((var (bindat-get-field + (get-text-property (point) 'gdb-register-name))) + (value (read-string (format "New value (%s): " var)))) + (gud-basic-call + (concat "-gdb-set variable $" var " = " value))))) + +(defvar gdb-registers-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-edit-register-value) + (define-key map [mouse-2] 'gdb-edit-register-value) + (define-key map "q" 'kill-this-buffer) + (define-key map "\t" '(lambda () + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create + 'gdb-locals-buffer + gdb-thread-number) t))) + map)) + +(defvar gdb-registers-header + (list + (gdb-propertize-header "Locals" gdb-locals-buffer + "mouse-1: select" mode-line-highlight mode-line-inactive) + " " + (gdb-propertize-header "Registers" gdb-registers-buffer + nil nil mode-line))) + +(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers" + "Major mode for gdb registers. + +\\{gdb-registers-mode-map}" + (setq header-line-format gdb-registers-header) + (run-mode-hooks 'gdb-registers-mode-hook) + 'gdb-invalidate-registers) + +(defun gdb-registers-buffer-name () + (gdb-current-context-buffer-name + (concat "registers of " (gdb-get-target-string)))) + +(def-gdb-display-buffer + gdb-display-registers-buffer + 'gdb-registers-buffer + "Display integer register contents.") + +(def-gdb-preempt-display-buffer + gdb-preemptively-display-registers-buffer + 'gdb-registers-buffer nil t) + +(def-gdb-frame-for-buffer + gdb-frame-registers-buffer + 'gdb-registers-buffer + "Display integer register contents in a new frame.") + +;; Needs GDB 6.4 onwards (used to fail with no stack). +(defun gdb-get-changed-registers () + (if (and (gdb-get-buffer 'gdb-registers-buffer) + (not (gdb-pending-p 'gdb-get-changed-registers))) + (progn + (gdb-input + (list + "-data-list-changed-registers" + 'gdb-changed-registers-handler)) + (gdb-add-pending 'gdb-get-changed-registers)))) + +(defun gdb-changed-registers-handler () + (gdb-delete-pending 'gdb-get-changed-registers) + (setq gdb-changed-registers nil) + (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) + (push register-number gdb-changed-registers))) + +(defun gdb-register-names-handler () + ;; Don't use gdb-pending-triggers because this handler is called + ;; only once (in gdb-init-1) + (setq gdb-register-names nil) + (dolist (register-name (bindat-get-field (gdb-json-partial-output) 'register-names)) + (push register-name gdb-register-names)) + (setq gdb-register-names (reverse gdb-register-names))) + + +(defun gdb-get-source-file-list () + "Create list of source files for current GDB session. +If buffers already exist for any of these files, gud-minor-mode +is set in them." + (goto-char (point-min)) + (while (re-search-forward gdb-source-file-regexp nil t) + (push (match-string 1) gdb-source-file-list)) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (member buffer-file-name gdb-source-file-list) + (gdb-init-buffer)))) + (gdb-force-mode-line-update + (propertize "ready" 'face font-lock-variable-name-face))) + +(defun gdb-get-main-selected-frame () + "Trigger for `gdb-frame-handler' which uses main current +thread. Called from `gdb-update'." + (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) + (progn + (gdb-input + (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler)) + (gdb-add-pending 'gdb-get-main-selected-frame)))) + +(defun gdb-frame-handler () + "Sets `gdb-selected-frame' and `gdb-selected-file' to show +overlay arrow in source buffer." + (gdb-delete-pending 'gdb-get-main-selected-frame) + (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) + (when frame + (setq gdb-selected-frame (bindat-get-field frame 'func)) + (setq gdb-selected-file (bindat-get-field frame 'fullname)) + (setq gdb-frame-number (bindat-get-field frame 'level)) + (setq gdb-frame-address (bindat-get-field frame 'addr)) + (let ((line (bindat-get-field frame 'line))) + (setq gdb-selected-line (and line (string-to-number line))) + (when (and gdb-selected-file gdb-selected-line) + (setq gud-last-frame (cons gdb-selected-file gdb-selected-line)) + (gud-display-frame))) + (if gud-overlay-arrow-position + (let ((buffer (marker-buffer gud-overlay-arrow-position)) + (position (marker-position gud-overlay-arrow-position))) + (when buffer + (with-current-buffer buffer + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle)))) + (setq gud-overlay-arrow-position (make-marker)) + (set-marker gud-overlay-arrow-position position)))))))) + +(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") + +(defun gdb-get-prompt () + "Find prompt for GDB session." + (goto-char (point-min)) + (setq gdb-prompt-name nil) + (re-search-forward gdb-prompt-name-regexp nil t) + (setq gdb-prompt-name (match-string 1)) + ;; Insert first prompt. + (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) + +;;;; Window management +(defun gdb-display-buffer (buf dedicated &optional frame) + "Show buffer BUF. + +If BUF is already displayed in some window, show it, deiconifying +the frame if necessary. Otherwise, find least recently used +window and show BUF there, if the window is not used for GDB +already, in which case that window is splitted first." + (let ((answer (get-buffer-window buf (or frame 0)))) + (if answer + (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary. + (let ((window (get-lru-window))) + (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window)) + 'gdbmi) + (let* ((largest (get-largest-window)) + (cur-size (window-height largest))) + (setq answer (split-window largest)) + (set-window-buffer answer buf) + (set-window-dedicated-p answer dedicated) + answer) + (set-window-buffer window buf) + window))))) + +(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal) + "Find window displaying a buffer with the same +`gdb-buffer-type' as BUF and show BUF there. If no such window +exists, just call `gdb-display-buffer' for BUF. If the window +found is already dedicated, split window according to +SPLIT-HORIZONTAL and show BUF in the new window." + (if buf + (when (not (get-buffer-window buf)) + (let* ((buf-type (gdb-buffer-type buf)) + (existing-window + (get-window-with-predicate + #'(lambda (w) + (and (eq buf-type + (gdb-buffer-type (window-buffer w))) + (not (window-dedicated-p w))))))) + (if existing-window + (set-window-buffer existing-window buf) + (let ((dedicated-window + (get-window-with-predicate + #'(lambda (w) + (eq buf-type + (gdb-buffer-type (window-buffer w))))))) + (if dedicated-window + (set-window-buffer + (split-window dedicated-window nil split-horizontal) buf) + (gdb-display-buffer buf t)))))) + (error "Null buffer"))) + +;;; Shared keymap initialization: + +(let ((menu (make-sparse-keymap "GDB-Windows"))) + (define-key gud-menu-map [displays] + `(menu-item "GDB-Windows" ,menu + :visible (eq gud-minor-mode 'gdbmi))) + (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) + (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) + (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) + (define-key menu [disassembly] + '("Disassembly" . gdb-display-disassembly-buffer)) + (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) + (define-key menu [inferior] + '("IO" . gdb-display-io-buffer)) + (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) + (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) + (define-key menu [breakpoints] + '("Breakpoints" . gdb-display-breakpoints-buffer))) + +(let ((menu (make-sparse-keymap "GDB-Frames"))) + (define-key gud-menu-map [frames] + `(menu-item "GDB-Frames" ,menu + :visible (eq gud-minor-mode 'gdbmi))) + (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) + (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) + (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) + (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer)) + (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) + (define-key menu [inferior] + '("IO" . gdb-frame-io-buffer)) + (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) + (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) + (define-key menu [breakpoints] + '("Breakpoints" . gdb-frame-breakpoints-buffer))) + +(let ((menu (make-sparse-keymap "GDB-MI"))) + (define-key menu [gdb-customize] + '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) + :help "Customize Gdb Graphical Mode options.")) + (define-key menu [gdb-many-windows] + '(menu-item "Display Other Windows" gdb-many-windows + :help "Toggle display of locals, stack and breakpoint information" + :button (:toggle . gdb-many-windows))) + (define-key menu [gdb-restore-windows] + '(menu-item "Restore Window Layout" gdb-restore-windows + :help "Restore standard layout for debug session.")) + (define-key menu [sep1] + '(menu-item "--")) + (define-key menu [all-threads] + '(menu-item "GUD controls all threads" + (lambda () + (interactive) + (setq gdb-gud-control-all-threads t)) + :help "GUD start/stop commands apply to all threads" + :button (:radio . gdb-gud-control-all-threads))) + (define-key menu [current-thread] + '(menu-item "GUD controls current thread" + (lambda () + (interactive) + (setq gdb-gud-control-all-threads nil)) + :help "GUD start/stop commands apply to current thread only" + :button (:radio . (not gdb-gud-control-all-threads)))) + (define-key menu [sep2] + '(menu-item "--")) + (define-key menu [gdb-customize-reasons] + '(menu-item "Customize switching..." + (lambda () + (interactive) + (customize-option 'gdb-switch-reasons)))) + (define-key menu [gdb-switch-when-another-stopped] + (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped gdb-switch-when-another-stopped + "Automatically switch to stopped thread" + "GDB thread switching %s" + "Switch to stopped thread")) + (define-key gud-menu-map [mi] + `(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi)))) + +;; TODO Fit these into tool-bar-local-item-from-menu call in gud.el. +;; GDB-MI menu will need to be moved to gud.el. We can't use +;; tool-bar-local-item-from-menu here because it appends new buttons +;; to toolbar from right to left while we want our A/T throttle to +;; show up right before Run button. +(define-key-after gud-tool-bar-map [all-threads] + '(menu-item "Switch to non-stop/A mode" gdb-control-all-threads + :image (find-image '((:type xpm :file "gud/thread.xpm"))) + :visible (and (eq gud-minor-mode 'gdbmi) + gdb-non-stop + (not gdb-gud-control-all-threads))) + 'run) + +(define-key-after gud-tool-bar-map [current-thread] + '(menu-item "Switch to non-stop/T mode" gdb-control-current-thread + :image (find-image '((:type xpm :file "gud/all.xpm"))) + :visible (and (eq gud-minor-mode 'gdbmi) + gdb-non-stop + gdb-gud-control-all-threads)) + 'all-threads) + +(defun gdb-frame-gdb-buffer () + "Display GUD buffer in a new frame." + (interactive) + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist + (remove '(menu-bar-lines) (remove '(tool-bar-lines) + gdb-frame-parameters))) + (same-window-regexps nil)) + (display-buffer gud-comint-buffer))) + +(defun gdb-display-gdb-buffer () + "Display GUD buffer." + (interactive) + (let ((same-window-regexps nil)) + (select-window (display-buffer gud-comint-buffer nil 0)))) + +(defun gdb-set-window-buffer (name &optional ignore-dedicated) + "Set buffer of selected window to NAME and dedicate window. + +When IGNORE-DEDICATED is non-nil, buffer is set even if selected +window is dedicated." + (when ignore-dedicated + (set-window-dedicated-p (selected-window) nil)) + (set-window-buffer (selected-window) (get-buffer name)) + (set-window-dedicated-p (selected-window) t)) + +(defun gdb-setup-windows () + "Layout the window pattern for `gdb-many-windows'." + (gdb-display-locals-buffer) + (gdb-display-stack-buffer) + (delete-other-windows) + (gdb-display-breakpoints-buffer) + (delete-other-windows) + ; Don't dedicate. + (pop-to-buffer gud-comint-buffer) + (split-window nil ( / ( * (window-height) 3) 4)) + (split-window nil ( / (window-height) 3)) + (split-window-horizontally) + (other-window 1) + (gdb-set-window-buffer (gdb-locals-buffer-name)) + (other-window 1) + (switch-to-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (if gdb-main-file + (gud-find-file gdb-main-file) + ;; Put buffer list in window if we + ;; can't find a source file. + (list-buffers-noselect)))) + (setq gdb-source-window (selected-window)) + (split-window-horizontally) + (other-window 1) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-inferior-io)) + (other-window 1) + (gdb-set-window-buffer (gdb-stack-buffer-name)) + (split-window-horizontally) + (other-window 1) + (gdb-set-window-buffer (if gdb-show-threads-by-default + (gdb-threads-buffer-name) + (gdb-breakpoints-buffer-name))) + (other-window 1)) + +(defcustom gdb-many-windows nil + "If nil just pop up the GUD buffer unless `gdb-show-main' is t. +In this case it starts with two windows: one displaying the GUD +buffer and the other with the source file with the main routine +of the debugged program. Non-nil means display the layout shown for +`gdb'." + :type 'boolean + :group 'gdb + :version "22.1") + +(defun gdb-many-windows (arg) + "Toggle the number of windows in the basic arrangement. +With arg, display additional buffers iff arg is positive." + (interactive "P") + (setq gdb-many-windows + (if (null arg) + (not gdb-many-windows) + (> (prefix-numeric-value arg) 0))) + (message (format "Display of other windows %sabled" + (if gdb-many-windows "en" "dis"))) + (if (and gud-comint-buffer + (buffer-name gud-comint-buffer)) + (condition-case nil + (gdb-restore-windows) + (error nil)))) + +(defun gdb-restore-windows () + "Restore the basic arrangement of windows used by gdb. +This arrangement depends on the value of `gdb-many-windows'." + (interactive) + (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. + (delete-other-windows) + (if gdb-many-windows + (gdb-setup-windows) + (when (or gud-last-last-frame gdb-show-main) + (split-window) + (other-window 1) + (switch-to-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (setq gdb-source-window (selected-window)) + (other-window 1)))) + +(defun gdb-reset () + "Exit a debugging session cleanly. +Kills the gdb buffers, and resets variables and the source buffers." + (dolist (buffer (buffer-list)) + (unless (eq buffer gud-comint-buffer) + (with-current-buffer buffer + (if (eq gud-minor-mode 'gdbmi) + (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) + (kill-local-variable 'gdb-define-alist)))))) + (setq gdb-disassembly-position nil) + (setq overlay-arrow-variable-list + (delq 'gdb-disassembly-position overlay-arrow-variable-list)) + (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) + (setq gdb-stack-position nil) + (setq overlay-arrow-variable-list + (delq 'gdb-stack-position overlay-arrow-variable-list)) + (setq gdb-thread-position nil) + (setq overlay-arrow-variable-list + (delq 'gdb-thread-position overlay-arrow-variable-list)) + (if (boundp 'speedbar-frame) (speedbar-timer-fn)) + (setq gud-running nil) + (setq gdb-active-process nil) + (remove-hook 'after-save-hook 'gdb-create-define-alist t)) + +(defun gdb-get-source-file () + "Find the source file where the program starts and display it with related +buffers, if required." + (goto-char (point-min)) + (if (re-search-forward gdb-source-file-regexp nil t) + (setq gdb-main-file (match-string 1))) + (if gdb-many-windows + (gdb-setup-windows) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) + (if gdb-show-main + (let ((pop-up-windows t)) + (display-buffer (gud-find-file gdb-main-file)))))) + +;;from put-image +(defun gdb-put-string (putstring pos &optional dprop &rest sprops) + "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 ((string (make-string 1 ?x)) + (buffer (current-buffer))) + (setq putstring (copy-sequence putstring)) + (let ((overlay (make-overlay pos pos buffer)) + (prop (or dprop + (list (list 'margin 'left-margin) putstring)))) + (put-text-property 0 1 'display prop string) + (if sprops + (add-text-properties 0 1 sprops string)) + (overlay-put overlay 'put-break t) + (overlay-put overlay 'before-string 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))) + (dolist (overlay (overlays-in start end)) + (when (overlay-get overlay 'put-break) + (delete-overlay overlay)))) + +(defun gdb-put-breakpoint-icon (enabled bptno &optional line) + (let* ((posns (gdb-line-posns (or line (line-number-at-pos)))) + (start (- (car posns) 1)) + (end (+ (cdr posns) 1)) + (putstring (if enabled "B" "b")) + (source-window (get-buffer-window (current-buffer) 0))) + (add-text-properties + 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt") + putstring) + (if enabled + (add-text-properties + 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) + (add-text-properties + 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring)) + (gdb-remove-breakpoint-icons start end) + (if (display-images-p) + (if (>= (or left-fringe-width + (if source-window (car (window-fringes source-window))) + gdb-buffer-fringe-width) 8) + (gdb-put-string + nil (1+ start) + `(left-fringe breakpoint + ,(if enabled + 'breakpoint-enabled + 'breakpoint-disabled)) + 'gdb-bptno bptno + 'gdb-enabled enabled) + (when (< left-margin-width 2) + (save-current-buffer + (setq left-margin-width 2) + (if source-window + (set-window-margins + source-window + 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 :pointer hand) + (:type pbm :data + ,breakpoint-disabled-pbm-data + :ascent 100 :pointer hand)))))) + (+ start 1) + putstring + 'left-margin)) + (when (< left-margin-width 2) + (save-current-buffer + (setq left-margin-width 2) + (let ((window (get-buffer-window (current-buffer) 0))) + (if window + (set-window-margins + window left-margin-width right-margin-width))))) + (gdb-put-string + (propertize putstring + 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) + (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) + (let ((window (get-buffer-window (current-buffer) 0))) + (if window + (set-window-margins + window left-margin-width right-margin-width))))) + +(provide 'gdb-mi) + +;; arch-tag: 1b41ea2b-f364-4cec-8f35-e02e4fe01912 +;;; gdb-mi.el ends here
--- a/lisp/progmodes/gdb-ui.el Sat Mar 20 10:32:32 2010 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4143 +0,0 @@ -;;; gdb-ui.el --- User Interface for running GDB - -;; Author: Nick Roberts <nickrob@gnu.org> -;; Maintainer: FSF -;; Keywords: unix, tools - -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; 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, if -;; required, and watches expressions in the speedbar. It also uses features of -;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar -;; (see the GDB Graphical Interface section in the Emacs info manual). - -;; By default, M-x gdb will start the debugger. - -;; This file has evolved from gdba.el that was included with GDB 5.0 and -;; written by Tom Lord and Jim Kingdon. It 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, see the Annotations -;; section in the GDB info manual. - -;; GDB developers plan to make the annotation interface obsolete. A new -;; interface called GDB/MI (machine interface) has been designed to replace it. -;; Some GDB/MI commands are used in this file through the CLI command -;; 'interpreter mi <mi-command>'. To help with the process of fully migrating -;; Emacs from annotations to GDB/MI, there is an experimental package called -;; gdb-mi in the Emacs Lisp Package Archive ("http://tromey.com/elpa/"). It -;; comprises of modified gud.el and a file called gdb-mi.el which replaces -;; gdb-ui.el. When installed, this overrides the current files and invoking -;; M-x gdb will use GDB/MI directly (starts with "gdb -i=mi"). When deleted -;; ('d' followed by 'x' in Package Menu mode), the files are deleted and old -;; functionality restored. This provides a convenient way to review the -;; current status/contribute to its improvement. For someone who just wants to -;; use GDB, however, the current mode in Emacs 22 is a much better option. -;; There is also a file, also called gdb-mi.el, a version of which is included -;; the GDB distribution. This will probably only work with versions -;; distributed with GDB 6.5 or later. Unlike the version in ELPA it works on -;; top of gdb-ui.el and you can only start it with M-x gdbmi. - -;; This mode SHOULD WORK WITH GDB 5.0 or later but you will NEED AT LEAST -;; GDB 6.0 to use watch expressions. It works best with GDB 6.4 or later -;; where watch expressions will update more quickly. - -;;; Windows Platforms: - -;; If you are using Emacs and GDB on Windows you will need to flush the buffer -;; explicitly in your program if you want timely display of I/O in Emacs. -;; Alternatively you can make the output stream unbuffered, for example, by -;; using a macro: - -;; #ifdef UNBUFFERED -;; setvbuf (stdout, (char *) NULL, _IONBF, 0); -;; #endif - -;; and compiling with -DUNBUFFERED while debugging. - -;; If you are using Cygwin GDB and find that the source is not being displayed -;; in Emacs when you step through it, possible solutions are to: - -;; 1) Use Cygwin X Windows and Cygwin Emacs. -;; (Since 22.1 Emacs builds under Cygwin.) -;; 2) Use MinGW GDB instead. -;; 3) Use cygwin-mount.el - -;;; Mac OSX: - -;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made -;; some changes to the version that they include as part of Mac OSX. -;; This requires GDB version 7.0 or later (estimated release date June 2009) -;; as earlier versions don not compile on Mac OSX. - -;;; Known Bugs: - -;; 1) Cannot handle multiple debug sessions. -;; 2) If you wish to call procedures from your program in GDB -;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations -;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed. -;; 3) After detaching from a process, clicking on the "GO" icon on toolbar -;; (gud-go) sends "continue" to GDB (should be "run"). - -;;; TODO: - -;; 1) Use MI command -data-read-memory for memory window. -;; 2) Use tree-buffer.el (from ECB) instead of the speedbar for -;; watch-expressions? Handling of watch-expressions needs to be -;; overhauled to work for large arrays/structures by creating variable -;; objects for visible watch-expressions only. -;; 3) Mark breakpoint locations on scroll-bar of source buffer? - -;;; Code: - -(require 'gud) -(require 'json) -(require 'bindat) - -(defvar tool-bar-map) -(defvar speedbar-initial-expansion-list-name) -(defvar speedbar-frame) - -(defvar gdb-pc-address nil "Initialization for Assembler buffer. -Set to \"main\" at start if `gdb-show-main' is t.") -(defvar gdb-frame-address nil "Identity of frame for watch expression.") -(defvar gdb-previous-frame-pc-address nil) -(defvar gdb-memory-address "main") -(defvar gdb-previous-frame nil) -(defvar gdb-selected-frame nil) -(defvar gdb-frame-number nil) -(defvar gdb-current-language nil) -(defvar gdb-var-list nil - "List of variables in watch window. -Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP) -where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame -address for root variables.") -(defvar gdb-main-file nil "Source file from which program execution begins.") -(defvar gud-old-arrow nil) -(defvar gdb-thread-indicator nil) -(defvar gdb-overlay-arrow-position nil) -(defvar gdb-stack-position nil) -(defvar gdb-server-prefix nil) -(defvar gdb-flush-pending-output nil) -(defvar gdb-location-alist nil - "Alist of breakpoint numbers and full filenames. -Only used for files that Emacs can't find.") -(defvar gdb-active-process nil - "GUD tooltips display variable values when t, and macro definitions otherwise.") -(defvar gdb-recording nil - "If t, then record session for playback and reverse execution") -(defvar gdb-error "Non-nil when GDB is reporting an error.") -(defvar gdb-macro-info nil - "Non-nil if GDB knows that the inferior includes preprocessor macro info.") -(defvar gdb-buffer-fringe-width nil) -(defvar gdb-signalled nil) -(defvar gdb-source-window nil) -(defvar gdb-inferior-status nil) -(defvar gdb-continuation nil) -(defvar gdb-look-up-stack nil) -(defvar gdb-frame-begin nil - "Non-nil when GDB generates frame-begin annotation.") -(defvar gdb-printing t) -(defvar gdb-parent-bptno-enabled nil) -(defvar gdb-ready nil) -(defvar gdb-stack-update nil) -(defvar gdb-early-user-input nil) - -(defvar gdb-buffer-type nil - "One of the symbols bound in `gdb-buffer-rules'.") -(make-variable-buffer-local 'gdb-buffer-type) - -(defvar gdb-input-queue () - "A list of gdb command objects.") - -(defvar gdb-prompting nil - "True when gdb is idle with no pending input.") - -(defvar gdb-output-sink nil - "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 output until the prompt annotation is - received, then go to USER disposition. - -gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two -\(`user' and `emacs').") - -(defvar gdb-current-item nil - "The most recent command item sent to gdb.") - -(defvar gdb-pending-triggers '() - "A list of trigger functions that have run later than their output handlers.") - -(defvar gdb-first-post-prompt nil) -(defvar gdb-version nil) -(defvar gdb-locals-font-lock-keywords nil) -(defvar gdb-source-file-list nil - "List of source files for the current executable.") -(defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"") - -(defvar gdb-locals-font-lock-keywords-1 - '(;; var = (struct struct_tag) value - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-keyword-face) - (4 font-lock-type-face)) - ;; var = (type) value - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-type-face)) - ;; var = val - ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]" - (1 font-lock-variable-name-face))) - "Font lock keywords used in `gdb-local-mode'.") - -(defvar gdb-locals-font-lock-keywords-2 - '(;; var = type value - ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)" - (1 font-lock-variable-name-face) - (3 font-lock-type-face))) - "Font lock keywords used in `gdb-local-mode'.") - -;; Variables for GDB 6.4+ -(defvar gdb-register-names nil "List of register names.") -(defvar gdb-changed-registers nil - "List of changed register numbers (strings).") - -;;;###autoload -(defun gdb (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 just -pops up the GUD buffer unless `gdb-show-main' is t. In this case -it starts with two windows: one displaying the GUD buffer and the -other with the source file with the main routine of the inferior. - -If `gdb-many-windows' is t, regardless of the value of -`gdb-show-main', the layout below will appear unless -`gdb-use-separate-io-buffer' is nil when the source buffer -occupies the full width of the frame. Keybindings are shown in -some of the buffers. - -Watch expressions appear in the speedbar/slowbar. - -The following commands help control operation : - -`gdb-many-windows' - Toggle the number of windows gdb uses. -`gdb-restore-windows' - To restore the window layout. - -See Info node `(emacs)GDB Graphical Interface' for a more -detailed description of this mode. - -+----------------------------------------------------------------------+ -| GDB Toolbar | -+-----------------------------------+----------------------------------+ -| GUD buffer (I/O of GDB) | Locals buffer | -|-----------------------------------+----------------------------------+ -| | | -| Source buffer | I/O buffer for debugged program | -| | | -|-----------------------------------+----------------------------------+ -| Stack buffer | Breakpoints/threads buffer | -+-----------------------------------+----------------------------------+ - -The option \"--annotate=3\" must be included in this value. To -run GDB in text command mode, use `gud-gdb'. You need to use -text command mode to debug multiple programs within one Emacs -session." - (interactive (list (gud-query-cmdline 'gdb))) - - (when (and gud-comint-buffer - (buffer-name gud-comint-buffer) - (get-buffer-process gud-comint-buffer) - (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) - (gdb-restore-windows) - (error - "Multiple debugging requires restarting in text command mode")) - - (gud-common-init command-line nil 'gud-gdba-marker-filter) - (set (make-local-variable 'gud-minor-mode) 'gdba) - (setq comint-input-sender 'gdb-send) - - (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "tbreak %f:%l" "\C-t" - "Set temporary breakpoint at current line.") - (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line.") - (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") - (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") - (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") - (gud-def gud-cont "continue" "\C-r" "Continue with display.") - (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") - (gud-def gud-jump - (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) - "\C-j" "Set execution address to current line.") - - (gud-def gud-rstep "reverse-step %p" nil "Reverse step one source line with display.") - (gud-def gud-rstepi "reverse-stepi %p" nil "Reverse step one instruction with display.") - (gud-def gud-rnext "reverse-next %p" nil "Reverse step one line (skip functions).") - (gud-def gud-rnexti "reverse-nexti %p" nil "Reverse step one instruction (skip functions).") - (gud-def gud-rcont "reverse-continue" nil "Reverse continue with display.") - (gud-def gud-rfinish "reverse-finish" nil "Reverse finish executing current function.") - - (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") - (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") - (gud-def gud-pstar "print* %e" nil - "Evaluate C dereferenced pointer expression at point.") - - ;; For debugging Emacs only. - (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.") - - (gud-def gud-until "until %l" "\C-u" "Continue to current line.") - (gud-def gud-run "run" nil "Run the program.") - - (local-set-key "\C-i" 'gud-gdb-complete-command) - (setq comint-prompt-regexp "^(.*gdb[+]?) *") - (setq paragraph-start comint-prompt-regexp) - (setq gdb-output-sink 'user) - (setq gdb-first-prompt t) - (setq gud-running nil) - (setq gdb-ready nil) - (setq gdb-stack-update nil) - (setq gdb-flush-pending-output nil) - (setq gdb-early-user-input nil) - (setq gud-filter-pending-text nil) - (gdb-thread-identification) - (run-hooks 'gdb-mode-hook)) - -;; Keep as an alias for compatibility with Emacs 22.1. -;;;###autoload -(defalias 'gdba 'gdb) - -(defgroup gdb nil - "Gdb Graphical Mode options specifically for running Gdb in Emacs." - :group 'processes - :group 'tools) - -(defcustom gdb-debug-log-max 128 - "Maximum size of `gdb-debug-log'. If nil, size is unlimited." - :group 'gdb - :type '(choice (integer :tag "Number of elements") - (const :tag "Unlimited" nil)) - :version "22.1") - -(defvar gdb-debug-log nil - "List of commands sent to and replies received from GDB. -Most recent commands are listed first. This list stores only the last -`gdb-debug-log-max' values. This variable is used to debug GDB-UI.") - -;;;###autoload -(defcustom gdb-enable-debug nil - "Non-nil means record the process input and output in `gdb-debug-log'." - :type 'boolean - :group 'gdb - :version "22.1") - -(defcustom gdb-cpp-define-alist-program "gcc -E -dM -" - "Shell command for generating a list of defined macros in a source file. -This list is used to display the #define directive associated -with an identifier as a tooltip. It works in a debug session with -GDB, when `gud-tooltip-mode' is t. - -Set `gdb-cpp-define-alist-flags' for any include paths or -predefined macros." - :type 'string - :group 'gdb - :version "22.1") - -(defcustom gdb-cpp-define-alist-flags "" - "Preprocessor flags for `gdb-cpp-define-alist-program'." - :type 'string - :group 'gdb - :version "22.1") - -(defcustom gdb-create-source-file-list t - "Non-nil means create a list of files from which the executable was built. -Set this to nil if the GUD buffer displays \"initializing...\" in the mode -line for a long time when starting, possibly because your executable was -built from a large number of files. This allows quicker initialization -but means that these files are not automatically enabled for debugging, -e.g., you won't be able to click in the fringe to set a breakpoint until -execution has already stopped there." - :type 'boolean - :group 'gdb - :version "23.1") - -(defcustom gdb-show-main nil - "Non-nil means display source file containing the main routine at startup. -Also display the main routine in the disassembly buffer if present." - :type 'boolean - :group 'gdb - :version "22.1") - -(defcustom gdb-many-windows nil - "If nil, just pop up the GUD buffer unless `gdb-show-main' is t. -In this case start with two windows: one displaying the GUD -buffer and the other with the source file with the main routine -of the debugged program. Non-nil means display the layout shown -for `gdba'." - :type 'boolean - :group 'gdb - :version "22.1") - -(defcustom gdb-use-separate-io-buffer nil - "Non-nil means display output from the debugged program in a separate buffer." - :type 'boolean - :group 'gdb - :version "22.1") - -(defun gdb-force-mode-line-update (status) - (let ((buffer gud-comint-buffer)) - (if (and buffer (buffer-name buffer)) - (with-current-buffer buffer - (setq mode-line-process - (format ":%s [%s]" - (process-status (get-buffer-process buffer)) status)) - ;; Force mode line redisplay soon. - (force-mode-line-update))))) - -(defun gdb-enable-debug (arg) - "Toggle logging of transaction between Emacs and Gdb. -The log is stored in `gdb-debug-log' as an alist with elements -whose cons is send, send-item or recv and whose cdr is the string -being transferred. This list may grow up to a size of -`gdb-debug-log-max' after which the oldest element (at the end of -the list) is deleted every time a new one is added (at the front)." - (interactive "P") - (setq gdb-enable-debug - (if (null arg) - (not gdb-enable-debug) - (> (prefix-numeric-value arg) 0))) - (message (format "Logging of transaction %sabled" - (if gdb-enable-debug "en" "dis")))) - -(defun gdb-many-windows (arg) - "Toggle the number of windows in the basic arrangement. -With prefix argument ARG, display additional buffers if ARG is positive, -otherwise use a single window." - (interactive "P") - (setq gdb-many-windows - (if (null arg) - (not gdb-many-windows) - (> (prefix-numeric-value arg) 0))) - (message (format "Display of other windows %sabled" - (if gdb-many-windows "en" "dis"))) - (if (and gud-comint-buffer - (buffer-name gud-comint-buffer)) - (condition-case nil - (gdb-restore-windows) - (error nil)))) - -(defun gdb-use-separate-io-buffer (arg) - "Toggle separate IO for debugged program. -With prefix argument ARG, use separate IO if ARG is positive, -otherwise do not." - (interactive "P") - (setq gdb-use-separate-io-buffer - (if (null arg) - (not gdb-use-separate-io-buffer) - (> (prefix-numeric-value arg) 0))) - (message (format "Separate IO %sabled" - (if gdb-use-separate-io-buffer "en" "dis"))) - (if (and gud-comint-buffer - (buffer-name gud-comint-buffer)) - (condition-case nil - (if gdb-use-separate-io-buffer - (if gdb-many-windows (gdb-restore-windows)) - (kill-buffer (gdb-inferior-io-name))) - (error nil)))) - -(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.") - -(defun gdb-create-define-alist () - "Create an alist of #define directives for GUD tooltips." - (let* ((file (buffer-file-name)) - (output - (with-output-to-string - (with-current-buffer standard-output - (and file - (file-exists-p file) - ;; call-process doesn't work with remote file names. - (not (file-remote-p default-directory)) - (call-process shell-file-name file - (list t nil) nil "-c" - (concat gdb-cpp-define-alist-program " " - gdb-cpp-define-alist-flags)))))) - (define-list (split-string output "\n" t)) (name)) - (setq gdb-define-alist nil) - (dolist (define define-list) - (setq name (nth 1 (split-string define "[( ]"))) - (push (cons name define) gdb-define-alist)))) - -(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) -(defvar tooltip-use-echo-area) - -(defun gdb-tooltip-print (expr) - (tooltip-show - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (let ((string - (if (search-forward "=" nil t) - (concat expr (buffer-substring (- (point) 2) (point-max))) - (buffer-string)))) - ;; remove newline for gud-tooltip-echo-area - (substring string 0 (- (length string) 1)))) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not (display-graphic-p))))) - -;; If expr is a macro for a function don't print because of possible dangerous -;; side-effects. Also printing a function within a tooltip generates an -;; unexpected starting annotation (phase error). -(defun gdb-tooltip-print-1 (expr) - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (if (search-forward "expands to: " nil t) - (unless (looking-at "\\S-+.*(.*).*") - (gdb-enqueue-input - (list (concat gdb-server-prefix "print " expr "\n") - `(lambda () (gdb-tooltip-print ,expr)))))))) - -(defconst gdb-source-file-regexp "\\(.+?\\), \\|\\([^, \n].*$\\)") - -(defun gdb-init-buffer () - (set (make-local-variable 'gud-minor-mode) - (buffer-local-value 'gud-minor-mode gud-comint-buffer)) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) - (when gud-tooltip-mode - (make-local-variable 'gdb-define-alist) - (gdb-create-define-alist) - (add-hook 'after-save-hook 'gdb-create-define-alist nil t))) - -(defun gdb-set-gud-minor-mode-existing-buffers () - "Create list of source files for current GDB session." - (goto-char (point-min)) - (when (search-forward "read in on demand:" nil t) - (while (re-search-forward gdb-source-file-regexp nil t) - (push (file-name-nondirectory (or (match-string 1) (match-string 2))) - gdb-source-file-list)) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (and buffer-file-name - (member (file-name-nondirectory buffer-file-name) - gdb-source-file-list)) - (gdb-init-buffer))))) - (gdb-force-mode-line-update - (propertize "ready" 'face font-lock-variable-name-face))) - -(defun gdb-find-watch-expression () - (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) - (varnum (car var)) expr array) - (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) - (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet - (component-list (split-string (match-string 2 varnum) "\\." t))) - (setq expr (nth 1 var1)) - (setq varnumlet (car var1)) - (dolist (component component-list) - (setq var2 (assoc varnumlet gdb-var-list)) - (setq expr (concat expr - (if (string-match ".*\\[[0-9]+\\]$" (nth 3 var2)) - (concat "[" component "]") - (concat "." component)))) - (setq varnumlet (concat varnumlet "." component))) - expr))) - -(defun gdb-toggle-recording () -"Start/stop recording of debug session." - (interactive) - (if gud-running - (message-box "Recording cannot be started or stopped while your program is still running") - (gdb-enqueue-input - (list (concat gdb-server-prefix - (if gdb-recording "record stop\n" "target record\n")) - 'gdb-recording-handler)))) - -;; Convenience function for tool bar. -(defalias 'gdb-toggle-recording-1 'gdb-toggle-recording) - -(defun gdb-recording-handler () - (goto-char (point-min)) - (if (re-search-forward "current architecture doesn't support record function" nil t) - (message-box "Not enabled. The current architecture doesn't support the process record function.") - (goto-char (point-min)) - (if (re-search-forward "Undefined target command" nil t) - (message-box "Not enabled. Process record requires GDB 7.0 onwards.") - (goto-char (point-min)) - (if (re-search-forward "the program is not being run" nil t) - (message-box "Not enabled. Starting process recording requires an active target (running process).") - (setq gdb-recording (not gdb-recording)) - ;; Actually forcing the tool-bar to update. - (force-mode-line-update))))) - -(defun gdb-init-1 () - (gud-def gud-break (if (not (string-match "Machine" mode-name)) - (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-match "Machine" mode-name)) - (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-match "Machine" mode-name)) - (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.") - ;; - (gud-def gud-go (gud-call (if gdb-active-process "continue" "run") arg) - nil "Start or continue execution.") - - ;; For debugging Emacs only. - (gud-def gud-pp - (gud-call - (concat - "pp1 " (if (eq (buffer-local-value - 'major-mode (window-buffer)) 'speedbar-mode) - (gdb-find-watch-expression) "%e")) arg) - nil "Print the Emacs s-expression.") - - (define-key gud-minor-mode-map [left-margin mouse-1] - 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-1] - 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-margin C-mouse-1] - 'gdb-mouse-toggle-breakpoint-margin) - (define-key gud-minor-mode-map [left-fringe C-mouse-1] - 'gdb-mouse-toggle-breakpoint-fringe) - - (define-key gud-minor-mode-map [left-margin drag-mouse-1] - 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-fringe drag-mouse-1] - 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-margin mouse-3] - 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-fringe mouse-3] - 'gdb-mouse-until) - - (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] - 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] - 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-fringe C-mouse-3] - 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-margin C-mouse-3] - 'gdb-mouse-jump) - - ;; (re-)initialize - (setq gdb-pc-address (if gdb-show-main "main" nil)) - (setq gdb-previous-frame-pc-address nil - gdb-memory-address "main" - gdb-previous-frame nil - gdb-selected-frame nil - gdb-current-language nil - gdb-frame-number nil - gdb-var-list nil - gdb-main-file nil - gdb-first-post-prompt t - gdb-prompting nil - gdb-input-queue nil - gdb-current-item nil - gdb-pending-triggers nil - gdb-output-sink 'user - gdb-server-prefix "server " - gdb-location-alist nil - gdb-source-file-list nil - gdb-error nil - gdb-macro-info nil - gdb-buffer-fringe-width (car (window-fringes)) - gdb-debug-log nil - gdb-signalled nil - gdb-source-window nil - gdb-inferior-status nil - gdb-continuation nil - gdb-look-up-stack nil - gdb-frame-begin nil - gdb-printing t - gud-old-arrow nil - gdb-thread-indicator nil - gdb-register-names nil - gdb-recording nil) - - (setq gdb-buffer-type 'gdba) - - (if gdb-use-separate-io-buffer (gdb-clear-inferior-io)) - - ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4) - (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n" - 'gdb-get-version))) - -(defun gdb-init-2 () - (if (eq window-system 'w32) - (gdb-enqueue-input (list "set new-console off\n" 'ignore))) - (gdb-enqueue-input (list "set height 0\n" 'ignore)) - (gdb-enqueue-input (list "set width 0\n" 'ignore)) - - (if (string-equal gdb-version "pre-6.4") - (if gdb-create-source-file-list - (gdb-enqueue-input (list (concat gdb-server-prefix "info sources\n") - 'gdb-set-gud-minor-mode-existing-buffers)) - (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1)) - ; Needs GDB 6.2 onwards. - (if gdb-create-source-file-list - (gdb-enqueue-input - (list "server interpreter mi \"-file-list-exec-source-files\"\n" - 'gdb-set-gud-minor-mode-existing-buffers-1))) - (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2) - ; Needs GDB 7.0 onwards. - (gdb-enqueue-input - (list "server interpreter mi -enable-pretty-printing\n" 'ignore))) - - ;; Find source file and compilation directory here. - ;; Works for C, C++, Fortran and Ada but not Java (GDB 6.4) - (gdb-enqueue-input (list "server list\n" 'ignore)) - (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) - (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))) - -(defun gdb-get-version () - (goto-char (point-min)) - (if (re-search-forward "Undefined\\( mi\\)* command:" nil t) - (setq gdb-version "pre-6.4") - (setq gdb-version "6.4+")) - (gdb-init-2)) - -(defmacro gdb-if-arrow (arrow-position &rest body) - `(if ,arrow-position - (let ((buffer (marker-buffer ,arrow-position)) (line)) - (if (equal buffer (window-buffer (posn-window end))) - (with-current-buffer buffer - (when (or (equal start end) - (equal (posn-point start) - (marker-position ,arrow-position))) - ,@body)))))) - -(defun gdb-mouse-until (event) - "Continue running until a source line past the current line. -The destination source line can be selected either by clicking -with mouse-3 on the fringe/margin or dragging the arrow -with mouse-1 (default bindings)." - (interactive "e") - (let ((start (event-start event)) - (end (event-end event))) - (gdb-if-arrow gud-overlay-arrow-position - (setq line (line-number-at-pos (posn-point end))) - (gud-call (concat "until " (number-to-string line)))) - (gdb-if-arrow gdb-overlay-arrow-position - (save-excursion - (goto-char (point-min)) - (forward-line (1- (line-number-at-pos (posn-point end)))) - (forward-char 2) - (gud-call (concat "until *%a")))))) - -(defun gdb-mouse-jump (event) - "Set execution address/line. -The destination source line can be selected either by clicking with C-mouse-3 -on the fringe/margin or dragging the arrow with C-mouse-1 (default bindings). -Unlike `gdb-mouse-until' the destination address can be before the current -line, and no execution takes place." - (interactive "e") - (let ((start (event-start event)) - (end (event-end event))) - (gdb-if-arrow gud-overlay-arrow-position - (setq line (line-number-at-pos (posn-point end))) - (progn - (gud-call (concat "tbreak " (number-to-string line))) - (gud-call (concat "jump " (number-to-string line))))) - (gdb-if-arrow gdb-overlay-arrow-position - (save-excursion - (goto-char (point-min)) - (forward-line (1- (line-number-at-pos (posn-point end)))) - (forward-char 2) - (progn - (gud-call (concat "tbreak *%a")) - (gud-call (concat "jump *%a"))))))) - -(defcustom gdb-speedbar-auto-raise nil - "If non-nil raise speedbar every time display of watch expressions is\ - updated." - :type 'boolean - :group 'gdb - :version "22.1") - -(defun gdb-speedbar-auto-raise (arg) - "Toggle automatic raising of the speedbar for watch expressions. -With prefix argument ARG, automatically raise speedbar if ARG is -positive, otherwise don't automatically raise it." - (interactive "P") - (setq gdb-speedbar-auto-raise - (if (null arg) - (not gdb-speedbar-auto-raise) - (> (prefix-numeric-value arg) 0))) - (message (format "Auto raising %sabled" - (if gdb-speedbar-auto-raise "en" "dis")))) - -(defcustom gdb-use-colon-colon-notation nil - "If non-nil use FUN::VAR format to display variables in the speedbar." - :type 'boolean - :group 'gdb - :version "22.1") - -(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) -(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch) - -(declare-function tooltip-identifier-from-point "tooltip" (point)) - -(defun gud-watch (&optional arg event) - "Watch expression at point. -With arg, enter name of variable to be watched in the minibuffer." - (interactive (list current-prefix-arg last-input-event)) - (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer))) - (if (memq minor-mode '(gdbmi gdba)) - (progn - (if event (posn-set-point (event-end event))) - (require 'tooltip) - (save-selected-window - (let ((expr - (if arg - (completing-read "Name of variable: " - 'gud-gdb-complete-command) - (if (and transient-mark-mode mark-active) - (buffer-substring (region-beginning) (region-end)) - (concat (if (eq major-mode 'gdb-registers-mode) "$") - (tooltip-identifier-from-point (point))))))) - (set-text-properties 0 (length expr) nil expr) - (gdb-enqueue-input - (list - (if (eq minor-mode 'gdba) - (concat - "server interpreter mi \"-var-create - * " expr "\"\n") - (concat"-var-create - * " expr "\n")) - `(lambda () (gdb-var-create-handler ,expr))))))) - (message "gud-watch is a no-op in this mode.")))) - -(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) - -(defun gdb-var-create-handler (expr) - (let* ((result (gdb-json-partial-output))) - (if (not (bindat-get-field result 'msg)) - (let ((var - (list (bindat-get-field result 'name) - (if (and (string-equal gdb-current-language "c") - gdb-use-colon-colon-notation gdb-selected-frame) - (setq expr (concat gdb-selected-frame "::" expr)) - expr) - (bindat-get-field result 'numchild) - (bindat-get-field result 'type) - (bindat-get-field result 'value) - nil - (bindat-get-field result 'has_more) - gdb-frame-address))) - (push var gdb-var-list) - (speedbar 1) - (unless (string-equal - speedbar-initial-expansion-list-name "GUD") - (speedbar-change-initial-expansion-list "GUD"))) - (message-box "No symbol \"%s\" in current context." expr)))) - -(declare-function speedbar-timer-fn "speedbar" ()) - -(defun gdb-speedbar-update () - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame) - (not (member 'gdb-speedbar-timer gdb-pending-triggers))) - ;; Dummy command to update speedbar even when idle. - (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn)) - ;; Keep gdb-pending-triggers non-nil till end. - (push 'gdb-speedbar-timer gdb-pending-triggers))) - -(defun gdb-speedbar-timer-fn () - (if gdb-speedbar-auto-raise - (raise-frame speedbar-frame)) - (setq gdb-pending-triggers - (delq 'gdb-speedbar-timer gdb-pending-triggers)) - (speedbar-timer-fn)) - -(defun gdb-var-evaluate-expression-handler (varnum changed) - (goto-char (point-min)) - (re-search-forward "\\(.+\\)\\^done,value=\\(\".*\"\\)" nil t) - (setq gdb-pending-triggers - (delq (string-to-number (match-string 1)) gdb-pending-triggers)) - (let ((var (assoc varnum gdb-var-list))) - (when var - (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 2))))) - (gdb-speedbar-update)) - -(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 - "child={.*?name=\"\\(.*?\\)\".*?,exp=\"\\(.*?\\)\".*?,\ -numchild=\"\\(.*?\\)\"\\(}\\|.*?,\\(type=\"\\(.*?\\)\"\\)?.*?}\\)") - -(defun gdb-var-list-children-handler (varnum) - (goto-char (point-min)) - (let ((var-list nil)) - (catch 'child-already-watched - (dolist (var gdb-var-list) - (if (string-equal varnum (car var)) - (progn - (push var var-list) - (while (re-search-forward gdb-var-list-children-regexp nil t) - (let ((varchild (list (match-string 1) - (match-string 2) - (match-string 3) - (match-string 6) - nil nil))) - (if (assoc (car varchild) gdb-var-list) - (throw 'child-already-watched nil)) - (push varchild var-list) - (gdb-enqueue-input - (list - (concat - "server interpreter mi \"0-var-evaluate-expression " - (car varchild) "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler - ,(car varchild) nil))))))) - (push var var-list))) - (setq gdb-var-list (nreverse var-list))))) - -(defun gdb-var-update () - (when (not (member 'gdb-var-update gdb-pending-triggers)) - (gdb-enqueue-input - (list "server interpreter mi \"-var-update *\"\n" - 'gdb-var-update-handler)) - (push 'gdb-var-update gdb-pending-triggers))) - -(defconst gdb-var-update-regexp - "{.*?name=\"\\(.*?\\)\".*?,in_scope=\"\\(.*?\\)\".*?,\ -type_changed=\".*?\".*?}") - -(defun gdb-var-update-handler () - (dolist (var gdb-var-list) - (setcar (nthcdr 5 var) nil)) - (goto-char (point-min)) - (let ((n 0)) - (while (re-search-forward gdb-var-update-regexp nil t) - (let ((varnum (match-string 1))) - (if (string-equal (match-string 2) "false") - (let ((var (assoc varnum gdb-var-list))) - (if var (setcar (nthcdr 5 var) 'out-of-scope))) - (setq n (1+ n)) - (push n gdb-pending-triggers) - (gdb-enqueue-input - (list - (concat "server interpreter mi \"" (number-to-string n) - "-var-evaluate-expression " varnum "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers))) - -(defun gdb-var-set-format (format) - "Set the output format for a variable displayed in the speedbar." - (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) - (varnum (car var))) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-set-format " - varnum " " format "\"\n") - (concat "-var-set-format " varnum " " format "\n")) - `(lambda () (gdb-var-set-format-handler ,varnum)))))) - -(defconst gdb-var-set-format-regexp - "format=\"\\(.*?\\)\",.*value=\"\\(.*?\\)\"") - -(defun gdb-var-set-format-handler (varnum) - (goto-char (point-min)) - (if (re-search-forward gdb-var-set-format-regexp nil t) - (let ((var (assoc varnum gdb-var-list))) - (setcar (nthcdr 4 var) (match-string 2)) - (gdb-var-update-1)))) - -(defun gdb-var-delete-1 (var varnum) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-delete " varnum "\"\n") - (concat "-var-delete " varnum "\n")) - 'ignore)) - (setq gdb-var-list (delq var gdb-var-list)) - (dolist (varchild gdb-var-list) - (if (string-match (concat (car var) "\\.") (car varchild)) - (setq gdb-var-list (delq varchild gdb-var-list))))) - -(defun gdb-var-delete () - "Delete watch expression at point from the speedbar." - (interactive) - (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba)) - (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) - (varnum (car var))) - (if (string-match "\\." (car var)) - (message-box "Can only delete a root expression") - (gdb-var-delete-1 var varnum))))) - -(defun gdb-var-delete-children (varnum) - "Delete children of variable object at point from the speedbar." - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-delete -c " varnum "\"\n") - (concat "-var-delete -c " varnum "\n")) 'ignore))) - -(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 (car var)) (value)) - (setq value (read-string "New value: ")) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-assign " - varnum " " value "\"\n") - (concat "-var-assign " varnum " " value "\n")) - `(lambda () (gdb-edit-value-handler ,value)))))) - -(defun gdb-edit-value-handler (value) - (goto-char (point-min)) - (if (re-search-forward gdb-error-regexp nil t) - (message-box "Invalid number or expression (%s)" value))) - -(defcustom gdb-show-changed-values t - "If non-nil change the face of out of scope variables and changed values. -Out of scope variables are suppressed with `shadow' face. -Changed values are highlighted with the face `font-lock-warning-face'." - :type 'boolean - :group 'gdb - :version "22.1") - -(defcustom gdb-max-children 40 - "Maximum number of children before expansion requires confirmation." - :type 'integer - :group 'gdb - :version "22.1") - -(defcustom gdb-delete-out-of-scope t - "If non-nil delete watch expressions automatically when they go out of scope." - :type 'boolean - :group 'gdb - :version "22.2") - -(declare-function speedbar-change-expand-button-char "speedbar" (char)) -(declare-function speedbar-delete-subblock "speedbar" (indent)) -(declare-function speedbar-center-buffer-smartly "speedbar" ()) - -(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." - (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) - (progn - (cond ((string-match "+" text) ;expand this node - (let* ((var (assoc token gdb-var-list)) - (expr (nth 1 var)) (children (nth 2 var))) - (if (or (<= (string-to-number children) gdb-max-children) - (y-or-n-p - (format - "%s has %s children. Continue? " expr children))) - (if (and (eq (buffer-local-value - 'gud-minor-mode gud-comint-buffer) 'gdba) - (string-equal gdb-version "pre-6.4")) - (gdb-var-list-children token) - (gdb-var-list-children-1 token))))) - ((string-match "-" text) ;contract this node - (dolist (var gdb-var-list) - (if (string-match (concat token "\\.") (car var)) - (setq gdb-var-list (delq var gdb-var-list)))) - (gdb-var-delete-children token) - (speedbar-change-expand-button-char ?+) - (speedbar-delete-subblock indent)) - (t (error "Ooops... not sure what to do"))) - (speedbar-center-buffer-smartly)) - (message-box "GUD session has been killed"))) - -(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-buffer-create 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-buffer-create (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 - (let ((trigger)) - (if (cdr (cdr rules)) - (setq trigger (funcall (car (cdr (cdr rules)))))) - (setq gdb-buffer-type key) - (set (make-local-variable 'gud-minor-mode) - (buffer-local-value 'gud-minor-mode gud-comint-buffer)) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) - (if trigger (funcall trigger))) - 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) - "*")) - -(defun gdb-display-separate-io-buffer () - "Display IO of debugged program in a separate window." - (interactive) - (if gdb-use-separate-io-buffer - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-inferior-io) t))) - -(defconst gdb-frame-parameters - '((height . 14) (width . 80) - (unsplittable . t) - (tool-bar-lines . nil) - (menu-bar-lines . nil) - (minibuffer . nil))) - -(defun gdb-frame-separate-io-buffer () - "Display IO of debugged program in a new frame." - (interactive) - (if gdb-use-separate-io-buffer - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))) - -(defvar gdb-inferior-io-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt) - (define-key map "\C-c\C-z" 'gdb-separate-io-stop) - (define-key map "\C-c\C-\\" 'gdb-separate-io-quit) - (define-key map "\C-c\C-d" 'gdb-separate-io-eof) - (define-key map "\C-d" 'gdb-separate-io-eof) - map)) - -(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior 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-separate-io-interrupt () - "Interrupt the program being debugged." - (interactive) - (interrupt-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-separate-io-quit () - "Send quit signal to the program being debugged." - (interactive) - (quit-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-separate-io-stop () - "Stop the program being debugged." - (interactive) - (stop-process - (get-buffer-process gud-comint-buffer) comint-ptyp)) - -(defun gdb-separate-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 input for a later time." - (if gdb-ready - (progn - (with-current-buffer gud-comint-buffer - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(face)))) - (if gud-running - (progn - (let ((item (concat string "\n"))) - (if gdb-enable-debug (push (cons 'send item) gdb-debug-log)) - (process-send-string proc item))) - (if (string-match "\\\\\\'" string) - (setq gdb-continuation (concat gdb-continuation string "\n")) - (let ((item (concat - gdb-continuation string - (if (not comint-input-sender-no-newline) "\n")))) - (gdb-enqueue-input item) - (setq gdb-continuation nil))))) - (push (concat string "\n") gdb-early-user-input))) - -;; 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 (not gud-running) - (if gdb-prompting - (progn - (gdb-send-item item) - (setq gdb-prompting nil)) - (push item gdb-input-queue)))) - -(defun gdb-dequeue-input () - (let ((queue gdb-input-queue)) - (if queue - (let ((last (car (last queue)))) - (unless (nbutlast queue) (setq gdb-input-queue '())) - last) - ;; This should be nil here anyway but set it just to make sure. - (setq gdb-pending-triggers nil)))) - -(defun gdb-send-item (item) - (setq gdb-flush-pending-output nil) - (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log)) - (setq gdb-current-item item) - (let ((process (get-buffer-process gud-comint-buffer))) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (if (stringp item) - (progn - (setq gdb-output-sink 'user) - (process-send-string process item)) - (progn - (gdb-clear-partial-output) - (setq gdb-output-sink 'pre-emacs) - (process-send-string process - (car item)))) - ;; case: eq gud-minor-mode 'gdbmi - (gdb-clear-partial-output) - (setq gdb-output-sink 'emacs) - (process-send-string process (car item))))) - -;; -;; 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-gdb-command-name "gdb --annotate=3" - "Default command to execute an executable under the GDB debugger. -The option \"--annotate=3\" must be included in this value if you -want the GDB Graphical Interface." - :type 'string - :group 'gud - :version "22.1") - -(defvar gdb-annotation-rules - '(("pre-prompt" gdb-pre-prompt) - ("prompt" gdb-prompt) - ("commands" gdb-subprompt) - ("overload-choice" gdb-subprompt) - ("query" gdb-subprompt) - ;; Need this prompt for GDB 6.1 - ("nquery" gdb-subprompt) - ("prompt-for-continue" gdb-subprompt) - ("post-prompt" gdb-post-prompt) - ("source" gdb-source) - ("starting" gdb-starting) - ("exited" gdb-exited) - ("signalled" gdb-signalled) - ("signal" gdb-signal) - ("breakpoint" gdb-stopping) - ("watchpoint" gdb-stopping) - ("frame-begin" gdb-frame-begin) - ("stopped" gdb-stopped) - ("error-begin" gdb-error) - ("error" gdb-error) - ("new-thread" (lambda (ignored) - (gdb-get-buffer-create 'gdb-threads-buffer))) - ("thread-changed" gdb-thread-changed)) - "An assoc mapping annotation tags to functions which process them.") - -(defun gdb-resync() - (setq gdb-flush-pending-output t) - (setq gud-running nil) - (gdb-force-mode-line-update - (propertize "stopped" 'face font-lock-warning-face)) - (setq gdb-output-sink 'user) - (setq gdb-input-queue nil) - (setq gdb-pending-triggers nil) - (setq gdb-prompting t)) - -(defconst gdb-source-spec-regexp - "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([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-number (match-string 2 args)))) - (setq gdb-pc-address (match-string 3 args)) - ;; cover for auto-display output which comes *before* - ;; stopped annotation - (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) - -(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." - (setq gdb-error nil) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'user) t) - ((eq sink 'emacs) - (setq gdb-output-sink 'post-emacs)) - (t - (gdb-resync) - (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-force-mode-line-update - (propertize "initializing..." 'face font-lock-variable-name-face)) - (gdb-init-1) - (setq gdb-first-prompt nil)) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'user) t) - ((eq sink 'post-emacs) - (setq gdb-output-sink 'user) - (let ((handler - (car (cdr gdb-current-item)))) - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (funcall handler)))) - (t - (gdb-resync) - (error "Phase error in gdb-prompt (got %s)" sink)))) - (let ((input (gdb-dequeue-input))) - (if input - (gdb-send-item input) - (progn - (setq gdb-prompting t) - (gud-display-frame) - (setq gdb-early-user-input (nreverse gdb-early-user-input)) - (while gdb-early-user-input - (gdb-enqueue-input (car gdb-early-user-input)) - (setq gdb-early-user-input (cdr gdb-early-user-input))))))) - -(defun gdb-subprompt (ignored) - "An annotation handler for non-top-level prompts." - (setq gdb-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." - (setq gdb-active-process t) - (setq gdb-printing t) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'user) - (progn - (setq gud-running t) - (setq gdb-stack-update t) - ;; Temporarily set gud-running to nil to force "info stack" onto queue. - (let ((gud-running nil)) - (gdb-invalidate-frames) - (unless (or gdb-register-names - (string-equal gdb-version "pre-6.4")) - (gdb-enqueue-input - (list "server interpreter mi -data-list-register-names\n" - 'gdb-get-register-names)))) - (setq gdb-inferior-status "running") - (setq gdb-signalled nil) - (gdb-force-mode-line-update - (propertize gdb-inferior-status 'face font-lock-type-face)) - (gdb-remove-text-properties) - (setq gud-old-arrow gud-overlay-arrow-position) - (setq gud-overlay-arrow-position nil) - (setq gdb-overlay-arrow-position nil) - (setq gdb-stack-position nil) - (if gdb-use-separate-io-buffer - (setq gdb-output-sink 'inferior)))) - (t - (gdb-resync) - (error "Unexpected `starting' annotation"))))) - -(defun gdb-signal (ignored) - (setq gdb-inferior-status "signal") - (gdb-force-mode-line-update - (propertize gdb-inferior-status 'face font-lock-warning-face)) - (gdb-stopping ignored)) - -(defun gdb-stopping (ignored) - "An annotation handler for `breakpoint' and other annotations. -They say that I/O for the subprocess is now GDB, not the program -being debugged." - (if gdb-use-separate-io-buffer - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'inferior) - (setq gdb-output-sink 'user)) - (t - (gdb-resync) - (error "Unexpected stopping annotation")))))) - -(defun gdb-exited (ignored) - "An annotation handler for `exited' and `signalled'. -They say that I/O for the subprocess is now GDB, not the program -being debugged and that the program is no longer running. This -function is used to change the focus of GUD tooltips to #define -directives." - (setq gdb-active-process nil) - (setq gud-overlay-arrow-position nil) - (setq gdb-overlay-arrow-position nil) - (setq gdb-stack-position nil) - (setq gud-old-arrow nil) - (setq gdb-inferior-status "exited") - (gdb-force-mode-line-update - (propertize gdb-inferior-status 'face font-lock-warning-face)) - (gdb-stopping ignored)) - -(defun gdb-signalled (ignored) - (setq gdb-signalled t)) - -(defun gdb-frame-begin (ignored) - (setq gdb-frame-begin t) - (setq gdb-printing nil) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'inferior) - (setq gdb-output-sink 'user)) - ((eq sink 'user) t) - ((eq sink 'emacs) t) - (t - (gdb-resync) - (error "Unexpected frame-begin annotation (%S)" sink))))) - -(defcustom gdb-same-frame (not focus-follows-mouse) - "Non-nil means pop up GUD buffer in same frame." - :group 'gdb - :type 'boolean - :version "22.1") - -(defcustom gdb-find-source-frame nil - "Non-nil means try to find a source frame further up stack e.g after signal." - :group 'gdb - :type 'boolean - :version "22.1") - -(defun gdb-find-source-frame (arg) - "Toggle looking for a source frame further up call stack. -The code associated with current (innermost) frame may not have -been compiled with debug information, e.g., C library routine. -With prefix argument ARG, look for a source frame further up -stack to display in the source buffer if ARG is positive, -otherwise don't look further up." - (interactive "P") - (setq gdb-find-source-frame - (if (null arg) - (not gdb-find-source-frame) - (> (prefix-numeric-value arg) 0))) - (message (format "Looking for source frame %sabled" - (if gdb-find-source-frame "en" "dis")))) - -(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) - (unless (or gud-overlay-arrow-position gud-last-frame) - (if (and gdb-frame-begin gdb-printing) - (setq gud-overlay-arrow-position gud-old-arrow) - ;;Pop up GUD buffer to display current frame when it doesn't have source - ;;information i.e if not compiled with -g as with libc routines generally. - (if gdb-same-frame - (gdb-display-gdb-buffer) - (gdb-frame-gdb-buffer)) - (if gdb-find-source-frame - ;;Try to find source further up stack e.g after signal. - (setq gdb-look-up-stack - (if (gdb-get-buffer 'gdb-stack-buffer) - 'keep - (progn - (gdb-get-buffer-create 'gdb-stack-buffer) - (gdb-invalidate-frames) - 'delete)))))) - (unless (member gdb-inferior-status '("exited" "signal")) - (setq gdb-active-process t) ;Just for attaching case. - (setq gdb-inferior-status "stopped") - (gdb-force-mode-line-update - (propertize gdb-inferior-status 'face font-lock-warning-face))) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'inferior) - (setq gdb-output-sink 'user)) - ((eq sink 'user) t) - (t - (gdb-resync) - (error "Unexpected stopped annotation")))) - (if gdb-signalled (gdb-exited ignored))) - -(defun gdb-error (ignored) - (setq gdb-error (not gdb-error))) - -(defun gdb-thread-changed (ignored) - (gdb-frames-force-update)) - -(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." - ;; Don't add to queue if there outstanding items or gdb-version is not known - ;; yet. - (unless (or gdb-pending-triggers gdb-first-post-prompt) - (gdb-get-selected-frame) - (gdb-invalidate-frames) - ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted. - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (gdb-invalidate-breakpoints) - ;; Do this through gdb-get-selected-frame -> gdb-frame-handler - ;; so gdb-pc-address is updated. - ;; (gdb-invalidate-assembler) - - (if (string-equal gdb-version "pre-6.4") - (gdb-invalidate-registers) - (gdb-get-changed-registers) - (gdb-invalidate-registers-1)) - - (gdb-invalidate-memory) - (if (string-equal gdb-version "pre-6.4") - (gdb-invalidate-locals) - (gdb-invalidate-locals-1)) - - (gdb-invalidate-threads) - (unless (or (null gdb-var-list) - (eq system-type 'darwin)) ;Breaks on Darwin's GDB-5.3. - ;; FIXME: with GDB-6 on Darwin, this might very well work. - ;; Only needed/used with speedbar/watch expressions. - (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (if (string-equal gdb-version "pre-6.4") - (gdb-var-update) - (gdb-var-update-1))))) - (setq gdb-first-post-prompt nil) - (let ((sink gdb-output-sink)) - (cond - ((eq sink 'user) t) - ((eq sink 'pre-emacs) - (setq gdb-output-sink 'emacs)) - (t - (gdb-resync) - (error "Phase error in gdb-post-prompt (got %s)" sink))))) - -(defconst gdb-buffer-list -'(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer)) - -(defun gdb-remove-text-properties () - (dolist (buffertype gdb-buffer-list) - (let ((buffer (gdb-get-buffer buffertype))) - (if buffer - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (remove-text-properties - (point-min) (point-max) '(mouse-face nil help-echo nil)))))))) - -;; GUD displays the selected GDB frame. This might might not be the current -;; GDB frame (after up, down etc). If no GDB frame is visible but the last -;; visited breakpoint is, use that window. -(defun gdb-display-source-buffer (buffer) - (let* ((last-window (if gud-last-last-frame - (get-buffer-window - (gud-find-file (car gud-last-last-frame))))) - (source-window (or last-window - (if (and gdb-source-window - (window-live-p gdb-source-window)) - gdb-source-window)))) - (when source-window - (setq gdb-source-window source-window) - (set-window-buffer source-window buffer)) - source-window)) - -;; Derived from gud-gdb-marker-regexp -(defvar gdb-fullname-regexp - (concat "\\(.:?[^" ":" "\n]*\\)" ":" "\\([0-9]*\\)" ":" ".*")) - -(defun gud-gdba-marker-filter (string) - "A gud marker filter for gdb. Handle a burst of output from GDB." - (if gdb-flush-pending-output - nil - (when gdb-enable-debug - (push (cons 'recv string) gdb-debug-log) - (if (and gdb-debug-log-max - (> (length gdb-debug-log) gdb-debug-log-max)) - (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil))) - ;; 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)) - (before (substring gud-marker-acc 0 (match-beginning 0))) - (after (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))) - - ;; Stuff prior to the match is just ordinary output. - ;; It is either concatenated to OUTPUT or directed - ;; elsewhere. - (setq output (gdb-concat-output output before)) - - ;; Take that stuff off the gud-marker-acc. - (setq gud-marker-acc after) - - ;; 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) - (if gdb-error - (put-text-property 0 (length new) 'face font-lock-warning-face new)) - (let ((sink gdb-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 - (gdb-resync) - (error "Bogon output sink %S" sink))))) - -(defun gdb-append-to-partial-output (string) - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (goto-char (point-max)) - (insert string))) - -(defun gdb-clear-partial-output () - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (erase-buffer))) - -(defun gdb-append-to-inferior-io (string) - (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (goto-char (point-max)) - (insert-before-markers string)) - (if (not (string-equal string "")) - (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))) - -(defun gdb-clear-inferior-io () - (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (erase-buffer))) - -(defun gdb-jsonify-buffer (&optional fix-key fix-list) - "Prepare GDB/MI output in current buffer for parsing with `json-read'. - -Field names are wrapped in double quotes and equal signs are -replaced with semicolons. - -If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from -partial output. This is used to get rid of useless keys in lists -in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and --break-info are examples of MI commands which issue such -responses. - -If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with -\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken --break-info output when it contains breakpoint script field -incompatible with GDB/MI output syntax." - (save-excursion - (goto-char (point-min)) - ;; Sometimes missing symbol information precedes "^done" record. - (re-search-forward "[[:ascii:]]*?\\^done," nil t) - (replace-match "") - (re-search-forward "(gdb) \n" nil t) - (replace-match "") - (goto-char (point-min)) - (when fix-key - (save-excursion - (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) - (replace-match "" nil nil nil 1)))) - (when fix-list - (save-excursion - ;; Find positions of braces which enclose broken list - (while (re-search-forward (concat fix-list "={\"") nil t) - (let ((p1 (goto-char (- (point) 2))) - (p2 (progn (forward-sexp) - (1- (point))))) - ;; Replace braces with brackets - (save-excursion - (goto-char p1) - (delete-char 1) - (insert "[") - (goto-char p2) - (delete-char 1) - (insert "]")))))) - (goto-char (point-min)) - (insert "{") - (while (re-search-forward - "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t) - (replace-match "\"\\1\":\\2" nil nil)) - (goto-char (point-max)) - (insert "}"))) - -(defun gdb-json-read-buffer (&optional fix-key fix-list) - "Prepare and parse GDB/MI output in current buffer with `json-read'. - -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." - (gdb-jsonify-buffer fix-key fix-list) - (save-excursion - (goto-char (point-min)) - (let ((json-array-type 'list)) - (json-read)))) - -(defun gdb-json-partial-output (&optional fix-key fix-list) - "Prepare and parse gdb-partial-output-buffer with `json-read'. - -FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." - (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (gdb-json-read-buffer fix-key fix-list))) - - -;; 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-pending-triggers))) - (progn - (gdb-enqueue-input - (list ,gdb-command ',output-handler)) - (push ',name gdb-pending-triggers))))) - -(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) - `(defun ,name () - (setq gdb-pending-triggers - (delq ',trigger - gdb-pending-triggers)) - (let ((buf (gdb-get-buffer ',buf-key))) - (and buf - (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (if window (window-point window) (point))) - (buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring (gdb-get-buffer-create - 'gdb-partial-output-buffer)) - (if window - (progn - (set-window-start window start) - (set-window-point window p)) - (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: - (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) - -(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.") - -(declare-function define-fringe-bitmap "fringe.c" - (bitmap bits &optional height width align)) - -(and (display-images-p) - ;; Bitmap for breakpoint in fringe - (define-fringe-bitmap 'breakpoint - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") - ;; Bitmap for gud-overlay-arrow in fringe - (define-fringe-bitmap 'hollow-right-triangle - "\xe0\x90\x88\x84\x84\x88\x90\xe0")) - -(defface breakpoint-enabled - '((t - :foreground "red1" - :weight bold)) - "Face for enabled breakpoint icon in fringe." - :group 'gdb) - -(defface breakpoint-disabled - '((((class color) (min-colors 88)) :foreground "grey70") - ;; Ensure that on low-color displays that we end up something visible. - (((class color) (min-colors 8) (background light)) - :foreground "black") - (((class color) (min-colors 8) (background dark)) - :foreground "white") - (((type tty) (class mono)) - :inverse-video t) - (t :background "gray")) - "Face for disabled breakpoint icon in fringe." - :group 'gdb) - -(defconst gdb-breakpoint-regexp - "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+") - -;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). -(defun gdb-info-breakpoints-custom () - (let ((flag) (bptno)) - ;; Remove all breakpoint-icons in source buffers but not assembler buffer. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (if (and (memq gud-minor-mode '(gdba gdbmi)) - (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) - (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (- (point-max) 1)) - (forward-line 1) - (if (looking-at gdb-breakpoint-regexp) - (progn - (setq bptno (or (match-string 1) (match-string 2))) - (setq flag (char-after (match-beginning 3))) - (if (match-string 1) - (setq gdb-parent-bptno-enabled (eq flag ?y))) - (add-text-properties - (match-beginning 3) (match-end 3) - (if (eq flag ?y) - '(face font-lock-warning-face) - '(face font-lock-type-face))) - (let ((bl (point)) - (el (line-end-position))) - (when (re-search-forward " in \\(.*\\) at" el t) - (add-text-properties - (match-beginning 1) (match-end 1) - '(face font-lock-function-name-face))) - (if (re-search-forward - ".*\\s-+\\(\\S-+\\):\\([0-9]+\\)$" el t) - (let ((line (match-string 2)) - (file (match-string 1))) - (add-text-properties bl el - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint")) - (unless (file-exists-p file) - (setq file (cdr (assoc bptno gdb-location-alist)))) - (if (and file - (not (string-equal file "File not found"))) - (with-current-buffer - (find-file-noselect file 'nowarn) - (gdb-init-buffer) - ;; Only want one breakpoint icon at each - ;; location. - (save-excursion - (goto-char (point-min)) - (forward-line (1- (string-to-number line))) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "list " - (match-string-no-properties 1) ":1\n") - 'ignore)) - (gdb-enqueue-input - (list (concat gdb-server-prefix "info source\n") - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))))) - (if (re-search-forward - "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" - el t) - (add-text-properties - (match-beginning 1) (match-end 1) - '(face font-lock-function-name-face)) - (end-of-line) - (re-search-backward "\\s-\\(\\S-*\\)" - bl t) - (add-text-properties - (match-beginning 1) (match-end 1) - '(face font-lock-variable-name-face))))))) - (end-of-line)))))) - (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)) - - ;; Breakpoints buffer is always present. Hack to just update - ;; current frame if there's been no execution. - (if gdb-stack-update - (setq gdb-stack-update nil) - (if (gdb-get-buffer 'gdb-stack-buffer) (gdb-info-stack-custom)))) - -(declare-function gud-remove "gdb-ui" t t) ; gud-def -(declare-function gud-break "gdb-ui" t t) ; gud-def -(declare-function fringe-bitmaps-at-pos "fringe.c" (&optional pos window)) - -(defun gdb-mouse-set-clear-breakpoint (event) - "Set/clear breakpoint in left fringe/margin at mouse click. -If not in a source or disassembly buffer just set point." - (interactive "e") - (mouse-minibuffer-check event) - (let ((posn (event-end event))) - (with-selected-window (posn-window posn) - (if (or (buffer-file-name) (eq major-mode 'gdb-assembler-mode)) - (if (numberp (posn-point posn)) - (save-excursion - (goto-char (posn-point posn)) - (if (or (posn-object posn) - (eq (car (fringe-bitmaps-at-pos (posn-point posn))) - 'breakpoint)) - (gud-remove nil) - (gud-break nil))))) - (posn-set-point posn)))) - -(defun gdb-mouse-toggle-breakpoint-margin (event) - "Enable/disable breakpoint in left margin with mouse click." - (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 (posn-object posn) - (let* ((bptno (get-text-property - 0 'gdb-bptno (car (posn-string posn))))) - (string-match "\\([0-9+]\\)*" bptno) - (gdb-enqueue-input - (list - (concat gdb-server-prefix - (if (get-text-property - 0 'gdb-enabled (car (posn-string posn))) - "disable " - "enable ") - (match-string 1 bptno) "\n") - 'ignore))))))))) - -(defun gdb-mouse-toggle-breakpoint-fringe (event) - "Enable/disable breakpoint in left fringe with mouse click." - (interactive "e") - (mouse-minibuffer-check event) - (let* ((posn (event-end event)) - (pos (posn-point posn)) - obj) - (when (numberp pos) - (with-selected-window (posn-window posn) - (with-current-buffer (window-buffer (selected-window)) - (goto-char pos) - (dolist (overlay (overlays-in pos pos)) - (when (overlay-get overlay 'put-break) - (setq obj (overlay-get overlay 'before-string)))) - (when (stringp obj) - (let* ((bptno (get-text-property 0 'gdb-bptno obj))) - (string-match "\\([0-9+]\\)*" bptno) - (gdb-enqueue-input - (list - (concat gdb-server-prefix - (if (get-text-property 0 'gdb-enabled obj) - "disable " - "enable ") - (match-string 1 bptno) "\n") - 'ignore))))))))) - -(defun gdb-breakpoints-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*breakpoints of " (gdb-get-target-string) "*"))) - -(defun gdb-display-breakpoints-buffer () - "Display status of user-settable breakpoints." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-breakpoints-buffer) t)) - -(defun gdb-frame-breakpoints-buffer () - "Display status of user-settable breakpoints in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer)))) - -(defvar gdb-breakpoints-mode-map - (let ((map (make-sparse-keymap)) - (menu (make-sparse-keymap "Breakpoints"))) - (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window)) - (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) - (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) - (define-key menu [toggle] '("Toggle" . gdb-toggle-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) - ;; Don't bind "q" to kill-this-buffer as we need it for breakpoint icons. - (define-key map "q" 'gdb-delete-frame-or-window) - (define-key map "\r" 'gdb-goto-breakpoint) - (define-key map [mouse-2] 'gdb-goto-breakpoint) - (define-key map [follow-link] 'mouse-face) - map)) - -(defun gdb-delete-frame-or-window () - "Delete frame if there is only one window. Otherwise delete the window." - (interactive) - (if (one-window-p) (delete-frame) - (delete-window))) - -;;from make-mode-line-mouse-map -(defun gdb-make-header-line-mouse-map (mouse function) "\ -Return a keymap with single entry for mouse key MOUSE on the header line. -MOUSE is defined to run function FUNCTION with no args in the buffer -corresponding to the mode line clicked." - (let ((map (make-sparse-keymap))) - (define-key map (vector 'header-line mouse) function) - (define-key map (vector 'header-line 'down-mouse-1) 'ignore) - map)) - -(defmacro gdb-propertize-header (name buffer help-echo mouse-face face) - `(propertize ,name - 'help-echo ,help-echo - 'mouse-face ',mouse-face - 'face ',face - 'local-map - (gdb-make-header-line-mouse-map - 'mouse-1 - (lambda (event) (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) - (set-window-dedicated-p (selected-window) nil) - (switch-to-buffer - (gdb-get-buffer-create ',buffer)) - (setq header-line-format(gdb-set-header ',buffer)) - (set-window-dedicated-p (selected-window) t)))))) - -(defun gdb-set-header (buffer) - (cond ((eq buffer 'gdb-locals-buffer) - (list - (gdb-propertize-header "Locals" gdb-locals-buffer - nil nil mode-line) - " " - (gdb-propertize-header "Registers" gdb-registers-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) - ((eq buffer 'gdb-registers-buffer) - (list - (gdb-propertize-header "Locals" gdb-locals-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive) - " " - (gdb-propertize-header "Registers" gdb-registers-buffer - nil nil mode-line))) - ((eq buffer 'gdb-breakpoints-buffer) - (list - (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer - nil nil mode-line) - " " - (gdb-propertize-header "Threads" gdb-threads-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) - ((eq buffer 'gdb-threads-buffer) - (list - (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive) - " " - (gdb-propertize-header "Threads" gdb-threads-buffer - nil nil mode-line))))) - -(defvar gdb-breakpoints-header - (list - (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer - nil nil mode-line) - " " - (gdb-propertize-header "Threads" gdb-threads-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) - -(defun gdb-breakpoints-mode () - "Major mode for gdb breakpoints. - -\\{gdb-breakpoints-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-breakpoints-mode) - (setq mode-name "Breakpoints") - (use-local-map gdb-breakpoints-mode-map) - (setq buffer-read-only t) - (buffer-disable-undo) - (setq header-line-format gdb-breakpoints-header) - (run-mode-hooks 'gdb-breakpoints-mode-hook) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - 'gdb-invalidate-breakpoints - 'gdbmi-invalidate-breakpoints)) - -(defun gdb-toggle-breakpoint () - "Enable/disable breakpoint at current line." - (interactive) - (save-excursion - (beginning-of-line 1) - (if (looking-at gdb-breakpoint-regexp) - (gdb-enqueue-input - (list - (concat gdb-server-prefix - (if (eq ?y (char-after (match-beginning 3))) - "disable " - "enable ") - (or (match-string 1) (match-string 2)) "\n") 'ignore)) - (error "Not recognized as break/watchpoint line")))) - -(defun gdb-delete-breakpoint () - "Delete the breakpoint at current line." - (interactive) - (save-excursion - (beginning-of-line 1) - (if (looking-at gdb-breakpoint-regexp) - (if (match-string 1) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "delete " (match-string 1) "\n") - 'ignore)) - (message-box "This breakpoint cannot be deleted on its own.")) - (error "Not recognized as break/watchpoint line")))) - -(defun gdb-goto-breakpoint (&optional event) - "Display the breakpoint location specified at current line." - (interactive (list last-input-event)) - (if event (posn-set-point (event-end event))) - (save-excursion - (beginning-of-line 1) - (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .*\\s-+\\(\\S-+\\):\\([0-9]+\\)$") - (let ((bptno (match-string 1)) - (file (match-string 2)) - (line (match-string 3))) - (save-selected-window - (let* ((buffer (find-file-noselect - (if (file-exists-p file) file - (cdr (assoc bptno gdb-location-alist))))) - (window (or (gdb-display-source-buffer buffer) - (display-buffer buffer)))) - (setq gdb-source-window window) - (with-current-buffer buffer - (goto-char (point-min)) - (forward-line (1- (string-to-number line))) - (set-window-point window (point)))))) - (error "No location specified")))) - - -;; Frames buffer. This displays a perpetually correct backtrace -;; (from the command `where'). -;; -;; Alas, if your stack is deep, it is costly. -;; -(defcustom gdb-max-frames 40 - "Maximum number of frames displayed in call stack." - :type 'integer - :group 'gdb - :version "22.1") - -(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 - (concat "server info stack " (number-to-string gdb-max-frames) "\n") - gdb-info-stack-handler - gdb-info-stack-custom) - -;; This may be more important for embedded targets where unwinding the -;; stack may take a long time. -(defadvice gdb-invalidate-frames (around gdb-invalidate-frames-advice - (&optional ignored) activate compile) - "Only queue \"info stack\" if execution has occurred." - (if gdb-stack-update ad-do-it)) - -(defun gdb-info-stack-custom () - (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) - (let (move-to) - (save-excursion - (unless (eq gdb-look-up-stack 'delete) - (let ((buffer-read-only nil) - bl el) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq bl (line-beginning-position) - el (line-end-position)) - (when (looking-at "#") - (add-text-properties bl el - '(mouse-face highlight - help-echo "mouse-2, RET: Select frame"))) - (goto-char bl) - (when (looking-at "^#\\([0-9]+\\)") - (when (string-equal (match-string 1) gdb-frame-number) - (if (gud-tool-bar-item-visible-no-fringe) - (progn - (put-text-property bl (+ bl 4) - 'face '(:inverse-video t)) - (setq move-to bl)) - (or gdb-stack-position - (setq gdb-stack-position (make-marker))) - (set-marker gdb-stack-position (point)) - (setq move-to gdb-stack-position))) - (when (re-search-forward "\\([^ ]+\\) (" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-function-name-face) - (setq bl (match-end 0)) - (while (re-search-forward "<\\([^>]+\\)>" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-function-name-face)) - (goto-char bl) - (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-variable-name-face)))) - (forward-line 1)) - (forward-line -1) - (when (looking-at "(More stack frames follow...)") - (add-text-properties - (match-beginning 0) (match-end 0) - '(mouse-face highlight - gdb-max-frames t - help-echo - "mouse-2, RET: customize gdb-max-frames to see more frames" - ))))) - (when gdb-look-up-stack - (goto-char (point-min)) - (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t) - (let ((start (line-beginning-position)) - (file (match-string 1)) - (line (match-string 2))) - (re-search-backward "^#*\\([0-9]+\\)" start t) - (gdb-enqueue-input - (list (concat gdb-server-prefix "frame " - (match-string 1) "\n") 'gdb-set-hollow)) - (gdb-enqueue-input - (list (concat gdb-server-prefix "frame 0\n") 'ignore)))))) - (when move-to - (let ((window (get-buffer-window (current-buffer) 0))) - (when window - (with-selected-window window - (goto-char move-to) - (unless (pos-visible-in-window-p) - (recenter '(center))))))))) - (if (eq gdb-look-up-stack 'delete) - (kill-buffer (gdb-get-buffer 'gdb-stack-buffer))) - (setq gdb-look-up-stack nil)) - -(defun gdb-set-hollow () - (if gud-last-last-frame - (with-current-buffer (gud-find-file (car gud-last-last-frame)) - (setq fringe-indicator-alist - '((overlay-arrow . hollow-right-triangle)))))) - -(defun gdb-stack-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*stack frames of " (gdb-get-target-string) "*"))) - -(defun gdb-display-stack-buffer () - "Display backtrace of current stack." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-stack-buffer) t)) - -(defun gdb-frame-stack-buffer () - "Display backtrace of current stack in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer)))) - -(defvar gdb-frames-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'kill-this-buffer) - (define-key map "\r" 'gdb-frames-select) - (define-key map "F" 'gdb-frames-force-update) - (define-key map [mouse-2] 'gdb-frames-select) - (define-key map [follow-link] 'mouse-face) - map)) - -(declare-function gdbmi-invalidate-frames "ext:gdb-mi" nil t) - -(defun gdb-frames-force-update () - "Force update of call stack. -Use when the displayed call stack gets out of sync with the -actual one, e.g after using the Gdb command \"return\" or setting -$pc directly from the GUD buffer. This command isn't normally needed." - (interactive) - (setq gdb-stack-update t) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (gdb-invalidate-frames) - (gdbmi-invalidate-frames))) - -(defun gdb-frames-mode () - "Major mode for gdb call stack. - -\\{gdb-frames-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-frames-mode) - (setq mode-name "Frames") - (setq gdb-stack-position nil) - (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) - (setq truncate-lines t) ;; Make it easier to see overlay arrow. - (setq buffer-read-only t) - (buffer-disable-undo) - (gdb-thread-identification) - (use-local-map gdb-frames-mode-map) - (run-mode-hooks 'gdb-frames-mode-hook) - (setq gdb-stack-update t) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - 'gdb-invalidate-frames - 'gdbmi-invalidate-frames)) - -(defun gdb-get-frame-number () - (save-excursion - (end-of-line) - (let* ((start (line-beginning-position)) - (pos (re-search-backward "^#*\\([0-9]+\\)" start t)) - (n (or (and pos (match-string 1)) "0"))) - n))) - -(defun gdb-frames-select (&optional event) - "Select the frame and display the relevant source." - (interactive (list last-input-event)) - (if event (posn-set-point (event-end event))) - (if (get-text-property (point) 'gdb-max-frames) - (progn - (message-box "After setting gdb-max-frames, you need to enter\n\ -another GDB command e.g pwd, to see new frames") - (customize-variable-other-window 'gdb-max-frames)) - (gdb-enqueue-input - (list (concat gdb-server-prefix "frame " - (gdb-get-frame-number) "\n") 'ignore)))) - - -;; 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 - (concat gdb-server-prefix "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)) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "\\* \\([0-9]+\\)" nil t) - (setq gdb-thread-indicator - (propertize (concat " [" (match-string 1) "]") - ; FIXME: this help-echo doesn't work - 'help-echo "thread id"))) - (goto-char (point-min)) - (while (< (point) (point-max)) - (unless (looking-at "No ") - (add-text-properties (line-beginning-position) (line-end-position) - '(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 () - "Display IDs of currently known threads." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-threads-buffer) t)) - -(defun gdb-frame-threads-buffer () - "Display IDs of currently known threads in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer)))) - -(defvar gdb-threads-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'kill-this-buffer) - (define-key map "\r" 'gdb-threads-select) - (define-key map [mouse-2] 'gdb-threads-select) - (define-key map [follow-link] 'mouse-face) - map)) - -(defvar gdb-threads-font-lock-keywords - '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face)) - ("in \\([^ ]+\\) (" (1 font-lock-function-name-face)) - ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face))) - "Font lock keywords used in `gdb-threads-mode'.") - -(defun gdb-threads-mode () - "Major mode for gdb threads. - -\\{gdb-threads-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-threads-mode) - (setq mode-name "Threads") - (setq buffer-read-only t) - (buffer-disable-undo) - (setq header-line-format gdb-breakpoints-header) - (use-local-map gdb-threads-mode-map) - (set (make-local-variable 'font-lock-defaults) - '(gdb-threads-font-lock-keywords)) - (run-mode-hooks 'gdb-threads-mode-hook) - ;; Force "info threads" onto queue. - (lambda () (let ((gud-running nil)) (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 (&optional event) - "Select the thread and display the relevant source." - (interactive (list last-input-event)) - (if event (posn-set-point (event-end event))) - (setq gdb-stack-update t) - (gdb-enqueue-input - (list (concat gdb-server-prefix "thread " - (gdb-get-thread-number) "\n") 'ignore)) - (gud-display-frame)) - -(defun gdb-thread-identification () - (setq mode-line-buffer-identification - (list (car mode-line-buffer-identification) - '(gdb-thread-indicator gdb-thread-indicator)))) - -;; Registers buffer. -;; -(defcustom gdb-all-registers nil - "Non-nil means include floating-point registers." - :type 'boolean - :group 'gdb - :version "22.1") - -(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 - (concat - gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n") - gdb-info-registers-handler - gdb-info-registers-custom) - -(defun gdb-info-registers-custom () - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (save-excursion - (let ((buffer-read-only nil) - start end) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq start (line-beginning-position)) - (setq end (line-end-position)) - (when (looking-at "^[^ ]+") - (unless (string-equal (match-string 0) "The") - (put-text-property start (match-end 0) - 'face font-lock-variable-name-face) - (add-text-properties start end - '(help-echo "mouse-2: edit value" - mouse-face highlight)))) - (forward-line 1)))))) - -(defun gdb-edit-register-value (&optional event) - (interactive (list last-input-event)) - (save-excursion - (if event (posn-set-point (event-end event))) - (beginning-of-line) - (let* ((register (current-word)) - (value (read-string (format "New value (%s): " register)))) - (gdb-enqueue-input - (list (concat gdb-server-prefix "set $" register "=" value "\n") - 'ignore))))) - -(defvar gdb-registers-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" 'gdb-edit-register-value) - (define-key map [mouse-2] 'gdb-edit-register-value) - (define-key map " " 'gdb-all-registers) - (define-key map "q" 'kill-this-buffer) - map)) - -(defvar gdb-locals-header - (list - (gdb-propertize-header "Locals" gdb-locals-buffer - nil nil mode-line) - " " - (gdb-propertize-header "Registers" gdb-registers-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) - - -(defun gdb-registers-mode () - "Major mode for gdb registers. - -\\{gdb-registers-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-registers-mode) - (setq mode-name "Registers") - (setq header-line-format gdb-locals-header) - (setq buffer-read-only t) - (buffer-disable-undo) - (gdb-thread-identification) - (use-local-map gdb-registers-mode-map) - (run-mode-hooks 'gdb-registers-mode-hook) - (if (string-equal gdb-version "pre-6.4") - (progn - (if gdb-all-registers (setq mode-name "Registers:All")) - 'gdb-invalidate-registers) - 'gdb-invalidate-registers-1)) - -(defun gdb-registers-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*registers of " (gdb-get-target-string) "*"))) - -(defun gdb-display-registers-buffer () - "Display integer register contents." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-registers-buffer) t)) - -(defun gdb-frame-registers-buffer () - "Display integer register contents in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer)))) - -(defun gdb-all-registers () - "Toggle the display of floating-point registers (pre GDB 6.4 only)." - (interactive) - (when (string-equal gdb-version "pre-6.4") - (if gdb-all-registers - (progn - (setq gdb-all-registers nil) - (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer) - (setq mode-name "Registers"))) - (setq gdb-all-registers t) - (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer) - (setq mode-name "Registers:All"))) - (message (format "Display of floating-point registers %sabled" - (if gdb-all-registers "en" "dis"))) - (gdb-invalidate-registers))) - - -;; Memory buffer. -;; -(defcustom gdb-memory-repeat-count 32 - "Number of data items in memory window." - :type 'integer - :group 'gdb - :version "22.1") - -(defcustom gdb-memory-format "x" - "Display format of data items in memory window." - :type '(choice (const :tag "Hexadecimal" "x") - (const :tag "Signed decimal" "d") - (const :tag "Unsigned decimal" "u") - (const :tag "Octal" "o") - (const :tag "Binary" "t")) - :group 'gdb - :version "22.1") - -(defcustom gdb-memory-unit "w" - "Unit size of data items in memory window." - :type '(choice (const :tag "Byte" "b") - (const :tag "Halfword" "h") - (const :tag "Word" "w") - (const :tag "Giant word" "g")) - :group 'gdb - :version "22.1") - -(gdb-set-buffer-rules 'gdb-memory-buffer - 'gdb-memory-buffer-name - 'gdb-memory-mode) - -(def-gdb-auto-updated-buffer gdb-memory-buffer - gdb-invalidate-memory - (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count) - gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n") - gdb-read-memory-handler - gdb-read-memory-custom) - -(defun gdb-read-memory-custom () - (save-excursion - (goto-char (point-min)) - (if (looking-at "0x[[:xdigit:]]+") - (setq gdb-memory-address (match-string 0))))) - -(defvar gdb-memory-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "S" 'gdb-memory-set-address) - (define-key map "N" 'gdb-memory-set-repeat-count) - (define-key map "q" 'kill-this-buffer) - map)) - -(defun gdb-memory-set-address (&optional event) - "Set the start memory address." - (interactive) - (let ((arg (read-from-minibuffer "Start address: "))) - (setq gdb-memory-address arg)) - (gdb-invalidate-memory)) - -(defun gdb-memory-set-repeat-count (&optional event) - "Set the number of data items in memory window." - (interactive) - (let* ((arg (read-from-minibuffer "Repeat count: ")) - (count (string-to-number arg))) - (if (<= count 0) - (error "Positive numbers only") - (customize-set-variable 'gdb-memory-repeat-count count) - (gdb-invalidate-memory)))) - -(defun gdb-memory-format-binary () - "Set the display format to binary." - (interactive) - (customize-set-variable 'gdb-memory-format "t") - (gdb-invalidate-memory)) - -(defun gdb-memory-format-octal () - "Set the display format to octal." - (interactive) - (customize-set-variable 'gdb-memory-format "o") - (gdb-invalidate-memory)) - -(defun gdb-memory-format-unsigned () - "Set the display format to unsigned decimal." - (interactive) - (customize-set-variable 'gdb-memory-format "u") - (gdb-invalidate-memory)) - -(defun gdb-memory-format-signed () - "Set the display format to decimal." - (interactive) - (customize-set-variable 'gdb-memory-format "d") - (gdb-invalidate-memory)) - -(defun gdb-memory-format-hexadecimal () - "Set the display format to hexadecimal." - (interactive) - (customize-set-variable 'gdb-memory-format "x") - (gdb-invalidate-memory)) - -(defvar gdb-memory-format-map - (let ((map (make-sparse-keymap))) - (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1) - map) - "Keymap to select format in the header line.") - -(defvar gdb-memory-format-menu (make-sparse-keymap "Format") - "Menu of display formats in the header line.") - -(define-key gdb-memory-format-menu [binary] - '(menu-item "Binary" gdb-memory-format-binary - :button (:radio . (equal gdb-memory-format "t")))) -(define-key gdb-memory-format-menu [octal] - '(menu-item "Octal" gdb-memory-format-octal - :button (:radio . (equal gdb-memory-format "o")))) -(define-key gdb-memory-format-menu [unsigned] - '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned - :button (:radio . (equal gdb-memory-format "u")))) -(define-key gdb-memory-format-menu [signed] - '(menu-item "Signed Decimal" gdb-memory-format-signed - :button (:radio . (equal gdb-memory-format "d")))) -(define-key gdb-memory-format-menu [hexadecimal] - '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal - :button (:radio . (equal gdb-memory-format "x")))) - -(defun gdb-memory-format-menu (event) - (interactive "@e") - (x-popup-menu event gdb-memory-format-menu)) - -(defun gdb-memory-format-menu-1 (event) - (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) - (let* ((selection (gdb-memory-format-menu event)) - (binding (and selection (lookup-key gdb-memory-format-menu - (vector (car selection)))))) - (if binding (call-interactively binding))))) - -(defun gdb-memory-unit-giant () - "Set the unit size to giant words (eight bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit "g") - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-word () - "Set the unit size to words (four bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit "w") - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-halfword () - "Set the unit size to halfwords (two bytes)." - (interactive) - (customize-set-variable 'gdb-memory-unit "h") - (gdb-invalidate-memory)) - -(defun gdb-memory-unit-byte () - "Set the unit size to bytes." - (interactive) - (customize-set-variable 'gdb-memory-unit "b") - (gdb-invalidate-memory)) - -(defvar gdb-memory-unit-map - (let ((map (make-sparse-keymap))) - (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1) - map) - "Keymap to select units in the header line.") - -(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit") - "Menu of units in the header line.") - -(define-key gdb-memory-unit-menu [giantwords] - '(menu-item "Giant words" gdb-memory-unit-giant - :button (:radio . (equal gdb-memory-unit "g")))) -(define-key gdb-memory-unit-menu [words] - '(menu-item "Words" gdb-memory-unit-word - :button (:radio . (equal gdb-memory-unit "w")))) -(define-key gdb-memory-unit-menu [halfwords] - '(menu-item "Halfwords" gdb-memory-unit-halfword - :button (:radio . (equal gdb-memory-unit "h")))) -(define-key gdb-memory-unit-menu [bytes] - '(menu-item "Bytes" gdb-memory-unit-byte - :button (:radio . (equal gdb-memory-unit "b")))) - -(defun gdb-memory-unit-menu (event) - (interactive "@e") - (x-popup-menu event gdb-memory-unit-menu)) - -(defun gdb-memory-unit-menu-1 (event) - (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) - (let* ((selection (gdb-memory-unit-menu event)) - (binding (and selection (lookup-key gdb-memory-unit-menu - (vector (car selection)))))) - (if binding (call-interactively binding))))) - -(defvar gdb-memory-font-lock-keywords - '(;; <__function.name+n> - ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face)) - ) - "Font lock keywords used in `gdb-memory-mode'.") - -(defun gdb-memory-mode () - "Major mode for examining memory. - -\\{gdb-memory-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-memory-mode) - (setq mode-name "Memory") - (setq buffer-read-only t) - (buffer-disable-undo) - (use-local-map gdb-memory-mode-map) - (setq header-line-format - '(:eval - (concat - "Start address[" - (propertize - "-" - 'face font-lock-warning-face - 'help-echo "mouse-1: decrement address" - 'mouse-face 'mode-line-highlight - 'local-map - (gdb-make-header-line-mouse-map - 'mouse-1 - (lambda () (interactive) - (let ((gdb-memory-address - ;; Let GDB do the arithmetic. - (concat - gdb-memory-address " - " - (number-to-string - (* gdb-memory-repeat-count - (cond ((string= gdb-memory-unit "b") 1) - ((string= gdb-memory-unit "h") 2) - ((string= gdb-memory-unit "w") 4) - ((string= gdb-memory-unit "g") 8))))))) - (gdb-invalidate-memory))))) - "|" - (propertize "+" - 'face font-lock-warning-face - 'help-echo "mouse-1: increment address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - (lambda () (interactive) - (let ((gdb-memory-address nil)) - (gdb-invalidate-memory))))) - "]: " - (propertize gdb-memory-address - 'face font-lock-warning-face - 'help-echo "mouse-1: set start address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-set-address)) - " Repeat Count: " - (propertize (number-to-string gdb-memory-repeat-count) - 'face font-lock-warning-face - 'help-echo "mouse-1: set repeat count" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-set-repeat-count)) - " Display Format: " - (propertize gdb-memory-format - 'face font-lock-warning-face - 'help-echo "mouse-3: select display format" - 'mouse-face 'mode-line-highlight - 'local-map gdb-memory-format-map) - " Unit Size: " - (propertize gdb-memory-unit - 'face font-lock-warning-face - 'help-echo "mouse-3: select unit size" - 'mouse-face 'mode-line-highlight - 'local-map gdb-memory-unit-map)))) - (set (make-local-variable 'font-lock-defaults) - '(gdb-memory-font-lock-keywords)) - (run-mode-hooks 'gdb-memory-mode-hook) - 'gdb-invalidate-memory) - -(defun gdb-memory-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*memory of " (gdb-get-target-string) "*"))) - -(defun gdb-display-memory-buffer () - "Display memory contents." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-memory-buffer) t)) - -(defun gdb-frame-memory-buffer () - "Display memory contents in a new frame." - (interactive) - (let* ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist - (cons '(left-fringe . 0) - (cons '(right-fringe . 0) - (cons '(width . 83) gdb-frame-parameters))))) - (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) - - -;; Locals buffer. -;; -(gdb-set-buffer-rules 'gdb-locals-buffer - 'gdb-locals-buffer-name - 'gdb-locals-mode) - -(def-gdb-auto-update-trigger gdb-invalidate-locals - (gdb-get-buffer 'gdb-locals-buffer) - "server info locals\n" - gdb-info-locals-handler) - -(defvar gdb-locals-watch-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" (lambda () (interactive) - (beginning-of-line) - (gud-watch))) - (define-key map [mouse-2] (lambda (event) (interactive "e") - (mouse-set-point event) - (beginning-of-line) - (gud-watch))) - map) - "Keymap to create watch expression of a complex data type local variable.") - -(defconst gdb-struct-string - (concat (propertize "[struct/union]" - 'mouse-face 'highlight - 'help-echo "mouse-2: create watch expression" - 'local-map gdb-locals-watch-map) "\n")) - -(defconst gdb-array-string - (concat " " (propertize "[array]" - 'mouse-face 'highlight - 'help-echo "mouse-2: create watch expression" - 'local-map gdb-locals-watch-map) "\n")) - -;; Abbreviate for arrays and structures. -;; These can be expanded using gud-display. -(defun gdb-info-locals-handler () - (setq gdb-pending-triggers (delq 'gdb-invalidate-locals - gdb-pending-triggers)) - (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) - (with-current-buffer buf - (goto-char (point-min)) - ;; Need this in case "set print pretty" is on. - (while (re-search-forward "^[ }].*\n" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) - (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t) - (replace-match gdb-struct-string nil nil)) - (goto-char (point-min)) - (while (re-search-forward "\\s-*{[^.].*\n" nil t) - (replace-match gdb-array-string nil nil)))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf - (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (window-point window)) - (buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring (gdb-get-buffer-create - 'gdb-partial-output-buffer)) - (set-window-start window start) - (set-window-point window p))))) - (run-hooks 'gdb-info-locals-hook)) - -(defvar gdb-locals-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'kill-this-buffer) - map)) - -(defun gdb-locals-mode () - "Major mode for gdb locals. - -\\{gdb-locals-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-locals-mode) - (setq mode-name (concat "Locals:" gdb-selected-frame)) - (use-local-map gdb-locals-mode-map) - (setq buffer-read-only t) - (buffer-disable-undo) - (setq header-line-format gdb-locals-header) - (gdb-thread-identification) - (set (make-local-variable 'font-lock-defaults) - '(gdb-locals-font-lock-keywords)) - (run-mode-hooks 'gdb-locals-mode-hook) - (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (string-equal gdb-version "pre-6.4")) - 'gdb-invalidate-locals - 'gdb-invalidate-locals-1)) - -(defun gdb-locals-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*locals of " (gdb-get-target-string) "*"))) - -(defun gdb-display-locals-buffer () - "Display local variables of current stack and their values." - (interactive) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-locals-buffer) t)) - -(defun gdb-frame-locals-buffer () - "Display local variables of current stack and their values in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer)))) - - -;;;; Window management -(defun gdb-display-buffer (buf dedicated &optional frame) - (let ((answer (get-buffer-window buf (or frame 0)))) - (if answer - (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary. - (let ((window (get-lru-window))) - (if (memq (buffer-local-value 'gud-minor-mode (window-buffer window)) - '(gdba gdbmi)) - (let* ((largest (get-largest-window)) - (cur-size (window-height largest))) - (setq answer (split-window largest)) - (set-window-buffer answer buf) - (set-window-dedicated-p answer dedicated) - answer) - (set-window-buffer window buf) - window))))) - - -;;; Shared keymap initialization: - -(let ((menu (make-sparse-keymap "GDB-Windows"))) - (define-key gud-menu-map [displays] - `(menu-item "GDB-Windows" ,menu - :help "Open a GDB-UI buffer in a new window." - :visible (memq gud-minor-mode '(gdbmi gdba)))) - (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) - (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) - (define-key menu [inferior] - '(menu-item "Separate IO" gdb-display-separate-io-buffer - :enable gdb-use-separate-io-buffer)) - (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) - (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) - (define-key menu [disassembly] - '("Disassembly" . gdb-display-assembler-buffer)) - (define-key menu [breakpoints] - '("Breakpoints" . gdb-display-breakpoints-buffer)) - (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) - (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))) - -(let ((menu (make-sparse-keymap "GDB-Frames"))) - (define-key gud-menu-map [frames] - `(menu-item "GDB-Frames" ,menu - :help "Open a GDB-UI buffer in a new frame." - :visible (memq gud-minor-mode '(gdbmi gdba)))) - (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) - (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) - (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) - (define-key menu [inferior] - '(menu-item "Separate IO" gdb-frame-separate-io-buffer - :enable gdb-use-separate-io-buffer)) - (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) - (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) - (define-key menu [breakpoints] - '("Breakpoints" . gdb-frame-breakpoints-buffer)) - (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) - (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))) - -(let ((menu (make-sparse-keymap "GDB-UI/MI"))) - (define-key gud-menu-map [ui] - `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") - ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) - (define-key menu [gdb-customize] - '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) - :help "Customize Gdb Graphical Mode options.")) - (define-key menu [gdb-find-source-frame] - '(menu-item "Look For Source Frame" gdb-find-source-frame - :visible (eq gud-minor-mode 'gdba) - :help "Toggle looking for source frame further up call stack." - :button (:toggle . gdb-find-source-frame))) - (define-key menu [gdb-use-separate-io] - '(menu-item "Separate IO" gdb-use-separate-io-buffer - :visible (eq gud-minor-mode 'gdba) - :help "Toggle separate IO for debugged program." - :button (:toggle . gdb-use-separate-io-buffer))) - (define-key menu [gdb-many-windows] - '(menu-item "Display Other Windows" gdb-many-windows - :help "Toggle display of locals, stack and breakpoint information." - :button (:toggle . gdb-many-windows))) - (define-key menu [gdb-restore-windows] - '(menu-item "Restore Window Layout" gdb-restore-windows - :help "Restore standard layout for debug session."))) - -(defun gdb-frame-gdb-buffer () - "Display GUD buffer in a new frame." - (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist - (remove '(menu-bar-lines) (remove '(tool-bar-lines) - gdb-frame-parameters))) - (same-window-regexps nil)) - (display-buffer gud-comint-buffer))) - -(defun gdb-display-gdb-buffer () - "Display GUD buffer." - (interactive) - (let ((same-window-regexps nil)) - (select-window (display-buffer gud-comint-buffer nil 0)))) - -(defun gdb-set-window-buffer (name) - (set-window-buffer (selected-window) (get-buffer name)) - (set-window-dedicated-p (selected-window) t)) - -(defun gdb-setup-windows () - "Layout the window pattern for `gdb-many-windows'." - (gdb-display-locals-buffer) - (gdb-display-stack-buffer) - (delete-other-windows) - (gdb-display-breakpoints-buffer) - (delete-other-windows) - ; Don't dedicate. - (pop-to-buffer gud-comint-buffer) - (split-window nil ( / ( * (window-height) 3) 4)) - (split-window nil ( / (window-height) 3)) - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer (gdb-locals-buffer-name)) - (other-window 1) - (switch-to-buffer - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (if gdb-main-file - (gud-find-file gdb-main-file) - ;; Put buffer list in window if we - ;; can't find a source file. - (list-buffers-noselect)))) - (setq gdb-source-window (selected-window)) - (when gdb-use-separate-io-buffer - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-inferior-io))) - (other-window 1) - (gdb-set-window-buffer (gdb-stack-buffer-name)) - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer (gdb-breakpoints-buffer-name)) - (other-window 1)) - -(defun gdb-restore-windows () - "Restore the basic arrangement of windows used by gdba. -This arrangement depends on the value of `gdb-many-windows'." - (interactive) - (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. - (delete-other-windows) - (if gdb-many-windows - (gdb-setup-windows) - (when (or gud-last-last-frame gdb-show-main) - (split-window) - (other-window 1) - (switch-to-buffer - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file))) - (setq gdb-source-window (selected-window)) - (other-window 1)))) - -(defun gdb-reset () - "Exit a debugging session cleanly. -Kills the gdb buffers, and resets variables and the source buffers." - (dolist (buffer (buffer-list)) - (unless (eq buffer gud-comint-buffer) - (with-current-buffer buffer - (if (memq gud-minor-mode '(gdbmi gdba)) - (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) - (kill-local-variable 'gdb-define-alist)))))) - (setq gdb-overlay-arrow-position nil) - (setq overlay-arrow-variable-list - (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) - (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) - (setq gdb-stack-position nil) - (setq overlay-arrow-variable-list - (delq 'gdb-stack-position overlay-arrow-variable-list)) - (if (boundp 'speedbar-frame) (speedbar-timer-fn)) - (setq gud-running nil) - (setq gdb-active-process nil) - (setq gdb-var-list nil) - (remove-hook 'after-save-hook 'gdb-create-define-alist t)) - -(defun gdb-source-info () - "Find the source file where the program starts and display it with related -buffers." - (goto-char (point-min)) - (if (and (search-forward "Located in " nil t) - (looking-at "\\S-+")) - (setq gdb-main-file (match-string 0))) - (goto-char (point-min)) - (if (search-forward "Includes preprocessor macro info." nil t) - (setq gdb-macro-info t)) - (if gdb-many-windows - (gdb-setup-windows) - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (if (and gdb-show-main gdb-main-file) - (let ((pop-up-windows t)) - (display-buffer (gud-find-file gdb-main-file))))) - (setq gdb-ready t)) - -(defun gdb-get-location (bptno line flag) - "Find the directory containing the relevant source file. -Put in buffer and place breakpoint icon." - (goto-char (point-min)) - (catch 'file-not-found - (if (search-forward "Located in " nil t) - (when (looking-at "\\S-+") - (delete (cons bptno "File not found") gdb-location-alist) - (push (cons bptno (match-string 0)) gdb-location-alist)) - (gdb-resync) - (unless (assoc bptno gdb-location-alist) - (push (cons bptno "File not found") gdb-location-alist) - (message-box "Cannot find source file for breakpoint location.\n\ -Add directory to search path for source files using the GDB command, dir.")) - (throw 'file-not-found nil)) - (with-current-buffer - (find-file-noselect (match-string 0)) - (gdb-init-buffer) - ;; only want one breakpoint icon at each location - (save-excursion - (goto-char (point-min)) - (forward-line (1- (string-to-number line))) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))))) - -(add-hook 'find-file-hook 'gdb-find-file-hook) - -(defun gdb-find-file-hook () - "Set up buffer for debugging if file is part of the source code -of the current session." - (if (and (buffer-name gud-comint-buffer) - ;; in case gud or gdb-ui is just loaded - gud-comint-buffer - (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdba gdbmi))) - ;;Pre GDB 6.3 "info sources" doesn't give absolute file name. - (if (member (if (string-equal gdb-version "pre-6.4") - (file-name-nondirectory buffer-file-name) - buffer-file-name) - gdb-source-file-list) - (with-current-buffer (find-buffer-visiting buffer-file-name) - (gdb-init-buffer))))) - -;;from put-image -(defun gdb-put-string (putstring pos &optional dprop &rest sprops) - "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 ((string (make-string 1 ?x)) - (buffer (current-buffer))) - (setq putstring (copy-sequence putstring)) - (let ((overlay (make-overlay pos pos buffer)) - (prop (or dprop - (list (list 'margin 'left-margin) putstring)))) - (put-text-property 0 1 'display prop string) - (if sprops - (add-text-properties 0 1 sprops string)) - (overlay-put overlay 'put-break t) - (overlay-put overlay 'before-string 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))) - (dolist (overlay (overlays-in start end)) - (when (overlay-get overlay 'put-break) - (delete-overlay overlay)))) - -(defun gdb-put-breakpoint-icon (enabled bptno) - (if (string-match "[0-9+]+\\." bptno) - (setq enabled gdb-parent-bptno-enabled)) - (let ((start (- (line-beginning-position) 1)) - (end (+ (line-end-position) 1)) - (putstring (if enabled "B" "b")) - (source-window (get-buffer-window (current-buffer) 0))) - (add-text-properties - 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt") - putstring) - (if enabled - (add-text-properties - 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) - (add-text-properties - 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring)) - (gdb-remove-breakpoint-icons start end) - (if (display-images-p) - (if (>= (or left-fringe-width - (if source-window (car (window-fringes source-window))) - gdb-buffer-fringe-width) 8) - (gdb-put-string - nil (1+ start) - `(left-fringe breakpoint - ,(if enabled - 'breakpoint-enabled - 'breakpoint-disabled)) - 'gdb-bptno bptno - 'gdb-enabled enabled) - (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (if source-window - (set-window-margins - source-window - 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 :pointer hand) - (:type pbm :data - ,breakpoint-disabled-pbm-data - :ascent 100 :pointer hand)))))) - (+ start 1) - putstring - 'left-margin)) - (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (let ((window (get-buffer-window (current-buffer) 0))) - (if window - (set-window-margins - window left-margin-width right-margin-width))))) - (gdb-put-string - (propertize putstring - 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) - (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) - (let ((window (get-buffer-window (current-buffer) 0))) - (if window - (set-window-margins - window left-margin-width right-margin-width))))) - - -;; -;; Assembler buffer. -;; -(gdb-set-buffer-rules 'gdb-assembler-buffer - 'gdb-assembler-buffer-name - 'gdb-assembler-mode) - -;; We can't use def-gdb-auto-update-handler because we don't want to use -;; window-start but keep the overlay arrow/current line visible. -(defun gdb-assembler-handler () - (setq gdb-pending-triggers - (delq 'gdb-invalidate-assembler - gdb-pending-triggers)) - (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) - (with-current-buffer buf - (goto-char (point-min)) - ;; The disassemble command in GDB 7.1 onwards displays an overlay arrow. - (while (re-search-forward "\\(^ 0x\\|=> 0x\\)" nil t) - (replace-match "0x" nil nil)))) - (let ((buf (gdb-get-buffer 'gdb-assembler-buffer))) - (and buf - (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (p (window-point window)) - (buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring (gdb-get-buffer-create - 'gdb-partial-output-buffer)) - (set-window-point window p))))) - ;; put customisation here - (gdb-assembler-custom)) - -(defun gdb-assembler-custom () - (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) - (pos 1) (address) (flag) (bptno)) - (with-current-buffer buffer - (save-excursion - (if (not (equal gdb-pc-address "main")) - (progn - (goto-char (point-min)) - (if (and gdb-pc-address - (search-forward gdb-pc-address nil t)) - (progn - (setq pos (point)) - (beginning-of-line) - (setq fringe-indicator-alist - (if (string-equal gdb-frame-number "0") - nil - '((overlay-arrow . hollow-right-triangle)))) - (or gdb-overlay-arrow-position - (setq gdb-overlay-arrow-position (make-marker))) - (set-marker gdb-overlay-arrow-position (point)))))) - ;; 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) - (when (looking-at - "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") - (setq bptno (match-string 1)) - (setq flag (char-after (match-beginning 2))) - (setq address (match-string 3)) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (if (re-search-forward (concat "^0x0*" address) nil t) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))) - (if (not (equal gdb-pc-address "main")) - (with-current-buffer buffer - (set-window-point (get-buffer-window buffer 0) pos))))) - -(defvar gdb-assembler-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'kill-this-buffer) - map)) - -(defvar gdb-assembler-font-lock-keywords - '(;; <__function.name+n> - ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" - (1 font-lock-function-name-face)) - ;; 0xNNNNNNNN <__function.name+n>: opcode - ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)" - (4 font-lock-keyword-face)) - ;; %register(at least i386) - ("%\\sw+" . font-lock-variable-name-face) - ("^\\(Dump of assembler code for function\\) \\(.+\\):" - (1 font-lock-comment-face) - (2 font-lock-function-name-face)) - ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face)) - "Font lock keywords used in `gdb-assembler-mode'.") - -(defun gdb-assembler-mode () - "Major mode for viewing code assembler. - -\\{gdb-assembler-mode-map}" - (kill-all-local-variables) - (setq major-mode 'gdb-assembler-mode) - (setq mode-name (concat "Machine:" gdb-selected-frame)) - (setq gdb-overlay-arrow-position nil) - (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) - (setq fringes-outside-margins t) - (setq buffer-read-only t) - (buffer-disable-undo) - (gdb-thread-identification) - (use-local-map gdb-assembler-mode-map) - (gdb-invalidate-assembler) - (set (make-local-variable 'font-lock-defaults) - '(gdb-assembler-font-lock-keywords)) - (run-mode-hooks 'gdb-assembler-mode-hook) - 'gdb-invalidate-assembler) - -(defun gdb-assembler-buffer-name () - (with-current-buffer gud-comint-buffer - (concat "*disassembly of " (gdb-get-target-string) "*"))) - -(defun gdb-display-assembler-buffer () - "Display disassembly view." - (interactive) - (setq gdb-previous-frame nil) - (gdb-display-buffer - (gdb-get-buffer-create 'gdb-assembler-buffer) t)) - -(defun gdb-frame-assembler-buffer () - "Display disassembly view in a new frame." - (interactive) - (setq gdb-previous-frame nil) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) - (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) - -;; modified because if gdb-pc-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 (and gdb-selected-frame - (string-equal gdb-selected-frame gdb-previous-frame)) - (if (or (not (member 'gdb-invalidate-assembler - gdb-pending-triggers)) - (not (equal (string-to-number gdb-pc-address) - (string-to-number - gdb-previous-frame-pc-address)))) - (progn - ;; take previous disassemble command, if any, off the queue - (with-current-buffer gud-comint-buffer - (let ((queue gdb-input-queue)) - (dolist (item queue) - (if (equal (cdr item) '(gdb-assembler-handler)) - (setq gdb-input-queue - (delete item gdb-input-queue)))))) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "disassemble " gdb-pc-address "\n") - 'gdb-assembler-handler)) - (push 'gdb-invalidate-assembler gdb-pending-triggers) - (setq gdb-previous-frame-pc-address gdb-pc-address) - (setq gdb-previous-frame gdb-selected-frame))))))) - -(defun gdb-get-selected-frame () - (if (not (member 'gdb-get-selected-frame gdb-pending-triggers)) - (progn - (if (string-equal gdb-version "pre-6.4") - (gdb-enqueue-input - (list (concat gdb-server-prefix "info frame\n") - 'gdb-frame-handler)) - (gdb-enqueue-input - (list "server interpreter mi -stack-info-frame\n" - 'gdb-frame-handler-1))) - (push 'gdb-get-selected-frame gdb-pending-triggers)))) - -(defun gdb-frame-handler () - (setq gdb-pending-triggers - (delq 'gdb-get-selected-frame gdb-pending-triggers)) - (goto-char (point-min)) - (when (re-search-forward - "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t) - (setq gdb-frame-number (match-string 1)) - (setq gdb-frame-address (match-string 2))) - (goto-char (point-min)) - (when (re-search-forward ".*=\\s-+\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\ -\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; " - nil t) - (setq gdb-selected-frame (match-string 2)) - (if (gdb-get-buffer 'gdb-locals-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) - (setq mode-name (concat "Locals:" gdb-selected-frame)))) - (if (gdb-get-buffer 'gdb-assembler-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) - (setq mode-name (concat "Machine:" gdb-selected-frame)))) - (setq gdb-pc-address (match-string 1)) - (if (and (match-string 3) gud-overlay-arrow-position) - (let ((buffer (marker-buffer gud-overlay-arrow-position)) - (position (marker-position gud-overlay-arrow-position))) - (when (and buffer - (string-equal (file-name-nondirectory - (buffer-file-name buffer)) - (file-name-nondirectory (match-string 3)))) - (with-current-buffer buffer - (setq fringe-indicator-alist - (if (string-equal gdb-frame-number "0") - nil - '((overlay-arrow . hollow-right-triangle)))) - (set-marker gud-overlay-arrow-position position)))))) - (goto-char (point-min)) - (if (re-search-forward " source language \\(\\S-+\\)\." nil t) - (setq gdb-current-language (match-string 1))) - (gdb-invalidate-assembler)) - - -;; Code specific to GDB 6.4 -(defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"") - -(defun gdb-set-gud-minor-mode-existing-buffers-1 () - "Create list of source files for current GDB session. -If buffers already exist for any of these files, `gud-minor-mode' -is set in them." - (goto-char (point-min)) - (while (re-search-forward gdb-source-file-regexp-1 nil t) - (push (match-string 1) gdb-source-file-list)) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (member buffer-file-name gdb-source-file-list) - (gdb-init-buffer)))) - (gdb-force-mode-line-update - (propertize "ready" 'face font-lock-variable-name-face))) - -;; Used for -stack-info-frame but could be used for -stack-list-frames too. -(defconst gdb-stack-list-frames-regexp -".*?level=\"\\(.*?\\)\".*?,addr=\"\\(.*?\\)\".*?,func=\"\\(.*?\\)\",\ -\\(?:.*?file=\".*?\".*?,fullname=\"\\(.*?\\)\".*?,line=\"\\(.*?\\)\".*?}\\|\ -from=\"\\(.*?\\)\"\\)") - -(defun gdb-frame-handler-1 () - (setq gdb-pending-triggers - (delq 'gdb-get-selected-frame gdb-pending-triggers)) - (goto-char (point-min)) - (when (re-search-forward gdb-stack-list-frames-regexp nil t) - (setq gdb-frame-number (match-string 1)) - (setq gdb-pc-address (match-string 2)) - (setq gdb-selected-frame (match-string 3)) - (if (gdb-get-buffer 'gdb-locals-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) - (setq mode-name (concat "Locals:" gdb-selected-frame)))) - (if (gdb-get-buffer 'gdb-assembler-buffer) - (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) - (setq mode-name (concat "Machine:" gdb-selected-frame))))) - (if (and (match-string 4) (match-string 5) gud-overlay-arrow-position) - (let ((buffer (marker-buffer gud-overlay-arrow-position)) - (position (marker-position gud-overlay-arrow-position))) - (when (and buffer - (string-equal (file-name-nondirectory - (buffer-file-name buffer)) - (file-name-nondirectory (match-string 4)))) - (with-current-buffer buffer - (setq fringe-indicator-alist - (if (string-equal gdb-frame-number "0") - nil - '((overlay-arrow . hollow-right-triangle)))) - (set-marker gud-overlay-arrow-position position))))) - (gdb-invalidate-assembler)) - -; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards. -(defun gdb-var-list-children-1 (varnum) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - (concat "server interpreter mi \"-var-list-children --all-values \\\"" - varnum "\\\"\"\n") - (concat "-var-list-children --all-values \"" varnum "\"\n")) - `(lambda () (gdb-var-list-children-handler-1 ,varnum))))) - -(defun gdb-var-list-children-handler-1 (varnum) - (let* ((var-list nil) - (output (bindat-get-field (gdb-json-partial-output "child"))) - (children (bindat-get-field output 'children))) - (catch 'child-already-watched - (dolist (var gdb-var-list) - (if (string-equal varnum (car var)) - (progn - ;; With dynamic varobjs numchild may have increased. - (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) - (push var var-list) - (dolist (child children) - (let ((varchild (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) - nil - (bindat-get-field child 'has_more)))) - (if (assoc (car varchild) gdb-var-list) - (throw 'child-already-watched nil)) - (push varchild var-list)))) - (push var var-list))) - (setq gdb-var-list (nreverse var-list)))) - (gdb-speedbar-update)) - -; Uses "-var-update --all-values". Needs GDB 6.4 onwards. -(defun gdb-var-update-1 () - (if (not (member 'gdb-var-update gdb-pending-triggers)) - (progn - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - "server interpreter mi \"-var-update --all-values *\"\n" - "-var-update --all-values *\n") - 'gdb-var-update-handler-1)) - (push 'gdb-var-update gdb-pending-triggers)))) - -(defun gdb-var-update-handler-1 () - (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) - (dolist (var gdb-var-list) - (setcar (nthcdr 5 var) nil)) - (let ((temp-var-list gdb-var-list)) - (dolist (change changelist) - (let* ((varnum (bindat-get-field change 'name)) - (var (assoc varnum gdb-var-list)) - (new-num (bindat-get-field change 'new_num_children))) - (when var - (let ((scope (bindat-get-field change 'in_scope)) - (has-more (bindat-get-field change 'has_more))) - (cond ((string-equal scope "false") - (if gdb-delete-out-of-scope - (gdb-var-delete-1 var varnum) - (setcar (nthcdr 5 var) 'out-of-scope))) - ((string-equal scope "true") - (setcar (nthcdr 6 var) has-more) - (when (and (or (not has-more) - (string-equal has-more "0")) - (not new-num) - (string-equal (nth 2 var) "0")) - (setcar (nthcdr 4 var) - (bindat-get-field change 'value)) - (setcar (nthcdr 5 var) 'changed))) - ((string-equal scope "invalid") - (gdb-var-delete-1 var varnum))))) - (let ((var-list nil) var1 - (children (bindat-get-field change 'new_children))) - (if new-num - (progn - (setq var1 (pop temp-var-list)) - (while var1 - (if (string-equal varnum (car var1)) - (let ((new (string-to-number new-num)) - (previous (string-to-number (nth 2 var1)))) - (setcar (nthcdr 2 var1) new-num) - (push var1 var-list) - (cond ((> new previous) - ;; Add new children to list. - (dotimes (dummy previous) - (push (pop temp-var-list) var-list)) - (dolist (child children) - (let ((varchild - (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) - 'changed - (bindat-get-field child 'has_more)))) - (push varchild var-list)))) - ;; Remove deleted children from list. - ((< new previous) - (dotimes (dummy new) - (push (pop temp-var-list) var-list)) - (dotimes (dummy (- previous new)) - (pop temp-var-list))))) - (push var1 var-list)) - (setq var1 (pop temp-var-list))) - (setq gdb-var-list (nreverse var-list))))))))) - (setq gdb-pending-triggers - (delq 'gdb-var-update gdb-pending-triggers)) - (gdb-speedbar-update)) - -;; Registers buffer. -;; -(gdb-set-buffer-rules 'gdb-registers-buffer - 'gdb-registers-buffer-name - 'gdb-registers-mode) - -(def-gdb-auto-update-trigger gdb-invalidate-registers-1 - (gdb-get-buffer 'gdb-registers-buffer) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - "server interpreter mi \"-data-list-register-values x\"\n" - "-data-list-register-values x\n") - gdb-data-list-register-values-handler) - -(defconst gdb-data-list-register-values-regexp - "{.*?number=\"\\(.*?\\)\".*?,value=\"\\(.*?\\)\".*?}") - -(defun gdb-data-list-register-values-handler () - (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1 - gdb-pending-triggers)) - (goto-char (point-min)) - (if (re-search-forward gdb-error-regexp nil t) - (let ((err (match-string 1))) - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (put-text-property 0 (length err) 'face font-lock-warning-face err) - (insert err) - (goto-char (point-min))))) - (let ((register-list (reverse gdb-register-names)) - (register nil) (register-string nil) (register-values nil)) - (goto-char (point-min)) - (while (re-search-forward gdb-data-list-register-values-regexp nil t) - (setq register (pop register-list)) - (setq register-string (concat register "\t" (match-string 2) "\n")) - (if (member (match-string 1) gdb-changed-registers) - (put-text-property 0 (length register-string) - 'face 'font-lock-warning-face - register-string)) - (setq register-values - (concat register-values register-string))) - (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) - (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (if window (window-point window) (point))) - (buffer-read-only nil)) - (erase-buffer) - (insert register-values) - (if window - (progn - (set-window-start window start) - (set-window-point window p)) - (goto-char p))))))) - (gdb-data-list-register-values-custom)) - -(defun gdb-data-list-register-values-custom () - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (save-excursion - (let ((buffer-read-only nil) - start end) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq start (line-beginning-position)) - (setq end (line-end-position)) - (when (looking-at "^[^\t]+") - (unless (string-equal (match-string 0) "No registers.") - (put-text-property start (match-end 0) - 'face font-lock-variable-name-face) - (add-text-properties start end - '(help-echo "mouse-2: edit value" - mouse-face highlight)))) - (forward-line 1)))))) - -;; Needs GDB 6.4 onwards (used to fail with no stack). -(defun gdb-get-changed-registers () - (if (and (gdb-get-buffer 'gdb-registers-buffer) - (not (member 'gdb-get-changed-registers gdb-pending-triggers))) - (progn - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - "server interpreter mi -data-list-changed-registers\n" - "-data-list-changed-registers\n") - 'gdb-get-changed-registers-handler)) - (push 'gdb-get-changed-registers gdb-pending-triggers)))) - -(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") - -(defun gdb-get-changed-registers-handler () - (setq gdb-pending-triggers - (delq 'gdb-get-changed-registers gdb-pending-triggers)) - (setq gdb-changed-registers nil) - (goto-char (point-min)) - (while (re-search-forward gdb-data-list-register-names-regexp nil t) - (push (match-string 1) gdb-changed-registers))) - - -;; Locals buffer. -;; -;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. -(gdb-set-buffer-rules 'gdb-locals-buffer - 'gdb-locals-buffer-name - 'gdb-locals-mode) - -(def-gdb-auto-update-trigger gdb-invalidate-locals-1 - (gdb-get-buffer 'gdb-locals-buffer) - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba) - "server interpreter mi -\"stack-list-locals --simple-values\"\n" - "-stack-list-locals --simple-values\n") - gdb-stack-list-locals-handler) - -(defconst gdb-stack-list-locals-regexp - "{.*?name=\"\\(.*?\\)\".*?,type=\"\\(.*?\\)\"") - -(defvar gdb-locals-watch-map-1 - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" 'gud-watch) - (define-key map [mouse-2] 'gud-watch) - map) - "Keymap to create watch expression of a complex data type local variable.") - -(defvar gdb-edit-locals-map-1 - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "\r" 'gdb-edit-locals-value) - (define-key map [mouse-2] 'gdb-edit-locals-value) - map) - "Keymap to edit value of a simple data type local variable.") - -(defun gdb-edit-locals-value (&optional event) - "Assign a value to a variable displayed in the locals buffer." - (interactive (list last-input-event)) - (save-excursion - (if event (posn-set-point (event-end event))) - (beginning-of-line) - (let* ((var (current-word)) - (value (read-string (format "New value (%s): " var)))) - (gdb-enqueue-input - (list (concat gdb-server-prefix "set variable " var " = " value "\n") - 'ignore))))) - -;; Dont display values of arrays or structures. -;; These can be expanded using gud-watch. -(defun gdb-stack-list-locals-handler () - (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 - gdb-pending-triggers)) - (goto-char (point-min)) - (if (re-search-forward gdb-error-regexp nil t) - (let ((err (match-string 1))) - (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert err) - (goto-char (point-min))))) - (let (local locals-list) - (goto-char (point-min)) - (while (re-search-forward gdb-stack-list-locals-regexp nil t) - (let ((local (list (match-string 1) - (match-string 2) - nil))) - (if (looking-at ",value=\\(\".*\"\\).*?}") - (setcar (nthcdr 2 local) (read (match-string 1)))) - (push local locals-list))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (if window (window-point window) (point))) - (buffer-read-only nil) (name) (value)) - (erase-buffer) - (dolist (local locals-list) - (setq name (car local)) - (setq value (nth 2 local)) - (if (or (not value) - (string-match "^\\0x" value)) - (add-text-properties 0 (length name) - `(mouse-face highlight - help-echo "mouse-2: create watch expression" - local-map ,gdb-locals-watch-map-1) - name) - (add-text-properties 0 (length value) - `(mouse-face highlight - help-echo "mouse-2: edit value" - local-map ,gdb-edit-locals-map-1) - value)) - (insert - (concat name "\t" (nth 1 local) - "\t" value "\n"))) - (if window - (progn - (set-window-start window start) - (set-window-point window p)) - (goto-char p))))))))) - -(defun gdb-get-register-names () - "Create a list of register names." - (goto-char (point-min)) - (while (re-search-forward gdb-data-list-register-names-regexp nil t) - (push (match-string 1) gdb-register-names))) - -(provide 'gdb-ui) - -;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 -;;; gdb-ui.el ends here
--- a/lisp/progmodes/gud.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/progmodes/gud.el Sun Mar 28 09:04:11 2010 -0400 @@ -43,10 +43,8 @@ (require 'comint) (defvar gdb-active-process) -(defvar gdb-recording) (defvar gdb-define-alist) (defvar gdb-macro-info) -(defvar gdb-server-prefix) (defvar gdb-show-changed-values) (defvar gdb-source-window) (defvar gdb-var-list) @@ -126,77 +124,52 @@ (throw 'info-found nil)))) nil 0) (select-frame (make-frame))) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (info "(emacs)GDB Graphical Interface") (info "(emacs)Debuggers")))) (defun gud-tool-bar-item-visible-no-fringe () (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) - (and (memq gud-minor-mode '(gdbmi gdba)) + (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode) + (and (eq gud-minor-mode 'gdbmi) (> (car (window-fringes)) 0))))) +(declare-function gdb-gud-context-command "gdb-mi.el") + (defun gud-stop-subjob () (interactive) (with-current-buffer gud-comint-buffer - (if (string-equal gud-target-name "emacs") - (comint-stop-subjob) - (if (eq gud-minor-mode 'jdb) - (gud-call "suspend") - (comint-interrupt-subjob))))) + (cond ((string-equal gud-target-name "emacs") + (comint-stop-subjob)) + ((eq gud-minor-mode 'jdb) + (gud-call "suspend")) + ((eq gud-minor-mode 'gdbmi) + (gud-call (gdb-gud-context-command "-exec-interrupt"))) + (t + (comint-interrupt-subjob))))) (easy-mmode-defmap gud-menu-map '(([help] "Info (debugger)" . gud-goto-info) - ([rfinish] menu-item "Reverse Finish Function" gud-rfinish - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([rstepi] menu-item "Reverse Step Instruction" gud-rstepi - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([rnexti] menu-item "Reverse Next Instruction" gud-rnexti - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([rstep] menu-item "Reverse Step Line" gud-rstep - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([rnext] menu-item "Reverse Next Line" gud-rnext - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([rcont] menu-item "Reverse Continue" gud-rcont - :enable (not gud-running) - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) - ([recstart] menu-item "Start Recording" gdb-toggle-recording-1 - :visible (and (not gdb-recording) - (eq gud-minor-mode 'gdba))) - ([recstop] menu-item "Stop Recording" gdb-toggle-recording - :visible (and gdb-recording - (eq gud-minor-mode 'gdba))) ([tooltips] menu-item "Show GUD tooltips" gud-tooltip-mode :enable (and (not emacs-basic-display) (display-graphic-p) (fboundp 'x-show-tip)) :visible (memq gud-minor-mode - '(gdbmi gdba dbx sdb xdb pdb)) + '(gdbmi dbx sdb xdb pdb)) :button (:toggle . gud-tooltip-mode)) ([refresh] "Refresh" . gud-refresh) ([run] menu-item "Run" gud-run :enable (not gud-running) :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go - :visible (and (not gud-running) - (eq gud-minor-mode 'gdba))) + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))) ([stop] menu-item "Stop" gud-stop-subjob - :visible (or (not (memq gud-minor-mode '(gdba pdb))) - (and gud-running - (eq gud-minor-mode 'gdba)))) + :visible (or (not (memq gud-minor-mode '(gdbmi pdb))) + (gdb-show-stop-p))) ([until] menu-item "Continue to selection" gud-until :enable (not gud-running) - :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb)) + :visible (and (memq gud-minor-mode '(gdbmi gdb perldb)) (gud-tool-bar-item-visible-no-fringe))) ([remove] menu-item "Remove Breakpoint" gud-remove :enable (not gud-running) @@ -204,50 +177,52 @@ ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb sdb xdb))) + '(gdbmi gdb sdb xdb))) ([break] menu-item "Set Breakpoint" gud-break :enable (not gud-running) :visible (gud-tool-bar-item-visible-no-fringe)) ([up] menu-item "Up Stack" gud-up :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb))) + '(gdbmi gdb dbx xdb jdb pdb))) ([down] menu-item "Down Stack" gud-down :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb))) + '(gdbmi gdb dbx xdb jdb pdb))) ([pp] menu-item "Print S-expression" gud-pp :enable (and (not gud-running) gdb-active-process) :visible (and (string-equal (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs") - (eq gud-minor-mode 'gdba))) - ([print*] menu-item "Print Dereference" gud-pstar + (eq gud-minor-mode 'gdbmi))) + ([print*] menu-item (if (eq gud-minor-mode 'jdb) + "Dump object" + "Print Dereference") gud-pstar :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb))) + :visible (memq gud-minor-mode '(gdbmi gdb jdb))) ([print] menu-item "Print Expression" gud-print :enable (not gud-running)) ([watch] menu-item "Watch Expression" gud-watch :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba))) + :visible (eq gud-minor-mode 'gdbmi)) ([finish] menu-item "Finish Function" gud-finish :enable (not gud-running) :visible (memq gud-minor-mode - '(gdbmi gdba gdb xdb jdb pdb))) + '(gdbmi gdb xdb jdb pdb))) ([stepi] menu-item "Step Instruction" gud-stepi :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))) ([nexti] menu-item "Next Instruction" gud-nexti :enable (not gud-running) - :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) + :visible (memq gud-minor-mode '(gdbmi gdb dbx))) ([step] menu-item "Step Line" gud-step :enable (not gud-running)) ([next] menu-item "Next Line" gud-next :enable (not gud-running)) ([cont] menu-item "Continue" gud-cont :enable (not gud-running) - :visible (not (eq gud-minor-mode 'gdba)))) + :visible (not (eq gud-minor-mode 'gdbmi)))) "Menu for `gud-mode'." :name "Gud") @@ -269,21 +244,22 @@ . (,(propertize "next" 'face 'font-lock-doc-face) . gud-next)) ([menu-bar until] menu-item ,(propertize "until" 'face 'font-lock-doc-face) gud-until - :visible (memq gud-minor-mode '(gdbmi gdba gdb perldb))) + :visible (memq gud-minor-mode '(gdbmi gdb perldb))) ([menu-bar cont] menu-item ,(propertize "cont" 'face 'font-lock-doc-face) gud-cont - :visible (not (eq gud-minor-mode 'gdba))) + :visible (not (eq gud-minor-mode 'gdbmi))) ([menu-bar run] menu-item ,(propertize "run" 'face 'font-lock-doc-face) gud-run :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) ([menu-bar go] menu-item ,(propertize " go " 'face 'font-lock-doc-face) gud-go - :visible (and (not gud-running) - (eq gud-minor-mode 'gdba))) + :visible (and (eq gud-minor-mode 'gdbmi) + (gdb-show-run-p))) ([menu-bar stop] menu-item ,(propertize "stop" 'face 'font-lock-doc-face) gud-stop-subjob - :visible (and gud-running - (eq gud-minor-mode 'gdba))) + :visible (or (and (eq gud-minor-mode 'gdbmi) + (gdb-show-stop-p)) + (not (eq gud-minor-mode 'gdbmi)))) ([menu-bar print] . (,(propertize "print" 'face 'font-lock-doc-face) . gud-print)) ([menu-bar tools] . undefined) @@ -322,14 +298,6 @@ (gud-stepi . "gud/stepi") (gud-up . "gud/up") (gud-down . "gud/down") - (gdb-toggle-recording-1 . "gud/recstart") - (gdb-toggle-recording . "gud/recstop") - (gud-rcont . "gud/rcont") - (gud-rnext . "gud/rnext") - (gud-rstep . "gud/rstep") - (gud-rfinish . "gud/rfinish") - (gud-rnexti . "gud/rnexti") - (gud-rstepi . "gud/rstepi") (gud-goto-info . "info")) map) (tool-bar-local-item-from-menu @@ -354,7 +322,7 @@ (setq directories (cdr directories))) result))) -(declare-function gdb-create-define-alist "gdb-ui" ()) +(declare-function gdb-create-define-alist "gdb-mi" ()) (defun gud-find-file (file) ;; Don't get confused by double slashes in the name that comes from GDB. @@ -370,7 +338,7 @@ (set (make-local-variable 'gud-minor-mode) minor-mode) (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) (when (and gud-tooltip-mode - (memq gud-minor-mode '(gdbmi gdba))) + (eq gud-minor-mode 'gdbmi)) (make-local-variable 'gdb-define-alist) (unless gdb-define-alist (gdb-create-define-alist)) (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) @@ -499,21 +467,21 @@ (defvar gud-speedbar-menu-items '(["Jump to stack frame" speedbar-edit-line - :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba)))] + :visible (not (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi))] ["Edit value" speedbar-edit-line - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ["Delete expression" gdb-var-delete - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ["Auto raise frame" gdb-speedbar-auto-raise :style toggle :selected gdb-speedbar-auto-raise - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))] + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)] ("Output Format" - :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba)) + :visible (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi) ["Binary" (gdb-var-set-format "binary") t] ["Natural" (gdb-var-set-format "natural") t] ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) @@ -542,7 +510,7 @@ (start (window-start window)) (p (window-point window))) (cond - ((memq minor-mode '(gdbmi gdba)) + ((eq minor-mode 'gdbmi) (erase-buffer) (insert "Watch Expressions:\n") (let ((var-list gdb-var-list) parent) @@ -632,7 +600,7 @@ (car frame) 'speedbar-file-face 'speedbar-highlight-face - (cond ((memq minor-mode '(gdbmi gdba gdb)) + (cond ((memq minor-mode '(gdbmi gdb)) 'gud-gdb-goto-stackframe) (t (error "Should never be here"))) frame t)))) @@ -689,8 +657,6 @@ ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0)))) - ;; Check for annotations and change gud-minor-mode to 'gdba if - ;; they are found. (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) (let ((match (match-string 1 gud-marker-acc))) @@ -754,10 +720,10 @@ (defvar gud-filter-pending-text nil "Non-nil means this is text that has been saved for later in `gud-filter'.") -;; If in gdba mode, gdb-ui is loaded. -(declare-function gdb-restore-windows "gdb-ui" ()) - -;; The old gdb command (text command mode). The new one is in gdb-ui.el. +;; If in gdb mode, gdb-mi is loaded. +(declare-function gdb-restore-windows "gdb-mi" ()) + +;; The old gdb command (text command mode). The new one is in gdb-mi.el. ;;;###autoload (defun gud-gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. @@ -768,10 +734,10 @@ (when (and gud-comint-buffer (buffer-name gud-comint-buffer) (get-buffer-process gud-comint-buffer) - (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) - (gdb-restore-windows) - (error - "Multiple debugging requires restarting in text command mode")) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdbmi))) + (gdb-restore-windows) + (error + "Multiple debugging requires restarting in text command mode")) (gud-common-init command-line nil 'gud-gdb-marker-filter) (set (make-local-variable 'gud-minor-mode) 'gdb) @@ -2642,7 +2608,7 @@ (defvar gud-overlay-arrow-position nil) (add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position) -(declare-function gdb-reset "gdb-ui" ()) +(declare-function gdb-reset "gdb-mi" ()) (defun gud-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) @@ -2654,14 +2620,14 @@ (string-equal speedbar-initial-expansion-list-name "GUD")) (speedbar-change-initial-expansion-list speedbar-previously-used-expansion-list-name)) - (if (memq gud-minor-mode-type '(gdbmi gdba)) + (if (eq gud-minor-mode-type 'gdbmi) (gdb-reset) (gud-reset))) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) - (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdba gdbmi)) + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi) (gdb-reset) (gud-reset)) (let* ((obuf (current-buffer))) @@ -2692,7 +2658,9 @@ (defun gud-kill-buffer-hook () (setq gud-minor-mode-type gud-minor-mode) (condition-case nil - (kill-process (get-buffer-process (current-buffer))) + (progn + (kill-process (get-buffer-process (current-buffer))) + (delete-process (get-process "gdb-inferior"))) (error nil))) (defun gud-reset () @@ -2715,8 +2683,8 @@ (declare-function global-hl-line-highlight "hl-line" ()) (declare-function hl-line-highlight "hl-line" ()) -(declare-function gdb-display-source-buffer "gdb-ui" (buffer)) -(declare-function gdb-display-buffer "gdb-ui" (buf dedicated &optional size)) +(declare-function gdb-display-source-buffer "gdb-mi" (buffer)) +(declare-function gdb-display-buffer "gdb-mi" (buf dedicated &optional size)) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. @@ -2732,7 +2700,7 @@ (gud-find-file true-file))) (window (and buffer (or (get-buffer-window buffer) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (or (if (get-buffer-window buffer 'visible) (display-buffer buffer nil 'visible)) (unless (gdb-display-source-buffer buffer) @@ -2769,7 +2737,7 @@ (goto-char pos)))) (when window (set-window-point window gud-overlay-arrow-position) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (setq gdb-source-window window))))))) ;; The gud-call function must do the right thing whether its invoking @@ -2875,7 +2843,7 @@ (forward-line 0)) (if (looking-at comint-prompt-regexp) (set-marker gud-delete-prompt-marker (point))) - (if (memq gud-minor-mode '(gdbmi gdba)) + (if (eq gud-minor-mode 'gdbmi) (apply comint-input-sender (list proc command)) (process-send-string proc (concat command "\n")))))))) @@ -3301,14 +3269,14 @@ (gud-tooltip-activate-mouse-motions-if-enabled) (if (and gud-comint-buffer (buffer-name gud-comint-buffer); gud-comint-buffer might be killed - (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - '(gdbmi gdba))) + (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdbmi)) (if gud-tooltip-mode (progn (dolist (buffer (buffer-list)) (unless (eq buffer gud-comint-buffer) (with-current-buffer buffer - (when (and (memq gud-minor-mode '(gdbmi gdba)) + (when (and (eq gud-minor-mode 'gdbmi) (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) (make-local-variable 'gdb-define-alist) @@ -3433,8 +3401,8 @@ ; Larger arrays (say 400 elements) are displayed in ; the tooltip incompletely and spill over into the gud buffer. ; Switching the process-filter creates timing problems and -; it may be difficult to do better. Using annotations as in -; gdb-ui.el gets round this problem. +; it may be difficult to do better. Using GDB/MI as in +; gdb-mi.el gets round this problem. (defun gud-tooltip-process-output (process output) "Process debugger output and show it in a tooltip window." (set-process-filter process gud-tooltip-original-filter) @@ -3444,12 +3412,12 @@ (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (case gud-minor-mode - (gdba (concat "server print " expr)) - ((dbx gdbmi) (concat "print " expr)) + (gdbmi (concat "-data-evaluate-expression " expr)) + (dbx (concat "print " expr)) ((xdb pdb) (concat "p " expr)) (sdb (concat expr "/")))) -(declare-function gdb-enqueue-input "gdb-ui" (item)) +(declare-function gdb-input "gdb-mi" (item)) (declare-function tooltip-expr-to-print "tooltip" (event)) (declare-function tooltip-event-buffer "tooltip" (event)) @@ -3469,12 +3437,12 @@ (buffer-name gud-comint-buffer); might be killed (setq process (get-buffer-process gud-comint-buffer)) (posn-point (event-end event)) - (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process)) + (or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) (progn (setq gud-tooltip-event event) (eval (cons 'and gud-tooltip-display))))) (let ((expr (tooltip-expr-to-print event))) (when expr - (if (and (eq gud-minor-mode 'gdba) + (if (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process)) (progn (with-current-buffer (tooltip-event-buffer event) @@ -3492,13 +3460,13 @@ (message-box "Using GUD tooltips in this mode is unsafe\n\ so they have been disabled.")) (unless (null cmd) ; CMD can be nil if unknown debugger - (if (memq gud-minor-mode '(gdba gdbmi)) + (if (eq gud-minor-mode 'gdbmi) (if gdb-macro-info - (gdb-enqueue-input + (gdb-input (list (concat - gdb-server-prefix "macro expand " expr "\n") + "server macro expand " expr "\n") `(lambda () (gdb-tooltip-print-1 ,expr)))) - (gdb-enqueue-input + (gdb-input (list (concat cmd "\n") `(lambda () (gdb-tooltip-print ,expr))))) (setq gud-tooltip-original-filter (process-filter process))
--- a/lisp/progmodes/make-mode.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/progmodes/make-mode.el Sun Mar 28 09:04:11 2010 -0400 @@ -272,7 +272,7 @@ "Characters to skip to find a line that might be a dependency.") (defvar makefile-rule-action-regex - "^\t[ \t]*\\([-@]*\\)[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)" + "^\t[ \t]*\\(?:\\([-@]+\\)[ \t]*\\)\\(.*\\(?:\\\\\n.*\\)*\\)" "Regex used to highlight rule action lines in font lock mode.") (defconst makefile-makepp-rule-action-regex @@ -281,8 +281,7 @@ "Regex used to highlight makepp rule action lines in font lock mode.") (defconst makefile-bsdmake-rule-action-regex - (progn (string-match "-@" makefile-rule-action-regex) - (replace-match "-+@" t t makefile-rule-action-regex)) + (replace-regexp-in-string "-@" "-+@" makefile-rule-action-regex) "Regex used to highlight BSD rule action lines in font lock mode.") ;; Note that the first and second subexpression is used by font lock. Note @@ -355,8 +354,9 @@ (3 'font-lock-string-face prepend t)) ;; Rule actions. + ;; FIXME: When this spans multiple lines we need font-lock-multiline. (makefile-match-action - (1 font-lock-type-face) + (1 font-lock-type-face nil t) (2 'makefile-shell prepend) ;; Only makepp has builtin commands. (3 font-lock-builtin-face prepend t)) @@ -520,25 +520,25 @@ ("Macro Assignment" ,makefile-macroassign-regex 1)) "Imenu generic expression for Makefile mode. See `imenu-generic-expression'.") -;;; ------------------------------------------------------------ -;;; The following configurable variables are used in the -;;; up-to-date overview . -;;; The standard configuration assumes that your `make' program -;;; can be run in question/query mode using the `-q' option, this -;;; means that the command -;;; -;;; make -q foo -;;; -;;; should return an exit status of zero if the target `foo' is -;;; up to date and a nonzero exit status otherwise. -;;; Many makes can do this although the docs/manpages do not mention -;;; it. Try it with your favourite one. GNU make, System V make, and -;;; Dennis Vadura's DMake have no problems. -;;; Set the variable `makefile-brave-make' to the name of the -;;; make utility that does this on your system. -;;; To understand what this is all about see the function definition -;;; of `makefile-query-by-make-minus-q' . -;;; ------------------------------------------------------------ +;; ------------------------------------------------------------ +;; The following configurable variables are used in the +;; up-to-date overview . +;; The standard configuration assumes that your `make' program +;; can be run in question/query mode using the `-q' option, this +;; means that the command +;; +;; make -q foo +;; +;; should return an exit status of zero if the target `foo' is +;; up to date and a nonzero exit status otherwise. +;; Many makes can do this although the docs/manpages do not mention +;; it. Try it with your favourite one. GNU make, System V make, and +;; Dennis Vadura's DMake have no problems. +;; Set the variable `makefile-brave-make' to the name of the +;; make utility that does this on your system. +;; To understand what this is all about see the function definition +;; of `makefile-query-by-make-minus-q' . +;; ------------------------------------------------------------ (defcustom makefile-brave-make "make" "*How to invoke make, for `makefile-query-targets'. @@ -573,11 +573,8 @@ ;;; --- end of up-to-date-overview configuration ------------------ -(defvar makefile-mode-abbrev-table nil +(define-abbrev-table 'makefile-mode-abbrev-table () "Abbrev table in use in Makefile buffers.") -(if makefile-mode-abbrev-table - () - (define-abbrev-table 'makefile-mode-abbrev-table ())) (defvar makefile-mode-map (let ((map (make-sparse-keymap)) @@ -705,15 +702,13 @@ (modify-syntax-entry ?\n "> " st) st)) -(defvar makefile-imake-mode-syntax-table (copy-syntax-table - makefile-mode-syntax-table)) -(if makefile-imake-mode-syntax-table - () - (modify-syntax-entry ?/ ". 14" makefile-imake-mode-syntax-table) - (modify-syntax-entry ?* ". 23" makefile-imake-mode-syntax-table) - (modify-syntax-entry ?# "'" makefile-imake-mode-syntax-table) - (modify-syntax-entry ?\n ". b" makefile-imake-mode-syntax-table)) - +(defvar makefile-imake-mode-syntax-table + (let ((st (make-syntax-table makefile-mode-syntax-table))) + (modify-syntax-entry ?/ ". 14" st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?# "'" st) + (modify-syntax-entry ?\n ". b" st) + st)) ;;; ------------------------------------------------------------ ;;; Internal variables. @@ -773,7 +768,7 @@ ;;; ------------------------------------------------------------ ;;;###autoload -(defun makefile-mode () +(define-derived-mode makefile-mode nil "Makefile" "Major mode for editing standard Makefiles. If you are editing a file for a different make, try one of the @@ -857,9 +852,6 @@ List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode." - - (interactive) - (kill-all-local-variables) (add-hook 'write-file-functions 'makefile-warn-suspicious-lines nil t) (add-hook 'write-file-functions @@ -873,59 +865,44 @@ (make-local-variable 'makefile-need-macro-pickup) ;; Font lock. - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - ;; SYNTAX-BEGIN set to backward-paragraph to avoid slow-down - ;; near the end of a large buffer, due to parse-partial-sexp's - ;; trying to parse all the way till the beginning of buffer. - '(makefile-font-lock-keywords - nil nil - ((?$ . ".")) - backward-paragraph - (font-lock-syntactic-keywords - . makefile-font-lock-syntactic-keywords))) + (set (make-local-variable 'font-lock-defaults) + ;; SYNTAX-BEGIN set to backward-paragraph to avoid slow-down + ;; near the end of a large buffer, due to parse-partial-sexp's + ;; trying to parse all the way till the beginning of buffer. + '(makefile-font-lock-keywords + nil nil + ((?$ . ".")) + backward-paragraph + (font-lock-syntactic-keywords + . makefile-font-lock-syntactic-keywords))) ;; Add-log. - (make-local-variable 'add-log-current-defun-function) - (setq add-log-current-defun-function 'makefile-add-log-defun) + (set (make-local-variable 'add-log-current-defun-function) + 'makefile-add-log-defun) ;; Imenu. - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression makefile-imenu-generic-expression) + (set (make-local-variable 'imenu-generic-expression) + makefile-imenu-generic-expression) ;; Dabbrev. - (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) - (setq dabbrev-abbrev-skip-leading-regexp "\\$") + (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "\\$") ;; Other abbrevs. (setq local-abbrev-table makefile-mode-abbrev-table) ;; Filling. - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'makefile-fill-paragraph) + (set (make-local-variable 'fill-paragraph-function) 'makefile-fill-paragraph) ;; Comment stuff. - (make-local-variable 'comment-start) - (setq comment-start "#") - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "#+[ \t]*") + (set (make-local-variable 'comment-start) "#") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) "#+[ \t]*") ;; Make sure TAB really inserts \t. (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) - ;; become the current major mode - (setq major-mode 'makefile-mode) - (setq mode-name "Makefile") - - ;; Activate keymap and syntax table. - (use-local-map makefile-mode-map) - (set-syntax-table makefile-mode-syntax-table) - ;; Real TABs are important in makefiles - (setq indent-tabs-mode t) - (run-mode-hooks 'makefile-mode-hook)) + (setq indent-tabs-mode t)) ;; These should do more than just differentiate font-lock. ;;;###autoload
--- a/lisp/replace.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/replace.el Sun Mar 28 09:04:11 2010 -0400 @@ -1016,18 +1016,7 @@ (setq count (+ count (if forwardp -1 1))) (setq beg (line-beginning-position) end (line-end-position)) - (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) - (text-property-not-all beg end 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) - (jit-lock-fontify-now beg end))) - (push - (if (and keep-props (not (eq occur-excluded-properties t))) - (let ((str (buffer-substring beg end))) - (remove-list-of-text-properties - 0 (length str) occur-excluded-properties str) - str) - (buffer-substring-no-properties beg end)) - result) + (push (occur-engine-line beg end keep-props) result) (forward-line (if forwardp 1 -1))) (nreverse result)))) @@ -1056,7 +1045,7 @@ (defun occur (regexp &optional nlines) "Show all lines in the current buffer containing a match for REGEXP. -This function can not handle matches that span more than one line. +If a match spreads across multiple lines, all those lines are shown. Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. @@ -1166,12 +1155,15 @@ (not (eq occur-excluded-properties t))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) - (message "Searched %d buffer%s%s; %s match%s for `%s'" + (message "Searched %d buffer%s%s; %s match%s%s" bufcount (if (= bufcount 1) "" "s") (if (zerop diff) "" (format " (%d killed)" diff)) (if (zerop count) "no" (format "%d" count)) (if (= count 1) "" "es") - regexp)) + ;; Don't display regexp if with remaining text + ;; it is longer than window-width. + (if (> (+ (length regexp) 42) (window-width)) + "" (format " for `%s'" (query-replace-descr regexp))))) (setq occur-revert-arguments (list regexp nlines bufs)) (if (= count 0) (kill-buffer occur-buf) @@ -1218,24 +1210,17 @@ (when (setq endpt (re-search-forward regexp nil t)) (setq matches (1+ matches)) ;; increment match count (setq matchbeg (match-beginning 0)) - (setq lines (+ lines (1- (count-lines origpt endpt)))) + ;; Get beginning of first match line and end of the last. (save-excursion (goto-char matchbeg) - (setq begpt (line-beginning-position) - endpt (line-end-position))) + (setq begpt (line-beginning-position)) + (goto-char endpt) + (setq endpt (line-end-position))) + ;; Sum line numbers up to the first match line. + (setq lines (+ lines (count-lines origpt begpt))) (setq marker (make-marker)) (set-marker marker matchbeg) - (if (and keep-props - (if (boundp 'jit-lock-mode) jit-lock-mode) - (text-property-not-all begpt endpt 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) - (jit-lock-fontify-now begpt endpt))) - (if (and keep-props (not (eq occur-excluded-properties t))) - (progn - (setq curstring (buffer-substring begpt endpt)) - (remove-list-of-text-properties - 0 (length curstring) occur-excluded-properties curstring)) - (setq curstring (buffer-substring-no-properties begpt endpt))) + (setq curstring (occur-engine-line begpt endpt keep-props)) ;; Highlight the matches (let ((len (length curstring)) (start 0)) @@ -1252,24 +1237,33 @@ curstring) (setq start (match-end 0)))) ;; Generate the string to insert for this match - (let* ((out-line + (let* ((match-prefix + ;; Using 7 digits aligns tabs properly. + (apply #'propertize (format "%7d:" lines) + (append + (when prefix-face + `(font-lock-face prefix-face)) + `(occur-prefix t mouse-face (highlight) + occur-target ,marker follow-link t + help-echo "mouse-2: go to this occurrence")))) + (match-str + ;; We don't put `mouse-face' on the newline, + ;; because that loses. And don't put it + ;; on context lines to reduce flicker. + (propertize curstring 'mouse-face (list 'highlight) + 'occur-target marker + 'follow-link t + 'help-echo + "mouse-2: go to this occurrence")) + (out-line (concat - ;; Using 7 digits aligns tabs properly. - (apply #'propertize (format "%7d:" lines) - (append - (when prefix-face - `(font-lock-face prefix-face)) - `(occur-prefix t mouse-face (highlight) - occur-target ,marker follow-link t - help-echo "mouse-2: go to this occurrence"))) - ;; We don't put `mouse-face' on the newline, - ;; because that loses. And don't put it - ;; on context lines to reduce flicker. - (propertize curstring 'mouse-face (list 'highlight) - 'occur-target marker - 'follow-link t - 'help-echo - "mouse-2: go to this occurrence") + match-prefix + ;; Add non-numeric prefix to all non-first lines + ;; of multi-line matches. + (replace-regexp-in-string + "\n" + "\n :" + match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) (data @@ -1288,7 +1282,11 @@ (goto-char endpt)) (if endpt (progn - (setq lines (1+ lines)) + ;; Sum line numbers between first and last match lines. + (setq lines (+ lines (count-lines begpt endpt) + ;; Add 1 for empty last match line since + ;; count-lines returns 1 line less. + (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) (goto-char (point-max)))))) @@ -1298,9 +1296,13 @@ (goto-char headerpt) (let ((beg (point)) end) - (insert (format "%d match%s for \"%s\" in buffer: %s\n" + (insert (format "%d match%s%s in buffer: %s\n" matches (if (= matches 1) "" "es") - regexp (buffer-name buf))) + ;; Don't display regexp for multi-buffer. + (if (> (length buffers) 1) + "" (format " for \"%s\"" + (query-replace-descr regexp))) + (buffer-name buf))) (setq end (point)) (add-text-properties beg end (append @@ -1308,6 +1310,18 @@ `(font-lock-face ,title-face)) `(occur-title ,buf)))) (goto-char (point-min))))))) + ;; Display total match count and regexp for multi-buffer. + (when (and (not (zerop globalcount)) (> (length buffers) 1)) + (goto-char (point-min)) + (let ((beg (point)) + end) + (insert (format "%d match%s total for \"%s\":\n" + globalcount (if (= globalcount 1) "" "es") + (query-replace-descr regexp))) + (setq end (point)) + (add-text-properties beg end (when title-face + `(font-lock-face ,title-face)))) + (goto-char (point-min))) (if coding ;; CODING is buffer-file-coding-system of the first buffer ;; that locally binds it. Let's use it also for the output @@ -1316,6 +1330,18 @@ ;; Return the number of matches globalcount))) +(defun occur-engine-line (beg end &optional keep-props) + (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) + (text-property-not-all beg end 'fontified t)) + (if (fboundp 'jit-lock-fontify-now) + (jit-lock-fontify-now beg end))) + (if (and keep-props (not (eq occur-excluded-properties t))) + (let ((str (buffer-substring beg end))) + (remove-list-of-text-properties + 0 (length str) occur-excluded-properties str) + str) + (buffer-substring-no-properties beg end))) + ;; Generate context display for occur. ;; OUT-LINE is the line where the match is. ;; NLINES and KEEP-PROPS are args to occur-engine.
--- a/lisp/textmodes/flyspell.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/textmodes/flyspell.el Sun Mar 28 09:04:11 2010 -0400 @@ -359,7 +359,7 @@ (put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) (put 'nxml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) -(declare-function sgml-lexical-context "sgml-mode" &optional limit) +(autoload 'sgml-lexical-context "sgml-mode") (defun sgml-mode-flyspell-verify () "Function used for `flyspell-generic-check-word-predicate' in SGML mode.
--- a/lisp/textmodes/reftex-vars.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/textmodes/reftex-vars.el Sun Mar 28 09:04:11 2010 -0400 @@ -100,22 +100,22 @@ ("enumerate" ?i "item:" "~\\ref{%s}" item (regexp "items?" "Punkte?")) - + ("equation" ?e "eq:" "~(\\ref{%s})" t (regexp "equations?" "eqs?\\." "eqn\\." "Gleichung\\(en\\)?" "Gl\\.")) ("eqnarray" ?e "eq:" nil eqnarray-like) - + ("figure" ?f "fig:" "~\\ref{%s}" caption (regexp "figure?[sn]?" "figs?\\." "Abbildung\\(en\\)?" "Abb\\.")) ("figure*" ?f nil nil caption) - + ("table" ?t "tab:" "~\\ref{%s}" caption (regexp "tables?" "tab\\." "Tabellen?")) ("table*" ?t nil nil caption) - + ("\\footnote[]{}" ?n "fn:" "~\\ref{%s}" 2 (regexp "footnotes?" "Fussnoten?")) - + ("any" ?\ " " "~\\ref{%s}" nil) ;; The label macro is hard coded, but it *could* be defined like this: @@ -207,7 +207,7 @@ `?t' should point to a textual citation (citation as a noun). `?p' should point to a parenthetical citation.") -(defconst reftex-index-macros-builtin +(defconst reftex-index-macros-builtin '((default "Default \\index and \\glossary macros" (("\\index{*}" "idx" ?i "" nil t) ("\\glossary{*}" "glo" ?g "" nil t))) @@ -219,9 +219,9 @@ (Index-Shortcut "index.sty with \\shortindexingon" (("\\index[]{*}" 1 ?i "" nil t) ("\\index*[]{*}" 1 ?I "" nil nil) - ("^[]{*}" 1 ?^ "" texmathp t) + ("^[]{*}" 1 ?^ "" texmathp t) ("_[]{*}" 1 ?_ "" texmathp nil)))) - "Builtin stuff for reftex-index-macros. + "Builtin stuff for `reftex-index-macros'. Lower-case symbols correspond to a style file of the same name in the LaTeX distribution. Mixed-case symbols are convenience aliases.") ) @@ -231,7 +231,7 @@ (defgroup reftex nil "LaTeX label and citation support." :tag "RefTeX" - :link '(url-link :tag "Home Page" + :link '(url-link :tag "Home Page" "http://staff.science.uva.nl/~dominik/Tools/reftex/") :link '(emacs-commentary-link :tag "Commentary in reftex.el" "reftex.el") :link '(custom-manual "(reftex)Top") @@ -280,7 +280,7 @@ level means the same level as the positive value, but the section will never get a number. The cdr may also be a function which will be called to after the section-re matched to determine the level. -This list is also used for promotion and demption of sectioning commands. +This list is also used for promotion and demotion of sectioning commands. If you are using a document class which has several sets of sectioning commands, promotion only works correctly if this list is sorted first by set, then within each set by level. The promotion commands always @@ -318,7 +318,7 @@ more than `reftex-idle-time' seconds. Value t means, turn on immediately when RefTeX gets started. Then, -recentering will work for any toc window created during the session. +recentering will work for any TOC window created during the session. Value 'frame (the default) means, turn automatic recentering on only while the dedicated TOC frame does exist, and do the recentering only in that frame. So @@ -326,14 +326,14 @@ automatic recentering is turned on. When the frame gets destroyed, automatic recentering is turned off again. -This feature can be turned on and off from the menu +This feature can be turned on and off from the menu \(Ref->Options)." :group 'reftex-table-of-contents-browser :type '(choice (const :tag "never" nil) (const :tag "always" t) (const :tag "in dedicated frame only" frame))) - + (defcustom reftex-toc-split-windows-horizontally nil "*Non-nil means, create TOC window by splitting window horizontally." :group 'reftex-table-of-contents-browser @@ -407,7 +407,7 @@ :type 'boolean) (defcustom reftex-toc-mode-hook nil - "Mode hook for reftex-toc-mode." + "Mode hook for `reftex-toc-mode'." :group 'reftex-table-of-contents-browser :type 'hook) @@ -425,7 +425,7 @@ '(amsmath endnotes fancybox floatfig longtable picinpar rotating sidecap subfigure supertab wrapfig LaTeX) "Default label alist specifications. LaTeX should always be the last entry. -The value of this variable is a list of symbols with associations in the +The value of this variable is a list of symbols with associations in the constant `reftex-label-alist-builtin'. Check that constant for a full list of options." :group 'reftex-defining-label-environments @@ -624,7 +624,7 @@ (defcustom reftex-section-prefixes '((0 . "part:") (1 . "cha:") (t . "sec:")) "Prefixes for section labels. When the label prefix given in an entry in `reftex-label-alist' contains `%S', -this list is used to determine the correct prefix string depending on the +this list is used to determine the correct prefix string depending on the current section level. The list is an alist, with each entry of the form (KEY . PREFIX) Possible keys are sectioning macro names like `chapter', section levels @@ -686,7 +686,7 @@ (regexp) (repeat :tag "List" (string :tag "prefix (with colon)")))) - + (defcustom reftex-special-environment-functions nil "List of functions to be called when trying to figure out current environment. These are special functions to detect \"environments\" which do not @@ -732,7 +732,7 @@ (let ((pos (point)) p1) (save-excursion ;; Search for any of the linguex item macros at the beginning of a line - (if (re-search-backward + (if (re-search-backward \"^[ \\t]*\\\\(\\\\\\\\\\\\(ex\\\\|a\\\\|b\\\\|c\\\\|d\\\\|e\\\\|f\\\\)g?\\\\.\\\\)\" bound t) (progn (setq p1 (match-beginning 1)) @@ -742,7 +742,7 @@ nil ;; OK, we got it (cons \"linguex\" p1))) - ;; Return nil for not found + ;; Return nil for not found nil)))) 3. Tell RefTeX to use this function @@ -941,7 +941,7 @@ (defcustom reftex-vref-is-default nil "*Non-nil means, the varioref macro \\vref is used as default. -In the selection buffer, the `v' key toggles the reference macro between +In the selection buffer, the `v' key toggles the reference macro between `\\ref' and `\\vref'. The value of this variable determines the default which is active when entering the selection process. Instead of nil or t, this may also be a string of type letters indicating @@ -952,7 +952,7 @@ (defcustom reftex-fref-is-default nil "*Non-nil means, the fancyref macro \\fref is used as default. -In the selection buffer, the `V' key toggles the reference macro between +In the selection buffer, the `V' key toggles the reference macro between `\\ref', `\\fref' and `\\Fref'. The value of this variable determines the default which is active when entering the selection process. Instead of nil or t, this may also be a string of type letters indicating @@ -979,7 +979,7 @@ (defcustom reftex-format-ref-function nil "Function which produces the string to insert as a reference. -Normally should be nil, because the format to insert a reference can +Normally should be nil, because the format to insert a reference can already be specified in `reftex-label-alist'. This hook also is used by the special commands to insert `\\vref' and `\\fref' references, so even if you set this, your setting will be ignored by @@ -1060,13 +1060,13 @@ %i institution %j journal %k key %m month %n number %o organization %p pages %P first page %r address %s school %u publisher %t title -%v volume %y year +%v volume %y year %B booktitle, abbreviated %T title, abbreviated Usually, only %l is needed. The other stuff is mainly for the echo area display, and for (setq reftex-comment-citations t). -%< as a special operator kills punctuation and space around it after the +%< as a special operator kills punctuation and space around it after the string has been formatted. A pair of square brackets indicates an optional argument, and RefTeX @@ -1081,7 +1081,7 @@ strings. In order to configure this variable, you can either set `reftex-cite-format' directly yourself or set it to the SYMBOL of one of -the predefined styles. The predefined symbols are those which have an +the predefined styles. The predefined symbols are those which have an association in the constant `reftex-cite-format-builtin'. E.g.: (setq reftex-cite-format 'natbib)" :group 'reftex-citation-support @@ -1164,8 +1164,8 @@ (defcustom reftex-cite-punctuation '(", " " \\& " " {\\it et al.}") "Punctuation for formatting of name lists in citations. This is a list of 3 strings. -1. normal names separator, like \", \" in Jones, Brown and Miller -2. final names separator, like \" and \" in Jones, Brown and Miller +1. Normal names separator, like \", \" in Jones, Brown and Miller +2. Final names separator, like \" and \" in Jones, Brown and Miller 3. The \"et al\" string, like \" {\\it et al.}\" in Jones {\\it et al.}" :group 'reftex-citation-support :type '(list @@ -1175,7 +1175,7 @@ (defcustom reftex-format-cite-function nil "Function which produces the string to insert as a citation. -Normally should be nil, because the format to insert a reference can +Normally should be nil, because the format to insert a reference can already be specified in `reftex-cite-format'. The function will be called with two arguments, the CITATION KEY and the DEFAULT FORMAT, which is taken from `reftex-cite-format'. The function @@ -1258,7 +1258,7 @@ :group 'reftex-index-support :set 'reftex-set-dirty :type `(list - (repeat + (repeat :inline t (list :value ("" "idx" ?a "" nil) (string :tag "Macro with args") @@ -1285,7 +1285,7 @@ This is a list with (MACRO-KEY DEFAULT-TAG). MACRO-KEY: Character identifying an index macro - see `reftex-index-macros'. -DEFAULT-TAG: This is the tag to be used if the macro requires a TAG argument. +DEFAULT-TAG: This is the tag to be used if the macro requires a TAG argument. When this is nil and a TAG is needed, RefTeX will ask for it. When this is the empty string and the TAG argument of the index macro is optional, the TAG argument will be omitted." @@ -1426,7 +1426,7 @@ (defcustom reftex-index-include-context nil "*Non-nil means, display the index definition context in the index buffer. -This flag may also be toggled from the index buffer with the `c' key." +This flag may also be toggled from the index buffer with the `c' key." :group 'reftex-index-support :type 'boolean) @@ -1449,7 +1449,7 @@ argument of a macro. Note that crossref viewing for citations, references (both ways) and index entries is hard-coded. This variable is only to configure additional structures for which crossreference -viewing can be useful. Each entry has the structure +viewing can be useful. Each entry has the structure \(MACRO-RE SEARCH-RE HIGHLIGHT). @@ -1470,7 +1470,7 @@ displayed, the echo area will display information about that cross reference. You can also set the variable to the symbol `window'. In this case a small temporary window is used for the display. -This feature can be turned on and off from the menu +This feature can be turned on and off from the menu \(Ref->Options)." :group 'reftex-viewing-cross-references :type '(choice (const :tag "off" nil) @@ -1516,7 +1516,7 @@ - If an element is the name of an environment variable, its content is used. - If an element starts with an exclamation mark, it is used as a command to retrieve the path. A typical command with the kpathsearch library would - be `!kpsewhich -show-path=.tex'. + be `!kpsewhich -show-path=.tex'. - Otherwise the element itself is interpreted as a path. Multiple directories can be separated by the system dependent `path-separator'. Directories ending in `//' or `!!' will be expanded recursively. @@ -1531,7 +1531,7 @@ - If an element is the name of an environment variable, its content is used. - If an element starts with an exclamation mark, it is used as a command to retrieve the path. A typical command with the kpathsearch library would - be `!kpsewhich -show-path=.bib'. + be `!kpsewhich -show-path=.bib'. - Otherwise the element itself is interpreted as a path. Multiple directories can be separated by the system dependent `path-separator'. Directories ending in `//' or `!!' will be expanded recursively. @@ -1575,7 +1575,7 @@ "*Non-nil means, search all specified directories before trying recursion. Thus, in a path \".//:/tex/\", search first \"./\", then \"/tex/\" and then all subdirectories of \"./\". If this option is nil, the subdirectories of -\"./\" are searched before \"/tex/\". This is mainly for speed - most of the +\"./\" are searched before \"/tex/\". This is mainly for speed - most of the time the recursive path is for the system files and not for the user files. Set this to nil if the default makes RefTeX finding files with equal names in wrong sequence." @@ -1588,7 +1588,7 @@ TEXINPUTS and BIBINPUTS to find TeX files and BibTeX database files. With this option turned on, it calls an external program specified in the option `reftex-external-file-finders' instead. As a side effect, -the variables `reftex-texpath-environment-variables' and +the variables `reftex-texpath-environment-variables' and `reftex-bibpath-environment-variables' will be ignored." :group 'reftex-finding-files :type 'boolean) @@ -1679,7 +1679,7 @@ (defcustom reftex-save-parse-info nil "*Non-nil means, save information gathered with parsing in a file. The file MASTER.rel in the same directory as MASTER.tex is used to save the -information. When this variable is t, +information. When this variable is t, - accessing the parsing information for the first time in an editing session will read that file (if available) instead of parsing the document. - exiting Emacs or killing a buffer in reftex-mode will cause a new version @@ -1753,7 +1753,7 @@ highlighted. This is the entry most keys in the selction and *toc* buffers act on. However, if you mainly use the mouse to select an item, you may find it nice to have mouse-triggered highlighting -instead or as well. The variable may have one of these values: +instead or as well. The variable may have one of these values: nil No highlighting. cursor Highlighting is cursor driven. @@ -1882,7 +1882,7 @@ may require a restart of Emacs in order to become effective." :group 'reftex-miscellaneous-configurations :group 'LaTeX - :type '(choice + :type '(choice (const :tag "No plug-ins" nil) (const :tag "All possible plug-ins" t) (list
--- a/lisp/textmodes/rst.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/textmodes/rst.el Sun Mar 28 09:04:11 2010 -0400 @@ -2585,62 +2585,132 @@ :group 'faces :version "21.1") -(defcustom rst-block-face 'font-lock-keyword-face +(defface rst-block '((t :inherit font-lock-keyword-face)) + "Face used for all syntax marking up a special block." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-block-face 'rst-block "All syntax marking up a special block." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-external-face 'font-lock-type-face +(make-obsolete-variable 'rst-block-face + "customize the face `rst-block' instead." + "24.1") + +(defface rst-external '((t :inherit font-lock-type-face)) + "Face used for field names and interpreted text." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-external-face 'rst-external "Field names and interpreted text." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-definition-face 'font-lock-function-name-face +(make-obsolete-variable 'rst-external-face + "customize the face `rst-external' instead." + "24.1") + +(defface rst-definition '((t :inherit font-lock-function-name-face)) + "Face used for all other defining constructs." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-definition-face 'rst-definition "All other defining constructs." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-directive-face - ;; XEmacs compatibility - (if (boundp 'font-lock-builtin-face) - 'font-lock-builtin-face - 'font-lock-preprocessor-face) +(make-obsolete-variable 'rst-definition-face + "customize the face `rst-definition' instead." + "24.1") + +;; XEmacs compatibility (?). +(defface rst-directive (if (boundp 'font-lock-builtin-face) + '((t :inherit font-lock-builtin-face)) + '((t :inherit font-lock-preprocessor-face))) + "Face used for directives and roles." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-directive-face 'rst-directive "Directives and roles." :group 'rst-faces :type '(face)) - -(defcustom rst-comment-face 'font-lock-comment-face +(make-obsolete-variable 'rst-directive-face + "customize the face `rst-directive' instead." + "24.1") + +(defface rst-comment '((t :inherit font-lock-comment-face)) + "Face used for comments." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-comment-face 'rst-comment "Comments." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-emphasis1-face - ;; XEmacs compatibility - (if (facep 'italic) - ''italic - 'italic) +(make-obsolete-variable 'rst-comment-face + "customize the face `rst-comment' instead." + "24.1") + +(defface rst-emphasis1 '((t :inherit italic)) + "Face used for simple emphasis." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-emphasis1-face 'rst-emphasis1 "Simple emphasis." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-emphasis2-face - ;; XEmacs compatibility - (if (facep 'bold) - ''bold - 'bold) +(make-obsolete-variable 'rst-emphasis1-face + "customize the face `rst-emphasis1' instead." + "24.1") + +(defface rst-emphasis2 '((t :inherit bold)) + "Face used for double emphasis." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-emphasis2-face 'rst-emphasis2 "Double emphasis." :group 'rst-faces :type '(face)) - -(defcustom rst-literal-face 'font-lock-string-face +(make-obsolete-variable 'rst-emphasis2-face + "customize the face `rst-emphasis2' instead." + "24.1") + +(defface rst-literal '((t :inherit font-lock-string-face)) + "Face used for literal text." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-literal-face 'rst-literal "Literal text." + :version "24.1" :group 'rst-faces :type '(face)) - -(defcustom rst-reference-face 'font-lock-variable-name-face +(make-obsolete-variable 'rst-literal-face + "customize the face `rst-literal' instead." + "24.1") + +(defface rst-reference '((t :inherit font-lock-variable-name-face)) + "Face used for references to a definition." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-reference-face 'rst-reference "References to a definition." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-reference-face + "customize the face `rst-reference' instead." + "24.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2818,94 +2888,76 @@ ;; Simple `Body Elements`_ ;; `Bullet Lists`_ - (list - (concat re-bol "\\([-*+]" re-blksep1 "\\)") - 1 rst-block-face) + `(,(concat re-bol "\\([-*+]" re-blksep1 "\\)") + 1 rst-block-face) ;; `Enumerated Lists`_ - (list - (concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]" - re-blksep1 "\\)") - 1 rst-block-face) + `(,(concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]" + re-blksep1 "\\)") + 1 rst-block-face) ;; `Definition Lists`_ FIXME: missing ;; `Field Lists`_ - (list - (concat re-bol "\\(:[^:\n]+:\\)" re-blksep1) - 1 rst-external-face) + `(,(concat re-bol "\\(:[^:\n]+:\\)" re-blksep1) + 1 rst-external-face) ;; `Option Lists`_ - (list - (concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*" - "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)") - 1 rst-block-face) + `(,(concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*" + "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)") + 1 rst-block-face) ;; `Tables`_ FIXME: missing ;; All the `Explicit Markup Blocks`_ ;; `Footnotes`_ / `Citations`_ - (list - (concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1) + `(,(concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1) 1 rst-definition-face) ;; `Directives`_ / `Substitution Definitions`_ - (list - (concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\(" - re-sym1 "+::\\)" re-blksep1) - (list 1 rst-directive-face) - (list 2 rst-definition-face) - (list 4 rst-directive-face)) + `(,(concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\(" + re-sym1 "+::\\)" re-blksep1) + (1 rst-directive-face) + (2 rst-definition-face) + (4 rst-directive-face)) ;; `Hyperlink Targets`_ - (list - (concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)" - re-blksep1) - 1 rst-definition-face) - (list - (concat re-bol "\\(__\\)" re-blksep1) - 1 rst-definition-face) + `(,(concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)" + re-blksep1) + 1 rst-definition-face) + `(,(concat re-bol "\\(__\\)" re-blksep1) + 1 rst-definition-face) ;; All `Inline Markup`_ ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented ;; `Strong Emphasis`_ - (list - (concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1) - 2 rst-emphasis2-face) + `(,(concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1) + 2 rst-emphasis2-face) ;; `Emphasis`_ - (list - (concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1) - 2 rst-emphasis1-face) + `(,(concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1) + 2 rst-emphasis1-face) ;; `Inline Literals`_ - (list - (concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1) - 2 rst-literal-face) + `(,(concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1) + 2 rst-literal-face) ;; `Inline Internal Targets`_ - (list - (concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1) - 2 rst-definition-face) + `(,(concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1) + 2 rst-definition-face) ;; `Hyperlink References`_ ;; FIXME: `Embedded URIs`_ not considered - (list - (concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1) + `(,(concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1) 2 rst-reference-face) ;; `Interpreted Text`_ - (list - (concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:" - re-sym1 "+:\\)?\\)" re-ims1) - (list 2 rst-directive-face) - (list 5 rst-external-face) - (list 8 rst-directive-face)) + `(,(concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:" + re-sym1 "+:\\)?\\)" re-ims1) + (2 rst-directive-face) + (5 rst-external-face) + (8 rst-directive-face)) ;; `Footnote References`_ / `Citation References`_ - (list - (concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1) - 2 rst-reference-face) + `(,(concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1) + 2 rst-reference-face) ;; `Substitution References`_ - (list - (concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1) - 2 rst-reference-face) + `(,(concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1) + 2 rst-reference-face) ;; `Standalone Hyperlinks`_ - (list - ;; FIXME: This takes it easy by using a whitespace as delimiter - (concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1) - 2 rst-definition-face) - (list - (concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1) - 2 rst-definition-face) + `(;; FIXME: This takes it easy by using a whitespace as delimiter + ,(concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1) + 2 rst-definition-face) + `(,(concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1) + 2 rst-definition-face) ;; Do all block fontification as late as possible so 'append works @@ -2914,7 +2966,7 @@ (list re-ado2) (if (not rst-mode-lazy) - (list 1 rst-block-face) + '(1 rst-block-face) (list (list 'rst-font-lock-handle-adornment '(progn @@ -2934,7 +2986,7 @@ (list (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:\n]\\|:\\([^:\n]\\|$\\)\\)*$") - (list 1 rst-comment-face)) + '(1 rst-comment-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -2942,12 +2994,12 @@ (setq rst-font-lock-indentation-point (match-end 1)) (point-max)) nil - (list 0 rst-comment-face 'append))))) + '(0 rst-comment-face append))))) (append (list (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$") - (list 1 rst-comment-face) - (list 2 rst-comment-face)) + '(1 rst-comment-face) + '(2 rst-comment-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -2955,13 +3007,13 @@ (setq rst-font-lock-indentation-point 'next) (point-max)) nil - (list 0 rst-comment-face 'append))))) + '(0 rst-comment-face append))))) ;; `Literal Blocks`_ (append (list (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$") - (list 3 rst-block-face)) + '(3 rst-block-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -2969,14 +3021,14 @@ (setq rst-font-lock-indentation-point t) (point-max)) nil - (list 0 rst-literal-face 'append))))) + '(0 rst-literal-face append))))) ;; `Doctest Blocks`_ (append (list (concat re-bol "\\(>>>\\|\\.\\.\\.\\)\\(.+\\)") - (list 1 rst-block-face) - (list 2 rst-literal-face))) + '(1 rst-block-face) + '(2 rst-literal-face))) )))
--- a/lisp/url/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/url/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,14 @@ +2010-03-24 Teodor Zlatanov <tzz@lifelogs.com> + + * url-http.el (url-http-parse-headers): Fix wrong variable name. + +2010-03-24 Teodor Zlatanov <tzz@lifelogs.com> + + * url-http.el (url-http-codes): New variable to hold a mapping of + HTTP status codes' numbers, their symbolic name, and their text. + (url-http-parse-headers): Use it, leaving the original numeric + code in a comment. + 2010-03-19 Glenn Morris <rgm@gnu.org> * url.el: Move mailcap require earlier in the file.
--- a/lisp/url/url-http.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/url/url-http.el Sun Mar 28 09:04:11 2010 -0400 @@ -64,6 +64,55 @@ nil will explicitly close the connection to the server after every request.") +(defconst url-http-codes + '((100 continue "Continue with request") + (101 switching-protocols "Switching protocols") + (102 processing "Processing (Added by DAV)") + (200 OK "OK") + (201 created "Created") + (202 accepted "Accepted") + (203 non-authoritative "Non-authoritative information") + (204 no-content "No content") + (205 reset-content "Reset content") + (206 partial-content "Partial content") + (207 multi-status "Multi-status (Added by DAV)") + (300 multiple-choices "Multiple choices") + (301 moved-permanently "Moved permanently") + (302 found "Found") + (303 see-other "See other") + (304 not-modified "Not modified") + (305 use-proxy "Use proxy") + (307 temporary-redirect "Temporary redirect") + (400 bad-request "Bad Request") + (401 unauthorized "Unauthorized") + (402 payment-required "Payment required") + (403 forbidden "Forbidden") + (404 not-found "Not found") + (405 method-not-allowed "Method not allowed") + (406 not-acceptable "Not acceptable") + (407 proxy-authentication-required "Proxy authentication required") + (408 request-timeout "Request time-out") + (409 conflict "Conflict") + (410 gone "Gone") + (411 length-required "Length required") + (412 precondition-failed "Precondition failed") + (413 request-entity-too-large "Request entity too large") + (414 request-uri-too-large "Request-URI too large") + (415 unsupported-media-type "Unsupported media type") + (416 requested-range-not-satisfiable "Requested range not satisfiable") + (417 expectation-failed "Expectation failed") + (422 unprocessable-entity "Unprocessable Entity (Added by DAV)") + (423 locked "Locked") + (424 failed-Dependency "Failed Dependency") + (500 internal-server-error "Internal server error") + (501 not-implemented "Not implemented") + (502 bad-gateway "Bad gateway") + (503 service-unavailable "Service unavailable") + (504 gateway-timeout "Gateway time-out") + (505 http-version-not-supported "HTTP version not supported") + (507 insufficient-storage "Insufficient storage") +"The HTTP return codes and their text.")) + ;(eval-when-compile ;; These are all macros so that they are hidden from external sight ;; when the file is byte-compiled. @@ -435,7 +484,9 @@ (delete-process url-http-process))))) (let ((buffer (current-buffer)) (class nil) - (success nil)) + (success nil) + ;; other status symbols: jewelry and luxury cars + (status-symbol (cadr (assq url-http-response-status url-http-codes)))) (setq class (/ url-http-response-status 100)) (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) (url-http-handle-cookies) @@ -463,8 +514,8 @@ ;; 205 Reset content ;; 206 Partial content ;; 207 Multi-status (Added by DAV) - (case url-http-response-status - ((204 205) + (case status-symbol + ((no-content reset-content) ;; No new data, just stay at the same document (url-mark-buffer-as-dead buffer) (setq success t)) @@ -485,8 +536,8 @@ ;; 307 Temporary redirect (let ((redirect-uri (or (mail-fetch-field "Location") (mail-fetch-field "URI")))) - (case url-http-response-status - (300 + (case status-symbol + (multiple-choices ; 300 ;; Quoth the spec (section 10.3.1) ;; ------------------------------- ;; The requested resource corresponds to any one of a set of @@ -503,7 +554,7 @@ ;; We do not support agent-driven negotiation, so we just ;; redirect to the preferred URI if one is provided. nil) - ((301 302 307) + ((moved-permanently found temporary-redirect) ; 301 302 307 ;; If the 301|302 status code is received in response to a ;; request other than GET or HEAD, the user agent MUST NOT ;; automatically redirect the request unless it can be @@ -519,20 +570,20 @@ url-http-method url-http-response-status) (setq url-http-method "GET" url-http-data nil))) - (303 + (see-other ; 303 ;; The response to the request can be found under a different ;; URI and SHOULD be retrieved using a GET method on that ;; resource. (setq url-http-method "GET" url-http-data nil)) - (304 + (not-modified ; 304 ;; The 304 response MUST NOT contain a message-body. (url-http-debug "Extracting document from cache... (%s)" (url-cache-create-filename (url-view-url t))) (url-cache-extract (url-cache-create-filename (url-view-url t))) (setq redirect-uri nil success t)) - (305 + (use-proxy ; 305 ;; The requested resource MUST be accessed through the ;; proxy given by the Location field. The Location field ;; gives the URI of the proxy. The recipient is expected @@ -620,51 +671,51 @@ ;; 422 Unprocessable Entity (Added by DAV) ;; 423 Locked ;; 424 Failed Dependency - (case url-http-response-status - (401 + (case status-symbol + (unauthorized ; 401 ;; The request requires user authentication. The response ;; MUST include a WWW-Authenticate header field containing a ;; challenge applicable to the requested resource. The ;; client MAY repeat the request with a suitable ;; Authorization header field. (url-http-handle-authentication nil)) - (402 + (payment-required ; 402 ;; This code is reserved for future use (url-mark-buffer-as-dead buffer) (error "Somebody wants you to give them money")) - (403 + (forbidden ; 403 ;; The server understood the request, but is refusing to ;; fulfill it. Authorization will not help and the request ;; SHOULD NOT be repeated. (setq success t)) - (404 + (not-found ; 404 ;; Not found (setq success t)) - (405 + (method-not-allowed ; 405 ;; The method specified in the Request-Line is not allowed ;; for the resource identified by the Request-URI. The ;; response MUST include an Allow header containing a list of ;; valid methods for the requested resource. (setq success t)) - (406 + (not-acceptable ; 406 ;; The resource identified by the request is only capable of ;; generating response entities which have content ;; characteristics nota cceptable according to the accept ;; headers sent in the request. (setq success t)) - (407 + (proxy-authentication-required ; 407 ;; This code is similar to 401 (Unauthorized), but indicates ;; that the client must first authenticate itself with the ;; proxy. The proxy MUST return a Proxy-Authenticate header ;; field containing a challenge applicable to the proxy for ;; the requested resource. (url-http-handle-authentication t)) - (408 + (request-timeout ; 408 ;; The client did not produce a request within the time that ;; the server was prepared to wait. The client MAY repeat ;; the request without modifications at any later time. (setq success t)) - (409 + (conflict ; 409 ;; The request could not be completed due to a conflict with ;; the current state of the resource. This code is only ;; allowed in situations where it is expected that the user @@ -673,11 +724,11 @@ ;; information for the user to recognize the source of the ;; conflict. (setq success t)) - (410 + (gone ; 410 ;; The requested resource is no longer available at the ;; server and no forwarding address is known. (setq success t)) - (411 + (length-required ; 411 ;; The server refuses to accept the request without a defined ;; Content-Length. The client MAY repeat the request if it ;; adds a valid Content-Length header field containing the @@ -687,29 +738,29 @@ ;; `url-http-create-request' automatically calculates the ;; content-length. (setq success t)) - (412 + (precondition-failed ; 412 ;; The precondition given in one or more of the ;; request-header fields evaluated to false when it was ;; tested on the server. (setq success t)) - ((413 414) + ((request-entity-too-large request-uri-too-large) ; 413 414 ;; The server is refusing to process a request because the ;; request entity|URI is larger than the server is willing or ;; able to process. (setq success t)) - (415 + (unsupported-media-type ; 415 ;; The server is refusing to service the request because the ;; entity of the request is in a format not supported by the ;; requested resource for the requested method. (setq success t)) - (416 + (requested-range-not-satisfiable ; 416 ;; A server SHOULD return a response with this status code if ;; a request included a Range request-header field, and none ;; of the range-specifier values in this field overlap the ;; current extent of the selected resource, and the request ;; did not include an If-Range request-header field. (setq success t)) - (417 + (expectation-failed ; 417 ;; The expectation given in an Expect request-header field ;; could not be met by this server, or, if the server is a ;; proxy, the server has unambiguous evidence that the @@ -736,16 +787,16 @@ ;; 507 Insufficient storage (setq success t) (case url-http-response-status - (501 + (not-implemented ; 501 ;; The server does not support the functionality required to ;; fulfill the request. nil) - (502 + (bad-gateway ; 502 ;; The server, while acting as a gateway or proxy, received ;; an invalid response from the upstream server it accessed ;; in attempting to fulfill the request. nil) - (503 + (service-unavailable ; 503 ;; The server is currently unable to handle the request due ;; to a temporary overloading or maintenance of the server. ;; The implication is that this is a temporary condition @@ -754,19 +805,19 @@ ;; header. If no Retry-After is given, the client SHOULD ;; handle the response as it would for a 500 response. nil) - (504 + (gateway-timeout ; 504 ;; The server, while acting as a gateway or proxy, did not ;; receive a timely response from the upstream server ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other ;; auxiliary server (e.g. DNS) it needed to access in ;; attempting to complete the request. nil) - (505 + (http-version-not-supported ; 505 ;; The server does not support, or refuses to support, the ;; HTTP protocol version that was used in the request ;; message. nil) - (507 ; DAV + (insufficient-storage ; 507 (DAV) ;; The method could not be performed on the resource ;; because the server is unable to store the representation ;; needed to successfully complete the request. This
--- a/lisp/vc-bzr.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/vc-bzr.el Sun Mar 28 09:04:11 2010 -0400 @@ -545,6 +545,7 @@ (goto-char (point-min))) found))) +(declare-function log-edit-mode "log-edit" ()) (defvar log-edit-extra-flags) (defvar log-edit-before-checkin-process) @@ -552,12 +553,14 @@ "Mode for editing Bzr commit logs. If a line like: Author: NAME -is present in the log, it is removed, and +is present in the log, it is removed, and --author NAME -is passed to the bzr commit command." +is passed to the bzr commit command. Similarly with Fixes: and --fixes." (set (make-local-variable 'log-edit-extra-flags) nil) (set (make-local-variable 'log-edit-before-checkin-process) - '(("^Author:[ \t]+\\(.*\\)[ \t]*$" . (list "--author" (match-string 1)))))) + '(("^\\(Author\\|Fixes\\):[ \t]+\\(.*\\)[ \t]*$" . + (list (format "--%s" (downcase (match-string 1))) + (match-string 2)))))) (defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff."
--- a/lisp/vc-dir.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/vc-dir.el Sun Mar 28 09:04:11 2010 -0400 @@ -950,7 +950,8 @@ (propertize "VC backend : " 'face 'font-lock-type-face) (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face) (propertize "Working dir: " 'face 'font-lock-type-face) - (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face) + (propertize (format "%s\n" (abbreviate-file-name dir)) + 'face 'font-lock-variable-name-face) ;; Then the backend specific ones. (vc-call-backend backend 'dir-extra-headers dir) "\n"))
--- a/lisp/vc-dispatcher.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/vc-dispatcher.el Sun Mar 28 09:04:11 2010 -0400 @@ -539,8 +539,9 @@ INITIAL-CONTENTS is nil, do action immediately as if the user had entered COMMENT. If COMMENT is t, also do action immediately with an empty comment. Remember the file's buffer in `vc-parent-buffer' -\(current one if no file). AFTER-HOOK specifies the local value -for `vc-log-after-operation-hook'." +\(current one if no file). Puts the log-entry buffer in major-mode +MODE, defaulting to `log-edit-mode' if MODE is nil. +AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -569,6 +570,9 @@ (vc-finish-logentry (eq comment t))))) (declare-function vc-dir-move-to-goal-column "vc-dir" ()) +;; vc-finish-logentry is called from a log-edit buffer (see above). +(declare-function log-view-process-buffer "log-edit" ()) +(defvar log-edit-extra-flags) (defun vc-finish-logentry (&optional nocomment) "Complete the operation implied by the current log entry.
--- a/lisp/vc-hg.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/vc-hg.el Sun Mar 28 09:04:11 2010 -0400 @@ -279,6 +279,7 @@ ("^date: \\(.+\\)" (1 'change-log-date)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) +(declare-function log-edit-mode "log-edit" ()) (defvar log-edit-extra-flags) (defvar log-edit-before-checkin-process) @@ -286,7 +287,7 @@ "Mode for editing Hg commit logs. If a line like: Author: NAME -is present in the log, it is removed, and +is present in the log, it is removed, and --author NAME is passed to the hg commit command." (set (make-local-variable 'log-edit-extra-flags) nil)
--- a/lisp/vc.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/vc.el Sun Mar 28 09:04:11 2010 -0400 @@ -1744,17 +1744,18 @@ (defun vc-modify-change-comment (files rev oldcomment) "Edit the comment associated with the given files and revision." - (vc-start-logentry - files rev oldcomment t - "Enter a replacement change comment." - "*VC-log*" - (lambda (files rev comment ignored) - (vc-call-backend - ;; Less of a kluge than it looks like; log-view mode only passes - ;; this function a singleton list. Arguments left in this form in - ;; case the more general operation ever becomes meaningful. - (vc-responsible-backend (car files)) - 'modify-change-comment files rev comment)))) + ;; Less of a kluge than it looks like; log-view mode only passes + ;; this function a singleton list. Arguments left in this form in + ;; case the more general operation ever becomes meaningful. + (let ((backend (vc-responsible-backend (car files)))) + (vc-start-logentry + files rev oldcomment t + "Enter a replacement change comment." + "*VC-log*" + (lambda () (vc-call-backend backend 'log-edit-mode)) + (lambda (files rev comment ignored) + (vc-call-backend backend + 'modify-change-comment files rev comment))))) ;;;###autoload (defun vc-merge () @@ -2433,6 +2434,8 @@ (defalias 'vc-default-check-headers 'ignore) +(declare-function log-edit-mode "log-edit" ()) + (defun vc-default-log-edit-mode (backend) (log-edit-mode)) (defun vc-default-log-view-mode (backend) (log-view-mode))
--- a/lisp/woman.el Sat Mar 20 10:32:32 2010 -0400 +++ b/lisp/woman.el Sun Mar 28 09:04:11 2010 -0400 @@ -3876,10 +3876,14 @@ ;; The first two cases below could be merged (maybe)! (let ((from (point))) ;; Discard zero width filler character used to hide leading dots - ;; and zero width characters. If on a line by itself, consume the - ;; newline as well, as this may interfere with (Bug#3651). - (while (re-search-forward "\\\\[&|^]\n?" to t) - (woman-delete-match 0)) + ;; and zero width characters. + (while (re-search-forward "\\\\[&|^]" to t) + (woman-delete-match 0) + ;; If on a line by itself, consume newline as well (Bug#3651). + (and (eq (char-before (match-beginning 0)) ?\n) + (eq (char-after (match-beginning 0)) ?\n) + (delete-char 1))) + (goto-char from) ;; Interrupt text processing -- CONTINUE current text with the ;; next text line (after any control lines, unless processing to
--- a/msdos/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/msdos/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,17 @@ +2010-03-27 Eli Zaretskii <eliz@gnu.org> + + * sedlisp.inp (VPATH): Don't edit, no longer needed. + (lisp, srcdir): Adapt to lisp/Makefile.in changes. + (abs_top_builddir): New edit. + + * sed3v2.inp (KRB4LIB, DESLIB, KRB5LIB, CRYPTOLIB, COM_ERRLIB) + (LIBHESIOD, LIBRESOLV, LIBS_MAIL): Edit to empty values. + + * sed3.inp (KRB4LIB, DESLIB, KRB5LIB, CRYPTOLIB, COM_ERRLIB) + (LIBHESIOD, LIBRESOLV, LIBS_MAIL): Edit to empty values. + + * sed1v2.inp (abs_builddir): Edit into "../src". + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/msdos/sed1v2.inp Sat Mar 20 10:32:32 2010 -0400 +++ b/msdos/sed1v2.inp Sun Mar 28 09:04:11 2010 -0400 @@ -29,6 +29,7 @@ /^MAKE *=/s/^/# / /^SHELL *=/s/^/# / /^srcdir *=/s/@[^@\n]*@/./ +/^abs_builddir *=/s|@abs_builddir@|../src| /^VPATH *=/s/@[^@\n]*@/./ /^CC *=/s/@[^@\n]*@/gcc/ /^CPP *=/s/@[^@\n]*@/gcc -e/
--- a/msdos/sed3.inp Sat Mar 20 10:32:32 2010 -0400 +++ b/msdos/sed3.inp Sun Mar 28 09:04:11 2010 -0400 @@ -28,6 +28,14 @@ /^libdir *=/s!=.*$!=/emacs/bin! /^srcdir *=/s!=.*$!=.! /^VPATH *=/s!=.*$!=.! +/^KRB4LIB *=/s/@[^@\n]*@//g +/^DESLIB *=/s/@[^@\n]*@//g +/^KRB5LIB *=/s/@[^@\n]*@//g +/^CRYPTOLIB *=/s/@[^@\n]*@//g +/^COM_ERRLIB *=/s/@[^@\n]*@//g +/^LIBHESIOD *=/s/@[^@\n]*@//g +/^LIBRESOLV *=/s/@[^@\n]*@//g +/^LIBS_MAIL *=/s/@[^@\n]*@//g /^CFLAGS *=/s!=.*$!=-O2 -g! /^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS! /^LOADLIBES *=/s!=.*$!=!
--- a/msdos/sed3v2.inp Sat Mar 20 10:32:32 2010 -0400 +++ b/msdos/sed3v2.inp Sun Mar 28 09:04:11 2010 -0400 @@ -26,6 +26,14 @@ /^libdir *=/s!=.*$!=/emacs/bin! /^srcdir=/s!srcdir=@srcdir@!srcdir := $(subst \\,/,$(shell command.com /c cd))! /^VPATH *=/s!=.*$!=.! +/^KRB4LIB *=/s/@[^@\n]*@//g +/^DESLIB *=/s/@[^@\n]*@//g +/^KRB5LIB *=/s/@[^@\n]*@//g +/^CRYPTOLIB *=/s/@[^@\n]*@//g +/^COM_ERRLIB *=/s/@[^@\n]*@//g +/^LIBHESIOD *=/s/@[^@\n]*@//g +/^LIBRESOLV *=/s/@[^@\n]*@//g +/^LIBS_MAIL *=/s/@[^@\n]*@//g /^CFLAGS *=/s!=.*$!=-O2 -g! /^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS! /^LOADLIBES *=/s!=.*$!=!
--- a/msdos/sedlisp.inp Sat Mar 20 10:32:32 2010 -0400 +++ b/msdos/sedlisp.inp Sun Mar 28 09:04:11 2010 -0400 @@ -20,8 +20,9 @@ /^SHELL *=/i\ export FNCASE=y -/^lisp=/s|@srcdir@|$(CURDIR)| -/^VPATH=/s|@srcdir@|.| -/^srcdir=/s|@srcdir@|.| +/^lisp *=/s|\$(srcdir)|$(CURDIR)| +/^srcdir *=/s|@srcdir@|.| +/^top_srcdir *=/s|@top_srcdir@|./..| +/^abs_top_builddir *=/s|@abs_top_builddir@|$(CURDIR)/..| # arch-tag: da7a3cff-4839-4ad7-bbe3-e2b61c84c38e
--- a/nextstep/Cocoa/Emacs.base/Contents/Info.plist Sat Mar 20 10:32:32 2010 -0400 +++ b/nextstep/Cocoa/Emacs.base/Contents/Info.plist Sun Mar 28 09:04:11 2010 -0400 @@ -1,5 +1,5 @@ <!-- -Copyright (C) 2008, 2009 Free Software Foundation, Inc. +Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs.
--- a/src/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/src/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,90 @@ +2010-03-27 Chong Yidong <cyd@stupidchicken.com> + + * process.c (Fmake_network_process): Don't apply Bug#5173 fix for + Windows. + +2010-03-25 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * process.c (Fmake_network_process): Don't call turn_on_atimers around + `connect' (Bug#5723). + +2010-03-25 Helmut Eller <eller.helmut@gmail.com> + + * process.c (Fmake_network_process): Call `select' for interrupted + `connect' rather than creating new socket (Bug#5173). + +2010-03-24 Jan Djärv <jan.h.d@swipnet.se> + + * frame.c (x_get_arg): Handle RES_TYPE_BOOLEAN_NUMBER (bug #5736). + + * xfns.c (Fx_create_frame): Make menuBar a RES_TYPE_BOOLEAN_NUMBER. + + * dispextern.h (resource_types): RES_TYPE_BOOLEAN_NUMBER is new. + +2010-03-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * xfns.c (Fx_create_frame) [USE_LUCID]: Add BLOCK_INPUT around + XLoadQueryFont. + +2010-03-24 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_ccl): Fix previous change for the + multibyte case. + (encode_coding_ccl): Don't setup ccl program here. Fix for the + case that the output buffer is fullfilled. + (encode_coding): Setup ccl program here. + +2010-03-24 Andreas Politz <politza@fh-trier.de> (tiny change) + + * editfns.c (Fformat): Account for string precision when computing + field width (Bug#5710). + +2010-03-23 Dan Nicolaescu <dann@ics.uci.edu> + + * s/gnu-linux.h (LIBS_SYSTEM): Remove, same as default. + + Simplify LIBS_MACHINE definitions. + * m/hp800.h (LIBS_MACHINE): Remove, same as default. + * m/iris4d.h (LIBS_MACHINE): Likewise. + * m/ibmrs6000.h (LIBS_MACHINE): Rename to LIBS_SYSTEM and move ... + * s/aix4-2.h (LIBS_SYSTEM): ... here. + * s/netbsd.h: Remove commented out code. + +2010-03-22 Dan Nicolaescu <dann@ics.uci.edu> + + Remove dead code dealing with POSIX_SIGNALS. + * atimer.c (set_alarm): Remove dead code, all USG systems define + POSIX_SIGNALS. + * data.c (arith_error): Likewise. + * keyboard.c (input_available_signal, handle_user_signal) + (interrupt_signal): Likewise. + * process.c (sigchld_handler): Likewise. + (create_process): Remove if 0 code. Remove HPUX conditional when + !defined (POSIX_SIGNALS), it cannot be true. + * syssignal.h: Remove USG5_4 and USG conditionals when + !POSIX_SIGNALS, they cannot be true. + + * keyboard.c (Fset_input_interrupt_mode): Remove code depending on + NO_SOCK_SIGIO, not used anymore. + +2010-03-21 Dan Nicolaescu <dann@ics.uci.edu> + + * m/vax.h (BSD_SYSTEM, BSD4_2): Remove conditionals, we only + support vax on BSDs. + + * m/ibmrs6000.h (ORDINARY_LINK): Move definition ... + * s/aix4-2.h (ORDINARY_LINK): ... here. + +2010-03-21 Andreas Schwab <schwab@linux-m68k.org> + + * Makefile.in (abs_builddir): Define. + (bootstrap_exe): Use it. + (VPATH): Use $(srcdir) instead of @srcdir@. + +2010-03-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in (bootstrap_exe): Use an absolute name. + 2010-03-20 Dan Nicolaescu <dann@ics.uci.edu> Remove support for old GNU/Linux using libc version 5.
--- a/src/ChangeLog.7 Sat Mar 20 10:32:32 2010 -0400 +++ b/src/ChangeLog.7 Sun Mar 28 09:04:11 2010 -0400 @@ -7154,9 +7154,9 @@ (ENCODE_ISO_CHARACTER): Bug of handling return value of unify_char fixed. (DECODE_SJIS_BIG5_CHARACTER): New macro. - (decode_coding_sjis_big5): Handle character unificatoin table. + (decode_coding_sjis_big5): Handle character unification table. Use macro DECODE_SJIS_BIG5_CHARACTER. - (encode_coding_sjis_big5): Handle character unificatoin table. + (encode_coding_sjis_big5): Handle character unification table. Use macro ENCODE_SJIS_BIG5_CHARACTER. (setup_coding_system): Handle members character_unification_table_for_decode and
--- a/src/Makefile.in Sat Mar 20 10:32:32 2010 -0400 +++ b/src/Makefile.in Sun Mar 28 09:04:11 2010 -0400 @@ -33,16 +33,17 @@ # Here are the things that we expect ../configure to edit. # We use $(srcdir) explicitly in dependencies so as not to depend on VPATH. -srcdir=@srcdir@ -VPATH=@srcdir@ -CC=@CC@ -CPP=@CPP@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ -LDFLAGS=@LDFLAGS@ -LN_S=@LN_S@ -EXEEXT=@EXEEXT@ -version=@version@ +srcdir = @srcdir@ +abs_builddir = @abs_builddir@ +VPATH = $(srcdir) +CC = @CC@ +CPP = @CPP@ +CFLAGS = @CFLAGS@ +CPPFLAGS = @CPPFLAGS@ +LDFLAGS = @LDFLAGS@ +LN_S = @LN_S@ +EXEEXT = @EXEEXT@ +version = @version@ # Substitute an assignment for the MAKE variable, because # BSD doesn't have it as a default. @SET_MAKE@ @@ -63,7 +64,7 @@ S_FILE = ${srcdir}/@opsysfile@ config_h = config.h $(M_FILE) $(S_FILE) -bootstrap_exe = ../src/bootstrap-emacs${EXEEXT} +bootstrap_exe = ${abs_builddir}/bootstrap-emacs${EXEEXT} OTHER_FILES = @OTHER_FILES@
--- a/src/atimer.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/atimer.c Sun Mar 28 09:04:11 2010 -0400 @@ -296,12 +296,6 @@ static void set_alarm () { -#if defined (USG) && !defined (POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time. */ - signal (SIGALRM, alarm_signal_handler); -#endif /* USG */ - if (atimers) { EMACS_TIME now, time;
--- a/src/coding.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/coding.c Sun Mar 28 09:04:11 2010 -0400 @@ -5245,7 +5245,7 @@ int multibytep = coding->src_multibyte; struct ccl_program *ccl = &coding->spec.ccl->ccl; int source_charbuf[1024]; - int source_byteidx[1024]; + int source_byteidx[1025]; Lisp_Object attrs, charset_list; CODING_GET_INFO (coding, attrs, charset_list); @@ -5256,11 +5256,14 @@ int i = 0; if (multibytep) - while (i < 1024 && p < src_end) - { - source_byteidx[i] = p - src; - source_charbuf[i++] = STRING_CHAR_ADVANCE (p); - } + { + while (i < 1024 && p < src_end) + { + source_byteidx[i] = p - src; + source_charbuf[i++] = STRING_CHAR_ADVANCE (p); + } + source_byteidx[i] = p - src; + } else while (i < 1024 && p < src_end) source_charbuf[i++] = *p++; @@ -5270,7 +5273,7 @@ ccl_driver (ccl, source_charbuf, charbuf, i, charbuf_end - charbuf, charset_list); charbuf += ccl->produced; - if (multibytep && ccl->consumed < i) + if (multibytep) src += source_byteidx[ccl->consumed]; else src += ccl->consumed; @@ -5304,7 +5307,7 @@ encode_coding_ccl (coding) struct coding_system *coding; { - struct ccl_program ccl; + struct ccl_program *ccl = &coding->spec.ccl->ccl; int multibytep = coding->dst_multibyte; int *charbuf = coding->charbuf; int *charbuf_end = charbuf + coding->charbuf_used; @@ -5315,35 +5318,34 @@ Lisp_Object attrs, charset_list; CODING_GET_INFO (coding, attrs, charset_list); - setup_ccl_program (&ccl, CODING_CCL_ENCODER (coding)); - - ccl.last_block = coding->mode & CODING_MODE_LAST_BLOCK; - ccl.dst_multibyte = coding->dst_multibyte; + if (coding->consumed_char == coding->src_chars + && coding->mode & CODING_MODE_LAST_BLOCK) + ccl->last_block = 1; while (charbuf < charbuf_end) { - ccl_driver (&ccl, charbuf, destination_charbuf, + ccl_driver (ccl, charbuf, destination_charbuf, charbuf_end - charbuf, 1024, charset_list); if (multibytep) { - ASSURE_DESTINATION (ccl.produced * 2); - for (i = 0; i < ccl.produced; i++) + ASSURE_DESTINATION (ccl->produced * 2); + for (i = 0; i < ccl->produced; i++) EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF); } else { - ASSURE_DESTINATION (ccl.produced); - for (i = 0; i < ccl.produced; i++) + ASSURE_DESTINATION (ccl->produced); + for (i = 0; i < ccl->produced; i++) *dst++ = destination_charbuf[i] & 0xFF; - produced_chars += ccl.produced; - } - charbuf += ccl.consumed; - if (ccl.status == CCL_STAT_QUIT - || ccl.status == CCL_STAT_INVALID_CMD) + produced_chars += ccl->produced; + } + charbuf += ccl->consumed; + if (ccl->status == CCL_STAT_QUIT + || ccl->status == CCL_STAT_INVALID_CMD) break; } - switch (ccl.status) + switch (ccl->status) { case CCL_STAT_SUSPEND_BY_SRC: record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC); @@ -7534,6 +7536,7 @@ Lisp_Object attrs; Lisp_Object translation_table; int max_lookup; + struct ccl_spec cclspec; attrs = CODING_ID_ATTRS (coding->id); if (coding->encoder == encode_coding_raw_text) @@ -7555,6 +7558,11 @@ ALLOC_CONVERSION_WORK_AREA (coding); + if (coding->encoder == encode_coding_ccl) + { + coding->spec.ccl = &cclspec; + setup_ccl_program (&cclspec.ccl, CODING_CCL_ENCODER (coding)); + } do { coding_set_source (coding); consume_chars (coding, translation_table, max_lookup);
--- a/src/config.in Sat Mar 20 10:32:32 2010 -0400 +++ b/src/config.in Sun Mar 28 09:04:11 2010 -0400 @@ -318,10 +318,10 @@ /* Define to 1 if you have the <kerberos/krb.h> header file. */ #undef HAVE_KERBEROS_KRB_H -/* Define to 1 if `e_text' is member of `krb5_error'. */ +/* Define to 1 if `e_text' is a member of `krb5_error'. */ #undef HAVE_KRB5_ERROR_E_TEXT -/* Define to 1 if `text' is member of `krb5_error'. */ +/* Define to 1 if `text' is a member of `krb5_error'. */ #undef HAVE_KRB5_ERROR_TEXT /* Define to 1 if you have the <krb5.h> header file. */ @@ -615,25 +615,25 @@ /* Define to 1 if you have the `strsignal' function. */ #undef HAVE_STRSIGNAL -/* Define to 1 if `ifr_addr' is member of `struct ifreq'. */ +/* Define to 1 if `ifr_addr' is a member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_ADDR -/* Define to 1 if `ifr_broadaddr' is member of `struct ifreq'. */ +/* Define to 1 if `ifr_broadaddr' is a member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_BROADADDR -/* Define to 1 if `ifr_flags' is member of `struct ifreq'. */ +/* Define to 1 if `ifr_flags' is a member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_FLAGS -/* Define to 1 if `ifr_hwaddr' is member of `struct ifreq'. */ +/* Define to 1 if `ifr_hwaddr' is a member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_HWADDR -/* Define to 1 if `ifr_netmask' is member of `struct ifreq'. */ +/* Define to 1 if `ifr_netmask' is a member of `struct ifreq'. */ #undef HAVE_STRUCT_IFREQ_IFR_NETMASK -/* Define to 1 if `n_un.n_name' is member of `struct nlist'. */ +/* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */ #undef HAVE_STRUCT_NLIST_N_UN_N_NAME -/* Define to 1 if `tm_zone' is member of `struct tm'. */ +/* Define to 1 if `tm_zone' is a member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE /* Define to 1 if `struct utimbuf' is declared by <utime.h>. */ @@ -860,6 +860,9 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME +/* Define to the home page for this package. */ +#undef PACKAGE_URL + /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -919,6 +922,28 @@ /* Define to 1 if using the Motif X toolkit. */ #undef USE_MOTIF +/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif + + /* Define to 1 if we should use toolkit scroll bars. */ #undef USE_TOOLKIT_SCROLL_BARS @@ -954,28 +979,6 @@ /* Define to 1 if you need to in order for `stat' and other things to work. */ #undef _POSIX_SOURCE -/* Enable extensions on AIX 3, Interix. */ -#ifndef _ALL_SOURCE -# undef _ALL_SOURCE -#endif -/* Enable GNU extensions on systems that have them. */ -#ifndef _GNU_SOURCE -# undef _GNU_SOURCE -#endif -/* Enable threading extensions on Solaris. */ -#ifndef _POSIX_PTHREAD_SEMANTICS -# undef _POSIX_PTHREAD_SEMANTICS -#endif -/* Enable extensions on HP NonStop. */ -#ifndef _TANDEM_SOURCE -# undef _TANDEM_SOURCE -#endif -/* Enable general extensions on Solaris. */ -#ifndef __EXTENSIONS__ -# undef __EXTENSIONS__ -#endif - - /* Define to rpl_ if the getopt replacement functions and variables should be used. */ #undef __GETOPT_PREFIX
--- a/src/data.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/data.c Sun Mar 28 09:04:11 2010 -0400 @@ -3291,11 +3291,6 @@ arith_error (signo) int signo; { -#if defined(USG) && !defined(POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time */ - signal (signo, arith_error); -#endif /* USG */ sigsetmask (SIGEMPTYMASK); SIGNAL_THREAD_CHECK (signo);
--- a/src/dispextern.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/dispextern.h Sun Mar 28 09:04:11 2010 -0400 @@ -3266,7 +3266,8 @@ RES_TYPE_FLOAT, RES_TYPE_BOOLEAN, RES_TYPE_STRING, - RES_TYPE_SYMBOL + RES_TYPE_SYMBOL, + RES_TYPE_BOOLEAN_NUMBER }; extern Lisp_Object x_get_arg P_ ((Display_Info *, Lisp_Object,
--- a/src/frame.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/frame.c Sun Mar 28 09:04:11 2010 -0400 @@ -4005,6 +4005,13 @@ case RES_TYPE_NUMBER: return make_number (atoi (SDATA (tem))); + case RES_TYPE_BOOLEAN_NUMBER: + if (!strcmp (SDATA (tem), "on") + || !strcmp (SDATA (tem), "true")) + return make_number (1); + return make_number (atoi (SDATA (tem))); + break; + case RES_TYPE_FLOAT: return make_float (atof (SDATA (tem)));
--- a/src/keyboard.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/keyboard.c Sun Mar 28 09:04:11 2010 -0400 @@ -7507,12 +7507,6 @@ { /* Must preserve main program's value of errno. */ int old_errno = errno; -#if defined (USG) && !defined (POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time */ - signal (signo, input_available_signal); -#endif /* USG */ - SIGNAL_THREAD_CHECK (signo); #ifdef SYNC_INPUT @@ -7595,12 +7589,6 @@ int old_errno = errno; struct user_signal_info *p; -#if defined (USG) && !defined (POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time */ - signal (sig, handle_user_signal); -#endif - SIGNAL_THREAD_CHECK (sig); for (p = user_signals; p; p = p->next) @@ -11089,13 +11077,6 @@ int old_errno = errno; struct terminal *terminal; -#if defined (USG) && !defined (POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time */ - signal (SIGINT, interrupt_signal); - signal (SIGQUIT, interrupt_signal); -#endif /* USG */ - SIGNAL_THREAD_CHECK (signalnum); /* See if we have an active terminal on our controlling tty. */ @@ -11304,11 +11285,7 @@ { /* When using X, don't give the user a real choice, because we haven't implemented the mechanisms to support it. */ -#ifdef NO_SOCK_SIGIO - new_interrupt_input = 0; -#else /* not NO_SOCK_SIGIO */ new_interrupt_input = 1; -#endif /* NO_SOCK_SIGIO */ } else #endif /* HAVE_X_WINDOWS */
--- a/src/m/hp800.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/m/hp800.h Sun Mar 28 09:04:11 2010 -0400 @@ -93,7 +93,6 @@ #define UNEXEC unexhp9k800.o -#define LIBS_MACHINE #define LIBS_DEBUG /* Include the file bsdtty.h, since this machine has job control. */
--- a/src/m/ibmrs6000.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/m/ibmrs6000.h Sun Mar 28 09:04:11 2010 -0400 @@ -57,15 +57,6 @@ #define NLIST_STRUCT #endif -/* -lpthreads seems to be necessary for Xlib in X11R6, and should be harmless - on older versions of X where it happens to exist. */ -#ifdef HAVE_LIBPTHREADS -#define LIBS_MACHINE -lrts -lIM -liconv -lpthreads -#else -/* IBM's X11R5 use -lIM and -liconv in AIX 3.2.2. */ -#define LIBS_MACHINE -lrts -lIM -liconv -#endif - #undef ADDR_CORRECT #define ADDR_CORRECT(x) ((int)(x)) @@ -81,7 +72,5 @@ #define BROKEN_SIGPTY #define BROKEN_SIGPOLL -#define ORDINARY_LINK - /* arch-tag: 028318ee-a7ae-4a08-804d-cc1e6588d003 (do not change this comment) */
--- a/src/m/iris4d.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/m/iris4d.h Sun Mar 28 09:04:11 2010 -0400 @@ -53,8 +53,6 @@ #define DATA_START 0x10000000 #define DATA_SEG_BITS 0x10000000 -#undef LIBS_MACHINE -#define LIBS_MACHINE #define LIBS_DEBUG /* Use terminfo instead of termcap. */
--- a/src/m/vax.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/m/vax.h Sun Mar 28 09:04:11 2010 -0400 @@ -38,7 +38,6 @@ #define CRT0_DUMMIES -#ifdef BSD_SYSTEM /* USG systems I know of running on Vaxes do not actually support the load average, so disable it for them. */ @@ -50,11 +49,7 @@ #define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) -#endif /* BSD_SYSTEM */ - -#ifdef BSD4_2 #define HAVE_FTIME -#endif /* arch-tag: 508bdf7a-01a0-4ce0-8eba-0704d0df55a0 (do not change this comment) */
--- a/src/process.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/process.c Sun Mar 28 09:04:11 2010 -0400 @@ -1878,13 +1878,7 @@ #ifdef AIX struct sigaction sighup_action; #endif -#else /* !POSIX_SIGNALS */ -#if 0 -#ifdef SIGCHLD - SIGTYPE (*sigchld)(); -#endif -#endif /* 0 */ -#endif /* !POSIX_SIGNALS */ +#endif /* POSIX_SIGNALS */ /* Use volatile to protect variables from being clobbered by longjmp. */ volatile int forkin, forkout; volatile int pty_flag = 0; @@ -2008,14 +2002,9 @@ sigprocmask (SIG_BLOCK, &blocked, &procmask); #else /* !POSIX_SIGNALS */ #ifdef SIGCHLD -#if defined (BSD_SYSTEM) || defined (HPUX) +#if defined (BSD_SYSTEM) sigsetmask (sigmask (SIGCHLD)); -#else /* ordinary USG */ -#if 0 - sigchld_deferred = 0; - sigchld = signal (SIGCHLD, create_process_sigchld); -#endif -#endif /* ordinary USG */ +#endif /* BSD_SYSTEM */ #endif /* SIGCHLD */ #endif /* !POSIX_SIGNALS */ @@ -2172,13 +2161,9 @@ sigprocmask (SIG_SETMASK, &procmask, 0); #else /* !POSIX_SIGNALS */ #ifdef SIGCHLD -#if defined (BSD_SYSTEM) || defined (HPUX) +#if defined (BSD_SYSTEM) sigsetmask (SIGEMPTYMASK); -#else /* ordinary USG */ -#if 0 - signal (SIGCHLD, sigchld); -#endif -#endif /* ordinary USG */ +#endif /* BSD_SYSTEM */ #endif /* SIGCHLD */ #endif /* !POSIX_SIGNALS */ @@ -2275,17 +2260,9 @@ sigprocmask (SIG_SETMASK, &procmask, 0); #else /* !POSIX_SIGNALS */ #ifdef SIGCHLD -#if defined (BSD_SYSTEM) || defined (HPUX) +#if defined (BSD_SYSTEM) sigsetmask (SIGEMPTYMASK); -#else /* ordinary USG */ -#if 0 - signal (SIGCHLD, sigchld); - /* Now really handle any of these signals - that came in during this function. */ - if (sigchld_deferred) - kill (getpid (), SIGCHLD); -#endif -#endif /* ordinary USG */ +#endif /* BSD_SYSTEM */ #endif /* SIGCHLD */ #endif /* !POSIX_SIGNALS */ @@ -3640,23 +3617,9 @@ immediate_quit = 1; QUIT; - /* This turns off all alarm-based interrupts; the - bind_polling_period call above doesn't always turn all the - short-interval ones off, especially if interrupt_input is - set. - - It'd be nice to be able to control the connect timeout - though. Would non-blocking connect calls be portable? - - This used to be conditioned by HAVE_GETADDRINFO. Why? */ - - turn_on_atimers (0); - ret = connect (s, lres->ai_addr, lres->ai_addrlen); xerrno = errno; - turn_on_atimers (1); - if (ret == 0 || xerrno == EISCONN) { /* The unwind-protect will be discarded afterwards. @@ -3676,6 +3639,40 @@ #endif #endif +#ifndef WINDOWSNT + if (xerrno == EINTR) + { + /* Unlike most other syscalls connect() cannot be called + again. (That would return EALREADY.) The proper way to + wait for completion is select(). */ + int sc, len; + SELECT_TYPE fdset; + retry_select: + FD_ZERO (&fdset); + FD_SET (s, &fdset); + QUIT; + sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0, + (EMACS_TIME *)0); + if (sc == -1) + { + if (errno == EINTR) + goto retry_select; + else + report_file_error ("select failed", Qnil); + } + eassert (sc > 0); + + len = sizeof xerrno; + eassert (FD_ISSET (s, &fdset)); + if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) == -1) + report_file_error ("getsockopt failed", Qnil); + if (xerrno) + errno = xerrno, report_file_error ("error during connect", Qnil); + else + break; + } +#endif /* !WINDOWSNT */ + immediate_quit = 0; /* Discard the unwind protect closing S. */ @@ -3683,8 +3680,10 @@ emacs_close (s); s = -1; +#ifdef WINDOWSNT if (xerrno == EINTR) goto retry_connect; +#endif } if (s >= 0) @@ -6704,11 +6703,6 @@ /* PID == 0 means no processes found, PID == -1 means a real failure. We have done all our job, so return. */ - /* USG systems forget handlers when they are used; - must reestablish each time */ -#if defined (USG) && !defined (POSIX_SIGNALS) - signal (signo, sigchld_handler); /* WARNING - must come after wait3() */ -#endif errno = old_errno; return; } @@ -6809,9 +6803,6 @@ #if (defined WINDOWSNT \ || (defined USG && !defined GNU_LINUX \ && !(defined HPUX && defined WNOHANG))) -#if defined (USG) && ! defined (POSIX_SIGNALS) - signal (signo, sigchld_handler); -#endif errno = old_errno; return; #endif /* USG, but not HPUX with WNOHANG */
--- a/src/s/aix4-2.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/s/aix4-2.h Sun Mar 28 09:04:11 2010 -0400 @@ -95,6 +95,15 @@ #define LIB_STANDARD +/* -lpthreads seems to be necessary for Xlib in X11R6, and should be harmless + on older versions of X where it happens to exist. */ +#ifdef HAVE_LIBPTHREADS +#define LIBS_SYSTEM -lrts -lIM -liconv -lpthreads +#else +/* IBM's X11R5 use -lIM and -liconv in AIX 3.2.2. */ +#define LIBS_SYSTEM -lrts -lIM -liconv +#endif + /* Use terminfo instead of termcap. */ #define TERMINFO @@ -170,5 +179,7 @@ #define UNEXEC unexaix.o +#define ORDINARY_LINK + /* arch-tag: 38fe75ea-6aef-42bd-8449-bc34d921a562 (do not change this comment) */
--- a/src/s/gnu-linux.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/s/gnu-linux.h Sun Mar 28 09:04:11 2010 -0400 @@ -207,9 +207,6 @@ #define C_DEBUG_SWITCH #endif -/* alane@wozzle.linet.org says that -lipc is not a separate library, - since libc-4.4.1. So -lipc was deleted. */ -#define LIBS_SYSTEM /* _BSD_SOURCE is redundant, at least in glibc2, since we define _GNU_SOURCE. Left in in case it's relevant to libc5 systems and anyone's still using Emacs on those. --fx 2002-12-14 */
--- a/src/s/netbsd.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/s/netbsd.h Sun Mar 28 09:04:11 2010 -0400 @@ -26,8 +26,6 @@ #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) -/* -lutil is not needed for NetBSD >0.9. */ -/* #define LIBS_SYSTEM -lutil */ #define LIBS_TERMCAP -ltermcap #define NEED_ERRNO
--- a/src/syssignal.h Sat Mar 20 10:32:32 2010 -0400 +++ b/src/syssignal.h Sun Mar 28 09:04:11 2010 -0400 @@ -88,38 +88,12 @@ #define sys_sigdel(MASK,SIG) sigdelset (&MASK,SIG) #else /* ! defined (POSIX_SIGNALS) */ -#ifdef USG5_4 - -extern SIGMASKTYPE sigprocmask_set; - -#ifndef sigblock -#define sigblock(sig) \ - (sigprocmask_set = SIGEMPTYMASK | (sig), \ - sigprocmask (SIG_BLOCK, &sigprocmask_set, NULL)) -#endif - -#ifndef sigunblock -#define sigunblock(sig) \ - (sigprocmask_set = SIGFULLMASK & ~(sig), \ - sigprocmask (SIG_SETMASK, &sigprocmask_set, NULL)) -#endif - -#else -#ifdef USG - -#ifndef sigunblock -#define sigunblock(sig) -#endif - -#else #ifndef sigunblock #define sigunblock(SIG) \ { SIGMASKTYPE omask = sigblock (SIGEMPTYMASK); sigsetmask (omask & ~SIG); } #endif -#endif /* ! defined (USG) */ -#endif /* ! defined (USG5_4) */ #endif /* ! defined (POSIX_SIGNALS) */ #ifndef SIGMASKTYPE
--- a/src/xfns.c Sat Mar 20 10:32:32 2010 -0400 +++ b/src/xfns.c Sun Mar 28 09:04:11 2010 -0400 @@ -3347,7 +3347,9 @@ #ifdef USE_LUCID /* Prevent lwlib/xlwmenu.c from crashing because of a bug whereby it fails to get any font. */ + BLOCK_INPUT; xlwmenu_default_font = XLoadQueryFont (FRAME_X_DISPLAY (f), "fixed"); + UNBLOCK_INPUT; #endif /* Frame contents get displaced if an embedded X window has a border. */ @@ -3421,7 +3423,7 @@ init_frame_faces (f); x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1), - "menuBar", "MenuBar", RES_TYPE_NUMBER); + "menuBar", "MenuBar", RES_TYPE_BOOLEAN_NUMBER); x_default_parameter (f, parms, Qtool_bar_lines, make_number (1), "toolBar", "ToolBar", RES_TYPE_NUMBER); x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
--- a/test/ChangeLog Sat Mar 20 10:32:32 2010 -0400 +++ b/test/ChangeLog Sun Mar 28 09:04:11 2010 -0400 @@ -1,3 +1,7 @@ +2010-03-23 Juri Linkov <juri@jurta.org> + + * occur-testsuite.el: New file. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/test/cedet/tests/testjavacomp.java Sat Mar 20 10:32:32 2010 -0400 +++ b/test/cedet/tests/testjavacomp.java Sun Mar 28 09:04:11 2010 -0400 @@ -1,23 +1,23 @@ /** testjavacomp.java --- * - * Copyright (C) 2009 Eric M. Ludlam + * Copyright (C) 2009, 2010 Free Software Foundation, Inc. * * Author: Eric M. Ludlam <eric@siege-engine.com> * - * This program 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. - * - * This program 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. - * + * 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 3 of the License, 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 this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. + * along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ package tests.testjavacomp;
--- a/test/cedet/tests/testpolymorph.cpp Sat Mar 20 10:32:32 2010 -0400 +++ b/test/cedet/tests/testpolymorph.cpp Sun Mar 28 09:04:11 2010 -0400 @@ -1,23 +1,23 @@ /** testpolymorph.cpp --- A sequence of polymorphism examples. * - * Copyright (C) 2009 Eric M. Ludlam + * Copyright (C) 2009, 2010 Free Software Foundation, Inc. * * Author: Eric M. Ludlam <eric@siege-engine.com> * - * This program 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. + * This file is part of GNU Emacs. * - * This program 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. + * 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 3 of the License, 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 this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. + * along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <cmath>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/occur-testsuite.el Sun Mar 28 09:04:11 2010 -0400 @@ -0,0 +1,140 @@ +;;; occur-testsuite.el --- Test suite for occur. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Juri Linkov <juri@jurta.org> +;; Keywords: matching, internal + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Type M-x test-occur RET to test the functionality of `occur'. + +;;; Code: + +(defconst occur-tests + '( + ;; * Test one-line matches (at bob, eob, bol, eol). + ("x" 0 "\ +xa +b +cx +xd +xex +fx +" "\ +5 matches for \"x\" in buffer: *temp* + 1:xa + 3:cx + 4:xd + 5:xex + 6:fx +") + ;; * Test multi-line matches, this is the first test from + ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; where numbers are replaced with letters. + ("a\na" 0 "\ +a +a +a +a +a +" "\ +2 matches for \"a^Ja\" in buffer: *temp* + 1:a + :a + 3:a + :a +") + ;; * Test multi-line matches, this is the second test from + ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; where numbers are replaced with letters. + ("a\nb" 0 "\ +a +b +c +a +b +" "\ +2 matches for \"a^Jb\" in buffer: *temp* + 1:a + :b + 4:a + :b +") + ;; * Test line numbers for multi-line matches with empty last match line. + ("a\n" 0 "\ +a + +c +a + +" "\ +2 matches for \"a^J\" in buffer: *temp* + 1:a + : + 4:a + : +") + ;; * Test multi-line matches with 3 match lines. + ("x\n.x\n" 0 "\ +ax +bx +c +d +ex +fx +" "\ +2 matches for \"x^J.x^J\" in buffer: *temp* + 1:ax + :bx + :c + 5:ex + :fx + : +") + ) + "List of tests for `occur'. +Each element has the format: +\(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).") + +(defun test-occur () + (interactive) + (let ((count 1) + failed + (occur-hook nil)) + (dolist (test occur-tests) + (let ((regexp (nth 0 test)) + (nlines (nth 1 test)) + (input-buffer-string (nth 2 test)) + (output-buffer-string (nth 3 test))) + (save-excursion + (with-temp-buffer + (insert input-buffer-string) + (occur regexp nlines) + (unless (equal output-buffer-string + (with-current-buffer "*Occur*" + (buffer-string))) + (setq failed (cons count failed)))))) + (setq count (1+ count))) + (if failed + (message "FAILED TESTS: %S" (reverse failed)) + (message "SUCCESS")))) + +(provide 'occur-testsuite) + +;;; occur-testsuite.el ends here