If mode-name stays non-string, add NEWS entry and doc fix.
http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg02048.html
+** pot@gnu.org, 17 Dec: strange From line maker rmail-reply loop
+
* DOCUMENTATION
** Check the Emacs Tutorial.
+2007-12-27 Richard Stallman <rms@gnu.org>
+
+ * text.texi (Formatted Text): Improve menu tag.
+ (Editing Format Info): In Info, add duplicate menu of nodes
+ about the submenus.
+ (Format Faces): Say where Faces menu is found. Mention Other.
+ (Format Colors): Say where these submenus are found.
+ (Format Indentation, Format Justification): Likewise.
+ (Format Properties): Likewise.
+
+2007-12-22 Richard Stallman <rms@gnu.org>
+
+ * search.texi (Query Replace): Make exp of query-replace more
+ self-contained, and clarify.
+
+ * cc-mode.texi (Getting Started): Change @ref to @pxref.
+
+2007-12-15 Richard Stallman <rms@gnu.org>
+
+ * files.texi (Auto Save): Clarify definition of auto-saving.
+
2007-11-26 Richard Stallman <rms@gnu.org>
* help.texi (Help Echo): Cleanups.
@cindex mode, Auto Save
@cindex crashes
- Emacs saves all the visited files from time to time (based on counting
-your keystrokes) without being asked. This is called @dfn{auto-saving}.
-It prevents you from losing more than a limited amount of work if the
-system crashes.
+ Emacs saves all the visited files from time to time (based on
+counting your keystrokes) without being asked, in separate files so as
+not to alter the files you actually use. This is called
+@dfn{auto-saving}. It prevents you from losing more than a limited
+amount of work if the system crashes.
When Emacs determines that it is time for auto-saving, it considers
each buffer, and each is auto-saved if auto-saving is enabled for it
@kindex M-%
@findex query-replace
If you want to change only some of the occurrences of @samp{foo} to
-@samp{bar}, not all of them, then you cannot use an ordinary
-@code{replace-string}. Instead, use @kbd{M-%} (@code{query-replace}).
+@samp{bar}, not all of them, use @kbd{M-%} (@code{query-replace}).
This command finds occurrences of @samp{foo} one by one, displays each
occurrence and asks you whether to replace it. Aside from querying,
-@code{query-replace} works just like @code{replace-string}. It
-preserves case, like @code{replace-string}, provided
-@code{case-replace} is non-@code{nil}, as it normally is
+@code{query-replace} works just like @code{replace-string}
+(@pxref{Unconditional Replace}). In particular, it preserves case
+provided @code{case-replace} is non-@code{nil}, as it normally is
(@pxref{Replacement and Case}). A numeric argument means consider
only occurrences that are bounded by word-delimiter characters.
* Justification: Format Justification.
Centering, setting text flush with the
left or right margin, etc.
-* Other: Format Properties. The "special" text properties submenu.
+* Special: Format Properties. The "special" text properties submenu.
* Forcing Enriched Mode:: How to force use of Enriched mode.
@end menu
mouse button). There are also keyboard commands described in the
following section.
- Most of the items in the Text Properties menu lead to other submenus.
-These are described in the sections that follow. Some items run
-commands directly:
+ These items in the Text Properties menu run commands directly:
@table @code
@findex facemenu-remove-face-props
Display a list of all the defined colors (@code{list-colors-display}).
@end table
+@ifinfo
+ Other items in the Text Properties menu lead to submenus:
+
+@menu
+* Faces: Format Faces. Bold, italic, underline, etc.
+* Color: Format Colors. Changing the color of text.
+* Indent: Format Indentation. Changing the left and right margins.
+* Justification: Format Justification.
+ Centering, setting text flush with the
+ left or right margin, etc.
+* Special: Format Properties. The "special" text properties submenu.
+@end menu
+@end ifinfo
+@ifnotinfo
+ The rest lead to submenus which are described in the following sections.
+@end ifnotinfo
+
@node Format Faces
@subsection Faces in Formatted Text
- The Faces submenu lists various Emacs faces including @code{bold},
-@code{italic}, and @code{underline} (@pxref{Faces}). These menu items
-operate on the region if it is active and nonempty. Otherwise, they
-specify to use that face for an immediately following self-inserting
-character. Instead of the menu, you can use these keyboard commands:
+ The Faces submenu under Text Properties lists various Emacs faces
+including @code{bold}, @code{italic}, and @code{underline}
+(@pxref{Faces}). These menu items operate on the region if it is
+active and nonempty. Otherwise, they specify to use that face for an
+immediately following self-inserting character. There is also an item
+@samp{Other} with which you can enter a face name through the
+minibuffer (@pxref{Standard Faces}).
+
+ Instead of the Faces submenu, you can use these keyboard commands:
@table @kbd
@kindex M-o d @r{(Enriched mode)}
@subsection Colors in Formatted Text
You can specify foreground and background colors for portions of the
-text. There is a menu for specifying the foreground color and a menu
-for specifying the background color. Each color menu lists all the
-colors that you have used in Enriched mode in the current Emacs session.
+text. Under Text Properties there is a submenu for specifying the
+foreground color, and a submenu for specifying the background color.
+Each one lists all the colors that you have used in Enriched mode in
+the current Emacs session.
If you specify a color with a prefix argument---or, in Transient
Mark mode, if the region is not active---then it applies to any
immediately following self-inserting input. Otherwise, the command
applies to the region.
- Each color menu contains one additional item: @samp{Other}. You can use
-this item to specify a color that is not listed in the menu; it reads
-the color name with the minibuffer. To display a list of available colors
-and their names, use the @samp{Display Colors} menu item in the Text
-Properties menu (@pxref{Editing Format Info}).
+ Each of the two color submenus contains one additional item:
+@samp{Other}. You can use this item to specify a color that is not
+listed in the menu; it reads the color name with the minibuffer. To
+display a list of available colors and their names, use the
+@samp{Display Colors} menu item in the Text Properties menu
+(@pxref{Editing Format Info}).
Any color that you specify in this way, or that is mentioned in a
formatted text file that you read in, is added to the corresponding
part of a paragraph. The margins you specify automatically affect the
Emacs fill commands (@pxref{Filling}) and line-breaking commands.
- The Indentation submenu provides a convenient interface for specifying
-these properties. The submenu contains four items:
+ The Indentation submenu of Text Properties provides a convenient
+interface for specifying these properties. The submenu contains four
+items:
@table @code
@kindex C-x TAB @r{(Enriched mode)}
justification for a paragraph. The style you specify automatically
affects the Emacs fill commands.
- The Justification submenu provides a convenient interface for specifying
-the style. The submenu contains five items:
+ The Justification submenu of Text Properties provides a convenient
+interface for specifying the style. The submenu contains five items:
@table @code
@item Left
@node Format Properties
@subsection Setting Other Text Properties
- The Special Properties menu lets you add or remove three other useful text
-properties: @code{read-only}, @code{invisible} and @code{intangible}.
-The @code{intangible} property disallows moving point within the text,
-the @code{invisible} text property hides text from display, and the
-@code{read-only} property disallows alteration of the text.
+ The Special Properties submenu of Text Properties can add or remove
+three other useful text properties: @code{read-only}, @code{invisible}
+and @code{intangible}. The @code{intangible} property disallows
+moving point within the text, the @code{invisible} text property hides
+text from display, and the @code{read-only} property disallows
+alteration of the text.
Each of these special properties has a menu item to add it to the
region. The last menu item, @samp{Remove Special}, removes all of these
+2007-12-28 Richard Stallman <rms@gnu.org>
+
+ * frames.texi (Size Parameters): Fix typo.
+ (Basic Parameters): For `title', refer to title bar.
+ (Size and Position): Explain meaning of frame pixel width and height.
+
+2007-12-23 Richard Stallman <rms@gnu.org>
+
+ * customize.texi (Type Keywords): Uncomment :validate and clarify it.
+ Improve some of the commented-out keywords' text too.
+
2007-12-14 Martin Rudalics <rudalics@gmx.at>
* nonascii.texi (Encoding and I/O): Reword to avoid saying
two arguments, a widget and a value; it should return non-@code{nil} if
the value is acceptable.
+@item :validate @var{function}
+Specify a validation function for input. @var{function} takes a
+widget as an argument, and should return @code{nil} if the widget's
+current value is valid for the widget. Otherwise, it should return
+the widget containing the invalid data, and set that widget's
+@code{:error} property to a string explaining the error.
+
+In many cases you can use the function @code{widget-children-validate}
+for this job; it tests that all children of @var{widget} are valid.
+
@ignore
@item :indent @var{columns}
Indent this item by @var{columns} columns. The indentation is used for
buttons, and for editable lists. It affects the whole of the
item except for the first line.
-@item :offset @var{columns}
-An integer indicating how many extra spaces to indent the subitems of
-this item. By default, subitems are indented the same as their parent.
+@item :offset @var{extra}
+Indent the subitems of this item @var{extra} columns more than this
+item itself. By default, subitems are indented the same as their
+parent.
-@item :extra-offset
-An integer indicating how many extra spaces to add to this item's
-indentation, compared to its parent.
+@item :extra-offset @var{n}
+Add @var{n} extra spaces to this item's indentation, compared to its
+parent's indentation.
-@item :notify
-A function called each time the item or a subitem is changed. The
-function is called with two or three arguments. The first argument is
-the item itself, the second argument is the item that was changed, and
-the third argument is the event leading to the change, if any.
+@item :notify @var{function}
+Call @var{function} each time the item or a subitem is changed. The
+function gets two or three arguments. The first argument is the item
+itself, the second argument is the item that was changed, and the
+third argument is the event leading to the change, if any.
-@item :menu-tag
-A tag used in the menu when the widget is used as an option in a
-@code{menu-choice} widget.
+@item :menu-tag @var{tag-string}
+Use @var{tag-string} in the menu when the widget is used as an option
+in a @code{menu-choice} widget.
@item :menu-tag-get
A function used for finding the tag when the widget is used as an option
@code{:menu-tag} or @code{:tag} property if present, or the @code{princ}
representation of the @code{:value} property if not.
-@item :validate
-A function which takes a widget as an argument, and return @code{nil}
-if the widget's current value is valid for the widget. Otherwise, it
-should return the widget containing the invalid data, and set that
-widget's @code{:error} property to a string explaining the error.
-
-You can use the function @code{widget-children-validate} for this job;
-it tests that all children of @var{widget} are valid.
-
@item :tab-order
Specify the order in which widgets are traversed with
@code{widget-forward} or @code{widget-backward}. This is only partially
@code{mono}.
@item title
-If a frame has a non-@code{nil} title, it appears in the window system's
-border for the frame, and also in the mode line of windows in that frame
-if @code{mode-line-frame-identification} uses @samp{%F}
-(@pxref{%-Constructs}). This is normally the case when Emacs is not
-using a window system, and can only display one frame at a time.
-@xref{Frame Titles}.
+If a frame has a non-@code{nil} title, it appears in the window
+system's title bar at the top of the frame, and also in the mode line
+of windows in that frame if @code{mode-line-frame-identification} uses
+@samp{%F} (@pxref{%-Constructs}). This is normally the case when
+Emacs is not using a window system, and can only display one frame at
+a time. @xref{Frame Titles}.
@item name
The name of the frame. The frame name serves as a default for the frame
pixels, call @code{frame-pixel-height}; see @ref{Size and Position}.)
@item width
-The width of the frame contents, in characters. (To get the height in
+The width of the frame contents, in characters. (To get the width in
pixels, call @code{frame-pixel-width}; see @ref{Size and Position}.)
@item user-size
@defun frame-pixel-height &optional frame
@defunx frame-pixel-width &optional frame
-These functions return the height and width of @var{frame}, measured in
-pixels. If you don't supply @var{frame}, they use the selected frame.
+These functions return the height and width of the main display area
+of @var{frame}, measured in pixels. If you don't supply @var{frame},
+they use the selected frame.
+
+These values include the internal borders, and windows' scroll bars
+and fringes (which belong to individual windows, not to the frame
+itself), but do not include menu bars or tool bars (except when using
+X without an X toolkit).
@end defun
@defun frame-char-height &optional frame
+2007-12-29 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Group Parameters): Reorder the text and add a note about
+ `gnus-parameters' near the beginning of the node.
+
+2007-12-29 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change)
+
+ * gnus.texi (Score File Editing): Fix function name.
+
+2007-12-23 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.1.12.
+
+ * trampver.texi: Update release number.
+
+2007-12-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Type Conversion): Correct input parameters mapping.
+
+2007-12-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Type Conversion): Extend for D-Bus compound types.
+ (Errors and Events): Mention wrong-type-argument error.
+
+2007-12-21 Alex Schroeder <alex@gnu.org>
+
+ * rcirc.texi: Changed single spaces after sentence end to double
+ spaces. Fixed some typos.
+ (Internet Relay Chat): Explain relay.
+ (Getting started with rcirc): Change items to reflect prompts.
+ Add more explanation to rcirc-track-minor-mode and added a comment to
+ warn future maintainers that this section is a copy.
+ (People): Changed /ignore example.
+ (Keywords): Not keywords.
+
+2007-12-20 Alex Schroeder <alex@gnu.org>
+
+ * rcirc.texi (Top): Fighting Information Overload chapter added.
+ (Getting started with rcirc): Add notice of rcirc-track-minor-mode.
+ (rcirc commands): Moved /ignore command to the new chapter.
+ (Fighting Information Overload): New chapter documenting /keyword,
+ /bright, /dim, channel ignore, and low priority channels.
+ (Configuration): Document rcirc-server-alist, remove
+ rcirc-startup-channels-alist and rcirc-default-server.
+
+2007-12-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbus.texi (Signals): Fix example in dbus-register-signal.
+
2007-12-14 Sven Joachim <svenjoac@gmx.de>
* gnus.texi (Score Variables): Fix typo.
have the latest @ccmode{} release and might want to upgrade your copy
(see below).
-You should probably start by skimming through the entire chapter
-@ref{Commands} to get an overview of @ccmode{}'s capabilities.
+You should probably start by skimming through the entire Commands chapter
+(@pxref{Commands}) to get an overview of @ccmode{}'s capabilities.
After trying out some commands, you may dislike some aspects of
@ccmode{}'s default configuration. Here is an outline of how to
parameters, either as input parameter, or as output parameter. Every
argument belongs to a D-Bus type.
-Such arguments must be mapped between the the value encoded as a D-Bus
+Such arguments must be mapped between the value encoded as a D-Bus
type, and the corresponding type of Lisp objects. The mapping is
applied Lisp object @expansion{} D-Bus type for input parameters, and
D-Bus type @expansion{} Lisp object for output parameters.
@section Input parameters.
Input parameters for D-Bus methods and signals occur as arguments of a
-Lisp function call. Only some primitive Lisp types are supported in
-the current implementation. The following mapping to D-Bus types is
+Lisp function call. The following mapping to D-Bus types is
applied, when the corresponding D-Bus message is created:
@example
@item integer @tab @expansion{} @tab DBUS_TYPE_INT32
@item float @tab @expansion{} @tab DBUS_TYPE_DOUBLE
@item string @tab @expansion{} @tab DBUS_TYPE_STRING
+@item list @tab @expansion{} @tab DBUS_TYPE_ARRAY
@end multitable
@end example
+Other Lisp objects, like symbols or hash tables, are not accepted as
+input parameter.
+
+If it is necessary to use another D-Bus type, a corresponding type
+symbol can be preceeded to the corresponding Lisp object. Basic D-Bus
+types are represented by the type symbols @code{:byte},
+@code{:boolean}, @code{:int16}, @code{:uint16}, @code{:int32},
+@code{:uint32}, @code{:int64}, @code{:uint64}, @code{:double},
+@code{:string}, @code{:object-path} and @code{:signature}.
+
@noindent
-Other Lisp types, especially lists, are not supported (yet).
+Example:
+
+@lisp
+(dbus-call-method ... @var{NUMBER} @var{STRING})
+@end lisp
+
+is equivalent to
+
+@lisp
+(dbus-call-method ... :uint32 @var{NUMBER} :string @var{STRING})
+@end lisp
+
+but different to
+
+@lisp
+(dbus-call-method ... :int32 @var{NUMBER} :signature @var{STRING})
+@end lisp
+
+A D-Bus compound type is always represented as list. The car of this
+list can be the type symbol @code{:array}, @code{:variant},
+@code{:struct} or @code{:dict-entry}, which would result in a
+corresponding D-Bus container. @code{:array} is optional, because
+this is the default compoud type for a list.
+
+The objects being elements of the list are checked according to the
+D-Bus compound type rules.
+
+@itemize
+@item An array must contain only elements of the same D-Bus type.
+@item A variant must contain only one single element.
+@item A dictionary entry must be element of an array, and it must
+contain only a key-value pair of two element, with a basic type key.
+@item There is no restriction for structs.
+@end itemize
+
+@noindent
+Example:
+
+@lisp
+(dbus-send-signal ...
+ :object-path STRING '(:variant :boolean BOOL)
+ '(:array NUMBER NUMBER) '(:array BOOL :boolean BOOL)
+ '(:struct BOOL :boolean BOOL BOOL
+ (:array NUMBER NUMBER) (:array BOOL BOOL))
+ '(:struct NUMBER NUMBER) '((:dict-entry NUMBER (NUMBER)))
+ '(:array (:dict-entry NUMBER :int32 NUMBER)))
+@end lisp
@section Output parameters.
Output parameters of D-Bus methods and signals are mapped to Lisp
-objects. This mapping is more powerful than the one for input
-parameters, i.e., more D-Bus types are supported by the current
-implementation.
+objects.
@example
@multitable {DBUS_TYPE_OBJECT_PATH} {@expansion{}} {@code{t} or @code{nil}}
@item D-Bus type @tab @tab Lisp type
@item
@item DBUS_TYPE_BOOLEAN @tab @expansion{} @tab @code{t} or @code{nil}
-@item DBUS_TYPE_UINT32 @tab @expansion{} @tab number
-@item DBUS_TYPE_INT32 @tab @expansion{} @tab number
+@item DBUS_TYPE_BYTE @tab @expansion{} @tab number
+@item DBUS_TYPE_UINT16 @tab @expansion{} @tab number
+@item DBUS_TYPE_INT16 @tab @expansion{} @tab number
+@item DBUS_TYPE_UINT32 @tab @expansion{} @tab number or float
+@item DBUS_TYPE_INT32 @tab @expansion{} @tab number or float
+@item DBUS_TYPE_UINT64 @tab @expansion{} @tab number or float
+@item DBUS_TYPE_INT64 @tab @expansion{} @tab number or float
@item DBUS_TYPE_DOUBLE @tab @expansion{} @tab float
@item DBUS_TYPE_STRING @tab @expansion{} @tab string
@item DBUS_TYPE_OBJECT_PATH @tab @expansion{} @tab string
+@item DBUS_TYPE_SIGNATURE @tab @expansion{} @tab string
@item DBUS_TYPE_ARRAY @tab @expansion{} @tab list
@item DBUS_TYPE_VARIANT @tab @expansion{} @tab list
@item DBUS_TYPE_STRUCT @tab @expansion{} @tab list
@end multitable
@end example
+A float object in case of @code{DBUS_TYPE_UINT32},
+@code{DBUS_TYPE_INT32}, @code{DBUS_TYPE_UINT64} and
+@code{DBUS_TYPE_INT6432} is returned, when the C value exceeds the
+Emacs number size range.
+
The resulting list of the last 4 D-Bus compound types contains as
elements the elements of the D-Bus container, mapped according to the
same rules.
"org.freedesktop.Hal.Manager" "DeviceAdded"
'my-dbus-signal-handler)
-@result{} (:system ":1.3" "/org/freedesktop/Hal/Manager"
- "org.freedesktop.Hal.Manager" "DeviceAdded")
+@result{} ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
+ ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
+ my-signal-handler))
@end example
As we know from the inspection data of interface
@cindex errors
@cindex events
+Input parameters of @code{dbus-call-method} and
+@code{dbus-register-signal} are checked for correct D-Bus types. If
+there is a type mismatch, the Lisp error @code{wrong-type-argument}
+@code{D-Bus ARG} is raised.
+
All errors raised by D-Bus are signaled with the error symbol
@code{dbus-error}. As usual, such an error can be trapped with a
@code{condition-case} form. If possible, error messages from D-Bus
@cindex group parameters
The group parameters store information local to a particular group.
+
+Use the @kbd{G p} or the @kbd{G c} command to edit group parameters of a
+group. (@kbd{G p} presents you with a Lisp-based interface, @kbd{G c}
+presents you with a Customize-like interface. The latter helps avoid
+silly Lisp errors.) You might also be interested in reading about topic
+parameters (@pxref{Topic Parameters}).
+Additionally, you can set group parameters via the
+@code{gnus-parameters} variable, see below.
+
Here's an example group parameter list:
@example
@end table
-Use the @kbd{G p} or the @kbd{G c} command to edit group parameters of a
-group. (@kbd{G p} presents you with a Lisp-based interface, @kbd{G c}
-presents you with a Customize-like interface. The latter helps avoid
-silly Lisp errors.) You might also be interested in reading about topic
-parameters (@pxref{Topic Parameters}).
-
@vindex gnus-parameters
Group parameters can be set via the @code{gnus-parameters} variable too.
But some variables, such as @code{visible}, have no effect (For this
@item C-c C-c
@kindex C-c C-c (Score)
-@findex gnus-score-edit-done
+@findex gnus-score-edit-exit
Save the changes you have made and return to the summary buffer
-(@code{gnus-score-edit-done}).
+(@code{gnus-score-edit-exit}).
@item C-c C-d
@kindex C-c C-d (Score)
@menu
* Basics::
* Reference::
+* Fighting Information Overload::
* Hacking and Tweaking::
* GNU Free Documentation License::
* Key Index::
* Useful IRC commands::
* Configuration::
+Fighting Information Overload
+
+* Channels::
+* People::
+* Keywords::
+* Notices::
+
Hacking and Tweaking
* Skipping /away messages using handlers::
@cindex server
@cindex network
Contrary to most Instant Messenger (IM) systems, users usually don't
-connect to a central server. Instead, users connect to a random server
-in a network, and the servers share information between them.
+connect to a central server. Instead, users connect to a random
+server in a network, and servers relay messages from one to the next.
Here's a typical example:
@table @asis
@cindex server, connecting
@cindex Freenode network
-@item IRC server
+@item IRC Server
What server do you want to connect to? All the servers in a particular
network are equivalent. Some networks use a round-robin system where a
single server redirects new connections to a random server in the
@cindex port, connecting
@cindex 6667, default IRC port
-@item IRC port
+@item IRC Port
All network connections require a port. Just as web servers and clients
use port 80 per default, IRC uses port 6667 per default. You rarely
have to use a different port.
@cindex nick, connecting
@cindex changing nick
@cindex name changes
-@item IRC nick
+@item IRC Nick
@vindex user-login-name
Every users needs a handle on-line. You will automatically be assigned
a slightly different nick if your chosen nick is already in use. If
@cindex channels, connecting
@cindex initial channels
@cindex startup channels
-@item Channels
+@item IRC Channels
A space separated list of channels you want to join when connecting.
You don't need to join any channels, if you just want to have one-to-one
conversations with friends on the same network. If you're new to the
@kindex RET
@cindex talking
@cindex communicating
-To talk in a channel, just type in what you want to say in a channel
+To talk in a channel, just type what you want to say in a channel
buffer, and press @key{RET}.
@kindex C-c C-c
though. Generally, IRC users don't like people pasting more than around
four lines of code, so use with care.
-@node Reference, Hacking and Tweaking, Basics, Top
+@comment This section copied from the Channels section.
+@comment All index markers should point to the original!
+Once you are connected to multiple channels, or once you've turned you
+attention to other buffers in Emacs, you probably want to be notified
+of any activity in channels not currently visible. All you need to do
+is switch channel tracking on using @kbd{M-x rcirc-track-minor-mode}.
+To make this permanent, add the following to your init file:
+
+@example
+(rcirc-track-minor-mode 1)
+@end example
+
+Use @kbd{C-c C-@key{SPC}} to switch to these buffers.
+
+@node Reference, Fighting Information Overload, Basics, Top
@chapter Reference
@cindex reference
@code{/quit ZZZzzz...}.)
@end table
-Some commands may not have a key binding, but only be available as typed
-commands, such as:
-
-@table @code
-@item /ignore
-@cindex /ignore
-@cindex ignoring other people
-@cindex trolls, ignoring
-@cindex hide some posts
-@cindex idiots online
-This command toggles the ignore status of a nick, if you provide one.
-If you don't provide a nick, the command lists all the nicks you are
-ignoring. All messages by ignored nicks are---you guessed it---ignored.
-Since only ``operators'' can kick people from channels, the
-ignore command is often the only way to deal with some of the more
-obnoxious fellows online. Example: @code{/ignore xah}.
-@end table
-
@node Useful IRC commands, Configuration, rcirc commands, Reference
@section Useful IRC commands
@cindex irc commands
liking.
@table @code
-@item rcirc-default-server
-@vindex rcirc-default-server
-the default server to connect to.
+@item rcirc-server-alist
+@vindex rcirc-server-alist
+@cindex channels, configuration
+@cindex initial channels, configuration
+@cindex startup channels, configuration
+@cindex servers, configuration
+@cindex initial servers, configuration
+@cindex startup servers, configuration
+This variable contains an alist of servers to connect to by default
+and the keywords parameters to use. The keyword parameters are
+optional. If you don't provide any, the defaults as documented below
+will be used.
-@item rcirc-default-port
-@vindex rcirc-default-port
-the default port to connect to.
+The most important parameter is the @code{:channels} parameter. It
+controls which channels you will join by default as soon as you are
+connected to the server.
+
+Here's an example of how to set it:
+
+@example
+(add-to-list 'rcirc-server-alist
+ '("otherworlders.org"
+ :channels ("#FUDGE" "#game-design")))
+@end example
+
+By default you will be connected to the @code{rcirc} support channel:
+@code{#rcirc} on @code{irc.freenode.net}.
+
+@table @code
+@item :nick
+This overrides @code{rcirc-default-nick}.
+
+@item :port
+This overrides @code{rcirc-default-port}.
+
+@item :user-name
+This overrides @code{rcirc-default-user-name}.
+
+@item :full-name
+This overrides @code{rcirc-default-full-name}.
+
+@item :channels
+This describes which channels to join when connecting to the server.
+If absent, no channels will be connected to automatically.
+
+@end table
@item rcirc-default-nick
@vindex rcirc-default-nick
-the default nick to use.
-@end table
+This variable is used for the default nick. It defaults to the login
+name returned by @code{user-login-name}.
@example
-(setq rcirc-default-server "irc.mozilla.org"
- rcirc-default-port 6666
- rcirc-default-nick "alx")
+(setq rcirc-default-nick "kensanata")
@end example
+@item rcirc-default-port
+@vindex rcirc-default-port
+@cindex port
+This variable contains the default port to connect to. It is 6667 by
+default and rarely needs changing.
+
+@item rcirc-default-user-name
+@vindex rcirc-default-user-name
+@cindex user name
+This variable contains the default user name to report to the server.
+It defaults to the login name returned by @code{user-login-name}, just
+like @code{rcirc-default-nick}.
+
+@item rcirc-default-user-full-name
@vindex rcirc-default-user-full-name
@cindex full name
@cindex real name
@cindex surname
-@code{rcirc-default-user-full-name} is used to set your ``real name'' on
-IRC. It defaults to @code{user-full-name}. If you want to hide your
-full name, you might want to set it to some pseudonym.
+This variable is used to set your ``real name'' on IRC. It defaults
+to the name returned by @code{user-full-name}. If you want to hide
+your full name, you might want to set it to some pseudonym.
@example
(setq rcirc-default-user-full-name "Curious Minds Want To Know")
@end example
-@vindex rcirc-startup-channels-alist
-@cindex channels, configuration
-@cindex initial channels, configuration
-@cindex startup channels, configuration
-@code{rcirc-startup-channels-alist} is the alist of channels to join
-when connecting to a particular network. An alist is a list of lists.
-Each sublist starts with a regular expression that is compared to the
-server address you're connecting to. The remaining sublist items are
-the channels to join.
-
-@example
-(setq rcirc-startup-channels-alist
- '(("\\.freenode\\.net$" "#emacs" "#rcirc" "#wiki")))
-@end example
-
-Note the subtle problem, here --- IRC clients connect to servers, and
-there is no way of knowing which servers belong to a particular network.
-In the example above we're exploiting a naming convention used by within
-the Freenode network --- all servers within the network have a host in
-the @code{freenode.net} domain.
-
+@item rcirc-authinfo
@vindex rcirc-authinfo
@cindex authentification
@cindex identification
@cindex nickserv
@cindex login
-@code{rcirc-authinfo} is an alist used to automatically identify
-yourself on networks. Each sublist starts with a regular expression
-that is compared to the server address you're connecting to. The second
-element in the list is a symbol representing the method to use, followed
-by the arguments this method requires.
+This variable is an alist used to automatically identify yourself on
+networks. Each sublist starts with a regular expression that is
+compared to the server address you're connecting to. The second
+element in the list is a symbol representing the method to use,
+followed by the arguments this method requires.
Here is an example to illustrate how you would set it:
the other instant messaging services, and Bitlbee will log you in. All
@code{rcirc} needs to know, is the login to your Bitlbee account. Don't
confuse the Bitlbee account with all the other accounts.
+
+@end table
+
@end table
+@node Fighting Information Overload, Hacking and Tweaking, Reference, Top
+@chapter Fighting Information Overload
+@cindex information overload
+
+This is the section of the manual that caters to the busy person
+online. There are support channels with several hundred people in
+them. Trying to follow a conversation in these channels can be a
+daunting task. This chapters tells you how @code{rcirc} can help.
+
+@menu
+* Channels::
+* People::
+* Keywords::
+* Notices::
+@end menu
+
+@node Channels, People, Fighting Information Overload, Fighting Information Overload
+@section Channels
+@cindex channels
+@cindex modeline
+
+@comment This section copied to the Getting started with rcirc section
@kindex C-c C-SPC
@vindex rcirc-track-minor-mode
@cindex switching channels
(rcirc-track-minor-mode 1)))
@end example
-@node Hacking and Tweaking, GNU Free Documentation License, Reference, Top
+@cindex busy channels
+If you've joined a very active support channel, tracking activity is
+no longer useful. The channel will be always active. Switching to
+active channels using @kbd{C-c C-@key{SPC}} no longer works as
+expected.
+
+@kindex C-c C-l
+@cindex low priority channels
+The solution is to mark this channel as as a low priority channel.
+Use @kbd{C-c C-l} to make the current channel a low-priority channel.
+Low priority channels have the modeline indicator ``LowPri''.
+@kbd{C-c C-@key{SPC}} will not switch to low priority channels unless
+you use the @kbd{C-u} prefix.
+
+@kindex C-c TAB
+@cindex ignored channels
+If you prefer a channel to never show up in the modeline, then you
+have to ignore it. Use @kbd{C-c @key{TAB}} to ignore the current
+channel.
+
+@node People, Keywords, Channels, Fighting Information Overload
+@section People
+@cindex people, how to ignore
+@cindex nicks, how to ignore
+@cindex friends
+@cindex buddies
+@cindex trolls
+
+The most important command available to the discerning IRC user is
+@code{/ignore}. It's the big equalizer online: If people aggravate
+you, just ignore them.
+
+This is of course a crude all-or-nothing solution. Fear not,
+@code{rcirc} offers alternatives: You can ``brighten'' your buddies
+and ``dim'' certain other nicks that you don't want to ignore
+altogether.
+
+@table @code
+@item /ignore
+@cindex /ignore
+@cindex ignoring other people
+@cindex trolls, ignoring
+@cindex hide some posts
+@cindex idiots online
+This command toggles the ignore status of a nick, if you provide one.
+If you don't provide a nick, the command lists all the nicks you are
+ignoring. All messages by ignored nicks are---you guessed it---ignored.
+Since only ``operators'' can kick people from channels, the
+ignore command is often the only way to deal with some of the more
+obnoxious fellows online. Example: @code{/ignore rudybot}.
+
+@item /bright
+@cindex /bright
+@cindex highlight other people
+@cindex friends, highlight
+@cindex buddies, highlight
+@cindex nicks, highlight
+@cindex brighten nicks
+This command toggles the bright status of a nick, if you provide one.
+If you don't provide a nick, the command lists all the ``brightened''
+nicks. All messages by brightened nicks are---you guessed
+it---brightened. Use this for your friends. Example: @code{/bright
+rcy}.
+
+@item /dim
+@cindex /dim
+@cindex soft-ignore other people
+@cindex obnoxious people online
+@cindex rabble online
+This command toggles the dim status of a nick, if you provide one. If
+you don't provide a nick, the command lists all the ``dimmed'' nicks.
+All messages by dimmed nicks are---you guessed it---dimmed. Use this
+for boring people and bots. If you are tracking channel activity,
+messages by dimmed nicks will not register as activity. Example:
+@code{/dim fsbot}.
+@end table
+
+
+@node Keywords, Notices, People, Fighting Information Overload
+@section Keywords
+@cindex keywords
+
+On a busy channel, you might want to ignore all activity (using
+@kbd{C-c @key{TAB}}) and just watch for certain keywords. The
+following command allows you to highlight certain keywords:
+
+@table @code
+@item /keyword
+@cindex /keyword
+This command toggles the highlighting of a keyword, if you provide
+one. If you don't provide a keyword, the current keywords are
+listed. Example: @code{/keyword manual}.
+@end table
+
+@node Notices, , Keywords, Fighting Information Overload
+@section Notices
+@cindex part notices, how to omit
+@cindex join notices, how to omit
+@cindex quit notices, how to omit
+@cindex nick notices, how to omit
+
+@kindex C-c C-o
+@cindex low priority channels
+In busy channels you might not be interested in all the joining,
+parting, quitting, and renaming that goes on. You can omit those
+notices using @kbd{C-c C-o}.
+
+@vindex rcirc-omit-responses
+@cindex away notices, how to omit
+You can control which notices get omitted via the
+@code{rcirc-omit-responses} variable. Here's an example of how to
+omit away messages:
+
+@example
+(setq rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK" "AWAY))
+@end example
+
+@vindex rcirc-omit-threshold
+Notice that these messages will not be omitted if the nick in question
+has recently been active. After all, you don't want to continue a
+conversation with somebody who just left. That's why @code{rcirc}
+checks recent lines in the buffer to figure out if a nick has been
+active and only omits a message if the nick has not been active. The
+window @code{rcirc} considers is controlled by the
+@code{rcirc-omit-threshold} variable.
+
+@node Hacking and Tweaking, GNU Free Documentation License, Fighting Information Overload, Top
@chapter Hacking and Tweaking
@cindex hacking and tweaking
@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.12-pre
+@set trampver 2.1.12
@c Other flags from configuration
@set instprefix /usr/local
* schema/xhtml-form.rnc, schema/xhtml-table.rnc, schema/xhtml.rnc:
Updated accordingly.
- * schema/docbook-dyntbl.rnc, schema/docbook-dyntbl.rnc: Renamed to
+ * schema/docbook-dyntbl.rnc, schema/docbook-soextbl.rnc: Renamed to
docbk-dyntbl.rnc and docbk-soextbl.rnc, respectively.
* images/icons/macemacs_16.png, images/icons/macemacs_24.png:
** TAB now indents the region if the region is active and
`transient-mark-mode' is turned on.
+** `use-empty-active-region' controls whether an empty active region
+in Transient Mark mode should make commands operate on that empty region.
+
** C-z now invokes `suspend-frame', C-x C-c now invokes
`save-buffers-kill-terminal'.
** New command kill-matching-buffers kills buffers whose name matches a regexp.
-** `interprogram-paste-function' can now return one string or a list
-of strings. In the latter case, Emacs puts the second and following
-strings on the kill ring.
+** You can disable kill ring commands from accessing the primary selection
+by setting `x-select-enable-primary' to nil.
+
+** If `select-active-regions' is t, setting the mark automatically
+makes the new region into the primary selection (for interaction with
+other window applications). If you enable this, you might want to bind
+`mouse-yank-primary' to Mouse-2.
+
+** If `yank-pop-change-selection' is t, rotating the kill ring
+also updates the selection or clipboard to the current yank,
+just as M-w would do so with the text it copies to the kill ring.
** Minibuffer changes:
** `frame-inherited-parameters' lets new frames inherit parameters from
the selected frame.
+** Commands should use `use-region-p' to test whether there is
+an active region that they should operate on.
+
+** `region-active-p' returns non-nil when Transient Mark mode
+is enabled and there is an active region. This is NOT the best function
+to use to test whether a command should operate on the region instead
+of the usual behavior -- for that, use `use-region-p'.
+
** New keymap `input-decode-map' overrides like key-translation-map, but
applies before function-key-map. Also it is terminal-local contrary to
key-translation-map. Terminal-specific key-sequences are generally added to
** The new function `read-color' reads a color name using the minibuffer.
+** `interprogram-paste-function' can now return one string or a list
+of strings. In the latter case, Emacs puts the second and following
+strings on the kill ring.
+
** Changes related to multiple tty support.
*** $TERM is now set to `dumb' for subprocesses. If you want to know the
* Changes in Emacs 22.2
+** `find-name-dired' now uses -iname rather than -name
+for case-insensitive filesystems. The default behavior is determined
+by the value of `read-file-name-completion-ignore-case'; if you don't
+like that, customize the value of the new option `find-name-arg'.
+
** In Image mode, whenever the displayed image is wider and/or higher
than the window, the usual keys for moving the cursor cause the image
to be scrolled horizontally or vertically instead.
Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
-Files: macemacs_16.png macemacs_24.png macemacs_32.png macemacs_48.png
- macemacs_256.png macemacs_512.png
+Files: emacs16_mac.png emacs24_mac.png emacs32_mac.png emacs48_mac.png
+ emacs256_mac.png emacs512_mac.png
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
Copyright (C) 2007 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
+2007-12-15 Richard Stallman <rms@gnu.org>
+
+ * quail/latin-post.el ("scandinavian-postfix"): Doc fix.
+
+ * quail/latin-alt.el: Many doc fixes.
+ ("danish-alt-postfix")
+ ("esperanto-alt-postfix", "finnish-alt-postfix")
+ ("german-alt-postfix", "icelandic-alt-postfix")
+ ("norwegian-alt-postfix", "scandinavian-alt-postfix")
+ ("spanish-alt-postfix", "swedish-alt-postfix"):
+ Deleted; they were identical to the non-alt versions.
+
2007-12-07 Kenichi Handa <handa@ni.aist.go.jp>
* quail/lao.el (quail-map-from-table): Allow a tone just after a
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
-;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+;; Author (of latin-post.el): TAKAHASHI Naoto <ntakahas@etl.go.jp>
;;; Commentary:
+;; These input methods differ from those in latin-post.el
+;; in that comma is not special (use / instead),
+;; and // is not special either (so you can enter a slash
+;; by typing //).
+
+;; At least, that's what I could see by comparing the first few
+;; of these with latin-post.el.
+
;;; Code:
(require 'quail)
(quail-define-package
"latin-1-alt-postfix" "Latin-1" "1<" t
"Latin-1 character input method with postfix modifiers
+This input method differs from `latin-1-postfix' in that
+comma is not special (use slash instead), and `//' is not
+special (so you can use that to enter a slash).
| postfix | examples
------------+---------+----------
others | /<> | s/ -> ß ?/ -> ¿ !/ -> ¡
| various | << -> « >> -> » o_ -> º a_ -> ª
-It would be natural to use comma for cedillas, but that would be
-inconvenient in practice because commas are needed very often after a
-letter.
+It seems natural to use comma for cedillas, but that is
+inconvenient in practice because commas are needed very
+often after a letter.
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-package
"latin-2-alt-postfix" "Latin-2" "2<" t
"Latin-2 character input method with postfix modifiers
+This input method differs from `latin-2-postfix' in that
+comma and period are not special (use ` instead).
| postfix | examples
------------+---------+----------
stroke | / | d/ -> đ
others | / | s/ -> ß
-It would be natural to use period and comma for dots/rings and
-cedillas/ogoneks, but that would inconvenient in practice, because
+It seems natural to use period and comma for dots/rings and
+cedillas/ogoneks, but that is inconvenient in practice, because
periods and commas are needed very often after a letter.
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
(quail-define-package
"latin-3-alt-postfix" "Latin-3" "3<" t
"Latin-3 character input method with postfix modifiers
+This input method differs from `latin-3-postfix' in that
+comma is not special (use ` instead), and period is not
+special (use slash instead).
| postfix | examples
------------+---------+----------
(quail-define-package
"latin-4-alt-postfix" "Latin-4" "4<" t
"Latin-4 characters input method with postfix modifiers
+This input method differs from `latin-4-postfix' in that
+comma is not special (use ` instead), and period is not
+special (use ~ instead).
| postfix | examples
------------+---------+----------
nordic | / | a/ -> å e/ -> æ o/ -> ø
others | / | s/ -> ß n/ -> ŋ k/ -> ĸ
-It would be natural to use period and comma for dots and
-cedillas/ogoneks, but that would inconvenient in practice, because
+It seems natural to use period and comma for dots and
+cedillas/ogoneks, but that is inconvenient in practice, because
periods and commas are needed very often after a letter.
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
(quail-define-package
"latin-5-alt-postfix" "Latin-5" "5<" t
"Latin-5 characters input method with postfix modifiers
+This input method differs from `latin-5-postfix' in that
+comma is not special (use ` instead), and period is not
+special (use / instead).
| postfix | examples
------------+---------+----------
nordic | / | a/ -> å e/ -> æ o/ -> ø
others | / | s/ -> ß
-It would be natural to use period and comma for dots and cedillas, but
-that would inconvenient in practice, because periods and commas are
+It seems natural to use period and comma for dots and cedillas, but
+that is inconvenient in practice, because periods and commas are
needed very often after a letter.
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
("y\"\"" ["y\""])
)
-(quail-define-package
- "danish-alt-postfix" "Latin-1" "DA<" t
- "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E' -> É)
-
-Doubling the postfix separates the letter and postfix: e.g. aee -> ae
-"
- nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("AE" ?Æ)
- ("ae" ?æ)
- ("OE" ?Ø)
- ("oe" ?ø)
- ("AA" ?Å)
- ("aa" ?å)
- ("E'" ?É)
- ("e'" ?é)
-
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("AAA" ["AA"])
- ("aaa" ["aa"])
- ("E''" ["E'"])
- ("e''" ["e'"])
- )
-
-(quail-define-package
- "esperanto-alt-postfix" "Latin-3" "EO<" t
- "Esperanto input method with postfix modifiers
-
-A following ^ or x will produce an accented character,
-e.g. c^ -> ĉ gx -> ĝ u^ -> ŭ.
-
-Doubling the postfix separates the letter and postfix,
-e.g. a'' -> a'.
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("Cx" ?Ĉ)
- ("C^" ?Ĉ)
- ("cx" ?ĉ)
- ("c^" ?ĉ)
- ("Gx" ?Ĝ)
- ("G^" ?Ĝ)
- ("gx" ?ĝ)
- ("g^" ?ĝ)
- ("Hx" ?Ĥ)
- ("H^" ?Ĥ)
- ("hx" ?ĥ)
- ("h^" ?ĥ)
- ("Jx" ?Ĵ)
- ("J^" ?Ĵ)
- ("jx" ?ĵ)
- ("j^" ?ĵ)
- ("Sx" ?Ŝ)
- ("S^" ?Ŝ)
- ("sx" ?ŝ)
- ("s^" ?ŝ)
- ("Ux" ?Ŭ)
- ("U^" ?Ŭ)
- ("ux" ?ŭ)
- ("u^" ?ŭ)
-
- ("Cxx" ["Cx"])
- ("C^^" ["C^"])
- ("cxx" ["cx"])
- ("c^^" ["c^"])
- ("Gxx" ["Gx"])
- ("G^^" ["G^"])
- ("gxx" ["gx"])
- ("g^^" ["g^"])
- ("Hxx" ["Hx"])
- ("H^^" ["H^"])
- ("hxx" ["hx"])
- ("h^^" ["h^"])
- ("Jxx" ["Jx"])
- ("J^^" ["J^"])
- ("jxx" ["jx"])
- ("j^^" ["j^"])
- ("Sxx" ["Sx"])
- ("S^^" ["S^"])
- ("sxx" ["sx"])
- ("s^^" ["s^"])
- ("Uxx" ["Ux"])
- ("U^^" ["U^"])
- ("uxx" ["ux"])
- ("u^^" ["u^"])
- )
-
-(quail-define-package
- "finnish-alt-postfix" "Latin-1" "FI<" t
- "Finnish (Suomi) input method
-
-AE -> Ä
-AEE -> AE
-OE -> Ö
-OEE -> OE
-"
- nil t nil nil nil nil nil nil nil nil t)
-(quail-define-rules
- ("AE" ?Ä)
- ("ae" ?ä)
- ("OE" ?Ö)
- ("oe" ?ö)
-
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- )
(quail-define-package
"french-alt-postfix" "French" "FR<" t
(">>>" [">>"])
)
-(quail-define-package
- "german-alt-postfix" "German" "DE<" t
- "German (Deutsch) input method
-
-ae -> ä
-aee -> ae
-oe -> ö
-oee -> oe
-ue -> ü
-uee -> ue
-sz -> ß
-szz -> sz
-"
- nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("AE" ?Ä)
- ("ae" ?ä)
- ("OE" ?Ö)
- ("oe" ?ö)
- ("UE" ?Ü)
- ("ue" ?ü)
- ("sz" ?ß)
-
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("UEE" ["UE"])
- ("uee" ["ue"])
- ("szz" ["sz"])
- )
-
-(quail-define-package
- "icelandic-alt-postfix" "Latin-1" "IS<" t
- "Icelandic (Íslenska) input method with postfix modifiers
-
-A' -> Á
-E' -> É
-I' -> Í
-O' -> Ó
-U' -> Ú
-Y' -> Ý
-AE -> Æ
-OE -> Ö
-D/ -> Ð (eth)
-T/ -> Þ (thorn)
-
-Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("A'" ?Á)
- ("a'" ?á)
- ("E'" ?É)
- ("e'" ?é)
- ("I'" ?Í)
- ("i'" ?í)
- ("O'" ?Ó)
- ("o'" ?ó)
- ("U'" ?Ú)
- ("u'" ?ú)
- ("Y'" ?Ý)
- ("y'" ?ý)
- ("AE" ?Æ)
- ("ae" ?æ)
- ("OE" ?Ö)
- ("oe" ?ö)
- ("D/" ?Ð)
- ("d/" ?ð)
- ("T/" ?Þ)
- ("t/" ?þ)
- ("A''" ["A'"])
- ("a''" ["a'"])
- ("E''" ["E'"])
- ("e''" ["e'"])
- ("I''" ["I'"])
- ("i''" ["i'"])
- ("O''" ["O'"])
- ("o''" ["o'"])
- ("U''" ["U'"])
- ("u''" ["u'"])
- ("Y''" ["Y'"])
- ("y''" ["y'"])
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("D//" ["D/"])
- ("d//" ["d/"])
- ("T//" ["T/"])
- ("t//" ["t/"])
- )
(quail-define-package
"italian-alt-postfix" "Latin-1" "IT<" t
("a__" ["a_"])
)
-(quail-define-package
- "norwegian-alt-postfix" "Latin-1" "NO<" t
- "Norwegian (Norsk) input method (rule: AE->Æ, OE->Ø, AA->Å, E'->É)
-
-Doubling the postfix separates the letter and postfix: e.g. aee -> ae
-"
- nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("AE" ?Æ)
- ("ae" ?æ)
- ("OE" ?Ø)
- ("oe" ?ø)
- ("AA" ?Å)
- ("aa" ?å)
- ("E'" ?É)
- ("e'" ?é)
-
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("AAA" ["AA"])
- ("aaa" ["aa"])
- ("E''" ["E'"])
- ("e''" ["e'"])
- )
-
-(quail-define-package
- "scandinavian-alt-postfix" "Latin-1" "SC<" t
- "Scandinavian input method with postfix modifiers
-Supported languages are Swedish, Norwegian, Danish, and Finnish.
-
-ae -> æ
-oe -> ø
-aa -> å
-a\" -> ä
-o\" -> ö
-e' -> é
-
-Doubling the postfix separates the letter and postfix:
-aee -> ae o\"\" -> o\" etc.
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("AE" ?Æ)
- ("ae" ?æ)
- ("OE" ?Ø)
- ("oe" ?ø)
- ("AA" ?Å)
- ("aa" ?å)
- ("A\"" ?Ä)
- ("a\"" ?ä)
- ("O\"" ?Ö)
- ("o\"" ?ö)
- ("E'" ?É)
- ("e'" ?é)
-
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("AAA" ["AA"])
- ("aaa" ["aa"])
- ("A\"\"" ["A\""])
- ("a\"\"" ["a\""])
- ("O\"\"" ["O\""])
- ("o\"\"" ["o\""])
- ("E''" ["E'"])
- ("e''" ["e'"])
- )
-
-(quail-define-package
- "spanish-alt-postfix" "Spanish" "ES<" t
- "Spanish (Español) input method with postfix modifiers
-
-A' -> Á
-E' -> É
-I' -> Í
-O' -> Ó
-U' -> Ú
-N~ -> Ñ
-!/ -> ¡
-?/ -> ¿
-
-Doubling the postfix separates the letter and postfix:
-a'' -> a' n~~ -> n~, etc.
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("A'" ?Á)
- ("a'" ?á)
- ("E'" ?É)
- ("e'" ?é)
- ("I'" ?Í)
- ("i'" ?í)
- ("O'" ?Ó)
- ("o'" ?ó)
- ("U'" ?Ú)
- ("u'" ?ú)
- ("N~" ?Ñ)
- ("n~" ?ñ)
- ("?/" ?¿)
- ("!/" ?¡)
-
- ("A''" ["A'"])
- ("a''" ["a'"])
- ("E''" ["E'"])
- ("e''" ["e'"])
- ("I''" ["I'"])
- ("i''" ["i'"])
- ("O''" ["O'"])
- ("o''" ["o'"])
- ("U''" ["U'"])
- ("u''" ["u'"])
- ("N~~" ["N~"])
- ("n~~" ["n~"])
- ("?//" ["?/"])
- ("!//" ["!/"])
- )
-
-(quail-define-package
- "swedish-alt-postfix" "Latin-1" "SV<" t
- "Swedish (Svenska) input method (rule: AA -> Å, AE -> Ä, OE -> Ö, E' -> É)
-
-Doubling the postfix separates the letter and postfix: e.g. aee -> ae
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("AA" ?Å)
- ("aa" ?å)
- ("AE" ?Ä)
- ("ae" ?ä)
- ("OE" ?Ö)
- ("oe" ?ö)
- ("E'" ?É)
- ("e'" ?é)
-
- ("AAA" ["AA"])
- ("aaa" ["aa"])
- ("AEE" ["AE"])
- ("aee" ["ae"])
- ("OEE" ["OE"])
- ("oee" ["oe"])
- ("E''" ["E'"])
- ("e''" ["e'"])
- )
(quail-define-package
"turkish-alt-postfix" "Turkish" "TR«" t
"Turkish (Türkçe) input method with postfix modifiers.
+This input method differs from `turkish-postfix' in that
+comma is not special (use ` instead).
turkish-latin-3-alt-postfix is an obsolete alias for turkish-alt-postfix.
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * progmodes/compile.el (compilation-start): Set initial visible
+ point properly even when compilation buffer already current.
+
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * files.el (conf-mode-maybe): New function.
+ (auto-mode-alist): Use conf-mode-maybe for .conf etc.
+
+2007-12-29 Martin Rudalics <rudalics@gmx.at>
+
+ * textmodes/fill.el (fill-find-break-point): Fix doc-string typo.
+
+2007-12-29 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * progmodes/asm-mode.el (asm-mode-map): Add a major mode menu.
+
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * comint.el (comint-mode-map): Explicitly bind `delete' and `kp-delete'
+ so they never do EOF.
+
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * faces.el (copy-face): Create the new face explicitly if it
+ does not exist already.
+
+2007-12-29 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (minibuffer-history, shell-command-history)
+ (set-variable-value-history):
+ * replace.el (regexp-history):
+ * international/mule-cmds.el (input-method-history):
+ * files.el (file-name-history): Add reference to history-length in
+ the doc string.
+
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * comint.el (comint-password-prompt-regexp): Match `Enter Password'.
+
+2007-12-29 Jason Rumney <jasonr@gnu.org>
+
+ * find-dired.el (find-name-arg): New custom variable.
+ (find-name-dired): Use it.
+ (find-dired-find-program): Remove.
+ (find-dired): Use find-program.
+ (find-grep-dired): Use grep-program.
+
+ * progmodes/grep.el (rgrep): Use find-name-arg.
+
+2007-12-29 Thien-Thi Nguyen <ttn@gnuvola.org>
+
+ * progmodes/cc-vars.el (defcustom-c-stylevar):
+ Revert to pre-2007-12-12 version.
+
+2007-12-29 Richard Stallman <rms@gnu.org>
+
+ * emacs-lisp/find-func.el (find-function-after-hook): Add :type.
+
+ * info.el (Info-clone-buffer): Renamed from Info-clone-buffer-hook.
+ Use changed.
+
+ * startup.el (fancy-splash-help-echo): Var deleted.
+ (fancy-splash-insert): Get help-echo from (startup-echo-area-message).
+ (fancy-about-screen): Don't display fancy-splash-help-echo.
+
+ * menu-bar.el (menu-bar-describe-menu): Remove dots from menu text.
+
+2007-12-28 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc-hooks.el, vc.el: Move vc-directory-exclusion-list from vc.el
+ to vc-hooks.el so it will be available to other modes, such as
+ speedbar.el. Also, teach it to recognize monotone state directories.
+
+ * speedbar.el: Remove this mode's fragile assumptions about
+ version-control systems. Instead, make it use logic from
+ vc-hooks.el so it will become smarter whenever VC mode does.
+
+ * vc-hooks.el: 'added is a real state, not a future hypothetical one.
+ Fix the documentation.
+
+ * vc-bzr.el, vc-cvs.el, vc-git.el, vc-hg.el, vc-mcvs.el, vc-svn.el:
+ Modify all instances of the dir-state back-end method to suppress
+ keeping undo lists on the buffers holding status output, which
+ can get extremely large.
+
+ * vc-cvs.el, vc-svn.el: Simplify backend dired-state-info functions
+ so they don't do work that the default one can do instead.
+
+ * vc-hooks.el (vc-state): Document new 'ignored and 'unregistered
+ states, and the new return-value convention. These are not
+ actually used yet, just set.
+
+ * vc-svn.el (vc-svn-parse-status): Set 'ignored and 'unregistered
+ states when appropriate.
+
+ * vc-hg.el (vc-hg-state, vc-hg-dir-state): Set 'ignored and
+ 'unregistered when appropriate.
+
+ * vc-git.el: Document that we don't set the new states yet.
+
+ * vc.el (vc-dired-state-info): Display 'added, 'unregistered and
+ 'ignored states.
+
+ * vc-cvs.el (vc-cvs-parse-status): Set the 'ignored state when
+ appropriate.
+
+ * vc-bzr.el (vc-bzr-dir-state): Set 'ignored and 'unregistered
+ when appropriate.
+
+2007-12-28 Nick Roberts <nickrob@snap.net.nz>
+
+ * thumbs.el (thumbs-call-convert): Use call-process directly
+ with thumbs-conversion-program instead of through shell-file-name
+ for better error reporting.
+
+2007-12-27 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-aent.el (math-remove-percentsigns):
+ * calc/calccomp.el (math-to-percentsigns): Change placeholder
+ for percent signs.
+
+2007-12-27 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc.el (vc-dired-ignorable-p, vc-dired-hook): Speed optimization;
+ use completion-ignored-extensions to detect files that should be
+ ignorted in VC-Dired listings, heading off lots of expensive calls
+ to (vc-state).
+
+ * vc.el (vc-dired-hook): Show unregistered file status as "?" in
+ non-terse mode.
+ (vc-dired-ignorable-p): Ignore Makefile when it has a peer named
+ Makefile.in or Makefile.am
+
+2007-12-27 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * ps-print.el (ps-mark-active-p): Fun returned back.
+ (ps-print-preprint-region): Use `ps-mark-active-p' instead of
+ `region-active-p' for error checking.
+
+2007-12-27 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc.el, vc-sccs.el, vc-rcs.el, vc-cs.el, vc-mcvs.el: Put
+ new machinery in place to support editing of change comments
+ with 'e' in a log-view buffer. Not documented yet as this
+ only works for SCCS, RCS, and maybe CVS if you have admin
+ privileges. When we have backend support for Subversion and
+ more modern systems it will be time to write this up.
+
+2007-12-27 Kenichi Handa <handa@ni.aist.go.jp>
+
+ * international/mule-cmds.el (select-safe-coding-system):
+ When a buffer is modified, cancel the writing.
+
+2007-12-26 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * log-view.el: Add Subversion and Mercurial log format samples.
+
+ * vc.el (vc-dired-hook): Significantly speed up by arranging for
+ it to call the backend dir-state hook (if it exists)
+ exactly *once*, rather than once per each subdirectory (with
+ dired-state-info calls on all toplevel files slowing it down even
+ further). For this to work, backend dir-state methods have to
+ recurse to subdirectories. Most of them already did anyway; a few
+ needed *non*-recursion switches removed. This change mostly
+ removed code that was perversely bad and should have been shot
+ through the head years ago.
+
+ * vc-bzr.el (vc-bzr-dir-state):
+ * vc-cvs.el (vc-cvs-dir-state):
+ * vc-mcvs.el (vc-mcvs-dir-state):
+ * vc-svn.el (vc-svn-dir-state): Recurse in subdirectories.
+
+ * vc-svn.el (vc-svn-print-log): svn log doesn't actually accept
+ multiple arguments, so generate logs sequentially when we get them.
+ * vc-hg.el (vc-hg-print-log): Gives this CVS-like "Working file:"
+ headers so the various log bindings can do the right thing.
+ * vc-cvs.el (vc-cvs-print-log): Fix a misleading comment.
+
+2007-12-26 Andreas Schwab <schwab@suse.de>
+
+ * font-lock.el (save-buffer-state): Make sure the state of the
+ buffer is always restored.
+
+2007-12-26 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-lang-allow-percentsigns): New variable.
+
+ * calc/calc-lang.el (calc-lang-allow-percentsigns): Declare as
+ a variable.
+
+ * calc/calccomp.el (math-to-percentsigns): New function.
+ (math-compose-var): Handle variables with percent signs.
+ (math-compose-expr): Handle function names with percent signs.
+
+ * calc/calc-aent.el (math-to-percentsigns): Declare as function.
+ (math-read-exprs): Handle percent signs in languages that
+ allow them.
+ (math-restore-underscores): Remove function.
+ (math-remove-percentsigns, math-restore-placeholders):
+ New functions.
+
+2007-12-26 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * ps-print.el (ps-print-preprint-region): Use `region-active-p' instead
+ of `mark' for error checking.
+
+2007-12-26 Tassilo Horn <tassilo@member.fsf.org>
+
+ * image-mode.el (image-bookmark-make-cell, image-bookmark-jump):
+ New functions.
+ (image-mode): Set bookmark-make-cell-function appropriately.
+
+ * doc-view.el (doc-view-bookmark-jump): Correct misspelled arg name.
+
+ * bookmark.el (bookmark-make-cell-function): New variable.
+ (bookmark-make): Call bookmark-make-cell-function's function
+ instead of bookmark-make-cell.
+ (bookmark-get-handler, bookmark-jump-internal): New functions.
+ (bookmark-jump, bookmark-jump-other-window, bookmark-insert)
+ (bookmark-bmenu-2-window, bookmark-bmenu-other-window):
+ Use bookmark-jump-internal.
+ (bookmark-make-cell-for-text-file): Renamed from bookmark-make-cell.
+
+ * doc-view.el (doc-view-bookmark-make-cell)
+ (doc-view-bookmark-jump): New functions.
+ (doc-view-mode): Set bookmark-make-cell-function buffer-locally.
+
+2007-12-25 Miles Bader <miles@gnu.org>
+
+ * indent.el (indent-for-tab-command): Rigidly indent the following
+ sexp along with the current line when a prefix arg is given in the
+ non-active-region case. Specify raw prefix in interactive spec.
+ Simplify main indentation logic to get rid of the conditional call
+ to `indent-according-to-mode' (it just ended up calling
+ `indent-line-function' in all cases anyway, which can be done more
+ simply here). Remove unnecessary test of ARG in active region case.
+
+2007-12-25 Richard Stallman <rms@gnu.org>
+
+ * allout.el (allout-region-active-p): Rename from my-region-active-p.
+ Use `use-region-p'.
+ (allout-write-file-hook-handler): Simplify code.
+
+ * ps-print.el (ps-mark-active-p): Function deleted.
+ (ps-print-preprint-region): Use (mark) for the error check.
+
+ * tooltip.el (tooltip-region-active-p): Use `use-region-p'.
+
+ * winner.el (winner-active-region): Use `mark-active' if it's defined.
+
+ * progmodes/ada-mode.el (ada-region-selected): Use `use-region-p'.
+
+ * textmodes/org.el (org-region-active-p): Use `use-region-p'.
+
+ * progmodes/idlwave.el (idlwave-region-active-p): Use `use-region-p'.
+
+ * textmodes/reftex.el (reftex-region-active-p): Use `use-region-p'.
+
+ * progmodes/cc-defs.el (c-region-is-active-p):
+ Use `mark-active' if it's defined.
+
+ * progmodes/cc-cmds.el (c-indent-line-or-region):
+ Pass prefix arg to `c-indent-command'. Use `use-region-p'.
+
+ * simple.el (select-active-regions): New option.
+ (set-mark): Obey it.
+ (yank-pop-change-selection): New option.
+ (current-kill): Obey it.
+
+ * simple.el (use-region-p): Renamed from `region-active-p'.
+ (region-active-p): New function.
+
+2007-12-25 David Golden <david.delaharpe.golden@gmail.com> (tiny change)
+
+ * term/x-win.el (x-select-enable-primary): New option.
+ (x-select-text, x-cut-buffer-or-selection-value): Obey it.
+
+ * mouse.el (mouse-yank-primary): New function (almost same
+ as mouse-yank-secondary).
+
+2007-12-25 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * calculator.el:
+ * dframe.el:
+ * iswitchb.el:
+ * whitespace.el:
+ * winner.el:
+ * emacs-lisp/checkdoc.el:
+ * mail/feedmail.el:
+ * net/quickurl.el:
+ * obsolete/fast-lock.el:
+ * play/5x5.el:
+ * progmodes/delphi.el:
+ * progmodes/idlw-shell.el:
+ * progmodes/idlwave.el:
+ * textmodes/artist.el:
+ * textmodes/ispell.el:
+ * textmodes/texinfmt.el:
+ * textmodes/texinfo.el: Remove obsolete definitions of backward
+ compatibility macros for defcustom, defgroup, defface, when,
+ unless, with-current-buffer and with-temp-message.
+
+2007-12-24 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/verilog-mode.el: Reformat parts to 80 columns.
+
+2007-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * server.el (server-save-buffers-kill-terminal): Check the `proc' is
+ indeed a process.
+
+2007-12-23 Richard Stallman <rms@gnu.org>
+
+ * simple.el (region-active-p): New function.
+ (use-empty-active-region): New variable.
+
+ * dired-aux.el (dired): Load dired.el at run time too.
+
+2007-12-23 Juri Linkov <juri@jurta.org>
+
+ * man.el (Man-follow-manual-reference): Fill the minibuffer's
+ default list with a full list of references.
+
+ * files.el (auto-mode-alist): Add \\' to doc-view files regexp.
+
+2007-12-23 Andreas Schwab <schwab@suse.de>
+
+ * files.el (switch-to-buffer-other-frame): Return the buffer
+ switched to.
+
+2007-12-23 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.1.12.
+
+ * net/tramp.el: New todo item.
+
+ * net/tramp-smb.el (tramp-smb-handle-insert-directory): Handle "-F"
+ switch. Reported by Mark T. Kennedy <mkennedy@diamondbackcap.com>.
+
+ * net/trampver.el: Update release number.
+
+2007-12-22 Richard Stallman <rms@gnu.org>
+
+ * newcomment.el (comment-region-default): Don't triple the
+ comment starter if the first region line isn't indented enough.
+
+2007-12-21 Martin Rudalics <rudalics@gmx.at>
+
+ * autoinsert.el (auto-insert-alist): Remove nonsensical precision
+ specifier from format-string. Reported by Ye Wenbin.
+
+2007-12-20 Jason Rumney <jasonr@gnu.org>
+
+ * nxml/nxml-mode.el (nxml-faces): Rename from nxml-highlighting-faces.
+ Parent group is font-lock-faces.
+ (nxml-light-blue-color, nxml-dark-blue-color, nxml-green-color)
+ (nxml-sky-blue-color, nxml-dark-green-color, nxml-light-green-color):
+ (nxml-version): Remove.
+ (nxml-delimited-data, nxml-name, nxml-ref, nxml-delimiter)
+ (nxml-text, nxml-comment-content, nxml-comment-delimiter)
+ (nxml-processing-instruction-delimiter)
+ (nxml-processing-instruction-target)
+ (nxml-processing-instruction-content, nxml-cdata-section-delimiter)
+ (nxml-cdata-section-CDATA, nxml-cdata-section-content)
+ (nxml-char-ref-number, nxml-char-ref-delimiter, nxml-entity-ref-name)
+ (nxml-entity-ref-delimiter, nxml-tag-delimiter, nxml-tag-slash)
+ (nxml-element-prefix, nxml-element-colon, nxml-element-local-name)
+ (nxml-attribute-prefix, nxml-attribute-colon)
+ (nxml-attribute-local-name, nxml-namespace-attribute-xmlns)
+ (nxml-namespace-attribute-colon, nxml-namespace-attribute-prefix)
+ (nxml-attribute-value, nxml-attribute-value-delimiter)
+ (nxml-namespace-attibute-value)
+ (nxml-namespace-attribure-value-delimiter)
+ (nxml-prolog-literal-delimiter, nxml-prolog-literal-content)
+ (nxml-prolog-keyword, nxml-markup-declaration-delimiter, nxml-hash)
+ (nxml-glyph): Rename, removing -face suffix.
+ Inherit from existing font-lock faces.
+ (nxml-apply-fontify-rule, nxml-char-ref-display-extra):
+ Use new face names.
+
+ * nxml/nxml-outln.el (nxml-heading, nxml-outline-indicator)
+ (nxml-outline-active-indicator, nxml-outline-ellipsis):
+ Rename, removing -face suffix.
+ (nxml-highlighted-less-than, nxml-highlighted-greater-than)
+ (nxml-highlighted-colon, nxml-highlighted-slash)
+ (nxml-highlighted-ellipsis, nxml-highlighted-inactive-minus)
+ (nxml-highlighted-active-minus, nxml-highlighted-active-plus)
+ (nxml-highlighted-qname, nxml-outline-display-heading):
+ Use new face names.
+
+ * nxml/rng-valid.el (rng-error): Rename from rng-error-face.
+
+ * nxml/rng-nxml.el (rng-nxml-easy-menu): Remove nxml-version.
+
+2007-12-19 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-start.el (all): Use correct group name for members of
+ mode-line group.
+
+ * man.el (Man-default-man-entry): When looking for default man
+ entry title search text preceding point. Use when instead of if.
+
+ * indent.el (indent-for-tab-command): Fix doc-string typo.
+
+ * vc.el (vc-ensure-vc-buffer): Avoid infinite looping when
+ vc-parent-buffer is the current buffer.
+
+ * info-look.el (info-lookup, info-lookup-setup-mode)
+ (info-lookup-make-completions): Avoid clobbering Info-history and
+ Info-history-list.
+
+2007-12-19 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/verilog-mode.el (top-level): Don't require compile.
+ (compilation-error-regexp-alist, compilation-last-buffer):
+ Define for compiler.
+ (verilog-insert-1): New function.
+ (verilog-insert-indices, verilog-generate-numbers): Doc fixes.
+ Use verilog-insert-1.
+ (verilog-surelint-off): Use next-error-last-buffer if bound.
+ Check compile buffer is live.
+
+2007-12-19 John J Foerch <jjfoerch@earthlink.net> (tiny change)
+
+ * progmodes/compile.el (compilation-start): Don't pass a FRAME
+ argument to display-buffer.
+
+2007-12-19 Jason Rumney <jasonr@gnu.org>
+
+ * nxml/rng-maint.el (rng-format-manual): Do not autoload.
+ (rng-autoload-modules, rng-update-autoloads, rng-compile-modules)
+ (rng-byte-compile-load, rng-write-version): Remove.
+
+ * nxml/rng-loc.el (rng-schema-locating-files-default)
+ (rng-schema-locating-file-schema-file): Use files in etc/schemas.
+ (rng-schema-loader-alist): Use rng-c-load-schema to load rnc files.
+
+2007-12-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (cd-absolute): Set `list-buffers-directory' in order to
+ show correct path in buffer list.
+
+ * net/tramp.el (tramp-open-connection-setup-interactive-shell)
+ (tramp-find-shell): Send only single prompt setting commands, in
+ order to avoid double-prompt.
+
+ * net/tramp-compat.el (top): Require cl only when compiling.
+ Reported by Glenn Morris <rgm@gnu.org>.
+
+2007-12-18 Thien-Thi Nguyen <ttn@gnuvola.org>
+
+ * progmodes/cc-vars.el (defcustom-c-stylevar): Eval VAL.
+ (c-comment-continuation-stars): No longer declare with
+ cc-bytecomp-obsolete-var and cc-bytecomp-defvar.
+ (c-block-comment-prefix): Use symbol-value to
+ access c-comment-continuation-stars.
+ * progmodes/cc-mode.el (c-initialize-cc-mode):
+ Use symbol-value to access c-comment-continuation-stars.
+
+2007-12-18 Mark A. Hershberger <mah@everybody.org>
+
+ * xml.el (xml-escape-string): New function. Escape string using
+ xml-entity-alist.
+ (xml-debug-print-internal): Use xml-escape-string to escape
+ characters in attributes and in text children of elements.
+
+2007-12-18 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/cc-subword.el (c-subword-mode): Drop support for
+ systems without define-minor-mode.
+
+ * progmodes/cc-vars.el (defcustom-c-stylevar): Remove debugging message.
+
+ * progmodes/verilog-mode.el: Replace all instances of
+ string-to-int with string-to-number, insert-string with insert,
+ and read-input with read-string.
+ (top-level): No need to require imenu, reporter, dinotrace, vc,
+ font-lock when compiling. Always require compile. Relegate remaining
+ compatibility cruft to XEmacs. Don't require font-lock.
+ (verilog-version): Remove superfluous concat.
+ (dinotrace-unannotate-all, zmacs-activate-region)
+ (customize-apropos): No need to define.
+ (verilog-regexp-opt): On Emacs, just make it an alias for regexp-opt.
+ (verilog-font-lock-keywords, verilog-font-lock-keywords-1)
+ (verilog-font-lock-keywords-2, verilog-font-lock-keywords-3)
+ (verilog-startup-message-displayed): These are variables, not constants.
+ (verilog-batch-execute-func, verilog-auto-inst)
+ (verilog-auto-inst-param): Use mapc rather than mapcar.
+ (sigs-in, sigs-inout, sigs-out): Define for compiler rather than
+ actually defining.
+ (verilog-modi-get-decls, verilog-modi-get-sub-decls)
+ (verilog-modi-get-outputs, verilog-modi-get-inouts)
+ (verilog-modi-get-inputs, verilog-modi-get-wires)
+ (verilog-modi-get-regs, verilog-modi-get-assigns)
+ (verilog-modi-get-consts, verilog-modi-get-gparams)
+ (verilog-modi-get-sub-outputs, verilog-modi-get-sub-inouts)
+ (verilog-modi-get-sub-inputs): Move inline functions earlier in
+ the file.
+ (sigs-in, sigs-out): Don't declare multiple times.
+ (got-sig, got-rvalue, uses-delayed): Define for compiler with just
+ `defvar'.
+ (verilog-auto): Call dinotrace-unannotate-all only if bound.
+ (verilog-module-inside-filename-p): No need to wrap fboundp test
+ in condition-case.
+ (reporter-submit-bug-report): Autoload it.
+ (verilog-mark-defun): Call zmacs-activate-region only if bound.
+ (verilog-font-customize): Call customize-apropos only if bound.
+ (verilog-getopt-flags, verilog-auto-reeval-locals): Use
+ make-local-variable rather than make-variable-buffer-local.
+ (verilog-company, verilog-project, verilog-modi-cache-list):
+ Move make-variable-buffer-local calls to top-level.
+ (font-lock-defaults-alist): Don't define it.
+ (verilog-need-fld): Remove.
+ (verilog-font-lock-init): Don't set font-lock-defaults-alist.
+ (verilog-mode): Only call make-local-hook on XEmacs. Set
+ font-lock-defaults rather than using verilog-font-lock-init.
+
+2007-12-17 Andreas Schwab <schwab@suse.de>
+
+ * progmodes/sh-script.el (sh-font-lock-syntactic-keywords):
+ Fix comment typo.
+
+2007-12-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-name-owner-changed-handler):
+ Use `dbus-unregister-signal' for removing old rules.
+ Obey new structure of `dbus-registered-functions-table'.
+
2007-12-12 Thien-Thi Nguyen <ttn@gnuvola.org>
* progmodes/cc-vars.el (defcustom-c-stylevar): Rewrite.
* progmodes/cperl-mode.el (cperl-brace-offset)
(cperl-continued-brace-offset, cperl-label-offset)
(cperl-continued-statement-offset)
- (cperl-extra-newline-before-brace, cperl-merge-trailing-else): Add
- safe-local-variable properties.
+ (cperl-extra-newline-before-brace, cperl-merge-trailing-else):
+ Add safe-local-variable properties.
2007-12-08 Dan Nicolaescu <dann@ics.uci.edu>
(verilog-end-of-statement, verilog-indent-declaration)
(verilog-get-lineup-indent): Remove trailing whitespace.
(verilog-mode): Fix autoload cookie. Set
- beginning-of-defun-function and end-of-defun-function. Use when
+ beginning-of-defun-function and end-of-defun-function. Use when
instead of if.
(verilog-emacs-features, verilog-auto-ascii-enum)
(verilog-insert-indices): Escape braces in doc strings.
(math-comp-comma, math-comp-vector-prec): Declare as variables.
(math-var-formatter, math-matrix-formatter)
(math-lang-adjust-words, math-lang-read-symbol, math-land-read)
- (math-punc-table, math-compose-subscr,math-dots)
+ (math-punc-table, math-compose-subscr, math-dots)
(math-func-formatter): New property names to store language
specific information.
(math-compose-tex-var, math-compose-tex-intv)
(math-compose-maple-intv, math-compose-eqn-intv)
(math-compose-tex-sum, math-compose-tex-func)
(math-compose-tex-intv): New functions.
- (math-eqn-ignore-words,math-tex-ignore-words)
+ (math-eqn-ignore-words, math-tex-ignore-words)
(math-latex-ignore-words): Move from calc.el.
(math-special-function-table): Add entries for tex.
(calc-lang-slash-idiv, calc-lang-allows-underscores):
Replace `mapcar*' by `math-map-binop'.
(math-nlfit-make-matrix): Replace `copy-list' with `copy-sequence'.
- * calc/calc-prog.el (edmacro-format-keys,edmacro-parse-keys)
+ * calc/calc-prog.el (edmacro-format-keys, edmacro-parse-keys)
(math-read-expr-level): Declare as functions.
* calc/calc-vec.el (math-read-expr-level): Declare as a function.
(condition-case failure
(setq allout-after-save-decrypt
(allout-encrypt-decrypted except-mark))
- (error (progn
- (message
- "allout-write-file-hook-handler suppressing error %s"
- failure)
- (sit-for 2))))))
+ (message "allout-write-file-hook-handler suppressing error %s"
+ failure)
+ (sit-for 2)
+ (error "allout-write-file-hook-handler suppressing error %s"
+ failure))))
))
nil)
;;;_ > allout-auto-save-hook-handler ()
(cdr format)))))))
;; Put the list with first at front, to last at back:
(nreverse result))))
-;;;_ > my-region-active-p ()
-(defmacro my-region-active-p ()
- (if (fboundp 'region-active-p)
- '(region-active-p)
- 'mark-active))
+;;;_ > allout-region-active-p ()
+(defmacro allout-region-active-p ()
+ (if (fboundp 'use-region-p)
+ '(use-region-p)
+ '(region-active-p)))
;;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
(defun allout-process-exposed (&optional func from to frombuf tobuf
; defaulting if necessary:
(if (not func) (setq func 'allout-insert-listified))
(if (not (and from to))
- (if (my-region-active-p)
+ (if (allout-region-active-p)
(setq from (region-beginning) to (region-end))
(setq from (point-min) to (point-max))))
(if frombuf
;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
'(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
finder-known-keywords)
- v2 (mapconcat (lambda (x) (format "%10.0s: %s" (car x) (cdr x)))
+ v2 (mapconcat (lambda (x) (format "%12s: %s" (car x) (cdr x)))
finder-known-keywords
"\n"))
((let ((minibuffer-help-form v2))
(message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
(sit-for 4))
+(defun bookmark-get-handler (bookmark)
+ (cdr (assq 'handler (bookmark-get-bookmark-record bookmark))))
(defvar bookmark-history nil
"The history list for bookmark functions.")
(interactive-p)
(setq bookmark-history (cons ,string bookmark-history))))
+(defvar bookmark-make-cell-function 'bookmark-make-cell-for-text-file
+ "A function that should be called to create the bookmark
+record. Modes may set this variable buffer-locally to enable
+bookmarking of non-text files like images or pdf documents.
+
+The function will be called with two arguments: ANNOTATION and
+INFO-NODE. See `bookmark-make-cell-for-text-file' for a
+description.
+
+The returned record may contain a special cons (handler
+. some-function) which sets the handler function that should be
+used to open this bookmark instead of `bookmark-jump-noselect'.
+It should return a cons (BUFFER . POINT) indicating buffer
+showing the bookmarked location and the value of point in that
+buffer. Like `bookmark-jump-noselect' the buffer shouldn't be
+selected by the handler.")
(defun bookmark-make (name &optional annotation overwrite info-node)
"Make a bookmark named NAME.
;; already existing bookmark under that name and
;; no prefix arg means just overwrite old bookmark
(setcdr (bookmark-get-bookmark stripped-name)
- (list (bookmark-make-cell annotation info-node)))
+ (list (funcall bookmark-make-cell-function annotation info-node)))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either
(setq bookmark-alist
(cons
(list stripped-name
- (bookmark-make-cell annotation info-node))
+ (funcall bookmark-make-cell-function annotation info-node))
bookmark-alist)))
;; Added by db
(bookmark-save))))
-(defun bookmark-make-cell (annotation &optional info-node)
+(defun bookmark-make-cell-for-text-file (annotation &optional info-node)
"Return the record part of a new bookmark, given ANNOTATION.
Must be at the correct position in the buffer in which the bookmark is
being set. This might change someday.
(defun bookmark-info-current-node ()
- "If in Info-mode, return current node name (a string), else nil."
+ "If in `Info-mode', return current node name (a string), else nil."
(if (eq major-mode 'Info-mode)
Info-current-node))
When you have finished composing, type \\[bookmark-send-annotation] to send
the annotation.
-\\{bookmark-read-annotation-mode-map}
-"
+\\{bookmark-read-annotation-mode-map}"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-paragraph)
"Mode for editing the annotation of bookmark BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation].
-\\{bookmark-edit-annotation-mode-map}
-"
+\\{bookmark-edit-annotation-mode-map}"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-name)
(unless bookmark
(error "No bookmark specified"))
(bookmark-maybe-historicize-string bookmark)
- (let ((cell (bookmark-jump-noselect bookmark)))
+ (let ((cell (bookmark-jump-internal bookmark)))
(and cell
(switch-to-buffer (car cell))
(goto-char (cdr cell))
(list bkm) bkm)))
(when bookmark
(bookmark-maybe-historicize-string bookmark)
- (let ((cell (bookmark-jump-noselect bookmark)))
+ (let ((cell (bookmark-jump-internal bookmark)))
(and cell
(switch-to-buffer-other-window (car cell))
(goto-char (cdr cell))
;; Last possibility: try VC
(if (vc-backend file) file))))
+(defun bookmark-jump-internal (bookmark)
+ "Call BOOKMARK's handler or `bookmark-jump-noselect' if it has none."
+ (funcall (or (bookmark-get-handler bookmark)
+ 'bookmark-jump-noselect)
+ bookmark))
(defun bookmark-jump-noselect (str)
;; a leetle helper for bookmark-jump :-)
(bookmark-maybe-historicize-string bookmark)
(bookmark-maybe-load-default-file)
(let ((orig-point (point))
- (str-to-insert
- (save-excursion
- (set-buffer (car (bookmark-jump-noselect bookmark)))
- (buffer-string))))
+ (str-to-insert
+ (save-excursion
+ (set-buffer (car (bookmark-jump-internal bookmark)))
+ (buffer-string))))
(insert str-to-insert)
(push-mark)
(goto-char orig-point)))
(pop-up-windows t))
(delete-other-windows)
(switch-to-buffer (other-buffer))
- (let* ((pair (bookmark-jump-noselect bmrk))
+ (let* ((pair (bookmark-jump-internal bmrk))
(buff (car pair))
(pos (cdr pair)))
(pop-to-buffer buff)
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark)))
(if (bookmark-bmenu-check-position)
- (let* ((pair (bookmark-jump-noselect bookmark))
+ (let* ((pair (bookmark-jump-internal bookmark))
(buff (car pair))
(pos (cdr pair)))
(switch-to-buffer-other-window buff)
same-window-buffer-names
same-window-regexps)
(if (bookmark-bmenu-check-position)
- (let* ((pair (bookmark-jump-noselect bookmark))
+ (let* ((pair (bookmark-jump-internal bookmark))
(buff (car pair))
(pos (cdr pair)))
(display-buffer buff)
(declare-function math-read-string "calc-ext" ())
(declare-function math-read-brackets "calc-vec" (space-sep math-rb-close))
(declare-function math-read-angle-brackets "calc-forms" ())
-
+(declare-function math-to-percentsigns "calccomp" (x))
(defvar calc-quick-calc-history nil
"The history list for quick-calc.")
(math-exp-keep-spaces nil)
math-exp-token math-expr-data)
(setq math-exp-str (math-read-preprocess-string math-exp-str))
+ (if (memq calc-language calc-lang-allow-percentsigns)
+ (setq math-exp-str (math-remove-percentsigns math-exp-str)))
(if calc-language-input-filter
(setq math-exp-str (funcall calc-language-input-filter math-exp-str)))
- (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
- (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
+ (while (setq math-exp-token
+ (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
+ (setq math-exp-str
+ (concat (substring math-exp-str 0 math-exp-token) "\\dots"
(substring math-exp-str (+ math-exp-token 2)))))
(math-build-parse-table)
(math-read-token)
(math-read-token)))
((and (memq ch calc-user-token-chars)
(let ((case-fold-search nil))
- (eq (string-match calc-user-tokens math-exp-str math-exp-pos)
+ (eq (string-match
+ calc-user-tokens math-exp-str math-exp-pos)
math-exp-pos)))
(setq math-exp-token 'punc
math-expr-data (math-match-substring math-exp-str 0)
math-exp-pos (match-end 0)))
((or (and (>= ch ?a) (<= ch ?z))
(and (>= ch ?A) (<= ch ?Z)))
- (string-match (if (memq calc-language calc-lang-allow-underscores)
- "[a-zA-Z0-9_#]*"
- "[a-zA-Z0-9'#]*")
- math-exp-str math-exp-pos)
+ (string-match
+ (cond
+ ((and (memq calc-language calc-lang-allow-underscores)
+ (memq calc-language calc-lang-allow-percentsigns))
+ "[a-zA-Z0-9_'#]*")
+ ((memq calc-language calc-lang-allow-underscores)
+ "[a-zA-Z0-9_#]*")
+ (t "[a-zA-Z0-9'#]*"))
+ math-exp-str math-exp-pos)
(setq math-exp-token 'symbol
math-exp-pos (match-end 0)
math-expr-data (math-restore-dashes
(concat (math-match-substring x 1) "#" (math-match-substring x 2)))
x))
+(defun math-remove-percentsigns (x)
+ (if (string-match "\\`\\(.*\\)%\\(.*\\)\\'" x)
+ (math-remove-percentsigns
+ (concat (math-match-substring x 1) "o'o" (math-match-substring x 2)))
+ x))
+
(defun math-restore-dashes (x)
(if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
(math-restore-dashes
(concat (math-match-substring x 1) "-" (math-match-substring x 2)))
x))
-(defun math-restore-underscores (x)
- "Replace pound signs by underscores in the symbol x.
-If the current Calc language does not allow underscores, return nil."
- (if (memq calc-language calc-lang-allow-underscores)
- (intern-soft (math-string-restore-underscores (symbol-name x)))))
+(defun math-restore-placeholders (x)
+ "Replace placeholders by the proper characters in the symbol x.
+This includes `#' for `_' and `'' for `%'.
+If the current Calc language does not use placeholders, return nil."
+ (if (or (memq calc-language calc-lang-allow-underscores)
+ (memq calc-language calc-lang-allow-percentsigns))
+ (let ((sx (symbol-name x)))
+ (when (memq calc-language calc-lang-allow-percentsigns)
+ (require 'calccomp)
+ (setq sx (math-to-percentsigns sx)))
+ (if (memq calc-language calc-lang-allow-underscores)
+ (setq sx (math-string-restore-underscores sx)))
+ (intern-soft sx))))
(defun math-string-restore-underscores (x)
"Replace pound signs by underscores in the string x."
(symbol-name sym)))))))
(let ((v (or
(assq (nth 1 val) math-expr-variable-mapping)
- (assq (math-restore-underscores (nth 1 val))
+ (assq (math-restore-placeholders (nth 1 val))
math-expr-variable-mapping))))
(and v (setq val (if (consp (cdr v))
(funcall (car (cdr v)) v val)
;; Declare variables which are defined elsewhere.
(defvar calc-lang-slash-idiv)
(defvar calc-lang-allow-underscores)
+(defvar calc-lang-allow-percentsigns)
(defvar math-comp-left-bracket)
(defvar math-comp-right-bracket)
(defvar math-comp-comma)
"A list of languages in which / might represent integer division.")
(defvar calc-lang-allow-underscores nil
"A list of languages which allow underscores in variable names.")
+(defvar calc-lang-allow-percentsigns nil
+ "A list of languages which allow percent signs in variable names.")
(defvar calc-lang-c-type-hex nil
"Languages in which octal and hex numbers are written with leading 0 and 0x,")
(defvar calc-lang-brackets-are-subscripts nil
(defvar math-comp-comma)
(defun math-compose-var (a)
- (let (v)
+ (let (v sn)
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(if (eq math-compose-hash-args 1)
"#"
(format "#%d" v))
+ (setq sn (symbol-name (nth 1 a)))
+ (if (memq calc-language calc-lang-allow-percentsigns)
+ (setq sn (math-to-percentsigns sn)))
(if (memq calc-language calc-lang-allow-underscores)
- (math-to-underscores (symbol-name (nth 1 a)))
- (symbol-name (nth 1 a))))))
+ (setq sn (math-to-underscores sn)))
+ sn)))
(defun math-compose-expr (a prec)
(let ((math-compose-level (1+ math-compose-level))
(symbol-name func))
(math-match-substring (symbol-name func) 1)
(symbol-name func))))
+ (if (memq calc-language calc-lang-allow-percentsigns)
+ (setq func (math-to-percentsigns func)))
(if (memq calc-language calc-lang-allow-underscores)
(setq func (math-to-underscores func)))
(if (setq spfn (get calc-language 'math-func-formatter))
(concat (math-match-substring x 1) "_" (math-match-substring x 2)))
x))
+(defun math-to-percentsigns (x)
+ (if (string-match "\\`\\(.*\\)o'o\\(.*\\)\\'" x)
+ (math-to-underscores
+ (concat (math-match-substring x 1) "%" (math-match-substring x 2)))
+ x))
+
(defun math-tex-expr-is-flat (a)
(or (Math-integerp a)
(memq (car a) '(float var))
;; I hate history.
(eval-when-compile (require 'cl))
-(eval-and-compile
- (if (fboundp 'defgroup) nil
- (defmacro defgroup (&rest forms) nil)
- (defmacro defcustom (s v d &rest r) (list 'defvar s v d))))
;;;=====================================================================
;;; Customization:
;; plink prints a prompt like `Passphrase for key "root@GNU.ORG": '.
;; Ubuntu's sudo prompts like `[sudo] password for user:'
;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
+;; Something called "perforce" uses "Enter password:".
(defcustom comint-password-prompt-regexp
- "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
+ "\\(\\(Enter \\|[Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
Kerberos \\|CVS \\|UNIX \\| SMB \\|LDAP \\|\\[sudo] \\|^\\)\
\[Pp]assword\\( (again)\\)?\\|\
pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\
(define-key map "\e\C-l" 'comint-show-output)
(define-key map "\C-m" 'comint-send-input)
(define-key map "\C-d" 'comint-delchar-or-maybe-eof)
+ ;; The following two are standardly aliased to C-d,
+ ;; but they should never do EOF, just delete.
+ (define-key map [delete] 'delete-char)
+ (define-key map [kp-delete] 'delete-char)
(define-key map "\C-c " 'comint-accumulate)
(define-key map "\C-c\C-x" 'comint-get-next-from-history)
(define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
(gc-cons-threshold alloc integer)
(garbage-collection-messages alloc boolean)
;; buffer.c
- (mode-line-format modeline sexp) ;Hard to do right.
+ (mode-line-format mode-line sexp) ;Hard to do right.
(default-major-mode internal function)
(enable-multibyte-characters mule boolean)
(case-fold-search matching boolean)
(hscroll-margin windows integer "22.1")
(hscroll-step windows number "22.1")
(truncate-partial-width-windows display boolean)
- (mode-line-inverse-video modeline boolean)
- (mode-line-in-non-selected-windows modeline boolean "22.1")
+ (mode-line-inverse-video mode-line boolean)
+ (mode-line-in-non-selected-windows mode-line boolean "22.1")
(line-number-display-limit display
(choice integer
(const :tag "No limit" nil)))
(defvar x-pointer-top-left-arrow)
;;; Code:
-
-;; From custom web page for compatibility between versions of custom
-;; with help from ptype@dera.gov.uk (Proto Type)
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable)
- ;; Some XEmacsen w/ custom don't have :set keyword.
- ;; This protects them against custom.
- (fboundp 'custom-initialize-set))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (if (boundp 'defgroup)
- nil
- (defmacro defgroup (&rest args)
- nil))
- (if (boundp 'defface)
- nil
- (defmacro defface (var values doc &rest args)
- ;; To make colors for your faces you need to set your .Xdefaults
- ;; or set them up ahead of time in your .emacs file.
- `(make-face ,var)
- ))
- (if (boundp 'defcustom)
- nil
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc)))))
-
\f
;;; Compatibility functions
;;
;;; Code:
-;; We need macros in dired.el to compile properly.
-(eval-when-compile (require 'dired))
+;; We need macros in dired.el to compile properly,
+;; and we call subroutines in it too.
+(require 'dired)
(defvar dired-create-files-failures nil
"Variable where `dired-create-files' records failing file names.
(set (make-local-variable 'cursor-type) nil)
(use-local-map doc-view-mode-map)
(set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc)
+ (set (make-local-variable 'bookmark-make-cell-function)
+ 'doc-view-bookmark-make-cell)
(setq mode-name "DocView"
buffer-read-only t
major-mode 'doc-view-mode)
;; End:
;; arch-tag: 5d6e5c5e-095f-489e-b4e4-1ca90a7d79be
+;;;; Bookmark integration
+
+(defun doc-view-bookmark-make-cell (annotation &rest args)
+ (let ((the-record
+ `((filename . ,(buffer-file-name))
+ (page . ,doc-view-current-page)
+ (handler . doc-view-bookmark-jump))))
+
+ ;; Take no chances with text properties
+ (set-text-properties 0 (length annotation) nil annotation)
+
+ (when annotation
+ (nconc the-record (list (cons 'annotation annotation))))
+
+ ;; Finally, return the completed record.
+ the-record))
+
+;;;###autoload
+(defun doc-view-bookmark-jump (bmk)
+ (save-window-excursion
+ (let ((filename (bookmark-get-filename bmk))
+ (page (cdr (assq 'page (bookmark-get-bookmark-record bmk)))))
+ (find-file filename)
+ (when (not (eq major-mode 'doc-view-mode))
+ (doc-view-toggle-display))
+ (doc-view-goto-page page)
+ (cons (current-buffer) 1))))
+
;;; doc-view.el ends here
(defvar checkdoc-version "0.6.1"
"Release version of checkdoc you are currently running.")
-;; From custom web page for compatibility between versions of custom:
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro custom-add-option (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
(defvar compilation-error-regexp-alist)
(defvar compilation-mode-font-lock-keywords)
"Hook run after finding symbol definition.
See the functions `find-function' and `find-variable'."
+ :type 'hook
:group 'find-function
:version "20.3")
If the optional fourth argument NEW-FRAME is given,
copy the information from face OLD-FACE on frame FRAME
-to NEW-FACE on frame NEW-FRAME."
+to NEW-FACE on frame NEW-FRAME. In this case, FRAME may not be nil."
(let ((inhibit-quit t))
(if (null frame)
(progn
+ (when new-frame
+ (error "Copying face %s from all frames to one frame"
+ old-face))
+ (make-empty-face new-face)
(dolist (frame (frame-list))
(copy-face old-face new-face frame))
(copy-face old-face new-face t))
+ (make-empty-face new-face)
(internal-copy-lisp-face old-face new-face frame new-frame))
new-face))
:group 'view)
(defvar file-name-history nil
- "History list of file names entered in the minibuffer.")
+ "History list of file names entered in the minibuffer.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
\f
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
(error "%s is not a directory" dir)
(error "%s: no such directory" dir))
(if (file-executable-p dir)
- (setq default-directory dir)
+ (setq default-directory dir
+ list-buffers-directory dir)
(error "Cannot cd to %s: Permission denied" dir))))
(defun cd (dir)
"Switch to buffer BUFFER in another frame.
Optional second arg NORECORD non-nil means
do not put this buffer at the front of the list of recently selected ones.
+This function returns the buffer it switched to.
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive "BSwitch to buffer in other frame: ")
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps)
- (pop-to-buffer buffer t norecord)
- (raise-frame (window-frame (selected-window)))))
+ (prog1
+ (pop-to-buffer buffer t norecord)
+ (raise-frame (window-frame (selected-window))))))
(defun display-buffer-other-frame (buffer)
"Switch to buffer BUFFER in another frame.
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js\\'" . java-mode) ; javascript-mode would be better
- ("\\.x[bp]m\\'" . c-mode)
("\\.d?v\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
("\\.[eE]?[pP][sS]\\'" . ps-mode)
- ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)" . doc-view-mode)
+ ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("java.+\\.conf\\'" . conf-javaprop-mode)
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
- ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
+ ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; ChangeLog.old etc. Other change-log-mode entries are above;
based on the interpreters they specify to run,
and `magic-mode-alist', which determines modes based on file contents.")
+(defun conf-mode-maybe ()
+ "Select Conf mode or XML mode according to start of file."
+ (if (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (looking-at "<\\?xml \\|<!-- \\|<!DOCTYPE ")))
+ (xml-mode)
+ (conf-mode)))
+
(defvar interpreter-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (awk-mode
;; and pike-mode) are added through autoload directives in that
:group 'dired
:prefix "find-")
-(defcustom find-dired-find-program "find"
- "Program used to find files."
- :group 'dired
- :type 'file)
-
;; find's -ls corresponds to these switches.
;; Note -b, at least GNU find quotes spaces etc. in filenames
;;;###autoload
:type 'string
:group 'find-dired)
+;;;###autoload
+(defcustom find-name-arg
+ (if read-file-name-completion-ignore-case
+ "-iname"
+ "-name")
+ "*Argument used to specify file name pattern.
+If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that
+find also ignores case. Otherwise, -name is used."
+ :type 'string
+ :group 'find-dired
+ :version "22.2")
+
(defvar find-args nil
"Last arguments given to `find' by \\[find-dired].")
(erase-buffer)
(setq default-directory dir
find-args args ; save for next interactive call
- args (concat find-dired-find-program " . "
+ args (concat find-program " . "
(if (string= args "")
""
(concat
find . -name 'PATTERN' -ls"
(interactive
"DFind-name (directory): \nsFind-name (filename wildcard): ")
- (find-dired dir (concat "-name " (shell-quote-argument pattern))))
+ (find-dired dir (concat find-name-arg " " (shell-quote-argument pattern))))
;; This functionality suggested by
;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
;; by FIFOs and devices. I'm not sure what's best to do
;; about symlinks, so as far as I know this is not wrong.
(find-dired dir
- (concat "-type f -exec grep " find-grep-options " -e "
+ (concat "-type f -exec " grep-program " " find-grep-options " -e "
(shell-quote-argument regexp)
" "
(shell-quote-argument "{}")
;; If the region is visible, make it look good when spanning
;; multiple windows.
(if (or (and (boundp 'mark-active) (symbol-value 'mark-active))
+ ;; The following isn't used in Emacs,
+ ;; since `mark-active' is bound.
(and (fboundp 'region-active-p)
(funcall (symbol-function 'region-active-p))))
(follow-maximize-region
deactivate-mark
buffer-file-name
buffer-file-truename))
- (progn
- ,@body)
- (unless ,modified
- (restore-buffer-modified-p nil)))))
+ (unwind-protect
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil))))))
;;
;; Shut up the byte compiler.
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
+2007-12-28 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-send-mail-function): Increase custom version.
+
+ * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of
+ password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>.
+
+2007-12-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * imap.el (imap-authenticate): Use current-buffer instead of buffer,
+ for the cases where imap-authenticate is called with a nil buffer
+ parameter.
+
+2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-parts): Work for two or more
+ html parts correctly; support forwarded messages.
+ (gnus-article-browse-html-article): Remove work buffers.
+
+ * netrc.el: Bind encrypt-file-alist for Emacs 21 and XEmacs when
+ compiling.
+ (netrc-bound-and-true-p): New macro.
+ (netrc-parse): Use it instead of bound-and-true-p that is not available
+ in XEmacs 21.4.
+
+2007-12-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-mark-article)
+ (gnus-registry-article-marks): Add functionality to mark articles
+ through the Gnus registry.
+
+ * netrc.el: Autoload encrypt when encrypt-file-alist is set.
+ (netrc-parse): Use encrypt-file-alist to determine if
+ encrypt-find-model or encrypt-insert-file-contents should be used.
+
+2007-12-19 Glenn Morris <rgm@gnu.org>
+
+ * mml.el (message-options-set, message-narrow-to-head)
+ (message-in-body-p, message-mail-p, message-encode-message-body):
+ Autoload.
+ (message-remove-header, message-narrow-to-headers-or-head)
+ (message-subscribed-p, message-make-mail-followup-to)
+ (message-position-on-field, message-news-p)
+ (message-options-set-recipient, message-generate-headers)
+ (message-sort-headers): Declare as functions.
+
+2007-12-18 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-draft.el (gnus-draft-send-message): Mention process/prefix
+ convention in doc string.
+
+2007-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-parts): Add message header and
+ title to html parts.
+ (gnus-article-browse-html-article): Pass message header to it.
+
+ * mm-decode.el (mm-display-external): Use mm-add-meta-html-tag.
+
+2007-12-16 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mml-sec.el, sieve-manage.el, smime.el: Make loading of password-cache
+ or password compatible with XEmacs.
+
2007-12-15 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-art.el (article-verify-x-pgp-sig): Add reference to X-PGP-Sig
* message.el (message-ignored-supersedes-headers): Add "X-ID".
+2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
+
+ * imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
+ (imap-parse-status): Upcase status-att for servers that sends them
+ lower-case (e.g., MS Exchange 2007).
+
2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc
(setq gnus-article-browse-html-temp-list nil))
gnus-article-browse-html-temp-list)
-(defun gnus-article-browse-html-parts (list)
+(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
-Recurse into multiparts."
+Recurse into multiparts. The optional HEADER that should be a decoded
+message header will be added to the bodies of the \"text/html\" parts."
;; Internal function used by `gnus-article-browse-html-article'.
(let (type file charset tmp-file showed)
;; Find and show the html-parts.
(cond ((not (listp handle)))
((or (equal (car (setq type (mm-handle-type handle))) "text/html")
(and (equal (car type) "message/external-body")
- (setq file (or (mail-content-type-get type 'name)
- (mail-content-type-get
- (mm-handle-disposition handle)
- 'filename)))
+ (or header
+ (setq file (or (mail-content-type-get type 'name)
+ (mail-content-type-get
+ (mm-handle-disposition handle)
+ 'filename))))
(or (mm-handle-cache handle)
(condition-case code
(progn (mm-extern-cache-contents handle) t)
type (mm-handle-type handle))
(equal (car type) "text/html"))))
(when (or (setq charset (mail-content-type-get type 'charset))
+ header
(not file))
(setq tmp-file (mm-make-temp-file
;; Do we need to care for 8.3 filenames?
"mm-" nil ".html")))
- (if charset
- ;; Add a meta html tag to specify charset.
- (mm-with-unibyte-buffer
- (insert (if (eq charset 'gnus-decoded)
- (mm-encode-coding-string (mm-get-part handle)
- (setq charset 'utf-8))
- (mm-get-part handle)))
- (if (or (mm-add-meta-html-tag handle charset)
- (not file))
- (mm-write-region (point-min) (point-max)
- tmp-file nil nil nil 'binary t)
- (setq tmp-file nil)))
- (when tmp-file
- (mm-save-part-to-file handle tmp-file)))
+ ;; Add a meta html tag to specify charset and a header.
+ (cond
+ (header
+ (let (title eheader body hcharset coding)
+ (with-temp-buffer
+ (mm-enable-multibyte)
+ (setq case-fold-search t)
+ (insert header "\n")
+ (setq title (message-fetch-field "subject"))
+ (goto-char (point-min))
+ (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t)
+ (replace-match (cond ((match-beginning 1) "<")
+ ((match-beginning 2) ">")
+ (t "&"))))
+ (goto-char (point-min))
+ (insert "<pre>\n")
+ (goto-char (point-max))
+ (insert "</pre>\n<hr>\n")
+ ;; We have to examine charset one by one since
+ ;; charset specified in parts might be different.
+ (if (eq charset 'gnus-decoded)
+ (setq charset 'utf-8
+ eheader (mm-encode-coding-string (buffer-string)
+ charset)
+ title (when title
+ (mm-encode-coding-string title charset))
+ body (mm-encode-coding-string (mm-get-part handle)
+ charset))
+ (setq hcharset (mm-find-mime-charset-region (point-min)
+ (point-max)))
+ (cond ((= (length hcharset) 1)
+ (setq hcharset (car hcharset)
+ coding (mm-charset-to-coding-system
+ hcharset)))
+ ((> (length hcharset) 1)
+ (setq hcharset 'utf-8
+ coding hcharset)))
+ (if coding
+ (if charset
+ (progn
+ (setq body
+ (mm-charset-to-coding-system charset))
+ (if (eq coding body)
+ (setq eheader (mm-encode-coding-string
+ (buffer-string) coding)
+ title (when title
+ (mm-encode-coding-string
+ title coding))
+ body (mm-get-part handle))
+ (setq charset 'utf-8
+ eheader (mm-encode-coding-string
+ (buffer-string) charset)
+ title (when title
+ (mm-encode-coding-string
+ title charset))
+ body (mm-encode-coding-string
+ (mm-decode-coding-string
+ (mm-get-part handle) body)
+ charset))))
+ (setq charset hcharset
+ eheader (mm-encode-coding-string
+ (buffer-string) coding)
+ title (when title
+ (mm-encode-coding-string
+ title coding))
+ body (mm-get-part handle)))
+ (setq eheader (mm-string-as-unibyte (buffer-string))
+ body (mm-get-part handle))))
+ (erase-buffer)
+ (mm-disable-multibyte)
+ (insert body)
+ (when charset
+ (mm-add-meta-html-tag handle charset))
+ (when title
+ (goto-char (point-min))
+ (unless (search-forward "<title>" nil t)
+ (re-search-forward "<head>\\s-*" nil t)
+ (insert "<title>" title "</title>\n")))
+ (goto-char (point-min))
+ (or (re-search-forward
+ "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
+ (re-search-forward
+ "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
+ (insert eheader)
+ (mm-write-region (point-min) (point-max)
+ tmp-file nil nil nil 'binary t))))
+ (charset
+ (mm-with-unibyte-buffer
+ (insert (if (eq charset 'gnus-decoded)
+ (mm-encode-coding-string
+ (mm-get-part handle)
+ (setq charset 'utf-8))
+ (mm-get-part handle)))
+ (if (or (mm-add-meta-html-tag handle charset)
+ (not file))
+ (mm-write-region (point-min) (point-max)
+ tmp-file nil nil nil 'binary t)
+ (setq tmp-file nil))))
+ (tmp-file
+ (mm-save-part-to-file handle tmp-file)))
(when tmp-file
(add-to-list 'gnus-article-browse-html-temp-list tmp-file))
(add-hook 'gnus-summary-prepare-exit-hook
(browse-url-of-file (or tmp-file (expand-file-name file)))
(setq showed t))
;; If multipart, recurse
- ((and (stringp (car handle))
- (string-match "^multipart/" (car handle))
- (setq showed
- (or showed
- (gnus-article-browse-html-parts handle)))))))
+ ((equal (mm-handle-media-supertype handle) "multipart")
+ (when (gnus-article-browse-html-parts handle header)
+ (setq showed t)))
+ ((equal (mm-handle-media-type handle) "message/rfc822")
+ (mm-with-multibyte-buffer
+ (mm-insert-part handle)
+ (setq handle (mm-dissect-buffer t t))
+ (when (and (bufferp (car handle))
+ (stringp (car (mm-handle-type handle))))
+ (setq handle (list handle)))
+ (when header
+ (article-decode-encoded-words)
+ (let ((gnus-visible-headers
+ (or (get 'gnus-visible-headers 'standard-value)
+ gnus-visible-headers)))
+ (article-hide-headers))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (skip-chars-backward "\t\n ")
+ (setq header (buffer-substring (point-min) (point)))))
+ (when (prog1
+ (gnus-article-browse-html-parts handle header)
+ (mm-destroy-parts handle))
+ (setq showed t)))))
showed))
;; FIXME: Documentation in texi/gnus.texi missing.
-(defun gnus-article-browse-html-article ()
+(defun gnus-article-browse-html-article (&optional arg)
"View \"text/html\" parts of the current article with a WWW browser.
+The message header is added to the beginning of every html part unless
+the prefix argument ARG is given.
Warning: Spammers use links to images in HTML articles to verify
whether you have read the message. As
If you alwasy want to display HTML part in the browser, set
`mm-text-html-renderer' to nil."
;; Cf. `mm-w3m-safe-url-regexp'
- (interactive)
- (save-window-excursion
- ;; Open raw article and select the buffer
- (gnus-summary-show-article t)
- (gnus-summary-select-article-buffer)
- (let ((parts (mm-dissect-buffer t t)))
+ (interactive "P")
+ (if arg
+ (gnus-summary-show-article)
+ (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
+ gnus-visible-headers)))
+ (gnus-summary-show-article)))
+ (with-current-buffer gnus-article-buffer
+ (let ((header (unless arg
+ (save-restriction
+ (widen)
+ (buffer-substring-no-properties
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (match-beginning 0)
+ (goto-char (point-max))
+ (skip-chars-backward "\t\n ")
+ (point))))))
+ parts)
+ (set-buffer gnus-original-article-buffer)
+ (setq parts (mm-dissect-buffer t t))
;; If singlepart, enforce a list.
(when (and (bufferp (car parts))
(stringp (car (mm-handle-type parts))))
(setq parts (list parts)))
;; Process the list
- (unless (gnus-article-browse-html-parts parts)
+ (unless (gnus-article-browse-html-parts parts header)
(gnus-error 3 "Mail doesn't contain a \"text/html\" part!"))
- (gnus-summary-show-article))))
+ (mm-destroy-parts parts)
+ (unless arg
+ (gnus-summary-show-article)))))
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
message-send-actions)))
(defun gnus-draft-send-message (&optional n)
- "Send the current draft."
+ "Send the current draft(s).
+Obeys the standard process/prefix convention."
(interactive "P")
(let* ((articles (gnus-summary-work-articles n))
(total (length articles))
(string-match word x))
list)))))
+(defun gnus-registry-mark-article (article &optional mark remove)
+ "Mark ARTICLE with MARK in the Gnus registry or remove MARK.
+MARK can be any symbol. If ARTICLE is nil, then the
+`gnus-current-article' will be marked. If MARK is nil,
+`gnus-registry-flag-default' will be used."
+ (interactive "nArticle number: ")
+ (let ((article (or article gnus-current-article))
+ (mark (or mark 'gnus-registry-flag-default))
+ article-id)
+ (unless article
+ (error "No article on current line"))
+ (setq article-id
+ (gnus-registry-fetch-message-id-fast gnus-current-article))
+ (unless article-id
+ (error "No article ID could be retrieved"))
+ (let* (
+ ;; all the marks for this article
+ (marks (gnus-registry-fetch-extra-flags article-id))
+ ;; the marks without the mark of interest
+ (cleaned-marks (delq mark marks))
+ ;; the new marks we want to use
+ (new-marks (if remove
+ cleaned-marks
+ (cons mark cleaned-marks))))
+ (apply 'gnus-registry-store-extra-flags ; set the extra flags
+ article-id ; for the message ID
+ new-marks)
+ (gnus-registry-fetch-extra-flags article-id))))
+
+(defun gnus-registry-article-marks (article)
+ "Get the Gnus registry marks for ARTICLE.
+If ARTICLE is nil, then the `gnus-current-article' will be
+used."
+ (interactive "nArticle number: ")
+ (let ((article (or article gnus-current-article))
+ article-id)
+ (unless article
+ (error "No article on current line"))
+ (setq article-id
+ (gnus-registry-fetch-message-id-fast gnus-current-article))
+ (unless article-id
+ (error "No article ID could be retrieved"))
+ (gnus-message 1
+ "Message ID %s, Registry flags: %s"
+ article-id
+ (concat (gnus-registry-fetch-extra-flags article-id)))))
+
+
;;; if this extends to more than 'flags, it should be improved to be more generic.
(defun gnus-registry-fetch-extra-flags (id)
"Get the flags of a message, based on the message ID.
\"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
")
-;; Byte-compiler warning.
+;; Byte-compiler warning. Specifically, this is responsible for:
+;; "Warning: the following functions might not be defined at runtime:
+;; gnus-build-sparse-threads, gnus-dead-summary-mode, gnus-summary-mark-below".
(eval-when-compile
;; Bind features so that require will believe that gnus-sum has
;; already been loaded (avoids infinite recursion)
:tag "Use Mailclient package")
(function :tag "Other"))
:group 'message-sending
+ :version "23.0" ;; No Gnus
:initialize 'custom-initialize-default
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(set-buffer (generate-new-buffer " *mm*"))
(setq method nil))
(mm-insert-part handle)
+ (mm-add-meta-html-tag handle)
(let ((win (get-buffer-window cur t)))
(when win
(select-window win)))
(mm-handle-set-undisplayer handle mm)))))
;; The function is a string to be executed.
(mm-insert-part handle)
+ (mm-add-meta-html-tag handle)
(let* ((dir (mm-make-temp-file
(expand-file-name "emm." mm-tmp-directory) 'dir))
(filename (or
;;; Code:
(eval-when-compile (require 'cl))
-(or (require 'password-cache nil t)
- (require 'password))
+
+(if (locate-library "password-cache")
+ (require 'password-cache)
+ (require 'password))
(autoload 'mml2015-sign "mml2015")
(autoload 'mml2015-encrypt "mml2015")
(autoload 'message-posting-charset "message")
(autoload 'dnd-get-local-file-name "dnd"))
+(autoload 'message-options-set "message")
+(autoload 'message-narrow-to-head "message")
+(autoload 'message-in-body-p "message")
+(autoload 'message-mail-p "message")
+
(defvar gnus-article-mime-handles)
(defvar gnus-mouse-2)
(defvar gnus-newsrc-hashtb)
;;; Transforming MIME to MML
;;;
+;; message-narrow-to-head autoloads message.
+(declare-function message-remove-header "message"
+ (header &optional is-regexp first reverse))
+
(defun mime-to-mml (&optional handles)
"Translate the current buffer (which should be a message) into MML.
If HANDLES is non-nil, use it instead reparsing the buffer."
(message-remove-header "Content-Disposition")
(message-remove-header "Content-Transfer-Encoding")))
+(autoload 'message-encode-message-body "message")
+(declare-function message-narrow-to-headers-or-head "message" ())
+
(defun mml-to-mime ()
"Translate the current buffer from MML to MIME."
(message-encode-message-body)
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
+(declare-function message-subscribed-p "message" ())
+(declare-function message-make-mail-followup-to "message"
+ (&optional only-show-subscribed))
+(declare-function message-position-on-field "message" (header &rest afters))
+
(defun mml-preview-insert-mail-followup-to ()
"Insert a Mail-Followup-To header before previewing an article.
Should be adopted if code in `message-send-mail' is changed."
(declare-function widget-event-point "wid-edit" (event))
;; If gnus-buffer-configuration is bound this is loaded.
(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
+;; Called after message-mail-p, which autoloads message.
+(declare-function message-news-p "message" ())
+(declare-function message-options-set-recipient "message" ())
+(declare-function message-generate-headers "message" (headers))
+(declare-function message-sort-headers "message" ())
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
;; For Emacs < 22.2.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-(or (require 'password-cache nil t)
- (require 'password))
+
+(if (locate-library "password-cache")
+ (require 'password-cache)
+ (require 'password))
+
(eval-when-compile
(require 'sasl)
(require 'starttls))
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(require 'dig)
-(or (require 'password-cache nil t)
- (require 'password))
+
+(if (locate-library "password-cache")
+ (require 'password-cache)
+ (require 'password))
+
(eval-when-compile (require 'cl))
(eval-and-compile
(kill-all-local-variables)
(setq mode-name "Image[text]")
(setq major-mode 'image-mode)
+ ;; Use our own bookmarking function for images.
+ (set (make-local-variable 'bookmark-make-cell-function)
+ 'image-bookmark-make-cell)
(add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
(if (and (display-images-p)
(not (get-char-property (point-min) 'display)))
(if (called-interactively-p)
(message "Repeat this command to go back to displaying the file as text")))))
+;;; Support for bookmark.el
+
+(defun image-bookmark-make-cell (annotation &rest args)
+ (let ((the-record
+ `((filename . ,(buffer-file-name))
+ (image-type . ,image-type)
+ (position . ,(point))
+ (handler . image-bookmark-jump))))
+
+ ;; Take no chances with text properties
+ (set-text-properties 0 (length annotation) nil annotation)
+
+ (when annotation
+ (nconc the-record (list (cons 'annotation annotation))))
+
+ ;; Finally, return the completed record.
+ the-record))
+
+;;;###autoload
+(defun image-bookmark-jump (bmk)
+ (save-window-excursion
+ (let ((filename (bookmark-get-filename bmk))
+ (type (cdr (assq 'image-type (bookmark-get-bookmark-record bmk))))
+ (pos (bookmark-get-position bmk)))
+ (find-file filename)
+ (when (not (string= image-type type))
+ (image-toggle-display))
+ (when (string= image-type "text")
+ (goto-char pos))
+ (cons (current-buffer) pos))))
+
(provide 'image-mode)
;; arch-tag: b5b2b7e6-26a7-4b79-96e3-1546b5c4c6cb
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.
-If `transient-mark-mode' is turned on the region is active,
-indent the region.
+
+If a prefix argument is given, also rigidly indent the entire
+balanced expression which starts at the beginning the current
+line to reflect the current line's change in indentation.
+
+If `transient-mark-mode' is turned on and the region is active,
+indent the region (in this case, any prefix argument is ignored).
+
The function actually called to indent the line is determined by the value of
`indent-line-function'."
- (interactive "p")
+ (interactive "P")
(cond
;; The region is active, indent it.
- ((and arg transient-mark-mode mark-active
+ ((and transient-mark-mode mark-active
(not (eq (region-beginning) (region-end))))
(indent-region (region-beginning) (region-end)))
((or ;; indent-to-left-margin is only meant for indenting,
(or (> (current-column) (current-indentation))
(eq this-command last-command))))
(insert-tab arg))
- ;; Those functions are meant specifically for tabbing and not for
- ;; indenting, so we can't pass them to indent-according-to-mode.
- ((memq indent-line-function '(indent-relative indent-relative-maybe))
- (funcall indent-line-function))
- ;; Indent the line.
(t
- (indent-according-to-mode))))
+ (let ((end-marker
+ (and arg
+ (save-excursion
+ (forward-line 0) (forward-sexp) (point-marker))))
+ (old-indent
+ (current-indentation)))
+
+ ;; Indent the line.
+ (funcall indent-line-function)
+
+ ;; If a prefix argument was given, rigidly indent the following
+ ;; sexp to match the change in the current line's indentation.
+ ;;
+ (when arg
+ (let ((indentation-change (- (current-indentation) old-indent)))
+ (unless (zerop indentation-change)
+ (save-excursion
+ (forward-line 1)
+ (when (< (point) end-marker)
+ (indent-rigidly (point) end-marker indentation-change))))))))))
(defun insert-tab (&optional arg)
(let ((count (prefix-numeric-value arg)))
(error "Not documented as a %s: %s" topic (or item ""))))
(modes (info-lookup->all-modes topic mode))
(window (selected-window))
+ (new-Info-history
+ ;; Avoid clobbering Info-history with nodes searched during
+ ;; lookup. If lookup succeeds set `Info-history' to
+ ;; `new-Info-history'.
+ (when (get-buffer "*info*")
+ (with-current-buffer "*info*"
+ (cons (list Info-current-file Info-current-node (point))
+ Info-history))))
found doc-spec node prefix suffix doc-found)
(if (not (eq major-mode 'Info-mode))
(if (not info-lookup-other-window-flag)
(progn
;; Don't need Index menu fontifications here, and
;; they slow down the lookup.
- (let (Info-fontify-maximum-menu-size)
+ (let (Info-fontify-maximum-menu-size
+ Info-history-list)
(Info-goto-node node)
(setq doc-found t)))
(error
(unless (or ignore-case
(string-equal item (car entry)))
(message "Found in different case: %s" (car entry)))
+ (when found
+ (setq Info-history new-Info-history))
(or doc-found
(error "Info documentation for lookup was not found"))
;; Don't leave the Info buffer if the help item couldn't be looked up.
(defun info-lookup-setup-mode (topic mode)
"Initialize the internal data structure."
(or (info-lookup->initialized topic mode)
- (let (cell data (initialized 0) completions refer-modes)
+ (let ((initialized 0)
+ cell data completions refer-modes Info-history-list)
(if (not (info-lookup->mode-value topic mode))
(message "No %s help available for `%s'" topic mode)
;; Recursively setup cross references.
(let ((doc-spec (info-lookup->doc-spec topic mode))
(regexp (concat "^\\(" (info-lookup->regexp topic mode)
"\\)\\([ \t].*\\)?$"))
- Info-fontify-maximum-menu-size
+ Info-history-list Info-fontify-maximum-menu-size
node trans entry item prefix result doc-found
(buffer (get-buffer-create " temp-info-look")))
(with-current-buffer buffer
(setq widen-automatically nil)
(setq desktop-save-buffer 'Info-desktop-buffer-misc-data)
(add-hook 'kill-buffer-hook 'Info-kill-buffer nil t)
- (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
+ (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
(set (make-local-variable 'isearch-search-fun-function)
Info-tag-table-buffer
(kill-buffer Info-tag-table-buffer)))
-(defun Info-clone-buffer-hook ()
+;; Placed on `clone-buffer-hook'.
+(defun Info-clone-buffer ()
(when (bufferp Info-tag-table-buffer)
(setq Info-tag-table-buffer
(with-current-buffer Info-tag-table-buffer (clone-buffer))))
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
+ (tick (if (not (stringp from)) (buffer-modified-tick)))
safe rejected unsafe)
(if (eq (car codings) 'undecided)
;; Any coding system is ok.
%s specified by file contents. Really save (else edit coding cookies \
and try again)? " coding-system auto-cs))
(error "Save aborted"))))
+ (when (and tick (/= tick (buffer-modified-tick)))
+ (error "Cancelled because the buffer was modified"))
coding-system)))
(setq select-safe-coding-system-function 'select-safe-coding-system)
(put 'input-method-function 'permanent-local t)
(defvar input-method-history nil
- "History list for some commands that read input methods.")
+ "History list of input methods read from the minibuffer.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(make-variable-buffer-local 'input-method-history)
(put 'input-method-history 'permanent-local t)
(require 'font-lock)
-;; Set up the custom library.
-;; taken from http://www.dina.kvl.dk/~abraham/custom/
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
;;; User Variables
;;
;; These are some things you might want to change.
;;;; Subversion:
+;; ------------------------------------------------------------------------
+;; r4622 | ckuethe | 2007-12-23 18:18:01 -0500 (Sun, 23 Dec 2007) | 2 lines
+;;
+;; uBlox AEK-4T in binary mode. Added to unstable because it breaks gpsfake
+;;
+;; ------------------------------------------------------------------------
+;; r4621 | ckuethe | 2007-12-23 16:48:11 -0500 (Sun, 23 Dec 2007) | 3 lines
+;;
+;; Add a note about requiring usbfs to use the garmin gps18 (usb)
+;; Mention firmware testing the AC12 with firmware BQ00 and BQ04
+;;
+;; ------------------------------------------------------------------------
+;; r4620 | ckuethe | 2007-12-23 15:52:34 -0500 (Sun, 23 Dec 2007) | 1 line
+;;
+;; add link to latest hardware reference
+;; ------------------------------------------------------------------------
+;; r4619 | ckuethe | 2007-12-23 14:37:31 -0500 (Sun, 23 Dec 2007) | 1 line
+;;
+;; there is now a regression test for AC12 without raw data output
+
;;;; Darcs:
;; Changes to darcsum.el:
;; Add trailing-whitespace option to mode hook and fix
;; darcsum-display-changeset not to use trailing whitespace.
+;;;; Mercurial
+
+;; changeset: 11:8ff1a4166444
+;; tag: tip
+;; user: Eric S. Raymond <esr@thyrsus.com>
+;; date: Wed Dec 26 12:18:58 2007 -0500
+;; summary: Explain keywords. Add markup fixes.
+;;
+;; changeset: 10:20abc7ab09c3
+;; user: Eric S. Raymond <esr@thyrsus.com>
+;; date: Wed Dec 26 11:37:28 2007 -0500
+;; summary: Typo fixes.
+;;
+;; changeset: 9:ada9f4da88aa
+;; user: Eric S. Raymond <esr@thyrsus.com>
+;; date: Wed Dec 26 11:23:00 2007 -0500
+;; summary: Add RCS example session.
+
;;; Todo:
;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
'(("q" . quit-window)
("z" . kill-this-buffer)
("m" . log-view-toggle-mark-entry)
- ;; ("e" . cvs-mode-edit-log)
+ ("e" . log-view-modify-change-comment)
("d" . log-view-diff)
("a" . log-view-annotate-version)
("f" . log-view-find-revision)
(if found
(delete-overlay found)
;; Create an overlay that covers this entry and change
- ;; it's color.
+ ;; its color.
(setq tag (log-view-current-tag (point)))
(forward-line 1)
(setq end
(switch-to-buffer (vc-find-revision (log-view-current-file)
(log-view-current-tag)))))
+
+(defun log-view-extract-comment ()
+ "Parse comment from around the current point in the log."
+ (save-excursion
+ (let (st en (backend (vc-backend (log-view-current-file))))
+ (log-view-end-of-defun)
+ (cond ((eq backend 'SVN)
+ (forward-line -1)))
+ (setq en (point))
+ (log-view-beginning-of-defun)
+ (cond ((memq backend '(SCCS RCS CVS MCVS SVN))
+ (forward-line 2))
+ ((eq backend 'Hg)
+ (forward-line 4)
+ (re-search-forward "summary: *" nil t)))
+ (setq st (point))
+ (buffer-substring st en))))
+
+(defun log-view-modify-change-comment ()
+ "Edit the change comment displayed at point."
+ (interactive)
+ (vc-modify-change-comment (list (log-view-current-file))
+ (log-view-current-tag)
+ (log-view-extract-comment)))
+
(defun log-view-annotate-version (pos)
"Annotate the version at point."
(interactive "d")
(defconst feedmail-patch-level "8")
-
-;; from <URL:http://www.dina.kvl.dk/~abraham/custom/>:
-;; If you write software that must work without the new custom, you
-;; can use this hack stolen from w3-cus.el:
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
(eval-when-compile (require 'smtpmail))
(autoload 'mail-do-fcc "sendmail")
(defun Footnote-current-regexp ()
"Return the regexp of the index of the current style."
(concat (nth 2 (or (assq footnote-style footnote-style-alist)
- (nth 0 footnote-style-alist))) "*"))
+ (nth 0 footnote-style-alist)))
+ "*"))
(defun Footnote-refresh-footnotes (&optional index-regexp)
"Redraw all footnotes.
(search-backward footnote-start-tag nil t)
(when (looking-at (concat
(regexp-quote footnote-start-tag)
- "\\(" index-regexp "\\)"
+ "\\(" index-regexp "+\\)"
(regexp-quote footnote-end-tag)))
(replace-match (concat
footnote-start-tag
(goto-char (cdr alist))
(when (looking-at (concat
(regexp-quote footnote-start-tag)
- "\\(" index-regexp "\\)"
+ "\\(" index-regexp "+\\)"
(regexp-quote footnote-end-tag)))
(replace-match (concat
footnote-start-tag
(defsubst Man-default-man-entry (&optional pos)
"Make a guess at a default manual entry based on the text at POS.
If POS is nil, the current point is used."
- (let (word)
+ (let (word start original-pos distance)
(save-excursion
(if pos (goto-char pos))
;; Default man entry title is any word the cursor is on, or if
- ;; cursor not on a word, then nearest preceding word.
- (skip-chars-backward "-a-zA-Z0-9._+:")
- (let ((start (point)))
- (skip-chars-forward "-a-zA-Z0-9._+:")
- ;; If there is a continuation at the end of line, check the
- ;; following line too, eg:
- ;; see this-
- ;; command-here(1)
- (setq word (buffer-substring-no-properties start (point)))
- (if (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
- (setq word (concat word (match-string 1)))))
- (if (string-match "[._]+$" word)
- (setq word (substring word 0 (match-beginning 0))))
+ ;; cursor not on a word, nearest preceding or next word-like
+ ;; object on this line.
+ (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
+ (setq start (point))
+ (setq original-pos (point))
+ (setq distance (abs (skip-chars-backward ",; \t")))
+ (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
+ (progn
+ (setq start (point))
+ (goto-char original-pos)
+ (if (and (< (skip-chars-forward ",; \t") distance)
+ (looking-at "[-a-zA-Z0-9._+:]"))
+ (setq start (point))
+ (goto-char start)))
+ (skip-chars-forward ",; \t")
+ (setq start (point))))
+ (skip-chars-forward "-a-zA-Z0-9._+:")
+ (setq word (buffer-substring-no-properties start (point)))
+ ;; If there is a continuation at the end of line, check the
+ ;; following line too, eg:
+ ;; see this-
+ ;; command-here(1)
+ (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
+ (setq word (concat word (match-string-no-properties 1))))
+ (when (string-match "[._]+$" word)
+ (setq word (substring word 0 (match-beginning 0))))
;; If looking at something like *strcat(... , remove the '*'
- (if (string-match "^*" word)
- (setq word (substring word 1)))
+ (when (string-match "^*" word)
+ (setq word (substring word 1)))
;; If looking at something like ioctl(2) or brc(1M), include the
;; section number in the returned value. Remove text properties.
(concat word
(interactive
(if (not Man-refpages-alist)
(error "There are no references in the current man page")
- (list (let* ((default (or
- (car (all-completions
- (let ((word
- (or (Man-possibly-hyphenated-word)
- "")))
- ;; strip a trailing '-':
- (if (string-match "-$" word)
- (substring word 0
- (match-beginning 0))
- word))
- Man-refpages-alist))
- (aheadsym Man-refpages-alist)))
- chosen
- (prompt (concat "Refer to (default " default "): ")))
- (setq chosen (completing-read prompt Man-refpages-alist))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
+ (list
+ (let* ((default (or
+ (car (all-completions
+ (let ((word
+ (or (Man-possibly-hyphenated-word)
+ "")))
+ ;; strip a trailing '-':
+ (if (string-match "-$" word)
+ (substring word 0
+ (match-beginning 0))
+ word))
+ Man-refpages-alist))
+ (aheadsym Man-refpages-alist)))
+ (defaults
+ (mapcar 'substring-no-properties
+ (delete-dups
+ (delq nil (cons default
+ (mapcar 'car Man-refpages-alist))))))
+ chosen
+ (prompt (concat "Refer to (default " default "): ")))
+ (setq chosen (completing-read prompt Man-refpages-alist
+ nil nil nil nil defaults))
+ (if (or (not chosen)
+ (string= chosen ""))
+ default
+ chosen)))))
(if (not Man-refpages-alist)
(error "Can't find any references in the current manpage")
(aput 'Man-refpages-alist reference)
:visible default-enable-multibyte-characters
:help "Display multilingual environment settings"))
(define-key menu-bar-describe-menu [describe-coding-system-briefly]
- '(menu-item "Describe Coding System (Briefly)..."
+ '(menu-item "Describe Coding System (Briefly)"
describe-current-coding-system-briefly
:visible default-enable-multibyte-characters))
(define-key menu-bar-describe-menu [describe-coding-system]
(setq mouse-selection-click-count 0)
(yank arg))
+(defun mouse-yank-primary (click)
+ "Insert the primary selection at the position clicked on.
+Move point to the end of the inserted text.
+If `mouse-yank-at-point' is non-nil, insert at point
+regardless of where you click."
+ (interactive "e")
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (or mouse-yank-at-point (mouse-set-point click))
+ (let ((primary (x-get-selection 'PRIMARY)))
+ (if primary
+ (insert (x-get-selection 'PRIMARY))
+ (error "No primary selection"))))
+
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
This does not delete the region; it acts like \\[kill-ring-save]."
'(lambda (key value)
(dolist (elt value)
;; key has the structure (BUS INTERFACE SIGNAL).
- ;; elt has the structure (SERVICE UNAME PATH HANDLER).
- (when (string-equal old-owner (cadr elt))
+ ;; elt has the structure (UNAME SERVICE PATH HANDLER).
+ (when (string-equal old-owner (car elt))
;; Remove old key, and add new entry with changed name.
- (when dbus-debug (message "Remove rule for %s %s" key elt))
- ;(dbus-unregister-signal key)
- (setcar (cdr elt) new-owner)
- (when dbus-debug (message "Add rule for %s %s" key elt))
+ (dbus-unregister-signal (list key (cdr elt)))
;; Maybe we could arrange the lists a little bit better
;; that we don't need to extract every single element?
- (when (not (zerop (length new-owner)))
- (dbus-register-signal
- ;; BUS SERVICE PATH
- (nth 0 key) (nth 0 elt) (nth 2 elt)
- ;; INTERFACE SIGNAL HANDLER
- (nth 1 key) (nth 2 key) (nth 3 elt))))))
+ (dbus-register-signal
+ ;; BUS SERVICE PATH
+ (nth 0 key) (nth 1 elt) (nth 2 elt)
+ ;; INTERFACE SIGNAL HANDLER
+ (nth 1 key) (nth 2 key) (nth 3 elt)))))
(copy-hash-table dbus-registered-functions-table)))))
;; Register the handler.
(if passwd (setq imap-password passwd))
(if imap-auth
(and (funcall (nth 2 (assq imap-auth
- imap-authenticator-alist)) buffer)
+ imap-authenticator-alist)) (current-buffer))
(setq imap-state 'auth))
;; Choose authenticator.
(let ((auths imap-authenticators)
auth)
(while (setq auth (pop auths))
;; OK to use authenticator?
- (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
+ (when (funcall (nth 1 (assq auth imap-authenticator-alist)) (current-buffer))
(message "imap: Authenticating to `%s' using `%s'..."
imap-server auth)
(setq imap-auth auth)
- (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
+ (if (funcall (nth 2 (assq auth imap-authenticator-alist)) (current-buffer))
(progn
(message "imap: Authenticating to `%s' using `%s'...done"
imap-server auth)
;;; .netrc and .authinfo rc parsing
;;;
+;; use encrypt if loaded (encrypt-file-alist has to be set as well)
+(eval-and-compile
+ (autoload 'encrypt-find-model "encrypt")
+ (autoload 'encrypt-insert-file-contents "encrypt"))
(defalias 'netrc-point-at-eol
(if (fboundp 'point-at-eol)
'point-at-eol
'line-end-position))
+(eval-when-compile
+ (defvar encrypt-file-alist)
+ ;; This is unnecessary in the compiled version as it is a macro.
+ (if (fboundp 'bound-and-true-p)
+ (defalias 'netrc-bound-and-true-p 'bound-and-true-p)
+ (defmacro netrc-bound-and-true-p (var)
+ "Return the value of symbol VAR if it is bound, else nil."
+ `(and (boundp (quote ,var)) ,var))))
(defgroup netrc nil
"Netrc configuration."
(let ((tokens '("machine" "default" "login"
"password" "account" "macdef" "force"
"port"))
+ (encryption-model (when (netrc-bound-and-true-p encrypt-file-alist)
+ (encrypt-find-model file)))
alist elem result pair)
- (insert-file-contents file)
+ (if encryption-model
+ (encrypt-insert-file-contents file encryption-model)
+ (insert-file-contents file))
(goto-char (point-min))
;; Go through the file, line by line.
(while (not (eobp))
(require 'pp)
(require 'browse-url)
-;; Attempt to handle older/other emacs.
-(eval-and-compile
- ;; If customize isn't available just use defvar instead.
- (unless (fboundp 'defgroup)
- (defmacro defgroup (&rest rest) nil)
- (defmacro defcustom (symbol init docstring &rest rest)
- `(defvar ,symbol ,init ,docstring))))
-
;; Customize options.
(defgroup quickurl nil
;;; Code:
-(eval-and-compile
+(eval-when-compile
;; Pacify byte-compiler.
- (require 'cl)
+ (require 'cl))
+
+(eval-and-compile
+
(require 'custom)
;; Load the appropriate timer package.
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
- ;; Sort entries
+ ;; Sort entries.
(setq entries
(sort
entries
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapcar
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
;; Print entries.
(mapcar
(lambda (x)
(when (featurep 'tramp-compat)
(unload-feature 'tramp-compat 'force))))
-(require 'format-spec) ;from Gnus 5.8, also in tar ball
+(require 'format-spec) ; from Gnus 5.8, also in tar ball
;; As long as password.el is not part of (X)Emacs, it shouldn't
;; be mandatory
(if (featurep 'xemacs)
;; as well.
(tramp-send-command
vec
- (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''"
+ (format "PS1='%s%s%s'"
tramp-rsh-end-of-line
tramp-end-of-output
tramp-rsh-end-of-line)
t)
+ (tramp-send-command vec "PS2=''" t)
+ (tramp-send-command vec "PS3=''" t)
+ (tramp-send-command vec "PROMPT_COMMAND=''" t)
(tramp-message vec 5 "Setting remote shell prompt...done"))
(t (tramp-message
vec 5 "Remote `%s' groks tilde expansion, good"
(tramp-send-command
vec
(format
- "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' PS2='' PS3='' %s"
+ "exec env ENV='' PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' %s"
(tramp-get-method-parameter
(tramp-file-name-method vec) 'tramp-remote-sh))
t)
;; regarded as prompt already.
(tramp-send-command
vec
- (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''"
+ (format "PS1='%s%s%s'"
tramp-rsh-end-of-line
tramp-end-of-output
tramp-rsh-end-of-line)
t)
+ (tramp-send-command vec "PS2=''" t)
+ (tramp-send-command vec "PS3=''" t)
+ (tramp-send-command vec "PROMPT_COMMAND=''" t)
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
;; * Reconnect directly to a compliant shell without first going
;; through the user's default shell. (Pete Forman)
;; * Make `tramp-default-user' obsolete.
+;; * Tramp shall reconnect automatically to its ssh connection when it
+;; detects that the process "has died". (David Reitter)
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
;; "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.12-pre"
+(defconst tramp-version "2.1.12"
"This version of Tramp.")
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
;; Check for (X)Emacs version.
-(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.12-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok")))
+(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.12 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok")))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
(provide 'trampver)
((< numarg 0) (uncomment-region beg end (- numarg)))
(t
(let ((multi-char (/= (string-match "[ \t]*\\'" comment-start) 1))
- indent)
+ indent triple)
(if (eq (nth 3 style) 'multi-char)
- (setq indent multi-char)
+ (save-excursion
+ (goto-char beg)
+ (setq indent multi-char
+ ;; Triple if we will put the comment starter at the margin
+ ;; and the first line of the region isn't indented
+ ;; at least two spaces.
+ triple (and (not multi-char) (looking-at "\t\\| "))))
(setq indent (nth 3 style)))
;; In Lisp and similar modes with one-character comment starters,
;; double it by default if `comment-add' says so.
;; If it isn't indented, triple it.
(if (and (null arg) (not multi-char))
- (setq numarg (* comment-add (if indent 1 2)))
+ (setq numarg (* comment-add (if triple 2 1)))
(setq numarg (1- (prefix-numeric-value arg))))
(comment-region-internal
:group 'languages
:group 'wp)
-(defgroup nxml-highlighting-faces nil
+(defgroup nxml-faces nil
"Faces for XML syntax highlighting."
:group 'nxml
- :group 'font-lock-highlighting-faces)
+ :group 'font-lock-faces)
(defcustom nxml-syntax-highlight-flag t
"*Non-nil means nxml-mode should perform syntax highlighting."
(defcustom nxml-char-ref-display-glyph-flag t
"*Non-nil means display glyph following character reference.
-The glyph is displayed in `nxml-glyph-face'. The hook
+The glyph is displayed in face `nxml-glyph'. The hook
`nxml-glyph-set-hook' can be used to customize for which characters
glyphs are displayed."
:group 'nxml
:group 'nxml
:type 'boolean)
-;; The following are the colors we use with a light background.
-;; The two blues have the same hue but contrasting saturation/value.
-;; The hue of the green is 120 degrees different from that of the
-;; blue. The red used for highlighting errors is 120 degrees
-;; different again. We use the light blue only for refs and
-;; delimiters, since these are short (long stretches in a light color
-;; would be too hard to read). The dark blue is closest to black
-;; (which we use by default for text), so we use it for attribute
-;; values, which are similar to text.
-
-(defconst nxml-light-blue-color "#9292C9") ; hue 240
-(defconst nxml-dark-blue-color "#3A3A7B") ; hue 240
-(defconst nxml-green-color "#257A25") ; hue 120
-
-;; Similar principles apply with a dark background. However,
-;; we switch green and blue, because darker blues are very hard to
-;; read (for me anyway) on a dark background.
-
-(defconst nxml-sky-blue-color "#ACACFC") ; hue 240
-(defconst nxml-dark-green-color "#00AD00") ; hue 120
-(defconst nxml-light-green-color "#70F170") ; hue 120
-
-(defface nxml-delimited-data-face
- `((((class color) (background light)) (:foreground ,nxml-dark-blue-color))
- (((class color) (background dark)) (:foreground ,nxml-light-green-color)))
+(defface nxml-delimited-data
+ '((t (:inherit font-lock-doc-face)))
"Face used to highlight data enclosed between delimiters.
-By default, this is inherited by `nxml-attribute-value-face'
-and `nxml-processing-instruction-content-face'."
- :group 'nxml-highlighting-faces)
+This is not used directly, but only via inheritance by other faces."
+ :group 'nxml-faces)
-(defface nxml-name-face
- `((((class color) (background light)) (:foreground ,nxml-green-color))
- (((class color) (background dark)) (:foreground ,nxml-sky-blue-color)))
+(defface nxml-name
+ '((t (:inherit font-lock-builtin-face)))
"Face used to highlight various names.
This includes element and attribute names, processing
instruction targets and the CDATA keyword in a CDATA section.
This is not used directly, but only via inheritance by other faces."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-ref-face
- `((((class color) (background light)) (:foreground ,nxml-light-blue-color))
- (((class color) (background dark)) (:foreground ,nxml-dark-green-color)))
+(defface nxml-ref
+ '((t (:inherit font-lock-constant-face)))
"Face used to highlight character and entity references.
This is not used directly, but only via inheritance by other faces."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-delimiter-face
- `((((class color) (background light)) (:foreground ,nxml-light-blue-color))
- (((class color) (background dark)) (:foreground ,nxml-dark-green-color))
- (t (:bold t)))
+(defface nxml-delimiter
+ nil
"Face used to highlight delimiters.
This is not used directly, but only via inheritance by other faces."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-text-face
+(defface nxml-text
nil
"Face used to highlight text."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-comment-content-face
- '((t (:italic t)))
+(defface nxml-comment-content
+ '((t (:inherit font-lock-comment-face)))
"Face used to highlight the content of comments."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-comment-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-comment-delimiter
+ '((t (:inherit font-lock-comment-delimiter-face)))
"Face used for the delimiters of comments, i.e <!-- and -->."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-processing-instruction-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-processing-instruction-delimiter
+ '((t (:inherit nxml-delimiter)))
"Face used for the delimiters of processing instructions, i.e <? and ?>."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-processing-instruction-target-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-processing-instruction-target
+ '((t (:inherit font-lock-keyword-face)))
"Face used for the target of processing instructions."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-processing-instruction-content-face
- '((t (:inherit nxml-delimited-data-face)))
+(defface nxml-processing-instruction-content
+ '((t (:inherit nxml-delimited-data)))
"Face used for the content of processing instructions."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-cdata-section-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-cdata-section-delimiter
+ '((t (:inherit nxml-delimiter)))
"Face used for the delimiters of CDATA sections, i.e <![, [, and ]]>."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-cdata-section-CDATA-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-cdata-section-CDATA
+ '((t (:inherit nxml-name)))
"Face used for the CDATA keyword in CDATA sections."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-cdata-section-content-face
- '((t (:inherit nxml-text-face)))
+(defface nxml-cdata-section-content
+ '((t (:inherit nxml-text)))
"Face used for the content of CDATA sections."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-char-ref-number-face
- '((t (:inherit nxml-ref-face)))
+(defface nxml-char-ref-number
+ '((t (:inherit nxml-ref)))
"Face used for the number in character references.
This includes ths `x' in hex references."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-char-ref-delimiter-face
- '((t (:inherit nxml-ref-face)))
+(defface nxml-char-ref-delimiter
+ '((t (:inherit nxml-ref)))
"Face used for the delimiters of character references, i.e &# and ;."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-entity-ref-name-face
- '((t (:inherit nxml-ref-face)))
+(defface nxml-entity-ref-name
+ '((t (:inherit nxml-ref)))
"Face used for the entity name in general entity references."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-entity-ref-delimiter-face
- '((t (:inherit nxml-ref-face)))
+(defface nxml-entity-ref-delimiter
+ '((t (:inherit nxml-ref)))
"Face used for the delimiters of entity references, i.e & and ;."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-tag-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-tag-delimiter
+ '((t (:inherit nxml-delimiter)))
"Face used for the angle brackets delimiting tags.
-`nxml-tag-slash-face' is used for slashes."
- :group 'nxml-highlighting-faces)
+`nxml-tag-slash' is used for slashes."
+ :group 'nxml-faces)
-(defface nxml-tag-slash-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-tag-slash
+ '((t (:inherit nxml-tag-delimiter)))
"Face used for slashes in tags, both in end-tags and empty-elements."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-element-prefix-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-element-prefix
+ '((t (:inherit nxml-name)))
"Face used for the prefix of elements."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-element-colon-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-element-colon
+ nil
"Face used for the colon in element names."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-element-local-name-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-element-local-name
+ '((t (:inherit font-lock-function-name-face)))
"Face used for the local name of elements."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-attribute-prefix-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-attribute-prefix
+ '((t (:inherit nxml-name)))
"Face used for the prefix of attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-attribute-colon-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-attribute-colon
+ '((t (:inherit nxml-delimiter)))
"Face used for the colon in attribute names."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-attribute-local-name-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-attribute-local-name
+ '((t (:inherit font-lock-variable-name-face)))
"Face used for the local name of attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-namespace-attribute-xmlns-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-namespace-attribute-xmlns
+ '((t (:inherit nxml-attribute-prefix)))
"Face used for `xmlns' in namespace attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-namespace-attribute-colon-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-namespace-attribute-colon
+ '((t (:inherit nxml-attribute-colon)))
"Face used for the colon in namespace attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-namespace-attribute-prefix-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-namespace-attribute-prefix
+ '((t (:inherit nxml-attribute-local-name)))
"Face used for the prefix declared in namespace attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-attribute-value-face
- '((t (:inherit nxml-delimited-data-face)))
+(defface nxml-attribute-value
+ '((t (:inherit font-lock-string-face)))
"Face used for the value of attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-attribute-value-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-attribute-value-delimiter
+ '((t (:inherit nxml-attribute-value)))
"Face used for the delimiters of attribute values."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-namespace-attribute-value-face
- '((t (:inherit nxml-attribute-value-face)))
+(defface nxml-namespace-attribute-value
+ '((t (:inherit nxml-attribute-value)))
"Face used for the value of namespace attributes."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-namespace-attribute-value-delimiter-face
- '((t (:inherit nxml-attribute-value-delimiter-face)))
+(defface nxml-namespace-attribute-value-delimiter
+ '((t (:inherit nxml-attribute-value-delimiter)))
"Face used for the delimiters of namespace attribute values."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-prolog-literal-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-prolog-literal-delimiter
+ '((t (:inherit nxml-delimited-data)))
"Face used for the delimiters of literals in the prolog."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-prolog-literal-content-face
- '((t (:inherit nxml-delimited-data-face)))
+(defface nxml-prolog-literal-content
+ '((t (:inherit nxml-delimited-data)))
"Face used for the content of literals in the prolog."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-prolog-keyword-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-prolog-keyword
+ '((t (:inherit font-lock-keyword-face)))
"Face used for keywords in the prolog."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-markup-declaration-delimiter-face
- '((t (:inherit nxml-delimiter-face)))
+(defface nxml-markup-declaration-delimiter
+ '((t (:inherit nxml-delimiter)))
"Face used for the delimiters of markup declarations in the prolog.
The delimiters are <! and >."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-hash-face
- '((t (:inherit nxml-name-face)))
+(defface nxml-hash
+ '((t (:inherit nxml-name)))
"Face used for # before a name in the prolog."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-glyph-face
+(defface nxml-glyph
'((((type x))
(:family
"misc-fixed"
:slant
normal)))
"Face used for glyph for char references."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
;;; Global variables
-;; This is initialized in rng-auto.el.
-(defvar nxml-version nil
- "*The version of nxml-mode that is being used.")
-
(defvar nxml-prolog-regions nil
"List of regions in the prolog to be fontified.
See the function `xmltok-forward-prolog' for more information.")
(put 'start-tag
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
- [-1 nil nxml-tag-delimiter-face]
+ '([nil 1 nxml-tag-delimiter]
+ [-1 nil nxml-tag-delimiter]
(element-qname . 1)
attributes))
(put 'partial-start-tag
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
+ '([nil 1 nxml-tag-delimiter]
(element-qname . 1)
attributes))
(put 'end-tag
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
- [1 2 nxml-tag-slash-face]
- [-1 nil nxml-tag-delimiter-face]
+ '([nil 1 nxml-tag-delimiter]
+ [1 2 nxml-tag-slash]
+ [-1 nil nxml-tag-delimiter]
(element-qname . 2)))
(put 'partial-end-tag
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
- [1 2 nxml-tag-slash-face]
+ '([nil 1 nxml-tag-delimiter]
+ [1 2 nxml-tag-slash]
(element-qname . 2)))
(put 'empty-element
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
- [-2 -1 nxml-tag-slash-face]
- [-1 nil nxml-tag-delimiter-face]
+ '([nil 1 nxml-tag-delimiter]
+ [-2 -1 nxml-tag-slash]
+ [-1 nil nxml-tag-delimiter]
(element-qname . 1)
attributes))
(put 'partial-empty-element
'nxml-fontify-rule
- '([nil 1 nxml-tag-delimiter-face]
- [-1 nil nxml-tag-slash-face]
+ '([nil 1 nxml-tag-delimiter]
+ [-1 nil nxml-tag-slash]
(element-qname . 1)
attributes))
(put 'char-ref
'nxml-fontify-rule
- '([nil 2 nxml-char-ref-delimiter-face]
- [2 -1 nxml-char-ref-number-face]
- [-1 nil nxml-char-ref-delimiter-face]
+ '([nil 2 nxml-char-ref-delimiter]
+ [2 -1 nxml-char-ref-number]
+ [-1 nil nxml-char-ref-delimiter]
char-ref))
(put 'entity-ref
'nxml-fontify-rule
- '([nil 1 nxml-entity-ref-delimiter-face]
- [1 -1 nxml-entity-ref-name-face]
- [-1 nil nxml-entity-ref-delimiter-face]))
+ '([nil 1 nxml-entity-ref-delimiter]
+ [1 -1 nxml-entity-ref-name]
+ [-1 nil nxml-entity-ref-delimiter]))
(put 'comment
'nxml-fontify-rule
- '([nil 4 nxml-comment-delimiter-face]
- [4 -3 nxml-comment-content-face]
- [-3 nil nxml-comment-delimiter-face]))
+ '([nil 4 nxml-comment-delimiter]
+ [4 -3 nxml-comment-content]
+ [-3 nil nxml-comment-delimiter]))
(put 'processing-instruction
'nxml-fontify-rule
- '([nil 2 nxml-processing-instruction-delimiter-face]
- [-2 nil nxml-processing-instruction-delimiter-face]
+ '([nil 2 nxml-processing-instruction-delimiter]
+ [-2 nil nxml-processing-instruction-delimiter]
processing-instruction-content))
(put 'cdata-section
'nxml-fontify-rule
- '([nil 3 nxml-cdata-section-delimiter-face] ; <![
- [3 8 nxml-cdata-section-CDATA-face] ; CDATA
- [8 9 nxml-cdata-section-delimiter-face] ; [
- [9 -3 nxml-cdata-section-content-face] ; ]]>
- [-3 nil nxml-cdata-section-delimiter-face]))
+ '([nil 3 nxml-cdata-section-delimiter] ; <![
+ [3 8 nxml-cdata-section-CDATA] ; CDATA
+ [8 9 nxml-cdata-section-delimiter] ; [
+ [9 -3 nxml-cdata-section-content] ; ]]>
+ [-3 nil nxml-cdata-section-delimiter]))
(put 'data
'nxml-fontify-rule
- '([nil nil nxml-text-face]))
+ '([nil nil nxml-text]))
;; Prolog region types in list returned by xmltok-forward-prolog.
(put 'xml-declaration
'nxml-fontify-rule
- '([nil 2 nxml-processing-instruction-delimiter-face]
- [2 5 nxml-processing-instruction-target-face]
- [-2 nil nxml-processing-instruction-delimiter-face]))
+ '([nil 2 nxml-processing-instruction-delimiter]
+ [2 5 nxml-processing-instruction-target]
+ [-2 nil nxml-processing-instruction-delimiter]))
(put 'xml-declaration-attribute-name
'nxml-fontify-rule
- '([nil nil nxml-attribute-local-name-face]))
+ '([nil nil nxml-attribute-local-name]))
(put 'xml-declaration-attribute-value
'nxml-fontify-rule
- '([nil 1 nxml-attribute-value-delimiter-face]
- [1 -1 nxml-attribute-value-face]
- [-1 nil nxml-attribute-value-delimiter-face]))
+ '([nil 1 nxml-attribute-value-delimiter]
+ [1 -1 nxml-attribute-value]
+ [-1 nil nxml-attribute-value-delimiter]))
(put 'processing-instruction-left
'nxml-fontify-rule
- '([nil 2 nxml-processing-instruction-delimiter-face]
- [2 nil nxml-processing-instruction-target-face]))
+ '([nil 2 nxml-processing-instruction-delimiter]
+ [2 nil nxml-processing-instruction-target]))
(put 'processing-instruction-right
'nxml-fontify-rule
- '([nil -2 nxml-processing-instruction-content-face]
- [-2 nil nxml-processing-instruction-delimiter-face]))
+ '([nil -2 nxml-processing-instruction-content]
+ [-2 nil nxml-processing-instruction-delimiter]))
(put 'literal
'nxml-fontify-rule
- '([nil 1 nxml-prolog-literal-delimiter-face]
- [1 -1 nxml-prolog-literal-content-face]
- [-1 nil nxml-prolog-literal-delimiter-face]))
+ '([nil 1 nxml-prolog-literal-delimiter]
+ [1 -1 nxml-prolog-literal-content]
+ [-1 nil nxml-prolog-literal-delimiter]))
(put 'keyword
'nxml-fontify-rule
- '([nil nil nxml-prolog-keyword-face]))
+ '([nil nil nxml-prolog-keyword]))
(put 'markup-declaration-open
'nxml-fontify-rule
- '([0 2 nxml-markup-declaration-delimiter-face]
- [2 nil nxml-prolog-keyword-face]))
+ '([0 2 nxml-markup-declaration-delimiter]
+ [2 nil nxml-prolog-keyword]))
(put 'markup-declaration-close
'nxml-fontify-rule
- '([nil nil nxml-markup-declaration-delimiter-face]))
+ '([nil nil nxml-markup-declaration-delimiter]))
(put 'internal-subset-open
'nxml-fontify-rule
- '([nil nil nxml-markup-declaration-delimiter-face]))
+ '([nil nil nxml-markup-declaration-delimiter]))
(put 'internal-subset-close
'nxml-fontify-rule
- '([nil 1 nxml-markup-declaration-delimiter-face]
- [-1 nil nxml-markup-declaration-delimiter-face]))
+ '([nil 1 nxml-markup-declaration-delimiter]
+ [-1 nil nxml-markup-declaration-delimiter]))
(put 'hash-name
'nxml-fontify-rule
- '([nil 1 nxml-hash-face]
- [1 nil nxml-prolog-keyword-face]))
+ '([nil 1 nxml-hash]
+ [1 nil nxml-prolog-keyword]))
(defun nxml-apply-fontify-rule (&optional type start end)
(let ((rule (get (or type xmltok-type) 'nxml-fontify-rule)))
(nxml-fontify-qname (+ start (cdr action))
xmltok-name-colon
xmltok-name-end
- 'nxml-element-prefix-face
- 'nxml-element-colon-face
- 'nxml-element-local-name-face)))
+ 'nxml-element-prefix
+ 'nxml-element-colon
+ 'nxml-element-local-name)))
((eq action 'attributes)
(nxml-fontify-attributes))
((eq action 'processing-instruction-content)
(nxml-set-face (+ start 2)
xmltok-name-end
- 'nxml-processing-instruction-target-face)
+ 'nxml-processing-instruction-target)
(nxml-set-face (save-excursion
(goto-char xmltok-name-end)
(skip-chars-forward " \t\r\n")
(point))
(- end 2)
- 'nxml-processing-instruction-content-face))
+ 'nxml-processing-instruction-content))
((eq action 'char-ref)
(nxml-char-ref-display-extra start
end
(nxml-fontify-qname (xmltok-attribute-name-start att)
(xmltok-attribute-name-colon att)
(xmltok-attribute-name-end att)
- 'nxml-namespace-attribute-xmlns-face
- 'nxml-namespace-attribute-colon-face
- 'nxml-namespace-attribute-prefix-face
- 'nxml-namespace-attribute-xmlns-face)
+ 'nxml-namespace-attribute-xmlns
+ 'nxml-namespace-attribute-colon
+ 'nxml-namespace-attribute-prefix
+ 'nxml-namespace-attribute-xmlns)
(nxml-fontify-qname (xmltok-attribute-name-start att)
(xmltok-attribute-name-colon att)
(xmltok-attribute-name-end att)
- 'nxml-attribute-prefix-face
- 'nxml-attribute-colon-face
- 'nxml-attribute-local-name-face))
+ 'nxml-attribute-prefix
+ 'nxml-attribute-colon
+ 'nxml-attribute-local-name))
(let ((start (xmltok-attribute-value-start att))
(end (xmltok-attribute-value-end att))
(refs (xmltok-attribute-refs att))
(delimiter-face (if namespace-declaration
- 'nxml-namespace-attribute-value-delimiter-face
- 'nxml-attribute-value-delimiter-face))
+ 'nxml-namespace-attribute-value-delimiter
+ 'nxml-attribute-value-delimiter))
(value-face (if namespace-declaration
- 'nxml-namespace-attribute-value-face
- 'nxml-attribute-value-face)))
+ 'nxml-namespace-attribute-value
+ 'nxml-attribute-value)))
(when start
(nxml-set-face (1- start) start delimiter-face)
(nxml-set-face end (1+ end) delimiter-face)
(when nxml-char-ref-extra-display
(let ((name (nxml-get-char-name n))
(glyph-string (and nxml-char-ref-display-glyph-flag
- (nxml-glyph-display-string n 'nxml-glyph-face)))
+ (nxml-glyph-display-string n 'nxml-glyph)))
ov)
(when (or name glyph-string)
(setq ov (make-overlay start end nil t))
(when glyph-string
(overlay-put ov
'after-string
- (propertize glyph-string 'face 'nxml-glyph-face)))))))
+ (propertize glyph-string 'face 'nxml-glyph)))))))
(defun nxml-clear-char-ref-extra-display (start end)
(let ((ov (overlays-in start end)))
(delete-overlay (car ov)))
(setq ov (cdr ov)))))
-;;; Versioning
-
-(defun nxml-version ()
- "Show the version of nXML mode that is being used."
- (interactive)
- (if nxml-version
- (message "nXML mode version %s" nxml-version)
- (message "nXML mode version unknown")))
-
(defun nxml-start-delimiter-length (type)
(or (get type 'nxml-start-delimiter-length)
:group 'nxml
:type 'integer)
-(defface nxml-heading-face
+(defface nxml-heading
'((t (:weight bold)))
"Face used for the contents of abbreviated heading elements."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-outline-indicator-face
+(defface nxml-outline-indicator
'((t (:inherit default)))
"Face used for `+' or `-' before element names in outlines."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-outline-active-indicator-face
- '((t (:box t :inherit nxml-outline-indicator-face)))
+(defface nxml-outline-active-indicator
+ '((t (:box t :inherit nxml-outline-indicator)))
"Face used for clickable `+' or `-' before element names in outlines."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
-(defface nxml-outline-ellipsis-face
+(defface nxml-outline-ellipsis
'((t (:bold t :inherit default)))
"Face used for `...' in outlines."
- :group 'nxml-highlighting-faces)
+ :group 'nxml-faces)
(defvar nxml-heading-scan-distance 1000
"Maximum distance from section to scan for heading.")
had-children))
(defconst nxml-highlighted-less-than
- (propertize "<" 'face 'nxml-tag-delimiter-face))
+ (propertize "<" 'face 'nxml-tag-delimiter))
(defconst nxml-highlighted-greater-than
- (propertize ">" 'face 'nxml-tag-delimiter-face))
+ (propertize ">" 'face 'nxml-tag-delimiter))
(defconst nxml-highlighted-colon
- (propertize ":" 'face 'nxml-element-colon-face))
+ (propertize ":" 'face 'nxml-element-colon))
(defconst nxml-highlighted-slash
- (propertize "/" 'face 'nxml-tag-slash-face))
+ (propertize "/" 'face 'nxml-tag-slash))
(defconst nxml-highlighted-ellipsis
- (propertize "..." 'face 'nxml-outline-ellipsis-face))
+ (propertize "..." 'face 'nxml-outline-ellipsis))
(defconst nxml-highlighted-empty-end-tag
(concat nxml-highlighted-ellipsis
nxml-highlighted-greater-than))
(defconst nxml-highlighted-inactive-minus
- (propertize "-" 'face 'nxml-outline-indicator-face))
+ (propertize "-" 'face 'nxml-outline-indicator))
(defconst nxml-highlighted-active-minus
- (propertize "-" 'face 'nxml-outline-active-indicator-face))
+ (propertize "-" 'face 'nxml-outline-active-indicator))
(defconst nxml-highlighted-active-plus
- (propertize "+" 'face 'nxml-outline-active-indicator-face))
+ (propertize "+" 'face 'nxml-outline-active-indicator))
(defun nxml-display-section (last-pos
section-start-pos
(if colon
(concat (propertize (substring qname 0 colon)
'face
- 'nxml-element-prefix-face)
+ 'nxml-element-prefix)
nxml-highlighted-colon
(propertize (substring qname (1+ colon))
'face
- 'nxml-element-local-name-face))
+ 'nxml-element-local-name))
(propertize qname
'face
- 'nxml-element-local-name-face))))
+ 'nxml-element-local-name))))
(defun nxml-outline-display-single-line-end-tag (last-pos)
(nxml-outline-set-overlay 'nxml-outline-display-hide
(put 'nxml-outline-display-heading 'help-echo nxml-outline-show-help)
(put 'nxml-outline-display-heading 'nxml-outline-display t)
(put 'nxml-outline-display-heading 'evaporate t)
-(put 'nxml-outline-display-heading 'face 'nxml-heading-face)
+(put 'nxml-outline-display-heading 'face 'nxml-heading)
(defvar nxml-outline-hiding-tag-map
(let ((map (make-sparse-keymap)))
Nil if using a vacuous schema.")
(make-variable-buffer-local 'rng-current-schema-file-name)
-(defvar rng-schema-locating-files-default nil
+(defvar rng-schema-locating-files-default
+ (list "schemas.xml" (expand-file-name "schema/schemas.xml" data-directory))
"Default value for variable `rng-schema-locating-files'.")
-(defvar rng-schema-locating-file-schema-file nil
+(defvar rng-schema-locating-file-schema-file
+ (expand-file-name "schema/locate.rnc" data-directory)
"File containing schema for schema locating files.")
(defvar rng-schema-locating-file-schema nil
:type '(repeat file)
:group 'relax-ng)
-(defvar rng-schema-loader-alist nil
+(defvar rng-schema-loader-alist '(("rnc" . rng-c-load-schema))
"Alist of schema extensions vs schema loader functions.")
(defvar rng-cached-document-element nil)
(defvar rng-dir (file-name-directory load-file-name))
-(defconst rng-autoload-modules
- '(xmltok
- nxml-mode
- nxml-uchnm
- nxml-glyph
- rng-cmpct
- rng-maint
- rng-valid
- rng-xsd
- rng-nxml))
-
-;;;###autoload
-(defun rng-update-autoloads ()
- "Update the autoloads in rng-auto.el."
- (interactive)
- (let* ((generated-autoload-file (expand-file-name "rng-auto.el"
- rng-dir)))
- (mapcar (lambda (x)
- (update-file-autoloads
- (expand-file-name (concat (symbol-name x) ".el") rng-dir)))
- rng-autoload-modules)))
-
-
-(defconst rng-compile-modules
- '(xmltok
- nxml-util
- nxml-enc
- nxml-glyph
- nxml-rap
- nxml-outln
- nxml-mode
- nxml-uchnm
- nxml-ns
- nxml-parse
- nxml-maint
- xsd-regexp
- rng-util
- rng-dt
- rng-xsd
- rng-uri
- rng-pttrn
- rng-cmpct
- rng-match
- rng-parse
- rng-loc
- rng-valid
- rng-nxml
- rng-maint))
-
-;;;###autoload
-(defun rng-byte-compile-load ()
- "Byte-compile and load all of the RELAX NG library in an appropriate order."
- (interactive)
- (mapcar (lambda (x)
- (byte-compile-file (expand-file-name (concat (symbol-name x) ".el")
- rng-dir)
- t))
- rng-compile-modules))
-
-
;;; Conversion from XML to texinfo.
;; This is all a hack and is just enough to make the conversion work.
;; It's not intended for public use.
(defvar rng-manual-texi (concat rng-manual-base ".texi"))
(defvar rng-manual-info (concat rng-manual-base ".info"))
-;;;###autoload
(defun rng-format-manual ()
"Create manual.texi from manual.xml."
(interactive)
(insert ?\n))
(insert "\n\n"))))
-;;; Versioning
-
-;;;###autoload
-(defun rng-write-version ()
- (find-file "VERSION")
- (erase-buffer)
- (insert nxml-version "\n")
- (save-buffer))
-
;;; Timing
(defun rng-time-to-float (time)
["First Error" rng-first-error :active rng-validate-mode]
["Next Error" rng-next-error :active rng-validate-mode]
"---"
- ["Customize nXML" (customize-group 'nxml)]
- "---"
- ["Show nXML Version" nxml-version]))
+ ["Customize nXML" (customize-group 'nxml)]))
;;;###autoload
(defun rng-nxml-mode-init ()
:group 'nxml
:group 'languages)
-(defface rng-error-face '((t (:underline "red")))
+(defface rng-error '((t (:inherit font-lock-warning-face)))
"Face for highlighting XML errors."
:group 'relax-ng)
conforming to the XML Namespaces Recommendation and valid against a
RELAX NG schema. The mode-line indicates whether it is or not. Any
parts of the buffer that cause it not to be are considered errors and
-are highlighted with `rng-error-face'. A description of each error is
+are highlighted with face `rng-error'. A description of each error is
available as a tooltip. \\[rng-next-error] goes to the next error
after point. Clicking mouse-1 on the word `Invalid' in the mode-line
goes to the first error in the buffer. If the buffer changes, then it
(overlay-put overlay 'category 'rng-error)
(overlay-put overlay 'help-echo message))))))
-(put 'rng-error 'face 'rng-error-face)
+(put 'rng-error 'face 'rng-error)
(put 'rng-error 'modification-hooks '(rng-error-modified))
;; If we don't do this, then the front delimiter can move
(let ((faces ,face))
(while (unless (memq (car faces) fast-lock-save-faces)
(setq faces (cdr faces))))
- faces))))
- ;;
- ;; We use this for compatibility with a future Emacs.
- (or (fboundp 'with-temp-message)
- (defmacro with-temp-message (message &rest body)
- `(let ((temp-message ,message) current-message)
- (unwind-protect
- (progn
- (when temp-message
- (setq current-message (current-message))
- (message "%s" temp-message))
- ,@body)
- (when temp-message
- (message "%s" current-message))))))
- ;;
- ;; We use this for compatibility with a future Emacs.
- (or (fboundp 'defcustom)
- (defmacro defcustom (symbol value doc &rest args)
- `(defvar ,symbol ,value ,doc))))
+ faces)))))
;;(defun fast-lock-submit-bug-report ()
;; "Submit via mail a bug report on fast-lock.el."
(eval-when-compile
(require 'cl))
-;; If customize isn't available just use defvar instead.
-(eval-and-compile
- (unless (fboundp 'defgroup)
- (defmacro defgroup (&rest rest) nil)
- (defmacro defcustom (symbol init docstring &rest rest)
- `(defvar ,symbol ,init ,docstring))))
-
;; Customize options.
(defgroup 5x5 nil
(progn (goto-char (symbol-value 'beg)) (forward-word -1) (point))
(goto-char aa-end)))))
-;; transient-mark-mode and mark-active are not defined in XEmacs
(defun ada-region-selected ()
- "Return t if a region has been selected by the user and is still active."
- (if (featurep 'xemacs)
- (region-active-p)
- (and transient-mark-mode mark-active)))
-
+ "Should we operate on an active region?"
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ (region-active-p)))
\f
;;-----------------------------------------------------------------
;; auto-casing
(define-key map "\C-c;" 'comment-region)
(define-key map "\C-j" 'newline-and-indent)
(define-key map "\C-m" 'newline-and-indent)
+ (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar asm-mode] (cons "Asm" map))
+ (define-key map [asm-colon]
+ '("Insert Colon" . asm-colon))
+ (define-key map [comment-region]
+ '("Comment Region" . comment-region))
+ (define-key map [newline-and-indent]
+ '("Insert Newline and Indent" . newline-and-indent))
map)
"Keymap for Asm mode.")
;; compiled, e.g. in the menus.
(c-region-is-active-p))
-(defun c-indent-line-or-region ()
- "When the region is active, indent it syntactically. Otherwise
-indent the current line syntactically."
- ;; Emacs has a variable called mark-active, XEmacs uses region-active-p
- (interactive)
- (if (and transient-mark-mode mark-active
- (not (eq (region-beginning) (region-end))))
+(defun c-indent-line-or-region (&optional arg region)
+ "Indent active region, current line, or block starting on this line.
+In Transient Mark mode, when the region is active, reindent the region.
+Othewise, with a prefix argument, rigidly reindent the expression
+starting on the current line.
+Otherwise reindent just the current line."
+ (interactive
+ (list current-prefix-arg (use-region-p)))
+ (if region
(c-indent-region (region-beginning) (region-end))
- (c-indent-line)))
-
+ (c-indent-command arg)))
\f
;; for progress reporting
(defvar c-progress-info nil)
(defmacro c-region-is-active-p ()
;; Return t when the region is active. The determination of region
;; activeness is different in both Emacs and XEmacs.
- (if (cc-bytecomp-fboundp 'region-active-p)
- ;; XEmacs.
- '(region-active-p)
- ;; Emacs.
- 'mark-active))
+ (if (cc-bytecomp-boundp 'mark-active)
+ ;; Emacs.
+ 'mark-active
+ ;; XEmacs.
+ '(region-active-p)))
(defmacro c-set-region-active (activate)
;; Activate the region if ACTIVE is non-nil, deactivate it
(run-hooks 'c-initialization-hook)
;; Fix obsolete variables.
(if (boundp 'c-comment-continuation-stars)
- (setq c-block-comment-prefix c-comment-continuation-stars))
+ (setq c-block-comment-prefix
+ (symbol-value 'c-comment-continuation-stars)))
(add-hook 'change-major-mode-hook 'c-leave-cc-mode-mode)
(setq c-initialization-ok t))
;; Will try initialization hooks again if they failed.
(cc-require 'cc-defs)
(cc-require 'cc-cmds)
-;; Don't complain about the `define-minor-mode' form if it isn't defined.
-(cc-bytecomp-defvar c-subword-mode)
-
-;; Autoload directives must be on the top level, so we construct an
-;; autoload form instead.
-;;;###autoload (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t)
-
-(if (not (fboundp 'define-minor-mode))
- (defun c-subword-mode ()
- "(Missing) mode enabling subword movement and editing keys.
-This mode is not (yet) available in this version of (X)Emacs. Sorry! If
-you really want it, please send a request to <bug-gnu-emacs@gnu.org>,
-telling us which (X)Emacs version you're using."
- (interactive)
- (error
- "c-subword-mode is not (yet) available in this version of (X)Emacs. Sorry!"))
-
- (defvar c-subword-mode-map
- (let ((map (make-sparse-keymap)))
- (dolist (cmd '(forward-word backward-word mark-word
- kill-word backward-kill-word
- transpose-words
- capitalize-word upcase-word downcase-word))
- (let ((othercmd (let ((name (symbol-name cmd)))
- (string-match "\\(.*-\\)\\(word.*\\)" name)
- (intern (concat "c-"
- (match-string 1 name)
- "sub"
- (match-string 2 name))))))
- (if (fboundp 'command-remapping)
- (define-key map (vector 'remap cmd) othercmd)
- (substitute-key-definition cmd othercmd map global-map))))
- map)
- "Keymap used in command `c-subword-mode' minor mode.")
-
- ;; Produces compiler warning about make-variable-buffer-local not
- ;; being called at toplevel (due to fboundp test).
- (define-minor-mode c-subword-mode
- "Mode enabling subword movement and editing keys.
+(defvar c-subword-mode-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (cmd '(forward-word backward-word mark-word
+ kill-word backward-kill-word
+ transpose-words
+ capitalize-word upcase-word downcase-word))
+ (let ((othercmd (let ((name (symbol-name cmd)))
+ (string-match "\\(.*-\\)\\(word.*\\)" name)
+ (intern (concat "c-"
+ (match-string 1 name)
+ "sub"
+ (match-string 2 name))))))
+ (if (fboundp 'command-remapping)
+ (define-key map (vector 'remap cmd) othercmd)
+ (substitute-key-definition cmd othercmd map global-map))))
+ map)
+ "Keymap used in command `c-subword-mode' minor mode.")
+
+;;;###autoload
+(define-minor-mode c-subword-mode
+ "Mode enabling subword movement and editing keys.
In spite of GNU Coding Standards, it is popular to name a symbol by
mixing uppercase and lowercase letters, e.g. \"GtkWidget\",
\"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these
c-subword-mode-map
(c-update-modeline))
- )
-
(defun c-forward-subword (&optional arg)
"Do the same as `forward-word' but on subwords.
See the command `c-subword-mode' for a description of subwords.
(setq c-fallback-style (cons (cons name val) c-fallback-style)))
(defmacro defcustom-c-stylevar (name val doc &rest args)
- "Define a style variable NAME with VAL and DOC.
-More precisely, convert the given `:type FOO', mined out of ARGS,
-to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append some
-some boilerplate documentation to DOC, arrange for the fallback
-value of NAME to be VAL, and call `custom-declare-variable' to
-do the rest of the work.
-
-STYLE stands for the choice where the value is taken from some
-style setting. PREAMBLE is optionally prepended to FOO; that is,
-if FOO contains :tag or :value, the respective two-element list
-component is ignored."
- (declare (debug (symbolp form stringp &rest)))
- (let* ((expanded-doc (concat doc "
+ "Defines a style variable."
+ `(let ((-value- ,val))
+ (c-set-stylevar-fallback ',name -value-)
+ (custom-declare-variable
+ ',name ''set-from-style
+ ,(concat doc "
This is a style variable. Apart from the valid values described
-above, it can be set to the symbol `set-from-style'. In that case,
-it takes its value from the style system (see `c-default-style' and
+above, it can be set to the symbol `set-from-style'. In that case, it
+takes its value from the style system (see `c-default-style' and
`c-style-alist') when a CC Mode buffer is initialized. Otherwise,
the value set here overrides the style system (there is a variable
-`c-old-style-variable-behavior' that changes this, though)."))
- (typ (eval (plist-get args :type)))
- (type (if (consp typ) typ (list typ)))
- (head (car type))
- (tail (cdr type))
- (newt (append (unless (plist-get tail :tag)
- '(:tag "Override style settings"))
- (unless (plist-get tail :value)
- `(:value ,val))
- tail))
- (aggregate `'(radio
- (const :tag "Use style settings" set-from-style)
- ,(cons head newt))))
- (message "aggregate: %S" aggregate)
- `(progn
- (c-set-stylevar-fallback ',name ,val)
- (custom-declare-variable
- ',name ''set-from-style
- ,expanded-doc
- ,@(plist-put args :type aggregate)))))
+`c-old-style-variable-behavior' that changes this, though).")
+ ,@(plist-put
+ args ':type
+ `(` (radio
+ (const :tag "Use style settings"
+ set-from-style)
+ ,(, (let ((type (eval (plist-get args ':type))))
+ (unless (consp type)
+ (setq type (list type)))
+ (unless (c-safe (plist-get (cdr type) ':value))
+ (setcdr type (append '(:value (, -value-))
+ (cdr type))))
+ (unless (c-safe (plist-get (cdr type) ':tag))
+ (setcdr type (append '(:tag "Override style settings")
+ (cdr type))))
+ (bq-process type)))))))))
(defun c-valid-offset (offset)
"Return non-nil if OFFSET is a valid offset for a syntactic symbol.
;; Although c-comment-continuation-stars is obsolete, we look at it in
;; some places in CC Mode anyway, so make the compiler ignore it
;; during our compilation.
-(cc-bytecomp-obsolete-var c-comment-continuation-stars)
-(cc-bytecomp-defvar c-comment-continuation-stars)
+;; [This is unclean; better to use `symbol-value'. --ttn]
+;;(cc-bytecomp-obsolete-var c-comment-continuation-stars)
+;;(cc-bytecomp-defvar c-comment-continuation-stars)
(defcustom-c-stylevar c-block-comment-prefix
(if (boundp 'c-comment-continuation-stars)
- c-comment-continuation-stars
+ (symbol-value 'c-comment-continuation-stars)
"* ")
"*Specifies the line prefix of continued C-style block comments.
You should set this variable to the literal string that gets inserted
command "\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
- ;; If we're already in the compilation buffer, go to the end
- ;; of the buffer, so point will track the compilation output.
- (if (eq outbuf (current-buffer))
- (goto-char (point-max)))
;; Pop up the compilation buffer.
- (setq outwin (display-buffer outbuf nil t))
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
+ (setq outwin (display-buffer outbuf))
(with-current-buffer outbuf
(let ((process-environment
(append
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(set-window-start outwin (point-min))
- (or (eq outwin (selected-window))
- (set-window-point outwin (if compilation-scroll-output
- (point)
- (point-min))))
+
+ ;; Position point as the user will see it.
+ (let ((desired-visible-point
+ ;; Put it at the end if `compilation-scroll-output' is set.
+ (if compilation-scroll-output
+ (point-max)
+ ;; Normally put it at the top.
+ (point-min))))
+ (if (eq outwin (selected-window))
+ (goto-char desired-visible-point)
+ (set-window-point outwin desired-visible-point)))
+
;; The setup function is called before compilation-set-window-height
;; so it can set the compilation-window-height buffer locally.
(if compilation-process-setup-function
(setq mode-line-process '(":%s"))
(set-process-sentinel proc 'compilation-sentinel)
(set-process-filter proc 'compilation-filter)
- (set-marker (process-mark proc) (point) outbuf)
+ ;; Use (point-max) here so that output comes in
+ ;; after the initial text,
+ ;; regardless of where the user sees point.
+ (set-marker (process-mark proc) (point-max) outbuf)
(when compilation-disable-input
(condition-case nil
(process-send-eof proc)
(provide 'delphi)
-(eval-and-compile
- ;; Allow execution on pre Emacs 20 versions.
- (or (fboundp 'when)
- (defmacro when (test &rest body)
- `(if ,test (progn ,@body))))
- (or (fboundp 'unless)
- (defmacro unless (test &rest body)
- `(if (not ,test) (progn ,@body))))
- (or (fboundp 'defgroup)
- (defmacro defgroup (group val docs &rest group-attributes)
- `(defvar ,group ,val ,docs)))
- (or (fboundp 'defcustom)
- (defmacro defcustom (val-name val docs &rest custom-attributes)
- `(defvar ,val-name ,val ,docs)))
- (or (fboundp 'cadr)
- (defmacro cadr (list) `(car (cdr ,list))))
- (or (fboundp 'cddr)
- (defmacro cddr (list) `(cdr (cdr ,list))))
- (or (fboundp 'with-current-buffer)
- (defmacro with-current-buffer (buf &rest forms)
- `(save-excursion (set-buffer ,buf) ,@forms)))
- )
-
(defgroup delphi nil
"Major mode for editing Delphi source in Emacs."
:version "21.1"
grep-find-template
regexp
(concat (shell-quote-argument "(")
- " -name "
+ " " find-name-arg " "
(mapconcat #'shell-quote-argument
(split-string files)
- " -o -name ")
+ (concat " -o " find-name-arg " "))
" "
(shell-quote-argument ")"))
dir
(eval-when-compile (require 'cl))
(defvar idlwave-shell-have-new-custom nil)
-(eval-and-compile
- ;; Kludge to allow `defcustom' for Emacs 19.
- (condition-case () (require 'custom) (error nil))
- (if (and (featurep 'custom)
- (fboundp 'custom-declare-variable)
- (fboundp 'defface))
- ;; We've got what we needed
- (setq idlwave-shell-have-new-custom t)
- ;; We have the old or no custom-library, hack around it!
- (defmacro defgroup (&rest args) nil)
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
;;; Customizations: idlwave-shell group
(require 'timer)
(error nil)))
-(eval-and-compile
- ;; Kludge to allow `defcustom' for Emacs 19.
- (condition-case () (require 'custom) (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old or no custom-library, hack around it!
- (defmacro defgroup (&rest args) nil)
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
(declare-function idlwave-shell-get-path-info "idlw-shell")
(declare-function idlwave-shell-temp-file "idlw-shell")
(declare-function idlwave-shell-is-running "idlw-shell")
(backward-char 1)
(point)))))
-(defvar transient-mark-mode)
-(defvar zmacs-regions)
-(defvar mark-active)
(defun idlwave-region-active-p ()
- "Is transient-mark-mode on and the region active?
-Works on both Emacs and XEmacs."
- (if (featurep 'xemacs)
- (and zmacs-regions (region-active-p))
- (and transient-mark-mode mark-active)))
+ "Should we operate on an active region?"
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ (region-active-p)))
(defun idlwave-show-matching-quote ()
"Insert quote and show matching quote if this is end of a string."
;; change the syntax, so we have to tell syntax-ppss that the states it
;; has just computed will need to be recomputed.
(sh-font-lock-flush-syntax-ppss-cache)
- ;; Make sure $@ and @? are correctly recognized as sexps.
+ ;; Make sure $@ and $? are correctly recognized as sexps.
("\\$\\([?@]\\)" 1 ,sh-st-symbol)
;; Find HEREDOC starters and add a corresponding rule for the ender.
(sh-font-lock-here-doc
(defun verilog-version ()
"Inform caller of the version of this file."
(interactive)
- (message (concat "Using verilog-mode version " verilog-mode-version) ))
+ (message "Using verilog-mode version %s" verilog-mode-version))
;; Insure we have certain packages, and deal with it if we don't
(eval-when-compile
- (condition-case nil
- (require 'imenu)
- (error nil))
- (condition-case nil
- (require 'reporter)
- (error nil))
- (condition-case nil
- (require 'easymenu)
- (error nil))
- (condition-case nil
- (require 'regexp-opt)
- (error nil))
- (condition-case nil
- (load "skeleton") ;; bug in 19.28 through 19.30 skeleton.el, not provided.
- (error nil))
- (condition-case nil
- (require 'vc)
- (error nil))
- (condition-case nil
- (if (fboundp 'when)
- nil ;; fab
- (defmacro when (cond &rest body)
- (list 'if cond (cons 'progn body))))
- (error nil))
- (condition-case nil
- (if (fboundp 'unless)
- nil ;; fab
- (defmacro unless (cond &rest body)
- (cons 'if (cons cond (cons nil body)))))
- (error nil))
- (condition-case nil
- (if (fboundp 'store-match-data)
- nil ;; fab
- (defmacro store-match-data (&rest args) nil))
- (error nil))
- (if (featurep 'xemacs)
- (condition-case nil
- (if (boundp 'current-menubar)
- nil ;; great
- (progn
- (defmacro add-submenu (&rest args) nil))
- )
- (error nil)))
- (condition-case nil
- (if (fboundp 'zmacs-activate-region)
- nil ;; great
- (defmacro zmacs-activate-region (&rest args) nil))
- (error nil))
- (condition-case nil
- (if (fboundp 'char-before)
- nil ;; great
- (defmacro char-before (&rest body)
- (char-after (1- (point)))))
- (error nil))
- ;; Requires to define variables that would be "free" warnings
- (condition-case nil
- (require 'font-lock)
- (error nil))
- (condition-case nil
- (require 'compile)
- (error nil))
- (condition-case nil
- (require 'custom)
- (error nil))
- (condition-case nil
- (require 'dinotrace)
- (error nil))
- (condition-case nil
- (if (fboundp 'dinotrace-unannotate-all)
- nil ;; great
- (defun dinotrace-unannotate-all (&rest args) nil))
- (error nil))
- (condition-case nil
- (if (fboundp 'customize-apropos)
- nil ;; great
- (defun customize-apropos (&rest args) nil))
- (error nil))
- (condition-case nil
- (if (fboundp 'match-string-no-properties)
- nil ;; great
- (defsubst match-string-no-properties (num &optional string)
- "Return string of text matched by last search, without text properties.
+ (when (featurep 'xemacs)
+ (condition-case nil
+ (require 'easymenu)
+ (error nil))
+ (condition-case nil
+ (require 'regexp-opt)
+ (error nil))
+ ;; Bug in 19.28 through 19.30 skeleton.el, not provided.
+ (condition-case nil
+ (load "skeleton")
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'when)
+ nil ;; fab
+ (defmacro when (cond &rest body)
+ (list 'if cond (cons 'progn body))))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'unless)
+ nil ;; fab
+ (defmacro unless (cond &rest body)
+ (cons 'if (cons cond (cons nil body)))))
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'store-match-data)
+ nil ;; fab
+ (defmacro store-match-data (&rest args) nil))
+ (error nil))
+ (condition-case nil
+ (if (boundp 'current-menubar)
+ nil ;; great
+ (progn
+ (defmacro add-submenu (&rest args) nil))
+ )
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'char-before)
+ nil ;; great
+ (defmacro char-before (&rest body)
+ (char-after (1- (point)))))
+ (error nil))
+ (condition-case nil
+ (require 'custom)
+ (error nil))
+ (condition-case nil
+ (if (fboundp 'match-string-no-properties)
+ nil ;; great
+ (defsubst match-string-no-properties (num &optional string)
+ "Return string of text matched by last search, without text properties.
NUM specifies which parenthesized expression in the last regexp.
Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (let ((result
- (substring string (match-beginning num) (match-end num))))
- (set-text-properties 0 (length result) nil result)
- result)
- (buffer-substring-no-properties (match-beginning num)
- (match-end num)
- (current-buffer)
- )))))
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args) nil)
- (defmacro customize (&rest args)
- (message "Sorry, Customize is not available with this version of emacs"))
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))
- )
- (if (fboundp 'defface)
- nil ; great!
- (defmacro defface (var values doc &rest args)
- `(make-face ,var))
- )
+ (if (match-beginning num)
+ (if string
+ (let ((result
+ (substring string
+ (match-beginning num) (match-end num))))
+ (set-text-properties 0 (length result) nil result)
+ result)
+ (buffer-substring-no-properties (match-beginning num)
+ (match-end num)
+ (current-buffer)
+ )))))
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ;; We've got what we needed
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args) nil)
+ (defmacro customize (&rest args)
+ (message
+ "Sorry, Customize is not available with this version of emacs"))
+ (defmacro defcustom (var value doc &rest args)
+ `(defvar ,var ,value ,doc))
+ )
+ (if (fboundp 'defface)
+ nil ; great!
+ (defmacro defface (var values doc &rest args)
+ `(make-face ,var))
+ )
- (if (and (featurep 'custom) (fboundp 'customize-group))
- nil ;; We've got what we needed
- ;; We have an intermediate custom-library, hack around it!
- (defmacro customize-group (var &rest args)
- `(customize ,var))
- )
+ (if (and (featurep 'custom) (fboundp 'customize-group))
+ nil ;; We've got what we needed
+ ;; We have an intermediate custom-library, hack around it!
+ (defmacro customize-group (var &rest args)
+ `(customize ,var))
+ )))
- )
;; Provide a regular expression optimization routine, using regexp-opt
;; if provided by the user's elisp libraries
(eval-and-compile
- (if (fboundp 'regexp-opt)
- ;; regexp-opt is defined, does it take 3 or 2 arguments?
- (if (fboundp 'function-max-args)
- (let ((args (function-max-args `regexp-opt)))
- (cond
- ((eq args 3) ;; It takes 3
- (condition-case nil ; Hide this defun from emacses
+ (if (featurep 'xemacs)
+ (if (fboundp 'regexp-opt)
+ ;; regexp-opt is defined, does it take 3 or 2 arguments?
+ (if (fboundp 'function-max-args)
+ (let ((args (function-max-args `regexp-opt)))
+ (cond
+ ((eq args 3) ;; It takes 3
+ (condition-case nil ; Hide this defun from emacses
;with just a two input regexp
- (defun verilog-regexp-opt (a b)
- "Deal with differing number of required arguments for `regexp-opt'.
+ (defun verilog-regexp-opt (a b)
+ "Deal with differing number of required arguments for `regexp-opt'.
Call 'regexp-opt' on A and B."
- (regexp-opt a b 't)
- )
- (error nil))
- )
- ((eq args 2) ;; It takes 2
- (defun verilog-regexp-opt (a b)
- "Call 'regexp-opt' on A and B."
- (regexp-opt a b))
- )
- (t nil)))
- ;; We can't tell; assume it takes 2
- (defun verilog-regexp-opt (a b)
- "Call 'regexp-opt' on A and B."
- (regexp-opt a b))
- )
- ;; There is no regexp-opt, provide our own
- (defun verilog-regexp-opt (strings &optional paren shy)
- (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
- (concat open (mapconcat 'regexp-quote strings "\\|") close)))
- ))
+ (regexp-opt a b 't)
+ )
+ (error nil))
+ )
+ ((eq args 2) ;; It takes 2
+ (defun verilog-regexp-opt (a b)
+ "Call 'regexp-opt' on A and B."
+ (regexp-opt a b))
+ )
+ (t nil)))
+ ;; We can't tell; assume it takes 2
+ (defun verilog-regexp-opt (a b)
+ "Call 'regexp-opt' on A and B."
+ (regexp-opt a b))
+ )
+ ;; There is no regexp-opt, provide our own
+ (defun verilog-regexp-opt (strings &optional paren shy)
+ (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
+ (concat open (mapconcat 'regexp-quote strings "\\|") close)))
+ )
+ ;; Emacs.
+ (defalias 'verilog-regexp-opt 'regexp-opt)))
(eval-when-compile
(defun verilog-regexp-words (a)
(defun verilog-font-customize ()
"Link to customize fonts used for Verilog."
(interactive)
- (customize-apropos "font-lock-*" 'faces))
+ (if (fboundp 'customize-apropos)
+ (customize-apropos "font-lock-*" 'faces)))
(defgroup verilog-mode nil
"Facilitates easy editing of Verilog source text"
"*Default name of Company for verilog header.
If set will become buffer local.")
+(make-variable-buffer-local 'verilog-company)
+
(defvar verilog-project nil
"*Default name of Project for verilog header.
If set will become buffer local.")
+(make-variable-buffer-local 'verilog-project)
+
(defvar verilog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map ";" 'electric-verilog-semi)
"\\b__FILE__\\b" (file-name-nondirectory (buffer-file-name))
t t compile-command))))
+;; Following code only gets called from compilation-mode-hook.
+(defvar compilation-error-regexp-alist)
+
(defun verilog-error-regexp-add ()
"Add the messages to the `compilation-error-regexp-alist'.
-Called by `compilation-mode-hook'. This allows \\[next-error] to find the errors."
+Called by `compilation-mode-hook'. This allows \\[next-error] to
+find the errors."
(if (not verilog-error-regexp-add-didit)
(progn
(setq verilog-error-regexp-add-didit t)
(append verilog-error-regexp
(default-value 'compilation-error-regexp-alist)))
;; Could be buffer local at this point; maybe also in let; change all three
- (setq compilation-error-regexp-alist (default-value 'compilation-error-regexp-alist))
+ (setq compilation-error-regexp-alist
+ (default-value 'compilation-error-regexp-alist))
(set (make-local-variable 'compilation-error-regexp-alist)
(default-value 'compilation-error-regexp-alist))
)))
;; figure out version numbers if not already discovered
(and (or (not major) (not minor))
(string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
- (setq major (string-to-int (substring emacs-version
+ (setq major (string-to-number (substring emacs-version
(match-beginning 1)
(match-end 1)))
- minor (string-to-int (substring emacs-version
+ minor (string-to-number (substring emacs-version
(match-beginning 2)
(match-end 2)))))
(if (not (and major minor))
(defvar verilog-mode-syntax-table nil
"Syntax table used in `verilog-mode' buffers.")
-(defconst verilog-font-lock-keywords nil
+(defvar verilog-font-lock-keywords nil
"Default highlighting for Verilog mode.")
-(defconst verilog-font-lock-keywords-1 nil
+(defvar verilog-font-lock-keywords-1 nil
"Subdued level highlighting for Verilog mode.")
-(defconst verilog-font-lock-keywords-2 nil
+(defvar verilog-font-lock-keywords-2 nil
"Medium level highlighting for Verilog mode.
See also `verilog-font-lock-extra-types'.")
-(defconst verilog-font-lock-keywords-3 nil
+(defvar verilog-font-lock-keywords-3 nil
"Gaudy level highlighting for Verilog mode.
See also `verilog-font-lock-extra-types'.")
(defvar verilog-font-lock-translate-off-face
(when verilog-highlight-translate-off
(list
;; Fontify things in translate off regions
- '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
- )))
- )
- )
+ '(verilog-match-translate-off
+ (0 'verilog-font-lock-translate-off-face prepend))
+ )))))
(let ((st-point (point)) hitbeg)
(or (search-backward "//" (verilog-get-beg-of-line) t)
(if (progn
- ;; This is for tricky case //*, we keep searching if /* is proceeded by // on same line
- (while (and (setq hitbeg (search-backward "/*" nil t))
- (progn (forward-char 1) (search-backward "//" (verilog-get-beg-of-line) t))))
+ ;; This is for tricky case //*, we keep searching if /* is
+ ;; proceeded by // on same line.
+ (while
+ (and (setq hitbeg (search-backward "/*" nil t))
+ (progn
+ (forward-char 1)
+ (search-backward "//" (verilog-get-beg-of-line) t))))
hitbeg)
(not (search-forward "*/" st-point t)))))))
(defun verilog-declaration-beg ()
(verilog-re-search-backward verilog-declaration-re (bobp) t))
-(require 'font-lock)
-(defvar verilog-need-fld 1)
-(defvar font-lock-defaults-alist nil) ;In case we are XEmacs
-
(defun verilog-font-lock-init ()
"Initialize fontification."
;; highlight keywords and standardized types, attributes, enumeration
(when verilog-highlight-translate-off
(list
;; Fontify things in translate off regions
- '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
- ))
- )
- )
+ '(verilog-match-translate-off
+ (0 'verilog-font-lock-translate-off-face prepend))
+ ))))
(put 'verilog-mode 'font-lock-defaults
'((verilog-font-lock-keywords
verilog-font-lock-keywords-1
verilog-font-lock-keywords-2
- verilog-font-lock-keywords-3
- )
- nil ;; nil means highlight strings & comments as well as keywords
- nil ;; nil means keywords must match case
- nil ;; syntax table handled elsewhere
- verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
- ))
- (if verilog-need-fld
- (let ((verilog-mode-defaults
- '((verilog-font-lock-keywords
- verilog-font-lock-keywords-1
- verilog-font-lock-keywords-2
- verilog-font-lock-keywords-3
- )
- nil ;; nil means highlight strings & comments as well as keywords
- nil ;; nil means keywords must match case
- nil ;; syntax table handled elsewhere
- verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
- )))
- (setq font-lock-defaults-alist
- (append
- font-lock-defaults-alist
- (list (cons 'verilog-mode verilog-mode-defaults))))
- (setq verilog-need-fld 0))))
+ verilog-font-lock-keywords-3)
+ nil ; nil means highlight strings & comments as well as keywords
+ nil ; nil means keywords must match case
+ nil ; syntax table handled elsewhere
+ ;; Function to move to beginning of reasonable region to highlight
+ verilog-beg-of-defun)))
;; initialize fontification for Verilog Mode
(verilog-font-lock-init)
'("Please use \\[verilog-submit-bug-report] to report bugs."
"Visit http://www.verilog.com to check for updates"
))
-(defconst verilog-startup-message-displayed t)
+(defvar verilog-startup-message-displayed t)
(defun verilog-display-startup-message ()
(if (not verilog-startup-message-displayed)
(if (sit-for 5)
(add-submenu nil verilog-stmt-menu)
))
;; Stuff for GNU emacs
- (make-local-variable 'font-lock-defaults)
+ (set (make-local-variable 'font-lock-defaults)
+ '((verilog-font-lock-keywords verilog-font-lock-keywords-1
+ verilog-font-lock-keywords-2
+ verilog-font-lock-keywords-3)
+ nil nil nil verilog-beg-of-defun))
;;------------------------------------------------------------
;; now hook in 'verilog-colorize-include-files (eldo-mode.el&spice-mode.el)
;; all buffer local:
- (make-local-hook 'font-lock-mode-hook)
- (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in emacs 20
+ (when (featurep 'xemacs)
+ (make-local-hook 'font-lock-mode-hook)
+ (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in emacs 20
+ (make-local-hook 'after-change-functions))
(add-hook 'font-lock-mode-hook 'verilog-colorize-include-files-buffer t t)
(add-hook 'font-lock-after-fontify-buffer-hook 'verilog-colorize-include-files-buffer t t) ; not in emacs 20
- (make-local-hook 'after-change-functions)
(add-hook 'after-change-functions 'verilog-colorize-include-files t t)
;; Tell imenu how to handle verilog.
(newline))
(progn
(newline)
- (insert-string "// ")
+ (insert "// ")
(beginning-of-line)))
(verilog-indent-line))
((nth 4 state) ; Inside any comment (hence /**/)
(newline)
(insert " * "))
-(defun verilog-insert-indices (MAX)
- "Insert a set of indices at into the rectangle.
-The upper left corner is defined by the current point. Indices always
-begin with 0 and extend to the MAX - 1. If no prefix arg is given, the
-user is prompted for a value. The indices are surrounded by square brackets
-\[]. For example, the following code with the point located after the first
-'a' gives:
+(defun verilog-insert-1 (fmt max)
+ "Insert integers 0 to MAX-1 according to format string FMT.
+Inserts one integer per line, at the current column. Stops early
+if it reaches the end of the buffer."
+ (let ((col (current-column))
+ (n 0))
+ (save-excursion
+ (while (< n max)
+ (insert (format fmt n))
+ (forward-line 1)
+ ;; Note that this function does not bother to check for lines
+ ;; shorter than col.
+ (if (eobp)
+ (setq n max)
+ (setq n (1+ n))
+ (move-to-column col))))))
+
+(defun verilog-insert-indices (max)
+ "Insert a set of indices into a rectangle.
+The upper left corner is defined by point. Indices begin with 0
+and extend to the MAX - 1. If no prefix arg is given, the user
+is prompted for a value. The indices are surrounded by square
+brackets \[]. For example, the following code with the point
+located after the first 'a' gives:
a = b a[ 0] = b
a = b a[ 1] = b
a = b a[ 7] = b
a = b a[ 8] = b"
- (interactive "NMAX?")
- (save-excursion
- (let ((n 0))
- (while (< n MAX)
- (save-excursion
- (insert (format "[%3d]" n)))
- (next-line 1)
- (setq n (1+ n))))))
+ (interactive "NMAX? ")
+ (verilog-insert-1 "[%3d]" max))
-
-(defun verilog-generate-numbers (MAX)
+(defun verilog-generate-numbers (max)
"Insert a set of generated numbers into a rectangle.
The upper left corner is defined by point. The numbers are padded to three
digits, starting with 000 and extending to (MAX - 1). If no prefix argument
-is supplied, then the user is prompted for the MAX number. consider the
+is supplied, then the user is prompted for the MAX number. Consider the
following code fragment:
- buf buf buf buf000
- buf buf buf buf001
- buf buf buf buf002
- buf buf buf buf003
- buf buf ==> insert-indices ==> buf buf004
- buf buf buf buf005
- buf buf buf buf006
- buf buf buf buf007
- buf buf buf buf008"
-
- (interactive "NMAX?")
- (save-excursion
- (let ((n 0))
- (while (< n MAX)
- (save-excursion
- (insert (format "%3.3d" n)))
- (next-line 1)
- (setq n (1+ n))))))
+ buf buf buf buf000
+ buf buf buf buf001
+ buf buf buf buf002
+ buf buf buf buf003
+ buf buf ==> generate-numbers ==> buf buf004
+ buf buf buf buf005
+ buf buf buf buf006
+ buf buf buf buf007
+ buf buf buf buf008"
+
+ (interactive "NMAX? ")
+ (verilog-insert-1 "%3.3d" max))
(defun verilog-mark-defun ()
"Mark the current verilog function (or procedure).
(verilog-end-of-defun)
(push-mark (point))
(verilog-beg-of-defun)
- (zmacs-activate-region))
+ (if (fboundp 'zmacs-activate-region)
+ (zmacs-activate-region)))
(defun verilog-comment-region (start end)
; checkdoc-params: (start end)
(cond
((looking-at "\\<randcase\\>")
(setq str "randcase")
- (setq err nil)
- )
+ (setq err nil))
((match-end 0)
(goto-char (match-end 1))
(if nil
(verilog-kill-existing-comment))
(delete-horizontal-space)
(insert (concat " // " str ))
- (if err (ding 't))
- ))
+ (if err (ding 't))))
(;- This is a begin..end block
(match-end 2) ;; of verilog-end-block-ordered-re
(let ((signal-string (buffer-substring (point)
(progn
(end-of-line) (point)))))
- (if (string-match (concat "\\(.*\\)"
- (regexp-quote bra)
- "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)"
+ (if (string-match
+ (concat "\\(.*\\)"
+ (regexp-quote bra)
+ "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)"
(regexp-quote ket)
"\\(.*\\)$") signal-string)
(let* ((sig-head (match-string 1 signal-string))
- (vec-start (string-to-int (match-string 2 signal-string)))
+ (vec-start (string-to-number (match-string 2 signal-string)))
(vec-end (if (= (match-beginning 3) (match-end 3))
vec-start
- (string-to-int (substring signal-string (1+ (match-beginning 3)) (match-end 3)))))
- (vec-range (if (= (match-beginning 4) (match-end 4))
- 1
- (string-to-int (substring signal-string (+ 2 (match-beginning 4)) (match-end 4)))))
+ (string-to-number
+ (substring signal-string (1+ (match-beginning 3))
+ (match-end 3)))))
+ (vec-range
+ (if (= (match-beginning 4) (match-end 4))
+ 1
+ (string-to-number
+ (substring signal-string (+ 2 (match-beginning 4))
+ (match-end 4)))))
(sig-tail (match-string 5 signal-string))
vec)
;; Decode vectors
;;
;; Expand vector
(while vec
- (insert (concat sig-head bra (int-to-string (car vec)) ket sig-tail "\n"))
+ (insert (concat sig-head bra
+ (int-to-string (car vec)) ket sig-tail "\n"))
(setq vec (cdr vec)))
(delete-char -1)
;;
(verilog-verilint-off))
(t (error "Linter name not set")))))
+(defvar compilation-last-buffer)
+
(defun verilog-surelint-off ()
"Convert a SureLint warning line into a disable statement.
Run from Verilog source window; assumes there is a *compile* buffer
becomes:
// surefire lint_line_off UDDONX"
(interactive)
- (save-excursion
- (switch-to-buffer compilation-last-buffer)
- (beginning-of-line)
- (when
- (looking-at "\\(INFO\\|WARNING\\|ERROR\\) \\[[^-]+-\\([^]]+\\)\\]: \\([^,]+\\), line \\([0-9]+\\): \\(.*\\)$")
- (let* ((code (match-string 2))
- (file (match-string 3))
- (line (match-string 4))
- (buffer (get-file-buffer file))
- dir filename)
- (unless buffer
- (progn
- (setq buffer
- (and (file-exists-p file)
- (find-file-noselect file)))
- (or buffer
- (let* ((pop-up-windows t))
- (let ((name (expand-file-name
- (read-file-name
- (format "Find this error in: (default %s) "
- file)
- dir file t))))
- (if (file-directory-p name)
- (setq name (expand-file-name filename name)))
- (setq buffer
- (and (file-exists-p name)
- (find-file-noselect name))))))))
- (switch-to-buffer buffer)
- (goto-line (string-to-number line))
- (end-of-line)
- (catch 'already
- (cond
- ((verilog-in-slash-comment-p)
- (re-search-backward "//")
- (cond
- ((looking-at "// surefire lint_off_line ")
- (goto-char (match-end 0))
- (let ((lim (save-excursion (end-of-line) (point))))
- (if (re-search-forward code lim 'move)
- (throw 'already t)
- (insert-string (concat " " code)))))
- (t
- )))
- ((verilog-in-star-comment-p)
- (re-search-backward "/\*")
- (insert-string (format " // surefire lint_off_line %6s" code ))
- )
- (t
- (insert-string (format " // surefire lint_off_line %6s" code ))
- )))))))
+ (let ((buff (if (boundp 'next-error-last-buffer)
+ next-error-last-buffer
+ compilation-last-buffer)))
+ (when (buffer-live-p buff)
+ ;; FIXME with-current-buffer?
+ (save-excursion
+ (switch-to-buffer buff)
+ (beginning-of-line)
+ (when
+ (looking-at "\\(INFO\\|WARNING\\|ERROR\\) \\[[^-]+-\\([^]]+\\)\\]: \\([^,]+\\), line \\([0-9]+\\): \\(.*\\)$")
+ (let* ((code (match-string 2))
+ (file (match-string 3))
+ (line (match-string 4))
+ (buffer (get-file-buffer file))
+ dir filename)
+ (unless buffer
+ (progn
+ (setq buffer
+ (and (file-exists-p file)
+ (find-file-noselect file)))
+ (or buffer
+ (let* ((pop-up-windows t))
+ (let ((name (expand-file-name
+ (read-file-name
+ (format "Find this error in: (default %s) "
+ file)
+ dir file t))))
+ (if (file-directory-p name)
+ (setq name (expand-file-name filename name)))
+ (setq buffer
+ (and (file-exists-p name)
+ (find-file-noselect name))))))))
+ (switch-to-buffer buffer)
+ (goto-line (string-to-number line))
+ (end-of-line)
+ (catch 'already
+ (cond
+ ((verilog-in-slash-comment-p)
+ (re-search-backward "//")
+ (cond
+ ((looking-at "// surefire lint_off_line ")
+ (goto-char (match-end 0))
+ (let ((lim (save-excursion (end-of-line) (point))))
+ (if (re-search-forward code lim 'move)
+ (throw 'already t)
+ (insert (concat " " code)))))
+ (t
+ )))
+ ((verilog-in-star-comment-p)
+ (re-search-backward "/\*")
+ (insert (format " // surefire lint_off_line %6s" code ))
+ )
+ (t
+ (insert (format " // surefire lint_off_line %6s" code ))
+ )))))))))
(defun verilog-verilint-off ()
"Convert a Verilint warning line into a disable statement.
;; Make sure any sub-files we read get proper mode
(setq default-major-mode `verilog-mode)
;; Ditto files already read in
- (mapcar '(lambda (buf)
- (when (buffer-file-name buf)
- (save-excursion
- (set-buffer buf)
- (verilog-mode))))
- (buffer-list))
+ (mapc (lambda (buf)
+ (when (buffer-file-name buf)
+ (save-excursion
+ (set-buffer buf)
+ (verilog-mode))))
+ (buffer-list))
;; Process the files
(mapcar '(lambda (buf)
(when (buffer-file-name buf)
(save-excursion
(if (not (file-exists-p (buffer-file-name buf)))
- (error (concat "File not found: " (buffer-file-name buf))))
+ (error
+ (concat "File not found: " (buffer-file-name buf))))
(message (concat "Processing " (buffer-file-name buf)))
(set-buffer buf)
(funcall funref)
(save-excursion
(verilog-beg-of-statement)
(if (= (point) here)
- (throw 'nesting 'block))
- )))
+ (throw 'nesting 'block)))))
(t (throw 'nesting 'block))))
((looking-at verilog-end-block-re)
(throw 'nesting 'cpp))
((bobp)
- (throw 'nesting 'cpp))
- ))
- (throw 'nesting 'cpp)
- )
- )
+ (throw 'nesting 'cpp))))
+ (throw 'nesting 'cpp)))
(defun verilog-calculate-indent-directive ()
"Return indentation level for directive.
((verilog-continued-line)
(let ((sp1 (point)))
(if (verilog-continued-line)
- (progn (goto-char sp)
- (setq indent-str (list 'statement (verilog-current-indent-level))))
+ (progn
+ (goto-char sp)
+ (setq
+ indent-str (list 'statement (verilog-current-indent-level))))
(goto-char sp1)
(setq indent-str (list 'block (verilog-current-indent-level)))))
(goto-char sp))
(setq e (point)) ;Might be on last line
(verilog-forward-syntactic-ws)
(beginning-of-line)
- (while (and (not(looking-at (concat "^\\s-*" verilog-complete-reg)))
+ (while (and (not (looking-at
+ (concat "^\\s-*" verilog-complete-reg)))
(looking-at myre))
(end-of-line)
(setq e (point))
(val)
(m1 (make-marker))
)
- (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
+ (setq val
+ (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
(indent-line-to val)
;; Use previous declaration (in this module) as template.
(skip-chars-forward " \t")
(setq ind (current-column))
(goto-char pos)
- (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
+ (setq val
+ (+ baseind
+ (eval (cdr (assoc 'declaration verilog-indent-alist)))))
(indent-line-to val)
(if (and verilog-indent-declaration-macros
(looking-at verilog-declaration-re-2-macro))
(if (/= (current-column) ind)
(progn
(just-one-space)
- (indent-to ind))
- )))
- )))
- )
- )
- (goto-char pos)
- )
- )
+ (indent-to ind))))))))))
+ (goto-char pos)))
(defun verilog-get-lineup-indent (b edpos)
"Return the indent level that will line up several lines within the region.
(progn
(save-excursion
(goto-char (point-min))
- (setq pt (re-search-forward (verilog-build-defun-re label t) nil t)))
+ (setq pt
+ (re-search-forward (verilog-build-defun-re label t) nil t)))
(when pt
(goto-char pt)
(beginning-of-line))
(search-forward "<title>")
(replace-match string t t)
(setq string (read-string "project: " verilog-project))
- (make-variable-buffer-local 'verilog-project)
(setq verilog-project string)
(search-forward "<project>")
(replace-match string t t)
(setq string (read-string "Company: " verilog-company))
- (make-variable-buffer-local 'verilog-company)
(setq verilog-company string)
(search-forward "<company>")
(replace-match string t t)
(setq bus (verilog-sig-bits sig))
(cond ((and bus
(or (and (string-match "\\[\\([0-9]+\\):\\([0-9]+\\)\\]" bus)
- (setq highbit (string-to-int (match-string 1 bus))
- lowbit (string-to-int (match-string 2 bus))))
+ (setq highbit (string-to-number (match-string 1 bus))
+ lowbit (string-to-number
+ (match-string 2 bus))))
(and (string-match "\\[\\([0-9]+\\)\\]" bus)
- (setq highbit (string-to-int (match-string 1 bus))
+ (setq highbit (string-to-number (match-string 1 bus))
lowbit highbit))))
;; Combine bits in bus
(if sv-highbit
(setq sig (car in-list))
(cond ((and sig (equal sv-name (verilog-sig-name sig)))
;; Combine with this signal
- (when (and sv-busstring (not (equal sv-busstring (verilog-sig-bits sig))))
+ (when (and sv-busstring
+ (not (equal sv-busstring (verilog-sig-bits sig))))
(when nil ;; Debugging
(message (concat "Warning, can't merge into single bus "
sv-name bus
;; Note sig may also be nil for the last signal in the list
(t
(setq out-list
- (cons (list sv-name
- (or sv-busstring
- (if sv-highbit
- (concat "[" (int-to-string sv-highbit) ":" (int-to-string sv-lowbit) "]")))
+ (cons
+ (list sv-name
+ (or sv-busstring
+ (if sv-highbit
+ (concat "[" (int-to-string sv-highbit) ":"
+ (int-to-string sv-lowbit) "]")))
(concat sv-comment combo buswarn)
sv-memory sv-enum sv-signed sv-type sv-multidim)
out-list)
(nreverse sigs-gparam)
))))
-(defvar sigs-in nil) ; Prevent compile warning
-(defvar sigs-inout nil) ; Prevent compile warning
-(defvar sigs-out nil) ; Prevent compile warning
+(defvar sigs-in) ; Prevent compile warning
+(defvar sigs-inout) ; Prevent compile warning
+(defvar sigs-out) ; Prevent compile warning
+
+
+(defsubst verilog-modi-get-decls (modi)
+ (verilog-modi-cache-results modi 'verilog-read-decls))
+
+(defsubst verilog-modi-get-sub-decls (modi)
+ (verilog-modi-cache-results modi 'verilog-read-sub-decls))
+
+
+;; Signal reading for given module
+;; Note these all take modi's - as returned from the
+;; verilog-modi-current function.
+(defsubst verilog-modi-get-outputs (modi)
+ (aref (verilog-modi-get-decls modi) 0))
+(defsubst verilog-modi-get-inouts (modi)
+ (aref (verilog-modi-get-decls modi) 1))
+(defsubst verilog-modi-get-inputs (modi)
+ (aref (verilog-modi-get-decls modi) 2))
+(defsubst verilog-modi-get-wires (modi)
+ (aref (verilog-modi-get-decls modi) 3))
+(defsubst verilog-modi-get-regs (modi)
+ (aref (verilog-modi-get-decls modi) 4))
+(defsubst verilog-modi-get-assigns (modi)
+ (aref (verilog-modi-get-decls modi) 5))
+(defsubst verilog-modi-get-consts (modi)
+ (aref (verilog-modi-get-decls modi) 6))
+(defsubst verilog-modi-get-gparams (modi)
+ (aref (verilog-modi-get-decls modi) 7))
+(defsubst verilog-modi-get-sub-outputs (modi)
+ (aref (verilog-modi-get-sub-decls modi) 0))
+(defsubst verilog-modi-get-sub-inouts (modi)
+ (aref (verilog-modi-get-sub-decls modi) 1))
+(defsubst verilog-modi-get-sub-inputs (modi)
+ (aref (verilog-modi-get-sub-decls modi) 2))
+
(defun verilog-read-sub-decls-sig (submodi comment port sig vec multidim)
"For verilog-read-sub-decls-line, add a signal."
(end-pt (point)))
(eval-region beg-pt end-pt nil)))))
-(eval-when-compile
- ;; These are passed in a let, not global
- (if (not (boundp 'sigs-in))
- (defvar sigs-in nil) (defvar sigs-out nil)
- (defvar got-sig nil) (defvar got-rvalue nil) (defvar uses-delayed nil)))
+;; These are passed in a let, not global
+(defvar got-sig)
+(defvar got-rvalue)
+(defvar uses-delayed)
(defun verilog-read-always-signals-recurse
(exit-keywd rvalue ignore-next)
"Convert `verilog-library-flags' into standard library variables."
;; If the flags are local, then all the outputs should be local also
(when (local-variable-p `verilog-library-flags (current-buffer))
- (make-variable-buffer-local 'verilog-library-extensions)
- (make-variable-buffer-local 'verilog-library-directories)
- (make-variable-buffer-local 'verilog-library-files)
- (make-variable-buffer-local 'verilog-library-flags))
+ (mapc 'make-local-variable '(verilog-library-extensions
+ verilog-library-directories
+ verilog-library-files
+ verilog-library-flags)))
;; Allow user to customize
(run-hooks 'verilog-before-getopt-flags-hook)
;; Process arguments
"Return point if MODULE is specified inside FILENAME, else nil.
Allows version control to check out the file if need be."
(and (or (file-exists-p filename)
- (and
- (condition-case nil
- (fboundp 'vc-backend)
- (error nil))
- (vc-backend filename)))
+ (and (fboundp 'vc-backend)
+ (vc-backend filename)))
(let (pt)
(save-excursion
(set-buffer (find-file-noselect filename))
For speeding up verilog-modi-get-* commands.
Buffer-local.")
+(make-variable-buffer-local 'verilog-modi-cache-list)
+
(defvar verilog-modi-cache-preserve-tick nil
"Modification tick after which the cache is still considered valid.
Use verilog-preserve-cache's to set")
(setq func-returns (funcall function))
(when fontlocked (font-lock-mode t)))
;; Cache for next time
- (make-variable-buffer-local 'verilog-modi-cache-list)
(setq verilog-modi-cache-list
(cons (list (list (verilog-modi-name modi) function)
(buffer-modified-tick)
(verilog-modi-cache-preserve-buffer (current-buffer)))
(progn ,@body)))
-(defsubst verilog-modi-get-decls (modi)
- (verilog-modi-cache-results modi 'verilog-read-decls))
-
-(defsubst verilog-modi-get-sub-decls (modi)
- (verilog-modi-cache-results modi 'verilog-read-sub-decls))
-
-;; Signal reading for given module
-;; Note these all take modi's - as returned from the verilog-modi-current function
-(defsubst verilog-modi-get-outputs (modi)
- (aref (verilog-modi-get-decls modi) 0))
-(defsubst verilog-modi-get-inouts (modi)
- (aref (verilog-modi-get-decls modi) 1))
-(defsubst verilog-modi-get-inputs (modi)
- (aref (verilog-modi-get-decls modi) 2))
-(defsubst verilog-modi-get-wires (modi)
- (aref (verilog-modi-get-decls modi) 3))
-(defsubst verilog-modi-get-regs (modi)
- (aref (verilog-modi-get-decls modi) 4))
-(defsubst verilog-modi-get-assigns (modi)
- (aref (verilog-modi-get-decls modi) 5))
-(defsubst verilog-modi-get-consts (modi)
- (aref (verilog-modi-get-decls modi) 6))
-(defsubst verilog-modi-get-gparams (modi)
- (aref (verilog-modi-get-decls modi) 7))
-(defsubst verilog-modi-get-sub-outputs (modi)
- (aref (verilog-modi-get-sub-decls modi) 0))
-(defsubst verilog-modi-get-sub-inouts (modi)
- (aref (verilog-modi-get-sub-decls modi) 1))
-(defsubst verilog-modi-get-sub-inputs (modi)
- (aref (verilog-modi-get-sub-decls modi) 2))
-
(defun verilog-signals-matching-enum (in-list enum)
"Return all signals in IN-LIST matching the given ENUM."
(setq range-exp (match-string 1 range-exp)))
(cond ((not range-exp)
"1")
- ((string-match "^\\s *\\([0-9]+\\)\\s *:\\s *\\([0-9]+\\)\\s *$" range-exp)
- (int-to-string (1+ (abs (- (string-to-int (match-string 1 range-exp))
- (string-to-int (match-string 2 range-exp)))))))
+ ((string-match "^\\s *\\([0-9]+\\)\\s *:\\s *\\([0-9]+\\)\\s *$"
+ range-exp)
+ (int-to-string
+ (1+ (abs (- (string-to-number (match-string 1 range-exp))
+ (string-to-number (match-string 2 range-exp)))))))
((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp)
- (concat "(1+(" (match-string 1 range-exp)
- ")"
- (if (equal "0" (match-string 2 range-exp)) ;; Don't bother with -(0)
+ (concat "(1+(" (match-string 1 range-exp) ")"
+ (if (equal "0" (match-string 2 range-exp))
+ ;; Don't bother with -(0)
""
(concat "-(" (match-string 2 range-exp) ")"))
")"))
(defun verilog-auto-reeval-locals (&optional force)
"Read file local variable segment at bottom of file if it has changed.
If FORCE, always reread it."
- (make-variable-buffer-local 'verilog-auto-last-file-locals)
+ (make-local-variable 'verilog-auto-last-file-locals)
(let ((curlocal (verilog-auto-read-locals)))
(when (or force (not (equal verilog-auto-last-file-locals curlocal)))
(setq verilog-auto-last-file-locals curlocal)
(when sig-list
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(indent-to indent-pt)
- (insert "// Outputs\n") ;; Note these are searched for in verilog-read-sub-decls
- (mapcar (function (lambda (port)
- (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
- sig-list)))
+ ;; Note these are searched for in verilog-read-sub-decls.
+ (insert "// Outputs\n")
+ (mapc (lambda (port)
+ (verilog-auto-inst-port port indent-pt
+ tpl-list tpl-num for-star))
+ sig-list)))
(let ((sig-list (verilog-signals-not-in
(verilog-modi-get-inouts submodi)
skip-pins))
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(indent-to indent-pt)
(insert "// Inouts\n")
- (mapcar (function (lambda (port)
- (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
- sig-list)))
+ (mapc (lambda (port)
+ (verilog-auto-inst-port port indent-pt
+ tpl-list tpl-num for-star))
+ sig-list)))
(let ((sig-list (verilog-signals-not-in
(verilog-modi-get-inputs submodi)
skip-pins))
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(indent-to indent-pt)
(insert "// Inputs\n")
- (mapcar (function (lambda (port)
- (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star)))
- sig-list)))
+ (mapc (lambda (port)
+ (verilog-auto-inst-port port indent-pt
+ tpl-list tpl-num for-star))
+ sig-list)))
;; Kill extra semi
(save-excursion
(cond (did-first
(when sig-list
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(indent-to indent-pt)
- (insert "// Parameters\n") ;; Note these are searched for in verilog-read-sub-decls
- (mapcar (function (lambda (port)
- (verilog-auto-inst-port port indent-pt tpl-list tpl-num nil)))
- sig-list)))
+ ;; Note these are searched for in verilog-read-sub-decls.
+ (insert "// Parameters\n")
+ (mapc (lambda (port)
+ (verilog-auto-inst-port port indent-pt
+ tpl-list tpl-num nil))
+ sig-list)))
;; Kill extra semi
(save-excursion
(cond (did-first
(goto-char (point-min))
(while (search-forward "AUTO_TEMPLATE" nil t)
(setq templateno (1+ templateno))
- (setq template-line (cons (count-lines (point-min) (point)) template-line)))
+ (setq template-line
+ (cons (count-lines (point-min) (point)) template-line)))
(setq template-line (nreverse template-line))
;; Replace T# L# with absolute line number
(goto-char (point-min))
(while (re-search-forward " Templated T\\([0-9]+\\) L\\([0-9]+\\)" nil t)
- (replace-match (concat " Templated "
- (int-to-string (+ (nth (string-to-int (match-string 1))
- template-line)
- (string-to-int (match-string 2)))))
- t t))))
+ (replace-match
+ (concat " Templated "
+ (int-to-string (+ (nth (string-to-number (match-string 1))
+ template-line)
+ (string-to-number (match-string 2)))))
+ t t))))
\f
;;
Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com."
(interactive)
(unless noninteractive (message "Updating AUTOs..."))
- (if (featurep 'dinotrace)
+ (if (fboundp 'dinotrace-unannotate-all)
(dinotrace-unannotate-all))
(let ((oldbuf (if (not (buffer-modified-p))
(buffer-string)))
(defvar verilog-sk-reset nil)
(defun verilog-sk-prompt-reset ()
"Prompt for the name of a state machine reset."
- (setq verilog-sk-reset (read-input "name of reset: " "rst")))
+ (setq verilog-sk-reset (read-string "name of reset: " "rst")))
(define-skeleton verilog-sk-prompt-state-selector
(princ "To submit a bug, use M-x verilog-submit-bug-report\n")
(princ "\n")))
+(autoload 'reporter-submit-bug-report "reporter")
+
(defun verilog-submit-bug-report ()
"Submit via mail a bug report on verilog-mode.el."
(interactive)
\f
(defvar regexp-history nil
- "History list for some commands that read regular expressions.")
+ "History list for some commands that read regular expressions.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(defalias 'delete-non-matching-lines 'keep-lines)
;;;###autoload
(defun server-save-buffers-kill-terminal (proc &optional arg)
+ ;; Called from save-buffers-kill-terminal in files.el.
"Offer to save each buffer, then kill PROC.
With prefix arg, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
- (let ((buffers (process-get proc 'buffers)))
- ;; If client is bufferless, emulate a normal Emacs session
- ;; exit and offer to save all buffers. Otherwise, offer to
- ;; save only the buffers belonging to the client.
- (save-some-buffers arg
- (if buffers
- (lambda () (memq (current-buffer) buffers))
- t))
- (server-delete-client proc)))
+ ;; save-buffers-kill-terminal occasionally calls us with proc set
+ ;; to `nowait' (comes from the value of the `client' frame parameter).
+ (when (processp proc)
+ (let ((buffers (process-get proc 'buffers)))
+ ;; If client is bufferless, emulate a normal Emacs session
+ ;; exit and offer to save all buffers. Otherwise, offer to
+ ;; save only the buffers belonging to the client.
+ (save-some-buffers arg
+ (if buffers
+ (lambda () (memq (current-buffer) buffers))
+ t))
+ (server-delete-client proc))))
(define-key ctl-x-map "#" 'server-edit)
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
-except when an alternate history list is specified.")
+except when an alternate history list is specified.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(defvar minibuffer-history-sexp-flag nil
"Control whether history list elements are expressions or strings.
If the value of this variable equals current minibuffer depth,
t))
\f
(defvar shell-command-history nil
- "History list for some commands that read shell commands.")
+ "History list for some commands that read shell commands.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(defvar shell-command-switch "-c"
"Switch used to have the shell execute its command line argument.")
(equal yank-handler (get-text-property 0 'yank-handler cur)))
yank-handler)))
+(defcustom yank-pop-change-selection nil
+ "If non-nil, rotating the kill ring changes the window system selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
+
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
If N is zero, `interprogram-paste-function' is set, and calling it returns a
string or list of strings, then that string (or list) is added to the front
of the kill ring and the string (or first string in the list) is returned as
-the latest kill. If optional arg DO-NOT-MOVE is non-nil, then don't
-actually move the yanking point; just return the Nth kill forward."
+the latest kill.
+
+If N is not zero, and if `yank-pop-change-selection' is
+non-nil, use `interprogram-cut-function' to transfer the
+kill at the new yank point into the window system selection.
+
+If optional arg DO-NOT-MOVE is non-nil, then don't actually
+move the yanking point; just return the Nth kill forward."
+
(let ((interprogram-paste (and (= n 0)
interprogram-paste-function
(funcall interprogram-paste-function))))
(nthcdr (mod (- n (length kill-ring-yank-pointer))
(length kill-ring))
kill-ring)))
- (or do-not-move
- (setq kill-ring-yank-pointer ARGth-kill-element))
+ (unless do-not-move
+ (setq kill-ring-yank-pointer ARGth-kill-element)
+ (when (and yank-pop-change-selection
+ (> n 0)
+ interprogram-cut-function)
+ (funcall interprogram-cut-function (car ARGth-kill-element))))
(car ARGth-kill-element)))))
(setq mark-active nil)
(run-hooks 'deactivate-mark-hook))))
+(defcustom select-active-regions nil
+ "If non-nil, an active region automatically becomes the window selection."
+ :type 'boolean
+ :group 'killing
+ :version "23.1")
+
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
That is to say, don't use this function unless you want
(progn
(setq mark-active t)
(run-hooks 'activate-mark-hook)
+ (and select-active-regions
+ (x-set-selection
+ nil (buffer-substring (region-beginning) (region-end))))
(set-marker (mark-marker) pos (current-buffer)))
;; Normally we never clear mark-active except in Transient Mark mode.
;; But when we actually clear out the mark value too,
(run-hooks 'deactivate-mark-hook)
(set-marker (mark-marker) nil)))
+(defcustom use-empty-active-region nil
+ "If non-nil, an active region takes control even if empty.
+This applies to certain commands which, in Transient Mark mode,
+apply to the active region if there is one. If the setting is t,
+these commands apply to an empty active region if there is one.
+If the setting is nil, these commands treat an empty active
+region as if it were not active."
+ :type 'boolean
+ :version "23.1"
+ :group 'editing-basics)
+
+(defun use-region-p ()
+ "Return t if certain commands should apply to the region.
+Certain commands normally apply to text near point,
+but in Transient Mark mode when the mark is active they apply
+to the region instead. Such commands should use this subroutine to
+test whether to do that.
+
+This function also obeys `use-empty-active-region'."
+ (and transient-mark-mode mark-active
+ (or use-empty-active-region (> (region-end) (region-beginning)))))
+
+(defun region-active-p ()
+ "Return t if Transient Mark mode is enabled and the mark is active.
+This is NOT the best function to use to test whether a command should
+operate on the region instead of the usual behavior -- for that,
+use `use-region-p'."
+ (and transient-mark-mode mark-active))
+
(defvar mark-ring nil
"The list of former marks of the current buffer, most recent first.")
(make-variable-buffer-local 'mark-ring)
'switch-to-buffer-other-frame yank-action send-actions))
\f
(defvar set-variable-value-history nil
- "History of values entered with `set-variable'.")
+ "History of values entered with `set-variable'.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(defun set-variable (variable value &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
speedbar-ignored-directory-regexp
(speedbar-extension-list-to-regex val))))
-(defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\|\\..*\\)\\'"
+(defcustom speedbar-directory-unshown-regexp "^\\(\\..*\\)\\'"
"*Regular expression matching directories not to show in speedbar.
They should include commonly existing directories which are not
-useful, such as version control."
+useful. It is no longer necessary to include include version-control
+directories here; see \\[vc-directory-exclusion-list\\]."
:group 'speedbar
:type 'string)
(while dir
(if (not
(or (string-match speedbar-file-unshown-regexp (car dir))
+ (member (car dir) vc-directory-exclusion-list)
(string-match speedbar-directory-unshown-regexp (car dir))))
(if (file-directory-p (car dir))
(setq dirs (cons (car dir) dirs))
"Return t if we should bother checking DIRECTORY for version control files.
This can be overloaded to add new types of version control systems."
(or
- ;; Local CVS available in Emacs 21
- (and (fboundp 'vc-state)
- (file-exists-p (concat directory "CVS/")))
- ;; Local RCS
- (file-exists-p (concat directory "RCS/"))
- ;; Local SCCS
- (file-exists-p (concat directory "SCCS/"))
- ;; Remote SCCS project
- (let ((proj-dir (getenv "PROJECTDIR")))
- (if proj-dir
- (file-exists-p (concat proj-dir "/SCCS"))
- nil))
+ (catch t (dolist (vcd vc-directory-exclusion-list)
+ (if (file-exists-p (concat directory vcd)) (throw t t))) nil)
;; User extension
(run-hook-with-args-until-success 'speedbar-vc-directory-enable-hook
directory)
(defun speedbar-this-file-in-vc (directory name)
"Check to see if the file in DIRECTORY with NAME is in a version control system.
-You can add new VC systems by overriding this function. You can
+Automatically recognizes all VCs supported by VC mode. You can
optimize this function by overriding it and only doing those checks
that will occur on your system."
(or
- (if (fboundp 'vc-state)
- ;; Emacs 21 handles VC state in a nice way.
- (condition-case nil
- (let ((state (vc-state (concat directory name))))
- (not (or (eq 'up-to-date state)
- (null state))))
- ;; An error means not in a VC system
- (error nil))
- (or
- ;; RCS file name
- (file-exists-p (concat directory "RCS/" name ",v"))
- (file-exists-p (concat directory "RCS/" name))
- ;; Local SCCS file name
- (file-exists-p (concat directory "SCCS/s." name))
- ;; Remote SCCS file name
- (let ((proj-dir (getenv "PROJECTDIR")))
- (if proj-dir
- (file-exists-p (concat proj-dir "/SCCS/s." name))
- nil))))
+ (vc-backend (concat directory "/" name))
;; User extension
(run-hook-with-args 'speedbar-vc-in-control-hook directory name)
))
;; These are temporary storage areas for the splash screen display.
-(defvar fancy-splash-help-echo nil)
-
(defun fancy-splash-insert (&rest args)
"Insert text into the current buffer, with faces.
Arguments from ARGS should be either strings; functions called
(funcall it)
it))
'face current-face
- 'help-echo fancy-splash-help-echo))))
+ 'help-echo (startup-echo-area-message)))))
(setq args (cdr args)))))
:type 'boolean
:group 'killing)
+(defcustom x-select-enable-primary t
+ "Non-nil means cutting and pasting uses the primary selection."
+ :type 'boolean
+ :group 'killing)
+
(defun x-select-text (text &optional push)
"Make TEXT, a string, the primary X selection.
Also, set the value of X cut buffer 0, for backward compatibility
;; ICCCM says cut buffer always contain ISO-Latin-1
(encode-coding-string text 'iso-latin-1))
(x-set-cut-buffer x-last-selected-text-cut-encoded push)))
- (x-set-selection 'PRIMARY text)
- (setq x-last-selected-text-primary text)
+ (when x-select-enable-primary
+ (x-set-selection 'PRIMARY text)
+ (setq x-last-selected-text-primary text))
(when x-select-enable-clipboard
(x-set-selection 'CLIPBOARD text)
(setq x-last-selected-text-clipboard text))))
nil)
(t (setq x-last-selected-text-clipboard clip-text)))))
- (setq primary-text (x-selection-value 'PRIMARY))
- ;; Check the PRIMARY selection for 'newness', is it different
- ;; from what we remebered them to be last time we did a
- ;; cut/paste operation.
- (setq primary-text
- (cond ;; check primary selection
- ((or (not primary-text) (string= primary-text ""))
- (setq x-last-selected-text-primary nil))
- ((eq primary-text x-last-selected-text-primary) nil)
- ((string= primary-text x-last-selected-text-primary)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-primary primary-text)
- nil)
- (t
- (setq x-last-selected-text-primary primary-text))))
+ (when x-select-enable-primary
+ (setq primary-text (x-selection-value 'PRIMARY))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq primary-text
+ (cond ;; check primary selection
+ ((or (not primary-text) (string= primary-text ""))
+ (setq x-last-selected-text-primary nil))
+ ((eq primary-text x-last-selected-text-primary) nil)
+ ((string= primary-text x-last-selected-text-primary)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-primary primary-text)
+ nil)
+ (t
+ (setq x-last-selected-text-primary primary-text)))))
(setq cut-text (x-get-cut-buffer 0))
(defvar x-pointer-crosshair)
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defface (var values doc &rest args)
- `(make-face ,var))
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
;; User options
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
This function is called when we are going to break the current line
after or before a non-ASCII character. If the charset of the
character has the property `fill-find-break-point-function', this
-function calls the property value as a function with one arg LINEBEG.
+function calls the property value as a function with one arg LIMIT.
If the charset has no such property, do nothing."
(let ((func (or
(aref fill-find-break-point-function-table (following-char))
(defvar mail-yank-prefix)
-;;; Custom.el macros require recompiling this when they are not present.
-;;; Add in backward compatible custom support.
-(eval-when-compile
- (if (not (fboundp 'defcustom))
- (defmacro defcustom (symbol value doc &rest args)
- "Empty replacement for defcustom when not supplied."
- `(defvar ,symbol ,value ,doc))))
-
-(eval-when-compile
- (if (not (fboundp 'defgroup))
- (defmacro defgroup (&rest args)
- "Empty replacement for defgroup when not supplied.")))
-
(defgroup ispell nil
"User variables for Emacs ispell interface."
:group 'applications)
(if org-ignore-region
nil
(if (featurep 'xemacs)
- (and zmacs-regions (region-active-p))
- (and transient-mark-mode mark-active))))
+ (region-active-p)
+ (use-region-p))))
;; Invisibility compatibility
(buffer-substring-no-properties (match-beginning n) (match-end n))))
(defun reftex-region-active-p ()
- "Is transient-mark-mode on and the region active?
-Works on both Emacs and XEmacs."
- (if (featurep 'xemacs)
- (and zmacs-regions (region-active-p))
- (and transient-mark-mode mark-active)))
+ "Should we operate on an active region?"
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ ;; For XEmacs.
+ (region-active-p)))
(defun reftex-kill-buffer (buffer)
;; Kill buffer if it exists.
;;; Emacs lisp functions to convert Texinfo files to Info files.
-(or (fboundp 'defgroup)
- (defmacro defgroup (&rest ignore) nil))
-
-(or (fboundp 'defcustom)
- (defmacro defcustom (var value doc &rest ignore)
- `(defvar ,var ,value ,doc)))
-
(defvar texinfmt-version "2.42 of 7 Jul 2006")
(defun texinfmt-version (&optional here)
;;; Code:
-(or (fboundp 'defgroup)
- (defmacro defgroup (&rest ignore) nil))
-
-(or (fboundp 'defcustom)
- (defmacro defcustom (var value doc &rest ignore)
- `(defvar ,var ,value ,doc)))
-
(eval-when-compile (require 'tex-mode) (require 'cl))
(defvar outline-heading-alist)
OUTPUT-FORMAT is the file format to output (default is jpeg),
ACTION-PREFIX is the symbol to place before the ACTION command
(defaults to '-' but can sometimes be '+')."
- (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
- thumbs-conversion-program
- (or action-prefix "-")
- action
- (or arg "")
- filein
- (or output-format "jpeg")
- fileout)))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+ (call-process thumbs-conversion-program nil nil nil
+ (or action-prefix "-")
+ action
+ (or arg "")
+ filein
+ (format "%s:%s" (or output-format "jpeg") fileout)))
(defun thumbs-new-image-size (s increment)
"New image (a cons of width x height)."
(buffer-substring start (point)))))))
(defmacro tooltip-region-active-p ()
- "Value is non-nil if the region is currently active."
- (if (not (featurep 'xemacs))
- `(and transient-mark-mode mark-active)
- `(region-active-p)))
+ "Value is non-nil if the region should override command actions."
+ `(use-region-p))
(defun tooltip-expr-to-print (event)
"Return an expression that should be printed for EVENT.
;; and implement a command to run ediff and `bzr resolve' once the
;; changes have been merged.
(defun vc-bzr-dir-state (dir &optional localp)
- "Find the VC state of all files in DIR.
+ "Find the VC state of all files in DIR and its subdirectories.
Optional argument LOCALP is always ignored."
(let ((bzr-root-directory (vc-bzr-root dir))
(at-start t)
;; evidence of the contrary.
(setq at-start t)
(with-temp-buffer
- (vc-bzr-command "ls" t 0 nil "--versioned" "--non-recursive")
+ (buffer-disable-undo) ;; Because these buffers can get huge
+ (vc-bzr-command "ls" t 0 nil "--versioned")
(goto-char (point-min))
(while (or at-start
(eq 0 (forward-line)))
((looking-at "^renamed")
(setq current-vc-state 'edited)
(setq current-bzr-state 'renamed))
- ((looking-at "^\\(unknown\\|ignored\\)")
- (setq current-vc-state nil)
+ ((looking-at "^ignored")
+ (setq current-vc-state 'ignored)
+ (setq current-bzr-state 'not-versioned))
+ ((looking-at "^unknown")
+ (setq current-vc-state 'unregistered)
(setq current-bzr-state 'not-versioned))
((looking-at " ")
;; file names are indented by two spaces
'edited)))
(defun vc-cvs-dir-state (dir)
- "Find the CVS state of all files in DIR."
+ "Find the CVS state of all files in DIR and subdirectories."
;; if DIR is not under CVS control, don't do anything.
(when (file-readable-p (expand-file-name "CVS/Entries" dir))
(if (vc-stay-local-p dir)
;; Don't specify DIR in this command, the default-directory is
;; enough. Otherwise it might fail with remote repositories.
(with-temp-buffer
- (vc-cvs-command t 0 nil "status" "-l")
+ (buffer-disable-undo) ;; Because these buffers can get huge
+ (vc-cvs-command t 0 nil "status")
(goto-char (point-min))
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
(narrow-to-region (match-beginning 0) (match-end 0))
(cond ((eq cvs-state 'edited)
(if (equal (vc-working-revision file) "0")
"(added)" "(modified)"))
- ((eq cvs-state 'needs-patch) "(patch)")
- ((eq cvs-state 'needs-merge) "(merge)"))))
-
+ (t
+ (vc-default-dired-state-info 'CVS file)))))
;;;
;;; State-changing functions
(error "Couldn't analyze cvs update result")))
(message "Merging changes into %s...done" file))))
+(defun vc-cvs-modify-change-comment (files rev comment)
+ "Modify the change comments for FILES on a specified REV.
+Will fail unless you have administrative privileges on the repo."
+ (vc-cvs-command nil 0 files "rcs" (concat "-m" comment ":" rev)))
;;;
;;; History functions
;;;
(defun vc-cvs-print-log (files &optional buffer)
- "Get change log associated with FILE."
+ "Get change logs associated with FILES."
+ ;; It's just the catenation of the individual logs.
(vc-cvs-command
buffer
(if (vc-stay-local-p files) 'async 0)
(defun vc-cvs-parse-status (&optional full)
"Parse output of \"cvs status\" command in the current buffer.
Set file properties accordingly. Unless FULL is t, parse only
-essential information."
+essential information. Note that this can never set the 'ignored
+state."
(let (file status)
(goto-char (point-min))
+ (while (looking-at "? \\(.*\\)")
+ (setq file (expand-file-name (match-string 1)))
+ (vc-file-setprop file 'vc-state 'unregistered)
+ (forward-line 1))
(if (re-search-forward "^File: " nil t)
(cond
((looking-at "no file") nil)
(defun vc-git-state (file)
"Git-specific version of `vc-state'."
+ ;; FIXME: This can't set 'ignored yet
(vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
(let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--")))
(if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} [ADMU]\0[^\0]+\0"
'up-to-date)))
(defun vc-git-dir-state (dir)
+ "Git-specific version of `dir-state'."
+ ;; FIXME: This can't set 'ignored yet
(with-temp-buffer
+ (buffer-disable-undo) ;; Because these buffers can get huge
(vc-git-command (current-buffer) nil nil "ls-files" "-t" "-c" "-m" "-o")
(goto-char (point-min))
(let ((status-char nil)
(cond
((eq state ?A) 'edited)
((eq state ?M) 'edited)
- ((eq state ?R) nil)
- ((eq state ??) nil)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'unregistered)
+ ((eq state ??) 'unregistered)
(t 'up-to-date))))))))
(defun vc-hg-dir-state (dir)
(with-temp-buffer
+ (buffer-disable-undo) ;; Because these buffers can get huge
(vc-hg-command (current-buffer) nil nil "status")
(goto-char (point-min))
(let ((status-char nil)
;; The rest of the possible states in "hg status" output:
;; R = removed
;; ! = deleted, but still tracked
- ;; ? = not tracked
;; should not show up in vc-dired, so don't deal with them
;; here.
((eq status-char ?A)
(vc-file-setprop file 'vc-state 'edited))
((eq status-char ?M)
(vc-file-setprop file 'vc-state 'edited))
+ ((eq status-char ?I)
+ (vc-file-setprop file 'vc-state 'ignored))
((eq status-char ??)
(vc-file-setprop file 'vc-backend 'none)
- (vc-file-setprop file 'vc-state 'nil)))
+ (vc-file-setprop file 'vc-state 'unregistered)))
(forward-line)))))
(defun vc-hg-working-revision (file)
;;; History functions
-(defun vc-hg-print-log(files &optional buffer)
+(defun vc-hg-print-log (files &optional buffer)
"Get change log associated with FILES."
- ;; `log-view-mode' needs to have the file name in order to function
+ ;; `log-view-mode' needs to have the file names in order to function
;; correctly. "hg log" does not print it, so we insert it here by
;; hand.
(let ((inhibit-read-only t))
;; We need to loop and call "hg log" on each file separately.
;; "hg log" with multiple file arguments mashes all the logs
- ;; together.
+ ;; together. Ironically enough, this puts us back near CVS
+ ;; which can't generate proper fileset logs either.
(dolist (file files)
(with-current-buffer
buffer
- (insert "File: " (file-name-nondirectory file) "\n"))
+ (insert "Working file: " file "\n")) ;; Like RCS/CVS.
(vc-hg-command buffer 0 file "log"))))
(defvar log-view-message-re)
(define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
(require 'add-log) ;; we need the add-log faces
- (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
+ (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)")
(set (make-local-variable 'log-view-message-re)
"^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
(set (make-local-variable 'log-view-font-lock-keywords)
:version "23.1"
:group 'vc)
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS"
+ ".svn" ".git" ".hg" ".bzr"
+ "_MTN" "{arch}")
+ "List of directory names to be ignored when walking directory trees."
+ :type '(repeat string)
+ :group 'vc)
+
(defcustom vc-path
(if (file-directory-p "/usr/sccs")
'("/usr/sccs")
the master file. This state can only occur if locking
is not used for the file.
- 'unlocked-changes The current version of the working file is not locked,
+ 'unlocked-changes The working version of the file is not locked,
but the working file has been changed with respect
to that version. This state can only occur for files
with locking; it represents an erroneous condition that
should be resolved by the user (vc-next-action will
- prompt the user to do it)."
+ prompt the user to do it).
+
+ 'added Scheduled to go into the repository on the next commit.
+ Often represented by vc-working-revision = \"0\" in VCSes
+ with monotonic IDs like Subversion and Mercurial.
+
+ 'ignored The file showed up in a dir-state listing with a flag
+ indicating the version-control system is ignoring it,
+ Note: This property is not set reliably (some VCSes
+ don't have useful directory-status commands) so assume
+ that any file with vc-state nil might be ignorable
+ without VC knowing it.
+
+ 'unregistered The file showed up in a dir-state listing with a flag
+ indicating that it is not under version control.
+ Note: This property is not set reliably (some VCSes
+ don't have useful directory-status commands) so assume
+ that any file with vc-state nil might be unregistered
+ without VC knowing it.
+
+A return of nil from this function means we have no information on the
+status of this file.
+"
+ ;; Note: in Emacs 22 and older, return of nil meant the file was unregistered.
+ ;; This is potentially a source of backward-compatibility bugs.
+
;; FIXME: New (sub)states needed (?):
- ;; - `added' (i.e. `edited' but with no base version yet,
- ;; typically represented by vc-working-revision = "0")
;; - `conflict' (i.e. `edited' with conflict markers)
;; - `removed'
;; - `copied' and `moved' (might be handled by `removed' and `added')
(defalias 'vc-mcvs-state-heuristic 'vc-cvs-state-heuristic)
(defun vc-mcvs-dir-state (dir)
- "Find the Meta-CVS state of all files in DIR."
+ "Find the Meta-CVS state of all files in DIR and subdirectories."
;; if DIR is not under Meta-CVS control, don't do anything.
(when (file-readable-p (expand-file-name "MCVS/CVS/Entries" dir))
(if (vc-stay-local-p dir)
;; Don't specify DIR in this command, the default-directory is
;; enough. Otherwise it might fail with remote repositories.
(with-temp-buffer
+ (buffer-disable-undo) ;; Because these buffers can get huge
(setq default-directory (vc-mcvs-root dir))
- (vc-mcvs-command t 0 nil "status" "-l")
+ (vc-mcvs-command t 0 nil "status")
(goto-char (point-min))
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
(narrow-to-region (match-beginning 0) (match-end 0))
(error "Couldn't analyze mcvs update result")))
(message "Merging changes into %s...done" file))))
+(defun vc-mcvs-modify-change-comment (files rev comment)
+ "Modify the change comments for FILES on a specified REV.
+Will fail unless you have administrative privileges on the repo."
+ (vc-mcvs-command nil 0 files "rcs" (concat "-m" comment ":" rev)))
+
+
;;;
;;; History functions
;;;
;; expanded headers.
(vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))
+(defun vc-rcs-modify-change-comment (files rev comment)
+ "Modify the change comments change on FILES on a specified REV."
+ (dolist (file files)
+ (vc-do-command nil 0 "rcs" (vc-name file)
+ (concat "-m" comment ":" rev))))
\f
;;;
(vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
(vc-do-command nil 0 "get" (vc-name file) "-g" (if rev (concat "-r" rev))))
+(defun vc-sccs-modify-change-comment (files rev comment)
+ "Modify (actually, append to) the change comments for FILES on a specified REV."
+ (dolist (file files)
+ (vc-do-command nil 0 "cdc" (vc-name file)
+ (concat "-y" comment) (concat "-r" rev))))
+
\f
;;;
;;; History functions
;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
;; has been extensively modified since to handle filesets.
-;;; Bugs:
-
-;; - VC-dired is (really) slow.
-
;;; Code:
(eval-when-compile
(vc-svn-state file 'local))
(defun vc-svn-dir-state (dir &optional localp)
- "Find the SVN state of all files in DIR."
+ "Find the SVN state of all files in DIR and its subdirectories."
(setq localp (or localp (vc-stay-local-p dir)))
(let ((default-directory dir))
;; Don't specify DIR in this command, the default-directory is
;; enough. Otherwise it might fail with remote repositories.
(with-temp-buffer
+ (buffer-disable-undo) ;; Because these buffers can get huge
(vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
(vc-svn-parse-status))))
(cond ((eq svn-state 'edited)
(if (equal (vc-working-revision file) "0")
"(added)" "(modified)"))
- ((eq svn-state 'needs-patch) "(patch)")
- ((eq svn-state 'needs-merge) "(merge)"))))
+ (t
+ ;; fall back to the default VC representation
+ (vc-default-dired-state-info 'SVN file)))))
+
(defun vc-svn-previous-revision (file rev)
(let ((newrev (1- (string-to-number rev))))
(vc-setup-buffer buffer)
(let ((inhibit-read-only t))
(goto-char (point-min))
- ;; Add a line to tell log-view-mode what file this is.
- ;; FIXME if there are multiple files, log-view-current-file
- ;; breaks. It's trivial to adapt log-view-file-re for the
- ;; changed prefix, but less trivial to make
- ;; log-view-current-file actually do the right thing in the
- ;; multiple file case.
- (insert (format "Working file%s: "
- (if (= (length files) 1)
- ""
- "s"))
- (vc-delistify (mapcar 'file-relative-name files)) "\n"))
- (vc-svn-command
- buffer
- (if (and (= (length files) 1) (vc-stay-local-p (car files))) 'async 0)
- files "log"
- ;; By default Subversion only shows the log upto the working revision,
- ;; whereas we also want the log of the subsequent commits. At least
- ;; that's what the vc-cvs.el code does.
- "-rHEAD:0")))
+ (if files
+ (dolist (file files)
+ (insert "Working file: " file "\n")
+ (vc-svn-command
+ buffer
+ 'async
+ ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
+ (list file)
+ "log"
+ ;; By default Subversion only shows the log up to the
+ ;; working revision, whereas we also want the log of the
+ ;; subsequent commits. At least that's what the
+ ;; vc-cvs.el code does.
+ "-rHEAD:0"))
+ ;; Dump log for the entire directory.
+ (vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
(defun vc-svn-wash-log ()
"Remove all non-comment information from log output."
(if (eq (char-after (match-beginning 1)) ?*)
'needs-merge
'edited))
+ ((eq status ?I)
+ (vc-file-setprop file 'vc-state 'ignored))
+ ((eq status ??)
+ (vc-file-setprop file 'vc-state 'unregistered))
(t 'edited)))))
(if filename (vc-file-getprop filename 'vc-state))))
;; - dir-state (dir)
;;
;; If provided, this function is used to find the version control state
-;; of all files in DIR in a fast way. The function should not return
-;; anything, but rather store the files' states into the corresponding
-;; `vc-state' properties.
+;; of all files in DIR, and all subdirecties of DIR, in a fast way.
+;; The function should not return anything, but rather store the files'
+;; states into the corresponding `vc-state' properties. (Note: in
+;; older versions this method was not required to recurse into
+;; subdirectories.)
;;
;; * working-revision (file)
;;
;; used for files under this backend, and if files can indeed be
;; locked by other users.
;;
+;; - modify-change-comment (files rev comment)
+;;
+;; Modify the change comments associated with the files at the
+;; given revision. This is optional, many backends do not support it.
+;;
;; HISTORY FUNCTIONS
;;
;; * print-log (files &optional buffer)
:group 'vc
:version "20.3")
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn"
- ".git" ".hg" ".bzr" "{arch}")
- "List of directory names to be ignored when walking directory trees."
- :type '(repeat string)
- :group 'vc)
-
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
When running diff under a given BACKEND, VC concatenates the values of
"Make sure that the current buffer visits a version-controlled file."
(if vc-dired-mode
(set-buffer (find-file-noselect (dired-get-filename)))
- (while vc-parent-buffer
+ (while (and vc-parent-buffer
+ ;; Avoid infinite looping when vc-parent-buffer and
+ ;; current buffer are the same buffer.
+ (not (eq vc-parent-buffer (current-buffer))))
(set-buffer vc-parent-buffer))
(if (not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name))
(interactive "P")
(when (and (null fname) (null buffer-file-name)) (error "No visited file"))
- (let ((bname (if fname (get-file-buffer fname) buffer-file-name)))
+ (let ((bname (if fname (get-file-buffer fname) (current-buffer))))
(unless fname (setq fname buffer-file-name))
(when (vc-backend fname)
(if (vc-registered fname)
(vc-call-backend backend 'clear-headers)
(kill-buffer filename)))))
+(defun vc-modify-change-comment (files rev oldcomment)
+ "Edit the comment associated with the given files and revision."
+ (vc-start-entry
+ files rev oldcomment t
+ "Enter a replacement change comment."
+ (lambda (files rev comment)
+ (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))))
+
;;;###autoload
(defun vc-merge ()
"Merge changes between two revisions into the current buffer's file.
(replace-match (substring (concat vc-info " ") 0 10)
t t nil 1)))
+(defun vc-dired-ignorable-p (filename)
+ "Should FILENAME be ignored in VC-Dired listings?"
+ (catch t
+ ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
+ (dolist (ignorable completion-ignored-extensions)
+ (let ((ext (substring filename
+ (- (length filename)
+ (length ignorable)))))
+ (if (string= ignorable ext) (throw t t))))
+ ;; Ignore Makefiles derived from something else
+ (when (string= (file-name-nondirectory filename) "Makefile")
+ (let* ((dir (file-name-directory filename))
+ (peers (directory-files (or dir default-directory))))
+ (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
+ (throw t t))))
+ nil))
+
(defun vc-dired-hook ()
"Reformat the listing according to version control.
Called by dired after any portion of a vc-dired buffer has been read in."
(message "Getting version information... ")
- (let (subdir filename (inhibit-read-only t))
+ ;; if the backend supports it, get the state
+ ;; of all files in this directory at once
+ (let ((backend (vc-responsible-backend default-directory)))
+ ;; check `backend' can really handle `default-directory'.
+ (if (and (vc-call-backend backend 'responsible-p default-directory)
+ (vc-find-backend-function backend 'dir-state))
+ (vc-call-backend backend 'dir-state default-directory)))
+ (let (filename (inhibit-read-only t))
(goto-char (point-min))
(while (not (eobp))
(cond
;; subdir header line
- ((setq subdir (dired-get-subdir))
- ;; if the backend supports it, get the state
- ;; of all files in this directory at once
- (let ((backend (vc-responsible-backend subdir)))
- ;; check `backend' can really handle `subdir'.
- (if (and (vc-call-backend backend 'responsible-p subdir)
- (vc-find-backend-function backend 'dir-state))
- (vc-call-backend backend 'dir-state subdir)))
+ ((dired-get-subdir)
(forward-line 1)
;; erase (but don't remove) the "total" line
(delete-region (point) (line-end-position))
(t
(vc-dired-reformat-line nil)
(forward-line 1))))
- ;; ordinary file
- ((and (vc-backend filename)
- (not (and vc-dired-terse-mode
- (vc-up-to-date-p filename))))
- (vc-dired-reformat-line (vc-call dired-state-info filename))
- (forward-line 1))
+ ;; try to head off calling the expensive state query -
+ ;; ignore object files, TeX intermediate files, and so forth.
+ ((vc-dired-ignorable-p filename)
+ (dired-kill-line))
+ ;; ordinary file -- call the (possibly expensive) state query
(t
- (dired-kill-line))))
+ (let ((backend (vc-backend filename)))
+ (cond
+ ;; Not registered
+ ((not backend)
+ (if vc-dired-terse-mode
+ (dired-kill-line)
+ (vc-dired-reformat-line "?")
+ (forward-line 1)))
+ ;; Either we're in non-terse mode or it's out of date
+ ((not (and vc-dired-terse-mode (vc-up-to-date-p filename)))
+ (vc-dired-reformat-line (vc-call dired-state-info filename))
+ (forward-line 1))
+ ;; Remaining cases are under version control but uninteresting
+ (t
+ (dired-kill-line)))))))
;; any other line
(t (forward-line 1))))
(vc-dired-purge))
(widen)
(cond ((eq (count-lines (point-min) (point-max)) 1)
(goto-char (point-min))
- (message "No files locked under %s" default-directory)))))
+ (message "No changes pending under %s" default-directory)))))
(defun vc-dired-purge ()
"Remove empty subdirs."
((eq state 'edited) (concat "(" (vc-user-login-name file) ")"))
((eq state 'needs-merge) "(merge)")
((eq state 'needs-patch) "(patch)")
- ((eq state 'unlocked-changes) "(stale)")))
+ ((eq state 'added) "(added)")
+ ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out
+ ((eq state 'unregistered) "?")
+ ((eq state 'unlocked-changes) "(stale)")
+ ((not state) "(unknown)")))
(buffer
(get-file-buffer file))
(modflag
"The variable to store the extent to highlight.")
(make-variable-buffer-local 'whitespace-highlighted-space)
-;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
-(eval-when-compile
- (if (not (fboundp 'defgroup))
- (defmacro defgroup (sym memb doc &rest args)
- "Null macro for `defgroup' in all versions of Emacs that don't define it."
- t))
- (if (not (fboundp 'defcustom))
- (defmacro defcustom (sym val doc &rest args)
- "Macro to alias `defcustom' to `defvar' in all versions of Emacs that
-don't define it."
- `(defvar ,sym ,val ,doc))))
-
(defalias 'whitespace-make-overlay
(if (featurep 'xemacs) 'make-extent 'make-overlay))
(defalias 'whitespace-overlay-put
Otherwise move current line to window center on first call, and to
top, middle, or bottom on successive calls.
-The starting position of the window determines the cycling order:
- If initially in the top or middle third: top -> middle -> bottom.
- If initially in the bottom third: bottom -> middle -> top.
+The cycling order is: middle -> top -> bottom.
Top and bottom destinations are actually `scroll-conservatively' lines
from true window top and bottom."
(defmacro winner-active-region ()
- (if (fboundp 'region-active-p)
- '(region-active-p)
- 'mark-active))
+ (if (boundp 'mark-active)
+ 'mark-active
+ '(region-active-p)))
(defsetf winner-active-region () (store)
(if (fboundp 'zmacs-activate-region)
(require 'ring)
-(unless (fboundp 'defgroup)
- (defmacro defgroup (&rest rest)))
-
(defgroup winner nil
"Restoring window configurations."
:group 'windows)
-(unless (fboundp 'defcustom)
- (defmacro defcustom (symbol &optional initvalue docs &rest rest)
- (list 'defvar symbol initvalue docs)))
-
;;;###autoload
(defcustom winner-mode nil
"Toggle Winner mode.
(defalias 'xml-print 'xml-debug-print)
+(defun xml-escape-string (string)
+ "Return the string with entity substitutions made from
+xml-entity-alist."
+ (mapconcat (lambda (byte)
+ (let ((char (char-to-string byte)))
+ (if (rassoc char xml-entity-alist)
+ (concat "&" (car (rassoc char xml-entity-alist)) ";")
+ char)))
+ (if (multibyte-string-p string)
+ (encode-coding-string string 'utf-8)
+ string)
+ ""))
+
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
The first line is indented with INDENT-STRING."
;; output the attribute list
(setq attlist (xml-node-attributes tree))
(while attlist
- (insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\")
+ (insert ?\ (symbol-name (caar attlist)) "=\""
+ (xml-escape-string (cdar attlist)) ?\")
(setq attlist (cdr attlist)))
(setq tree (xml-node-children tree))
((listp node)
(insert ?\n)
(xml-debug-print-internal node (concat indent-string " ")))
- ((stringp node) (insert node))
+ ((stringp node)
+ (insert (xml-escape-string node)))
(t
(error "Invalid XML tree"))))
+2007-12-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * process.c (make_process): Initialize pty_flag to Qnil instead of 0
+ as it is not a bit field on Emacs 22 yet.
+
+ * xdisp.c (phys_cursor_in_rect_p): Check if cursor is in fringe area.
+
+2007-12-22 Eli Zaretskii <eliz@gnu.org>
+
+ * callint.c (syms_of_callint) <command-history>: Add reference to
+ history-length in the doc string.
+
+2007-12-17 Jason Rumney <jasonr@gnu.org>
+
+ * w32fns.c (w32_wnd_proc) <WM_KEYDOWN>: Cast char to unsigned
+ before passing as wParam.
+
+2007-12-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (xd_retrieve_arg): Handle DBUS_TYPE_BYTE,
+ DBUS_TYPE_INT16, DBUS_TYPE_UINT16, DBUS_TYPE_INT64,
+ DBUS_TYPE_UINT64, DBUS_TYPE_DOUBLE and DBUS_TYPE_SIGNATURE.
+ Return float when DBUS_TYPE_INT32 or DBUS_TYPE_UINT32 do not fit
+ as number.
+ (Fdbus_call_method): Fix docstring.
+
+2007-12-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (XD_BASIC_DBUS_TYPE, XD_DBUS_TYPE_P, XD_NEXT_VALUE):
+ New macros.
+ (XD_SYMBOL_TO_DBUS_TYPE): Renamed from
+ XD_LISP_SYMBOL_TO_DBUS_TYPE.
+ (XD_OBJECT_TO_DBUS_TYPE): Renamed from
+ XD_LISP_OBJECT_TO_DBUS_TYPE. Simplify.
+ (xd_signature): New function.
+ (xd_append_arg): Compute also signatures. Major rewrite.
+ (xd_retrieve_arg): Make debug messages friendly.
+ (Fdbus_call_method, Fdbus_send_signal): Extend docstring. Check
+ for signatures of arguments.
+
+2007-12-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (QCdbus_type_byte, QCdbus_type_boolean)
+ (QCdbus_type_int16, QCdbus_type_uint16, QCdbus_type_int32)
+ (QCdbus_type_uint32, QCdbus_type_int64, QCdbus_type_uint64)
+ (QCdbus_type_double, QCdbus_type_string, QCdbus_type_object_path)
+ (QCdbus_type_signature, QCdbus_type_array, QCdbus_type_variant)
+ (QCdbus_type_struct, QCdbus_type_dict_entry): New D-Bus type
+ symbols.
+ (XD_LISP_SYMBOL_TO_DBUS_TYPE): New macro.
+ (XD_LISP_OBJECT_TO_DBUS_TYPE): Add compound types.
+ (xd_retrieve_value): Removed. Functionality included in ...
+ (xd_append_arg): New function.
+ (Fdbus_call_method, Fdbus_send_signal): Apply it.
+
+2007-12-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * dbusbind.c (top): Include <stdio.h>.
+ (Fdbus_call_method, Fdbus_send_signal): Apply type cast in
+ dbus_message_new_method_call and dbus_message_new_signal.
+ (Fdbus_register_signal): Rename unique_name to uname. Check
+ handler for FUNCTIONP instead of CHECK_SYMBOL. Handle case of
+ non-existing unique name. Fix typos in matching rule. Return an
+ object which is useful in Fdbus_unregister_signal.
+ (Fdbus_unregister_signal): Reimplementation, in order to remove
+ only the corresponding entry.
+ (Vdbus_registered_functions_table): Change the order of entries.
+ Apply these changes in xd_read_message and Fdbus_register_signal.
+
+2007-12-16 Andreas Schwab <schwab@suse.de>
+
+ * fileio.c (Finsert_file_contents): Fix overflow check to not
+ depend on undefined integer overflow.
+
2007-12-14 Jason Rumney <jasonr@gnu.org>
* w32term.c (w32_read_socket): Use MULTIBYTE_CHAR_KEYSTROKE_EVENT
* msdos.c (dos_rawgetc): Undo last change (there's no ``leaving
selected frame'' on MSDOS).
+2007-10-12 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (Qexplicit_name): New variable.
+ (x_report_frame_params): Report it in parameter alist.
+ (syms_of_frame): Intern and staticpro it.
+
2007-10-10 Patrick Mahan <mahan@mahan.org> (tiny change)
* macfns.c (x_create_tip_frame): Set terminal for frame.
* puresize.h (BASE_PURESIZE): Increase to 1170000.
+2007-10-09 Jason Rumney <jasonr@gnu.org>
+
+ * w32term.c (x_set_window_size): Disable code that attempts to tell
+ Lisp code about a size change before it actually happens.
+
2007-10-09 Richard Stallman <rms@gnu.org>
* xdisp.c (handle_invisible_prop): After setting up an ellipsis,
DEFVAR_LISP ("command-history", &Vcommand_history,
doc: /* List of recent commands that read arguments from terminal.
-Each command is represented as a form to evaluate. */);
+Each command is represented as a form to evaluate.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see. */);
Vcommand_history = Qnil;
DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
#ifdef HAVE_DBUS
#include <stdlib.h>
+#include <stdio.h>
#include <dbus/dbus.h>
#include "lisp.h"
#include "frame.h"
/* Lisp symbols of the system and session buses. */
Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
+/* Lisp symbols of D-Bus types. */
+Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
+Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
+Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
+Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
+Lisp_Object QCdbus_type_double, QCdbus_type_string;
+Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
+Lisp_Object QCdbus_type_array, QCdbus_type_variant;
+Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
+
/* Hash table which keeps function definitions. */
Lisp_Object Vdbus_registered_functions_table;
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
we don't want to poison other namespaces with "dbus_". */
-/* Raise a Lisp error from a D-Bus error. */
+/* Raise a Lisp error from a D-Bus ERROR. */
#define XD_ERROR(error) \
{ \
char s[1024]; \
#define XD_DEBUG_VALID_LISP_OBJECT_P(object)
#endif
-/* Determine the DBusType of a given Lisp object. It is used to
+/* Check whether TYPE is a basic DBusType. */
+#define XD_BASIC_DBUS_TYPE(type) \
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16) \
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32) \
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64) \
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE))
+
+/* Determine the DBusType of a given Lisp symbol. OBJECT must be one
+ of the predefined D-Bus type symbols. */
+#define XD_SYMBOL_TO_DBUS_TYPE(object) \
+ ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \
+ : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \
+ : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \
+ : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \
+ : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \
+ : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \
+ : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \
+ : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \
+ : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \
+ : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \
+ : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \
+ : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \
+ : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \
+ : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \
+ : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \
+ : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \
+ : DBUS_TYPE_INVALID)
+
+/* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
+#define XD_DBUS_TYPE_P(object) \
+ (SYMBOLP (object) && ((XD_SYMBOL_TO_DBUS_TYPE (object) != DBUS_TYPE_INVALID)))
+
+/* Determine the DBusType of a given Lisp OBJECT. It is used to
convert Lisp objects, being arguments of `dbus-call-method' or
`dbus-send-signal', into corresponding C values appended as
arguments to a D-Bus message. */
-#define XD_LISP_OBJECT_TO_DBUS_TYPE(object) \
- (EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN : \
- (NATNUMP (object)) ? DBUS_TYPE_UINT32 : \
- (INTEGERP (object)) ? DBUS_TYPE_INT32 : \
- (FLOATP (object)) ? DBUS_TYPE_DOUBLE : \
- (STRINGP (object)) ? DBUS_TYPE_STRING : \
- DBUS_TYPE_INVALID
-
-/* Extract C value from Lisp OBJECT. DTYPE must be a valid DBusType,
- as detected by XD_LISP_OBJECT_TO_DBUS_TYPE. Compound types are not
- supported (yet). It is used to convert Lisp objects, being
- arguments of `dbus-call-method' or `dbus-send-signal', into
- corresponding C values appended as arguments to a D-Bus
- message. */
-char *
-xd_retrieve_value (dtype, object)
- unsigned int dtype;
+#define XD_OBJECT_TO_DBUS_TYPE(object) \
+ ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
+ : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
+ : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
+ : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
+ : (STRINGP (object)) ? DBUS_TYPE_STRING \
+ : (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object) \
+ : (CONSP (object)) ? ((XD_DBUS_TYPE_P (XCAR (object))) \
+ ? XD_SYMBOL_TO_DBUS_TYPE (XCAR (object)) \
+ : DBUS_TYPE_ARRAY) \
+ : DBUS_TYPE_INVALID)
+
+/* Return a list pointer which does not have a Lisp symbol as car. */
+#define XD_NEXT_VALUE(object) \
+ ((XD_DBUS_TYPE_P (XCAR (object))) ? XCDR (object) : object)
+
+/* Compute SIGNATURE of OBJECT. It must have a form that it can be
+ used in dbus_message_iter_open_container. DTYPE is the DBusType
+ the object is related to. It is passed as argument, because it
+ cannot be detected in basic type objects, when they are preceded by
+ a type symbol. PARENT_TYPE is the DBusType of a container this
+ signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
+ check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
+void
+xd_signature(signature, dtype, parent_type, object)
+ char *signature;
+ unsigned int dtype, parent_type;
Lisp_Object object;
{
+ unsigned int subtype;
+ Lisp_Object elt;
+ char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+
+ elt = object;
- XD_DEBUG_VALID_LISP_OBJECT_P (object);
switch (dtype)
{
- case DBUS_TYPE_BOOLEAN:
- XD_DEBUG_MESSAGE ("%d %s", dtype, (NILP (object)) ? "false" : "true");
- return (NILP (object)) ? (char *) FALSE : (char *) TRUE;
+ case DBUS_TYPE_BYTE:
+ case DBUS_TYPE_UINT16:
case DBUS_TYPE_UINT32:
- XD_DEBUG_MESSAGE ("%d %d", dtype, XUINT (object));
- return (char *) XUINT (object);
+ case DBUS_TYPE_UINT64:
+ CHECK_NATNUM (object);
+ sprintf (signature, "%c", dtype);
+ break;
+
+ case DBUS_TYPE_BOOLEAN:
+ if (!EQ (object, Qt) && !EQ (object, Qnil))
+ wrong_type_argument (intern ("booleanp"), object);
+ sprintf (signature, "%c", dtype);
+ break;
+
+ case DBUS_TYPE_INT16:
case DBUS_TYPE_INT32:
- XD_DEBUG_MESSAGE ("%d %d", dtype, XINT (object));
- return (char *) XINT (object);
+ case DBUS_TYPE_INT64:
+ CHECK_NUMBER (object);
+ sprintf (signature, "%c", dtype);
+ break;
+
case DBUS_TYPE_DOUBLE:
- XD_DEBUG_MESSAGE ("%d %d", dtype, XFLOAT (object));
- return (char *) XFLOAT (object);
+ CHECK_FLOAT (object);
+ sprintf (signature, "%c", dtype);
+ break;
+
case DBUS_TYPE_STRING:
- XD_DEBUG_MESSAGE ("%d %s", dtype, SDATA (object));
- return SDATA (object);
+ case DBUS_TYPE_OBJECT_PATH:
+ case DBUS_TYPE_SIGNATURE:
+ CHECK_STRING (object);
+ sprintf (signature, "%c", dtype);
+ break;
+
+ case DBUS_TYPE_ARRAY:
+ /* Check that all list elements have the same D-Bus type. For
+ complex element types, we just check the container type, not
+ the whole element's signature. */
+ CHECK_CONS (object);
+
+ if (EQ (QCdbus_type_array, XCAR (elt))) /* Type symbol is optional. */
+ elt = XD_NEXT_VALUE (elt);
+ subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
+ xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
+
+ while (!NILP (elt))
+ {
+ if (subtype != XD_OBJECT_TO_DBUS_TYPE (XCAR (elt)))
+ wrong_type_argument (intern ("D-Bus"), XCAR (elt));
+ elt = XCDR (XD_NEXT_VALUE (elt));
+ }
+
+ sprintf (signature, "%c%s", dtype, x);
+ break;
+
+ case DBUS_TYPE_VARIANT:
+ /* Check that there is exactly one list element. */
+ CHECK_CONS (object);
+
+ elt = XD_NEXT_VALUE (elt);
+ subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
+ xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
+
+ if (!NILP (XCDR (XD_NEXT_VALUE (elt))))
+ wrong_type_argument (intern ("D-Bus"),
+ XCAR (XCDR (XD_NEXT_VALUE (elt))));
+
+ sprintf (signature, "%c%s", dtype, x);
+ break;
+
+ case DBUS_TYPE_STRUCT:
+ /* A struct list might contain any number of elements with
+ different types. No further check needed. */
+ CHECK_CONS (object);
+
+ elt = XD_NEXT_VALUE (elt);
+
+ /* Compose the signature from the elements. It is enclosed by
+ parentheses. */
+ sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
+ while (!NILP (elt))
+ {
+ subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
+ xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
+ strcat (signature, x);
+ elt = XCDR (XD_NEXT_VALUE (elt));
+ }
+ sprintf (signature, "%s%c", signature, DBUS_STRUCT_END_CHAR);
+ break;
+
+ case DBUS_TYPE_DICT_ENTRY:
+ /* Check that there are exactly two list elements, and the first
+ one is of basic type. The dictionary entry itself must be an
+ element of an array. */
+ CHECK_CONS (object);
+
+ /* Check the parent object type. */
+ if (parent_type != DBUS_TYPE_ARRAY)
+ wrong_type_argument (intern ("D-Bus"), object);
+
+ /* Compose the signature from the elements. It is enclosed by
+ curly braces. */
+ sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
+
+ /* First element. */
+ elt = XD_NEXT_VALUE (elt);
+ subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
+ xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
+ strcat (signature, x);
+
+ if (!XD_BASIC_DBUS_TYPE (subtype))
+ wrong_type_argument (intern ("D-Bus"), XCAR (XD_NEXT_VALUE (elt)));
+
+ /* Second element. */
+ elt = XCDR (XD_NEXT_VALUE (elt));
+ subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
+ xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
+ strcat (signature, x);
+
+ if (!NILP (XCDR (XD_NEXT_VALUE (elt))))
+ wrong_type_argument (intern ("D-Bus"),
+ XCAR (XCDR (XD_NEXT_VALUE (elt))));
+
+ /* Closing signature. */
+ sprintf (signature, "%s%c", signature, DBUS_DICT_ENTRY_END_CHAR);
+ break;
+
default:
- XD_DEBUG_MESSAGE ("DBus-Type %d not supported", dtype);
- return NULL;
+ wrong_type_argument (intern ("D-Bus"), object);
+ }
+
+ XD_DEBUG_MESSAGE ("%s", signature);
+}
+
+/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
+ DTYPE must be a valid DBusType. It is used to convert Lisp
+ objects, being arguments of `dbus-call-method' or
+ `dbus-send-signal', into corresponding C values appended as
+ arguments to a D-Bus message. */
+void
+xd_append_arg (dtype, object, iter)
+ unsigned int dtype;
+ Lisp_Object object;
+ DBusMessageIter *iter;
+{
+ Lisp_Object elt;
+ char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+ DBusMessageIter subiter;
+ char *value;
+
+ XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", object, Qnil)));
+
+ if (XD_BASIC_DBUS_TYPE (dtype))
+ {
+ switch (dtype)
+ {
+ case DBUS_TYPE_BYTE:
+ XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
+ value = (unsigned char *) XUINT (object);
+ break;
+
+ case DBUS_TYPE_BOOLEAN:
+ XD_DEBUG_MESSAGE ("%c %s", dtype, (NILP (object)) ? "false" : "true");
+ value = (NILP (object))
+ ? (unsigned char *) FALSE : (unsigned char *) TRUE;
+ break;
+
+ case DBUS_TYPE_INT16:
+ XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
+ value = (char *) (dbus_int16_t *) XINT (object);
+ break;
+
+ case DBUS_TYPE_UINT16:
+ XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
+ value = (char *) (dbus_uint16_t *) XUINT (object);
+ break;
+
+ case DBUS_TYPE_INT32:
+ XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
+ value = (char *) (dbus_int32_t *) XINT (object);
+ break;
+
+ case DBUS_TYPE_UINT32:
+ XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
+ value = (char *) (dbus_uint32_t *) XUINT (object);
+ break;
+
+ case DBUS_TYPE_INT64:
+ XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
+ value = (char *) (dbus_int64_t *) XINT (object);
+ break;
+
+ case DBUS_TYPE_UINT64:
+ XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
+ value = (char *) (dbus_int64_t *) XUINT (object);
+ break;
+
+ case DBUS_TYPE_DOUBLE:
+ XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object));
+ value = (char *) (float *) XFLOAT (object);
+ break;
+
+ case DBUS_TYPE_STRING:
+ case DBUS_TYPE_OBJECT_PATH:
+ case DBUS_TYPE_SIGNATURE:
+ XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (object));
+ value = SDATA (object);
+ break;
+ }
+
+ if (!dbus_message_iter_append_basic (iter, dtype, &value))
+ xsignal2 (Qdbus_error,
+ build_string ("Unable to append argument"), object);
+ }
+
+ else /* Compound types. */
+ {
+
+ /* All compound types except array have a type symbol. For
+ array, it is optional. Skip it. */
+ if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (XCAR (object))))
+ object = XD_NEXT_VALUE (object);
+
+ /* Open new subiteration. */
+ switch (dtype)
+ {
+ case DBUS_TYPE_ARRAY:
+ case DBUS_TYPE_VARIANT:
+ /* A variant has just one element. An array has elements of
+ the same type. Both have been checked already for
+ correct types, it is sufficient to retrieve just the
+ signature of the first element. */
+ xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (XCAR (object)),
+ dtype, XCAR (XD_NEXT_VALUE (object)));
+ XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
+ SDATA (format2 ("%s", object, Qnil)));
+ if (!dbus_message_iter_open_container (iter, dtype,
+ signature, &subiter))
+ xsignal3 (Qdbus_error,
+ build_string ("Cannot open container"),
+ make_number (dtype), build_string (signature));
+ break;
+
+ case DBUS_TYPE_STRUCT:
+ case DBUS_TYPE_DICT_ENTRY:
+ /* These containers do not require a signature. */
+ XD_DEBUG_MESSAGE ("%c %s", dtype,
+ SDATA (format2 ("%s", object, Qnil)));
+ if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
+ xsignal2 (Qdbus_error,
+ build_string ("Cannot open container"),
+ make_number (dtype));
+ break;
+ }
+
+ /* Loop over list elements. */
+ while (!NILP (object))
+ {
+ dtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (object));
+ object = XD_NEXT_VALUE (object);
+
+ xd_append_arg (dtype, XCAR (object), &subiter);
+
+ object = XCDR (object);
+ }
+
+ /* Close the subiteration. */
+ if (!dbus_message_iter_close_container (iter, &subiter))
+ xsignal2 (Qdbus_error,
+ build_string ("Cannot close container"),
+ make_number (dtype));
}
}
/* Retrieve C value from a DBusMessageIter structure ITER, and return
a converted Lisp object. The type DTYPE of the argument of the
- D-Bus message must be a valid DBusType. Compound D-Bus types are
- partly supported; they result always in a Lisp list. */
+ D-Bus message must be a valid DBusType. Compound D-Bus types
+ result always in a Lisp list. */
Lisp_Object
xd_retrieve_arg (dtype, iter)
unsigned int dtype;
switch (dtype)
{
+ case DBUS_TYPE_BYTE:
+ case DBUS_TYPE_INT16:
+ case DBUS_TYPE_UINT16:
+ {
+ dbus_uint16_t val;
+ dbus_message_iter_get_basic (iter, &val);
+ XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ return make_number (val);
+ }
+
case DBUS_TYPE_BOOLEAN:
{
dbus_bool_t val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%d %s", dtype, (val == FALSE) ? "false" : "true");
+ XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
return (val == FALSE) ? Qnil : Qt;
}
+
case DBUS_TYPE_INT32:
case DBUS_TYPE_UINT32:
{
dbus_uint32_t val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%d %d", dtype, val);
- return make_number (val);
+ if (FIXNUM_OVERFLOW_P (val))
+ XD_DEBUG_MESSAGE ("%c %f", dtype, val)
+ else
+ XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ return make_fixnum_or_float (val);
+ }
+
+ case DBUS_TYPE_INT64:
+ case DBUS_TYPE_UINT64:
+ {
+ dbus_uint64_t val;
+ dbus_message_iter_get_basic (iter, &val);
+ if (FIXNUM_OVERFLOW_P (val))
+ XD_DEBUG_MESSAGE ("%c %f", dtype, val)
+ else
+ XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+ return make_fixnum_or_float (val);
+ }
+
+ case DBUS_TYPE_DOUBLE:
+ {
+ double val;
+ dbus_message_iter_get_basic (iter, &val);
+ XD_DEBUG_MESSAGE ("%c %f", dtype, val);
+ return make_float (val);
}
+
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
+ case DBUS_TYPE_SIGNATURE:
{
char *val;
dbus_message_iter_get_basic (iter, &val);
- XD_DEBUG_MESSAGE ("%d %s", dtype, val);
+ XD_DEBUG_MESSAGE ("%c %s", dtype, val);
return build_string (val);
}
+
case DBUS_TYPE_ARRAY:
case DBUS_TYPE_VARIANT:
case DBUS_TYPE_STRUCT:
}
RETURN_UNGCPRO (Fnreverse (result));
}
+
default:
- XD_DEBUG_MESSAGE ("DBusType %d not supported", dtype);
+ XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
return Qnil;
}
}
integer => DBUS_TYPE_INT32
float => DBUS_TYPE_DOUBLE
string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
-Other Lisp objects are not supported as input arguments of METHOD.
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
`dbus-call-method' returns the resulting values of METHOD as a list of
Lisp objects. The type conversion happens the other direction as for
-input arguments. Additionally to the types supported for input
-arguments, the D-Bus compound types DBUS_TYPE_ARRAY, DBUS_TYPE_VARIANT,
-DBUS_TYPE_STRUCT and DBUS_TYPE_DICT_ENTRY are accepted. All of them
-are converted into a list of Lisp objects which correspond to the
-elements of the D-Bus container. Example:
+input arguments. It follows the mapping rules:
+
+ DBUS_TYPE_BOOLEAN => t or nil
+ DBUS_TYPE_BYTE => number
+ DBUS_TYPE_UINT16 => number
+ DBUS_TYPE_INT16 => integer
+ DBUS_TYPE_UINT32 => number or float
+ DBUS_TYPE_INT32 => integer or float
+ DBUS_TYPE_UINT64 => number or float
+ DBUS_TYPE_INT64 => integer or float
+ DBUS_TYPE_DOUBLE => float
+ DBUS_TYPE_STRING => string
+ DBUS_TYPE_OBJECT_PATH => string
+ DBUS_TYPE_SIGNATURE => string
+ DBUS_TYPE_ARRAY => list
+ DBUS_TYPE_VARIANT => list
+ DBUS_TYPE_STRUCT => list
+ DBUS_TYPE_DICT_ENTRY => list
+
+Example:
\(dbus-call-method
:session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
DBusError derror;
unsigned int dtype;
int i;
- char *value;
+ char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
bus = args[0];
connection = xd_initialize (bus);
/* Create the message. */
- dmessage = dbus_message_new_method_call (SDATA (service),
- SDATA (path),
- SDATA (interface),
- SDATA (method));
+ dmessage = dbus_message_new_method_call ((char *) SDATA (service),
+ (char *) SDATA (path),
+ (char *) SDATA (interface),
+ (char *) SDATA (method));
if (dmessage == NULL)
{
UNGCPRO;
UNGCPRO;
+ /* Initialize parameter list of message. */
+ dbus_message_iter_init_append (dmessage, &iter);
+
/* Append parameters to the message. */
for (i = 5; i < nargs; ++i)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_MESSAGE ("Parameter%d %s",
- i-4,
- SDATA (format2 ("%s", args[i], Qnil)));
+ i-4, SDATA (format2 ("%s", args[i], Qnil)));
- dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]);
- if (dtype == DBUS_TYPE_INVALID)
- xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
+ if (XD_DBUS_TYPE_P (args[i]))
+ ++i;
- value = (char *) xd_retrieve_value (dtype, args[i]);
+ /* Check for valid signature. We use DBUS_TYPE_INVALID is
+ indication that there is no parent type. */
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
- if (!dbus_message_append_args (dmessage,
- dtype,
- &value,
- DBUS_TYPE_INVALID))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), args[i]);
+ xd_append_arg (dtype, args[i], &iter);
}
/* Send the message. */
integer => DBUS_TYPE_INT32
float => DBUS_TYPE_DOUBLE
string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
-Other Lisp objects are not supported as arguments of SIGNAL.
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
Example:
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DBusConnection *connection;
DBusMessage *dmessage;
+ DBusMessageIter iter;
unsigned int dtype;
int i;
- char *value;
+ char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
/* Check parameters. */
bus = args[0];
connection = xd_initialize (bus);
/* Create the message. */
- dmessage = dbus_message_new_signal (SDATA (path),
- SDATA (interface),
- SDATA (signal));
+ dmessage = dbus_message_new_signal ((char *) SDATA (path),
+ (char *) SDATA (interface),
+ (char *) SDATA (signal));
if (dmessage == NULL)
{
UNGCPRO;
UNGCPRO;
+ /* Initialize parameter list of message. */
+ dbus_message_iter_init_append (dmessage, &iter);
+
/* Append parameters to the message. */
for (i = 5; i < nargs; ++i)
{
XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
XD_DEBUG_MESSAGE ("Parameter%d %s",
- i-4,
- SDATA (format2 ("%s", args[i], Qnil)));
+ i-4, SDATA (format2 ("%s", args[i], Qnil)));
- dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]);
- if (dtype == DBUS_TYPE_INVALID)
- xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
+ if (XD_DBUS_TYPE_P (args[i]))
+ ++i;
- value = (char *) xd_retrieve_value (dtype, args[i]);
+ /* Check for valid signature. We use DBUS_TYPE_INVALID is
+ indication that there is no parent type. */
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
- if (!dbus_message_append_args (dmessage,
- dtype,
- &value,
- DBUS_TYPE_INVALID))
- xsignal2 (Qdbus_error,
- build_string ("Unable to append argument"), args[i]);
+ xd_append_arg (dtype, args[i], &iter);
}
/* Send the message. The message is just added to the outgoing
while (!NILP (value))
{
key = XCAR (value);
- /* key has the structure (SERVICE UNAME PATH HANDLER). */
+ /* key has the structure (UNAME SERVICE PATH HANDLER). */
if (((uname == NULL)
- || (NILP (XCAR (XCDR (key))))
- || (strcmp (uname, SDATA (XCAR (XCDR (key)))) == 0))
+ || (NILP (XCAR (key)))
+ || (strcmp (uname, SDATA (XCAR (key))) == 0))
&& ((path == NULL)
|| (NILP (XCAR (XCDR (XCDR (key)))))
|| (strcmp (path, SDATA (XCAR (XCDR (XCDR (key))))) == 0))
xd_read_queued_messages ()
{
- /* Vdbus_registered_functions_table will be made as hash table in
- dbus.el. When it isn't loaded yet, it doesn't make sense to
- handle D-Bus messages. Furthermore, we ignore all Lisp errors
- during the call. */
+ /* Vdbus_registered_functions_table will be initialized as hash
+ table in dbus.el. When this package isn't loaded yet, it doesn't
+ make sense to handle D-Bus messages. Furthermore, we ignore all
+ Lisp errors during the call. */
if (HASH_TABLE_P (Vdbus_registered_functions_table))
{
internal_condition_case_1 (xd_read_message, QCdbus_system_bus,
:system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
"org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
- => (:system ":1.3" "/org/freedesktop/Hal/Manager"
- "org.freedesktop.Hal.Manager" "DeviceAdded")
+ => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
+ ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
`dbus-register-signal' returns an object, which can be used in
`dbus-unregister-signal' for removing the registration. */)
(bus, service, path, interface, signal, handler)
Lisp_Object bus, service, path, interface, signal, handler;
{
- Lisp_Object unique_name, key, value;
+ Lisp_Object uname, key, value;
DBusConnection *connection;
char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
DBusError derror;
if (!NILP (path)) CHECK_STRING (path);
CHECK_STRING (interface);
CHECK_STRING (signal);
- CHECK_SYMBOL (handler);
+ FUNCTIONP (handler);
/* Retrieve unique name of service. If service is a known name, we
will register for the corresponding unique name, if any. Signals
&& (strlen (SDATA (service)) > 0)
&& (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
&& (strncmp (SDATA (service), ":", 1) != 0))
- unique_name = call2 (intern ("dbus-get-name-owner"), bus, service);
+ {
+ uname = call2 (intern ("dbus-get-name-owner"), bus, service);
+ /* When there is no unique name, we mark it with an empty
+ string. */
+ if (NILP (uname))
+ uname = build_string ("");
+ }
else
- unique_name = service;
+ uname = service;
- /* Open a connection to the bus. */
- connection = xd_initialize (bus);
+ /* Create a matching rule if the unique name exists (when no
+ wildcard). */
+ if (NILP (uname) || (strlen (SDATA (uname)) > 0))
+ {
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus);
- /* Create a rule to receive related signals. */
- sprintf (rule,
- "type='signal',interface='%s',member=%s%",
- SDATA (interface),
- SDATA (signal));
+ /* Create a rule to receive related signals. */
+ sprintf (rule,
+ "type='signal',interface='%s',member='%s'",
+ SDATA (interface),
+ SDATA (signal));
- /* Add unique name and path to the rule if they are non-nil. */
- if (!NILP (unique_name))
- sprintf (rule, "%s,sender='%s'%", rule, SDATA (unique_name));
+ /* Add unique name and path to the rule if they are non-nil. */
+ if (!NILP (uname))
+ sprintf (rule, "%s,sender='%s'", rule, SDATA (uname));
- if (!NILP (path))
- sprintf (rule, "%s,path='%s'", rule, SDATA (path));
+ if (!NILP (path))
+ sprintf (rule, "%s,path='%s'", rule, SDATA (path));
- /* Add the rule to the bus. */
- dbus_error_init (&derror);
- dbus_bus_add_match (connection, rule, &derror);
- if (dbus_error_is_set (&derror))
- XD_ERROR (derror);
+ /* Add the rule to the bus. */
+ dbus_error_init (&derror);
+ dbus_bus_add_match (connection, rule, &derror);
+ if (dbus_error_is_set (&derror))
+ XD_ERROR (derror);
- XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
+ XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
+ }
/* Create a hash table entry. */
key = list3 (bus, interface, signal);
value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
- if (NILP (Fmember (list4 (service, unique_name, path, handler), value)))
+ if (NILP (Fmember (list4 (uname, service, path, handler), value)))
Fputhash (key,
- Fcons (list4 (service, unique_name, path, handler), value),
+ Fcons (list4 (uname, service, path, handler), value),
Vdbus_registered_functions_table);
- /* Return key. */
- return key;
+ /* Return object. */
+ return list2 (key, list3 (service, path, handler));
}
-/* The current implementation removes ALL registered functions for a
- given signal. Shouldn't be a problem in general, but there might
- be cases it is not desired. Maybe we can refine the
- implementation. */
DEFUN ("dbus-unregister-signal", Fdbus_unregister_signal, Sdbus_unregister_signal,
1, 1, 0,
doc: /* Unregister OBJECT from the D-Bus.
(object)
Lisp_Object object;
{
+ Lisp_Object value;
+ struct gcpro gcpro1;
+
+ /* Check parameter. */
+ CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object));
- /* Unintern the signal symbol. */
- Fremhash (object, Vdbus_registered_functions_table);
+ /* Find the corresponding entry in the hash table. */
+ value = Fgethash (XCAR (object), Vdbus_registered_functions_table, Qnil);
+
+ /* Loop over the registered functions. */
+ while (!NILP (value))
+ {
+ GCPRO1 (value);
+
+ /* (car value) has the structure (UNAME SERVICE PATH HANDLER).
+ (cdr object) has the structure ((SERVICE PATH HANDLER) ...). */
+ if (!NILP (Fequal (XCDR (XCAR (value)), XCAR (XCDR (object)))))
+ {
+ /* Compute new hash value. */
+ value = Fdelete (XCAR (value),
+ Fgethash (XCAR (object),
+ Vdbus_registered_functions_table, Qnil));
+ if (NILP (value))
+ Fremhash (XCAR (object), Vdbus_registered_functions_table);
+ else
+ Fputhash (XCAR (object), value, Vdbus_registered_functions_table);
+ RETURN_UNGCPRO (Qt);
+ }
+ UNGCPRO;
+ value = XCDR (value);
+ }
/* Return. */
return Qnil;
QCdbus_session_bus = intern (":session");
staticpro (&QCdbus_session_bus);
+ QCdbus_type_byte = intern (":byte");
+ staticpro (&QCdbus_type_byte);
+
+ QCdbus_type_boolean = intern (":boolean");
+ staticpro (&QCdbus_type_boolean);
+
+ QCdbus_type_int16 = intern (":int16");
+ staticpro (&QCdbus_type_int16);
+
+ QCdbus_type_uint16 = intern (":uint16");
+ staticpro (&QCdbus_type_uint16);
+
+ QCdbus_type_int32 = intern (":int32");
+ staticpro (&QCdbus_type_int32);
+
+ QCdbus_type_uint32 = intern (":uint32");
+ staticpro (&QCdbus_type_uint32);
+
+ QCdbus_type_int64 = intern (":int64");
+ staticpro (&QCdbus_type_int64);
+
+ QCdbus_type_uint64 = intern (":uint64");
+ staticpro (&QCdbus_type_uint64);
+
+ QCdbus_type_double = intern (":double");
+ staticpro (&QCdbus_type_double);
+
+ QCdbus_type_string = intern (":string");
+ staticpro (&QCdbus_type_string);
+
+ QCdbus_type_object_path = intern (":object-path");
+ staticpro (&QCdbus_type_object_path);
+
+ QCdbus_type_signature = intern (":signature");
+ staticpro (&QCdbus_type_signature);
+
+ QCdbus_type_array = intern (":array");
+ staticpro (&QCdbus_type_array);
+
+ QCdbus_type_variant = intern (":variant");
+ staticpro (&QCdbus_type_variant);
+
+ QCdbus_type_struct = intern (":struct");
+ staticpro (&QCdbus_type_struct);
+
+ QCdbus_type_dict_entry = intern (":dict-entry");
+ staticpro (&QCdbus_type_dict_entry);
+
DEFVAR_LISP ("dbus-registered-functions-table", &Vdbus_registered_functions_table,
doc: /* Hash table of registered functions for D-Bus.
-The key in the hash table is the list (BUS MEMBER INTERFACE). BUS is
+The key in the hash table is the list (BUS INTERFACE MEMBER). BUS is
either the symbol `:system' or the symbol `:session'. INTERFACE is a
string which denotes a D-Bus interface, and MEMBER, also a string, is
either a method or a signal INTERFACE is offering. All arguments but
BUS must not be nil.
-The value in the hash table is a list of triple lists
-\((SERVICE UNAME PATH HANDLER) (SERVICE UNAME PATH HANDLER) ...).
+The value in the hash table is a list of quadruple lists
+\((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
SERVICE is the service name as registered, UNAME is the corresponding
unique name. PATH is the object path of the sending object. All of
-them be nil, which means a wildcard then. HANDLER is the function to
-be called when a D-Bus message, which matches the key criteria,
+them can be nil, which means a wildcard then. HANDLER is the function
+to be called when a D-Bus message, which matches the key criteria,
arrives. */);
/* We initialize Vdbus_registered_functions_table in dbus.el,
because we need to define a hash table function first. */
Boston, MA 02110-1301, USA. */
#include <config.h>
+#include <limits.h>
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
overflow. The calculations below double the file size
twice, so check that it can be multiplied by 4 safely. */
if (XINT (end) != st.st_size
- || ((int) st.st_size * 4) / 4 != st.st_size)
+ || st.st_size > INT_MAX / 4)
error ("Maximum buffer size exceeded");
/* The file size returned from stat may be zero, but data
}
#endif /* !TARGET_API_MAC_CARBON */
}
- else
+
+ if (!menu)
{
#if TARGET_API_MAC_CARBON
err = CreateNewMenu (id, 0, &menu);
p->tick = 0;
p->update_tick = 0;
p->pid = 0;
- p->pty_flag = 0;
+ p->pty_flag = Qnil;
p->raw_status_new = 0;
p->status = Qrun;
p->mark = Fmake_marker ();
{
/* Forward asciified character sequence. */
post_character_message
- (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
+ (hwnd, WM_CHAR,
+ (unsigned char) key.uChar.AsciiChar, lParam,
w32_get_key_modifiers (wParam, lParam));
w32_kbd_patch_key (&key);
}
{
XRectangle cr, result;
struct glyph *cursor_glyph;
+ struct glyph_row *row;
+
+ if (w->phys_cursor.vpos >= 0
+ && w->phys_cursor.vpos < w->current_matrix->nrows
+ && (row = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos),
+ row->enabled_p)
+ && row->cursor_in_fringe_p)
+ {
+ /* Cursor is in the fringe. */
+ cr.x = window_box_right_offset (w,
+ (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? RIGHT_MARGIN_AREA
+ : TEXT_AREA));
+ cr.y = row->y;
+ cr.width = WINDOW_RIGHT_FRINGE_WIDTH (w);
+ cr.height = row->height;
+ return x_intersect_rectangles (&cr, r, &result);
+ }
cursor_glyph = get_phys_cursor_glyph (w);
if (cursor_glyph)