+2007-10-23 Glenn Morris <rgm@gnu.org>
+
+ * MAINTAINERS: Move to admin/.
+
2007-10-17 Chong Yidong <cyd@stupidchicken.com>
* configure.in (HAVE_RES_INIT): Define if res_init() exists.
* config.bat: Fix configuring `doc' due to changes in the
directory structure.
-2007-09-16 Peter O'Gorman <bug-gnu-emacs@mlists.thewrittenword.com> (tiny change)
+2007-09-16 Peter O'Gorman <bug-gnu-emacs@mlists.thewrittenword.com> (tiny change)
* configure.in: Don't use -lpthread on HP-UX.
* README.multi-tty: Move to admin/notes/multi-tty, with some edits.
-2007-08-29 Karoly Lorentey <karoly@lorentey.hu>
+2007-08-29 K\e,Aa\e(Broly L\e$,1 q\e(Brentey <karoly@lorentey.hu>
* README.multi-tty: New file.
2007-06-11 Jan Dj\e,Ad\e(Brv <jan.h.d@swipnet.se>
- * configure.in: Change wording about yes/gtk and lucid/athena being
- synonyms.
+ * configure.in: Change wording about yes/gtk and lucid/athena
+ being synonyms.
2007-06-08 Glenn Morris <rgm@gnu.org>
2007-04-19 Glenn Morris <rgm@gnu.org>
- * configure.in: Signal error if Xaw libs are missing in a Lucid
- build.
+ * configure.in: Signal error if Xaw libs are missing in a Lucid build.
2007-04-18 Glenn Morris <rgm@gnu.org>
2000-10-01 Andreas Schwab <schwab@suse.de>
- * Makefile.in (install-arch-indep): Update list of installed info
- files.
+ * Makefile.in (install-arch-indep): Update list of installed info files.
2000-09-30 Gerd Moellmann <gerd@gnu.org>
1999-02-26 Richard Stallman <rms@gnu.org>
- * configure.in: Use epaths.h and epaths-force instead of paths....
+ * configure.in: Use epaths.h and epaths-force instead of paths...
* Makefile.in (epaths-force): Renamed from paths-force;
operate on epaths.in and produce epaths.h.
1998-04-16 Eli Zaretskii <eliz@delysid.gnu.org>
* config.bat: Make sure the environment is large enough to support
- all the "set foo=bar" commands. Update pointers to DJGPP FTP
- sites.
+ all the "set foo=bar" commands. Update pointers to DJGPP FTP sites.
1998-04-10 Karl Heuer <kwzh@gnu.org>
1998-03-23 Kenichi Handa <handa@etl.go.jp>
- * Makefile.in (top_distclean): Check the existence of `lock'
- subdir.
+ * Makefile.in (top_distclean): Check the existence of `lock' subdir.
1998-03-22 Richard Stallman <rms@gnu.org>
1997-08-22 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * configure.in (HAVE_MOTIF_2_1): Test for Motif 2.1,
+ * configure.in (HAVE_MOTIF_2_1): Test for Motif 2.1.
1997-08-22 Jonathan I. Kamens <jik@kamens.brookline.ma.us>
+2007-10-23 Glenn Morris <rgm@gnu.org>
+
+ * MAINTAINERS: Move here from ../.
+
2007-10-17 Juanma Barranquero <lekktu@gmail.com>
* make-emacs: Doc fix.
+2007-10-25 Glenn Morris <rgm@gnu.org>
+
+ * fortran-xtra.texi (Fortran): F90 mode handles F2003.
+
+2007-10-24 Richard Stallman <rms@gnu.org>
+
+ * misc.texi (Interactive Shell): Cleanup last change.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * mini.texi (Minibuffer History): Add text about a list of minibuffer
+ default values.
+
+2007-10-20 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * files.texi: Disambiguate two slightly different uses of the term
+ 'filesets'.
+
2007-10-18 Martin Rudalics <rudalics@gmx.at>
* trouble.texi (Quitting): Fix typo.
systems, such as CVS and RCS. It supports different transports for
interoperating between users, offline operations, and it has good
branching and merging features. It also supports atomic commits of
-fileset changes, and keeps a history of file renaming and moving. VC
+filesets, and keeps a history of file renaming and moving. VC
does not support all operations provided by GNU Arch, so you must
sometimes invoke it from the command line, or use a specialized
module.
@cindex git
git is a version-control system invented by Linus Torvalds to
support Linux kernel development. Like GNU Arch, it supports atomic
-commits of fileset changes, and keeps a history of file renaming and
+commits of filesets, and keeps a history of file renaming and
moving. One significant feature of git is that it largely abolishes
the notion of a single centralized repository; instead, each working
copy of a git project is its own repository and coordination is done
a group. Now it does, which enables VC to drive changeset-based
version-control systems.
+ Emacs uses the concept of named filesets elsewhere
+(@pxref{Filesets}) to allow you to view and visit files in functional
+groups. Unlike those, VC filesets are not named and don't persist
+across sessions.
+
@node Doing The Right Thing
@subsubsection Performing the next operation in the development cycle
a fileset. These commands are also available from the @samp{Filesets}
menu, where each existing fileset is represented by a submenu.
+ Emacs uses the concept of a fileset elsewhere @pxref{Version
+Control} to describe sets of files to be treated as a group for
+purposes of version-control operations. Those filesets are
+unnamed and do not persist across Emacs essions.
+
@ignore
arch-tag: 768d32cb-e15a-4cc1-b7bf-62c00ee12250
@end ignore
@findex f90-mode
@findex fortran-mode
Fortran mode is meant for editing Fortran77 ``fixed format'' (and also
-``tab format'') source code. For editing the modern Fortran90 or
-Fortran95 ``free format'' source code, use F90 mode (@code{f90-mode}).
+``tab format'') source code. For editing the modern Fortran90/95/2003
+``free format'' source code, use F90 mode (@code{f90-mode}).
Emacs normally uses Fortran mode for files with extension @samp{.f},
@samp{.F} or @samp{.for}, and F90 mode for the extension @samp{.f90} and
@samp{.f95}. GNU Fortran supports both kinds of format.
not change the history element that you ``moved'' to, but your new
argument does go at the end of the history list in its own right.
- For many minibuffer arguments there is a ``default'' value. You can
-insert the default value into the minibuffer as text by using
-@kbd{M-n}. You can think of this as moving ``into the future'' in the
-history.
+ For many minibuffer arguments there is a ``default'' value, or
+a list of default values. You can insert the default value into the
+minibuffer as text by using @kbd{M-n} one or more times. You can
+think of this as moving ``into the future'' in the history.
@findex previous-matching-history-element
@findex next-matching-history-element
Coding}.
@cindex @env{INSIDE_EMACS} environment variable
- Emacs sets the environment variable @env{INSIDE_EMACS} (to a
-comma-separated list including the Emacs version) in the subshell.
+ Emacs sets the environment variable @env{INSIDE_EMACS} in the
+subshell to a comma-separated list including the Emacs version.
Programs can check this variable to determine whether they are running
inside an Emacs subshell.
+2007-10-26 Richard Stallman <rms@gnu.org>
+
+ * objects.texi (Equality Predicates): Null strings are uniquified.
+
+ * minibuf.texi: Minor clarifications in previous change.
+
+2007-10-25 Glenn Morris <rgm@gnu.org>
+
+ * customize.texi (Variable Definitions): Add :risky and :safe keywords.
+
+2007-10-24 Richard Stallman <rms@gnu.org>
+
+ * elisp.texi (Top): Delete Frame-Local Variables from subnode menu.
+
+ * variables.texi (Frame-Local Variables): Node deleted.
+ (Variables): Delete Frame-Local Variables from menu.
+ (Local Variables, Buffer-Local Variables, Intro to Buffer-Local)
+ (Default Value): Don't mention frame-local vars.
+
+ * os.texi (Idle Timers): current-idle-time returns nil if not idle.
+
+ * loading.texi (Unloading): Document FEATURE-unload-function
+ instead of FEATURE-unload-hook.
+
+ * frames.texi (Multiple Displays): Don't mention frame-local vars.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * minibuf.texi (Text from Minibuffer, Minibuffer Completion)
+ (High-Level Completion): Document a list of default value strings
+ in the DEFAULT argument, for which minibuffer functions return the
+ first element.
+
2007-10-17 Juri Linkov <juri@jurta.org>
* text.texi (Filling): Update arguments of fill-paragraph.
variables and functions will be defined, so there will not be an error.
@end table
+@item :risky @var{value}
+@kindex risky@r{, @code{defcustom} keyword}
+Set this variable's @code{risky-local-variable} property to @var{value}.
+
+@item :safe @var{function}
+@kindex safe@r{, @code{defcustom} keyword}
+Set this variable's @code{safe-local-variable} property to @var{function}.
+
@item :set-after @var{variables}
@kindex set-after@r{, @code{defcustom} keyword}
When setting variables according to saved customizations, make sure to
* Setting Variables:: Storing new values in variables.
* Variable Scoping:: How Lisp chooses among local and global values.
* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* Frame-Local Variables:: Variable values in effect only in one frame.
* Future Local Variables:: New kinds of local values we might add some day.
* File Local Variables:: Handling local variable lists in files.
* Variable Aliases:: Variables that are aliases for other variables.
to. These variables include @code{default-minibuffer-frame},
@code{defining-kbd-macro}, @code{last-kbd-macro}, and
@code{system-key-alist}. They are always terminal-local, and can never
-be buffer-local (@pxref{Buffer-Local Variables}) or frame-local.
+be buffer-local (@pxref{Buffer-Local Variables}).
A single X server can handle more than one screen. A display name
@samp{@var{host}:@var{server}.@var{screen}} has three parts; the last
@item call-interactively
See @ref{Interactive Call}.
+@item called-interactively-p
+See @ref{Distinguish Interactive}.
+
@item commandp
See @ref{Interactive Call}.
See @ref{Using Interactive}.
@item interactive-p
-See @ref{Interactive Call}.
+See @ref{Distinguish Interactive}.
@item mapatoms
See @ref{Creating Symbols}.
It then restores any autoloads formerly associated with those symbols.
(Loading saves these in the @code{autoload} property of the symbol.)
-@vindex unload-feature-special-hooks
Before restoring the previous definitions, @code{unload-feature} runs
@code{remove-hook} to remove functions in the library from certain
hooks. These hooks include variables whose names end in @samp{hook}
or @samp{-hooks}, plus those listed in
-@code{unload-feature-special-hooks}. This is to prevent Emacs from
-ceasing to function because important hooks refer to functions that
-are no longer defined.
+@code{unload-feature-special-hooks}, as well as
+@code{auto-mode-alist}. This is to prevent Emacs from ceasing to
+function because important hooks refer to functions that are no longer
+defined.
-@vindex @var{feature}-unload-hook
+Standard unloading activities also undoes ELP profiling of functions
+in that library, unprovides any features provided by the library, and
+cancels timers held in variables defined by the library.
+
+@vindex @var{feature}-unload-function
If these measures are not sufficient to prevent malfunction, a library
-can define an explicit unload hook. If @code{@var{feature}-unload-hook}
-is defined, it is run as a normal hook before restoring the previous
-definitions, @emph{instead of} the usual hook-removing actions. The
-unload hook ought to undo all the global state changes made by the
-library that might cease to work once the library is unloaded.
-@code{unload-feature} can cause problems with libraries that fail to do
-this, so it should be used with caution.
+can define an explicit unloader named @code{@var{feature}-unload-function}.
+If that symbol is defined as a function, @code{unload-feature} calls
+it with no arguments before doing anything else. It can do whatever
+is appropriate to unload the library. If it returns @code{nil},
+@code{unload-feature} proceeds to take the normal unload actions.
+Otherwise it considers the job to be done.
Ordinarily, @code{unload-feature} refuses to unload a library on which
other loaded libraries depend. (A library @var{a} depends on library
reads the text and returns the resulting Lisp object, unevaluated.
(@xref{Input Functions}, for information about reading.)
-The argument @var{default} specifies a default value to make available
-through the history commands. It should be a string, or @code{nil}.
-If non-@code{nil}, the user can access it using
-@code{next-history-element}, usually bound in the minibuffer to
-@kbd{M-n}. If @var{read} is non-@code{nil}, then @var{default} is
-also used as the input to @code{read}, if the user enters empty input.
-(If @var{read} is non-@code{nil} and @var{default} is @code{nil}, empty
+The argument @var{default} specifies default values to make available
+through the history commands. It should be a string, a list of
+strings, or @code{nil}. The string or strings become the minibuffer's
+``future history,'' available to the user with @kbd{M-n}.
+
+If @var{read} is non-@code{nil}, then @var{default} is also used as
+the input to @code{read}, if the user enters empty input. (If
+@var{read} is non-@code{nil} and @var{default} is @code{nil}, empty
input results in an @code{end-of-file} error.) However, in the usual
case (where @var{read} is @code{nil}), @code{read-from-minibuffer}
ignores @var{default} when the user enters empty input and returns an
-empty string, @code{""}. In this respect, it is different from all
-the other minibuffer input functions in this chapter.
+empty string, @code{""}. In this respect, it differs from all the
+other minibuffer input functions in this chapter.
If @var{keymap} is non-@code{nil}, that keymap is the local keymap to
use in the minibuffer. If @var{keymap} is omitted or @code{nil}, the
The optional argument @var{default} is used as in
@code{read-from-minibuffer}, except that, if non-@code{nil}, it also
specifies a default value to return if the user enters null input. As
-in @code{read-from-minibuffer} it should be a string, or @code{nil},
-which is equivalent to an empty string.
-
-This function is a simplified interface to the
+in @code{read-from-minibuffer} it should be a string, a list of
+strings, or @code{nil} which is equivalent to an empty string. When
+@var{default} is a string, that string is the default value. When it
+is a list of strings, the first string is the default value. (All
+these strings are available to the user in the ``future minibuffer
+history.'')
+
+This function works by calling the
@code{read-from-minibuffer} function:
@smallexample
(read-from-minibuffer @var{prompt} @var{initial} nil nil
@var{history} @var{default} @var{inherit})))
(if (and (equal value "") @var{default})
- @var{default}
+ (if (consp @var{default}) (car @var{default}) @var{default})
value))
@end group
@end smallexample
input already in the buffer matches an element of @var{collection}.
However, empty input is always permitted, regardless of the value of
-@var{require-match}; in that case, @code{completing-read} returns
-@var{default}, or @code{""}, if @var{default} is @code{nil}. The
-value of @var{default} (if non-@code{nil}) is also available to the
-user through the history commands.
+@var{require-match}; in that case, @code{completing-read} returns the
+first element of @var{default}, if it is a list; @code{""}, if
+@var{default} is @code{nil}; or @var{default}. The string or strins
+in @var{default} aer also available to the user through the history
+commands.
The function @code{completing-read} uses
@code{minibuffer-local-completion-map} as the keymap if
This function reads the name of a buffer and returns it as a string.
The argument @var{default} is the default name to use, the value to
return if the user exits with an empty minibuffer. If non-@code{nil},
-it should be a string or a buffer. It is mentioned in the prompt, but
-is not inserted in the minibuffer as initial input.
+it should be a string, a list of strings, or a buffer. If it is
+a list, the default value is the first element of this list. It is
+mentioned in the prompt, but is not inserted in the minibuffer as
+initial input.
The argument @var{prompt} should be a string ending with a colon and a
space. If @var{default} is non-@code{nil}, the function inserts it in
for which @code{commandp} returns @code{t}. @xref{Interactive Call}.
The argument @var{default} specifies what to return if the user enters
-null input. It can be a symbol or a string; if it is a string,
-@code{read-command} interns it before returning it. If @var{default} is
-@code{nil}, that means no default has been specified; then if the user
-enters null input, the return value is @code{(intern "")}, that is, a
-symbol whose name is an empty string.
+null input. It can be a symbol, a string or a list of strings. If it
+is a string, @code{read-command} interns it before returning it.
+If it is a list, @code{read-command} returns the first element of this list.
+If @var{default} is @code{nil}, that means no default has been
+specified; then if the user enters null input, the return value is
+@code{(intern "")}, that is, a symbol whose name is an empty string.
@example
(read-command "Command name? ")
This function reads the name of a user variable and returns it as a
symbol.
-The argument @var{default} specifies what to return if the user enters
-null input. It can be a symbol or a string; if it is a string,
-@code{read-variable} interns it before returning it. If @var{default}
-is @code{nil}, that means no default has been specified; then if the
-user enters null input, the return value is @code{(intern "")}.
+The argument @var{default} specifies the default value to return if
+the user enters null input. It can be a symbol, a string, or a list
+of strings. If it is a string, @code{read-variable} interns it to
+make the default value; If it is a list, @code{read-variable} interns
+the first element. If @var{default} is @code{nil}, that means no
+default has been specified; then if the user enters null input, the
+return value is @code{(intern "")}.
@example
@group
@cindex equality
Here we describe two functions that test for equality between any two
-objects. Other functions test equality between objects of specific
+objects. Other functions test equality of contents between objects of specific
types, e.g., strings. For these predicates, see the appropriate chapter
describing the data type.
@result{} nil
@end group
+@group
+(eq "" "")
+ @result{} t
+;; @r{This exception occurs because Emacs Lisp}
+;; @r{makes just one multibyte empty string, to save space.}
+@end group
+
@group
(eq '(1 (2 (3))) '(1 (2 (3))))
@result{} nil
@c Emacs 19 feature
@defun current-idle-time
-This function returns the length of time Emacs has been idle, as a
-list of three integers: @code{(@var{high} @var{low} @var{microsec})}.
-The integers @var{high} and @var{low} combine to give the number of
-seconds of idleness, which is
+If Emacs is idle, this function returns the length of time Emacs has
+been idle, as a list of three integers: @code{(@var{high} @var{low}
+@var{microsec})}. The integers @var{high} and @var{low} combine to
+give the number of seconds of idleness, which is
@ifnottex
@var{high} * 2**16 + @var{low}.
@end ifnottex
start of the current second (or 0 for systems that return time with
the resolution of only one second).
+When Emacs is not idle, @code{current-idle-time} returns @code{nil}.
+This is a convenient way to test whether Emacs is idle.
+
The main use of this function is when an idle timer function wants to
``take a break'' for a while. It can set up another idle timer to
call the same function again, after a few seconds more idleness.
* Setting Variables:: Storing new values in variables.
* Variable Scoping:: How Lisp chooses among local and global values.
* Buffer-Local Variables:: Variable values in effect only in one buffer.
-* Frame-Local Variables:: Variable values in effect only in one frame.
* Future Local Variables:: New kinds of local values we might add some day.
* File Local Variables:: Handling local variable lists in files.
* Variable Aliases:: Variables that are aliases for other variables.
@end itemize
Variables can also have buffer-local bindings (@pxref{Buffer-Local
-Variables}) and frame-local bindings (@pxref{Frame-Local Variables}); a
-few variables have terminal-local bindings (@pxref{Multiple Displays}).
-These kinds of bindings work somewhat like ordinary local bindings, but
-they are localized depending on ``where'' you are in Emacs, rather than
-localized in time.
+Variables}); a few variables have terminal-local bindings
+(@pxref{Multiple Displays}). These kinds of bindings work somewhat
+like ordinary local bindings, but they are localized depending on
+``where'' you are in Emacs, rather than localized in time.
@defvar max-specpdl-size
@anchor{Definition of max-specpdl-size}
@cindex buffer-local variables
Global and local variable bindings are found in most programming
-languages in one form or another. Emacs, however, also supports additional,
-unusual kinds of variable binding: @dfn{buffer-local} bindings, which
-apply only in one buffer, and @dfn{frame-local} bindings, which apply only in
-one frame. Having different values for a variable in different buffers
-and/or frames is an important customization method.
-
- This section describes buffer-local bindings; for frame-local
-bindings, see the following section, @ref{Frame-Local Variables}. (A few
-variables have bindings that are local to each terminal; see
-@ref{Multiple Displays}.)
+languages in one form or another. Emacs, however, also supports
+additional, unusual kinds of variable binding, such as
+@dfn{buffer-local} bindings, which apply only in one buffer. Having
+different values for a variable in different buffers is an important
+customization method. (A few variables have bindings that are local
+to each terminal; see @ref{Multiple Displays}.)
@menu
* Intro to Buffer-Local:: Introduction and concepts.
other buffers. The default binding is shared by all the buffers that
don't have their own bindings for the variable. (This includes all
newly-created buffers.) If you set the variable in a buffer that does
-not have a buffer-local binding for it, this sets the default binding
-(assuming there are no frame-local bindings to complicate the matter),
+not have a buffer-local binding for it, this sets the default binding,
so the new value is visible in all the buffers that see the default
binding.
be changed with @code{setq} in any buffer; the only way to change it is
with @code{setq-default}.
- @strong{Warning:} When a variable has buffer-local or frame-local
+ @strong{Warning:} When a variable has buffer-local
bindings in one or more buffers, @code{let} rebinds the binding that's
currently in effect. For instance, if the current buffer has a
buffer-local value, @code{let} temporarily rebinds that. If no
-buffer-local or frame-local bindings are in effect, @code{let} rebinds
+buffer-local bindings are in effect, @code{let} rebinds
the default value. If inside the @code{let} you then change to a
different current buffer in which a different binding is in effect,
you won't see the @code{let} binding any more. And if you exit the
@c Emacs 19 feature
The special forms @code{defvar} and @code{defconst} also set the
default value (if they set the variable at all), rather than any
-buffer-local or frame-local value.
+buffer-local value.
@defun default-value symbol
This function returns @var{symbol}'s default value. This is the value
@end example
@end defun
-@node Frame-Local Variables
-@section Frame-Local Variables
-@cindex frame-local variables
-
- Just as variables can have buffer-local bindings, they can also have
-frame-local bindings. These bindings belong to one frame, and are in
-effect when that frame is selected. Frame-local bindings are actually
-frame parameters: you create a frame-local binding in a specific frame
-by calling @code{modify-frame-parameters} and specifying the variable
-name as the parameter name.
-
- To enable frame-local bindings for a certain variable, call the function
-@code{make-variable-frame-local}.
-
-@deffn Command make-variable-frame-local variable
-Enable the use of frame-local bindings for @var{variable}. This does
-not in itself create any frame-local bindings for the variable; however,
-if some frame already has a value for @var{variable} as a frame
-parameter, that value automatically becomes a frame-local binding.
-
-If @var{variable} does not have a default value, then calling this
-command will give it a default value of @code{nil}. If @var{variable}
-already has a default value, that value remains unchanged.
-
-If the variable is terminal-local, this function signals an error,
-because such variables cannot have frame-local bindings as well.
-@xref{Multiple Displays}. A few variables that are implemented
-specially in Emacs can be buffer-local, but can never be frame-local.
-
-This command returns @var{variable}.
-@end deffn
-
- Buffer-local bindings take precedence over frame-local bindings. Thus,
-consider a variable @code{foo}: if the current buffer has a buffer-local
-binding for @code{foo}, that binding is active; otherwise, if the
-selected frame has a frame-local binding for @code{foo}, that binding is
-active; otherwise, the default binding of @code{foo} is active.
-
- Here is an example. First we prepare a few bindings for @code{foo}:
-
-@example
-(setq f1 (selected-frame))
-(make-variable-frame-local 'foo)
-
-;; @r{Make a buffer-local binding for @code{foo} in @samp{b1}.}
-(set-buffer (get-buffer-create "b1"))
-(make-local-variable 'foo)
-(setq foo '(b 1))
-
-;; @r{Make a frame-local binding for @code{foo} in a new frame.}
-;; @r{Store that frame in @code{f2}.}
-(setq f2 (make-frame))
-(modify-frame-parameters f2 '((foo . (f 2))))
-@end example
-
- Now we examine @code{foo} in various contexts. Whenever the
-buffer @samp{b1} is current, its buffer-local binding is in effect,
-regardless of the selected frame:
-
-@example
-(select-frame f1)
-(set-buffer (get-buffer-create "b1"))
-foo
- @result{} (b 1)
-
-(select-frame f2)
-(set-buffer (get-buffer-create "b1"))
-foo
- @result{} (b 1)
-@end example
-
-@noindent
-Otherwise, the frame gets a chance to provide the binding; when frame
-@code{f2} is selected, its frame-local binding is in effect:
-
-@example
-(select-frame f2)
-(set-buffer (get-buffer "*scratch*"))
-foo
- @result{} (f 2)
-@end example
-
-@noindent
-When neither the current buffer nor the selected frame provides
-a binding, the default binding is used:
-
-@example
-(select-frame f1)
-(set-buffer (get-buffer "*scratch*"))
-foo
- @result{} nil
-@end example
-
-@noindent
-When the active binding of a variable is a frame-local binding, setting
-the variable changes that binding. You can observe the result with
-@code{frame-parameters}:
-
-@example
-(select-frame f2)
-(set-buffer (get-buffer "*scratch*"))
-(setq foo 'nobody)
-(assq 'foo (frame-parameters f2))
- @result{} (foo . nobody)
-@end example
-
@node Future Local Variables
@section Possible Future Local Variables
+2007-10-25 Jonathan Yavner <jyavner@member.fsf.org>
+
+ * ses.texi (The Basics): Mention how to create a new spreadsheet.
+ Mention the new three-letter column identifiers.
+ (More on cell printing): Calculate-cell and truncate-cell are now `c'
+ and `t' rather than `C-c C-c' and `C-c C-t'. Mention the stupid error
+ message when using `c' on an empty default with default printer.
+ (Buffer-local variables in spreadsheets): `symbolic-formulas' was
+ renamed to `ses--symbolic-formulas' some time ago.
+
+2007-10-25 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc.texi (Default Simplifications, Making Selections)
+ (Customizing Calc): Clarify associativity of multiplication.
+
+2007-10-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Traces and Profiles): Simplify loop over
+ `trace-function-background'.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * dired-x.texi (Shell Command Guessing): Default values are now
+ available by typing M-n instead of M-p.
+
+2007-10-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (Cleanup remote connections): New section.
+ (Password caching): Remove `tramp-clear-passwd'.
+ It's not a command anymore.
+ (Bug Reports): Add `tramp-bug' to function index.
+ (Function Index, Variable Index): New nodes.
+ (Remote shell setup): Describe `tramp-password-prompt-regexp'.
+
+ * trampver.texi: Update release number.
+
2007-10-20 Jay Belanger <jay.p.belanger@gmail.com>
- * calc.texi (History and Acknowledgements): Turn comment
+ * calc.texi (History and Acknowledgements): Turn comment
about integer size into past tense.
(Time Zones): Remove pointer to Calc author's address.
(Trigonometric and Hyperbolic Functions): Mention cotangent
- and hyperbolic cotangent.
+ and hyperbolic cotangent. Fix typo.
2007-10-10 Michael Albinus <michael.albinus@gmx.de>
2007-09-08 Michael Olson <mwolson@gnu.org>
- * erc.texi (Copying): New section included from gpl.texi. This matches
- the look of the upstream ERC manual.
+ * erc.texi (Copying): New section included from gpl.texi.
+ This matches the look of the upstream ERC manual.
2007-09-07 Jay Belanger <jay.p.belanger@gmail.com>
- * calc.texi (History and Acknowledgements): Adjust the
- "thanks".
+ * calc.texi (History and Acknowledgements): Adjust the "thanks".
(Random Numbers): Clarify the distribution of `random'.
2007-09-06 Glenn Morris <rgm@gnu.org>
* Move manual sources from man/ to subdirectories of doc/.
- Split into the Emacs manual in emacs/, and other manuals in misc/.
+ Split into the Emacs manual in emacs/, and other manuals in misc/.
Change all setfilename commands to use ../../info.
* Makefile.in: Move the parts of the old man/Makefile.in that do not
refer to the Emacs manual here.
(../etc/GNU): Delete obsolete target.
(.SUFFIXES): Use $(TEXI2DVI) rather than texi2dvi.
(mostlyclean): Add *.op, *.ops. Move *.aux *.cps *.fns *.kys *.pgs
- *.vrs *.toc here...
- (maintainer-clean): ...from here.
+ *.vrs *.toc here...
+ (maintainer-clean): ...from here.
* makefile.w32-in (../etc/GNU): Delete obsolete target.
2007-08-30 Carsten Dominik <dominik@science.uva.nl>
- * org.texi: Version 5.07
+ * org.texi: Version 5.07.
2007-08-24 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change)
available. With the Hyperbolic flag, these compute their hyperbolic
counterparts, which are also available separately as @code{calc-sech}
[@code{sech}], @code{calc-csch} [@code{csch}] and @code{calc-coth}
-[@code{coth}]. (These commmands do not accept the Inverse flag.)
+[@code{coth}]. (These commands do not accept the Inverse flag.)
@node Advanced Math Functions, Branch Cuts, Trigonometric and Hyperbolic Functions, Scientific Functions
@section Advanced Mathematical Functions
@pindex calc-break-selections
The @kbd{j b} (@code{calc-break-selections}) command controls a mode
in which the ``deep structure'' of these associative formulas shows
-through. Calc actually stores the above formulas as @samp{((a + b) - c) + d}
-and @samp{x * (y * z)}. (Note that for certain obscure reasons, Calc
-treats multiplication as right-associative.) Once you have enabled
-@kbd{j b} mode, selecting with the cursor on the @samp{-} sign would
-only select the @samp{a + b - c} portion, which makes sense when the
-deep structure of the sum is considered. There is no way to select
-the @samp{b - c + d} portion; although this might initially look
-like just as legitimate a sub-formula as @samp{a + b - c}, the deep
-structure shows that it isn't. The @kbd{d U} command can be used
-to view the deep structure of any formula (@pxref{Normal Language Modes}).
+through. Calc actually stores the above formulas as
+@samp{((a + b) - c) + d} and @samp{x * (y * z)}. (Note that for certain
+obscure reasons, by default Calc treats multiplication as
+right-associative.) Once you have enabled @kbd{j b} mode, selecting
+with the cursor on the @samp{-} sign would only select the @samp{a + b -
+c} portion, which makes sense when the deep structure of the sum is
+considered. There is no way to select the @samp{b - c + d} portion;
+although this might initially look like just as legitimate a sub-formula
+as @samp{a + b - c}, the deep structure shows that it isn't. The @kbd{d
+U} command can be used to view the deep structure of any formula
+(@pxref{Normal Language Modes}).
When @kbd{j b} mode has not been enabled, the deep structure is
generally hidden by the selection commands---what you see is what
arguments in Calc's internal form. Sums and products of three or
more terms are arranged by the associative law of algebra into
a left-associative form for sums, @expr{((a + b) + c) + d}, and
-a right-associative form for products, @expr{a * (b * (c * d))}.
-Formulas like @expr{(a + b) + (c + d)} are rearranged to
-left-associative form, though this rarely matters since Calc's
-algebra commands are designed to hide the inner structure of
-sums and products as much as possible. Sums and products in
-their proper associative form will be written without parentheses
-in the examples below.
+(by default) a right-associative form for products,
+@expr{a * (b * (c * d))}. Formulas like @expr{(a + b) + (c + d)} are
+rearranged to left-associative form, though this rarely matters since
+Calc's algebra commands are designed to hide the inner structure of sums
+and products as much as possible. Sums and products in their proper
+associative form will be written without parentheses in the examples
+below.
Sums and products are @emph{not} rearranged according to the
commutative law (@expr{a + b} to @expr{b + a}) except in a few
@defvar calc-multiplication-has-precedence
The variable @code{calc-multiplication-has-precedence} determines
-whether multiplication has precedence over division in algebraic formulas
-in normal language modes. If @code{calc-multiplication-has-precedence}
-is non-@code{nil}, then multiplication has precedence, and so for
-example @samp{a/b*c} will be interpreted as @samp{a/(b*c)}. If
-@code{calc-multiplication-has-precedence} is @code{nil}, then
-multiplication has the same precedence as division, and so for example
+whether multiplication has precedence over division in algebraic
+formulas in normal language modes. If
+@code{calc-multiplication-has-precedence} is non-@code{nil}, then
+multiplication has precedence (and, for certain obscure reasons, is
+right associative), and so for example @samp{a/b*c} will be interpreted
+as @samp{a/(b*c)}. If @code{calc-multiplication-has-precedence} is
+@code{nil}, then multiplication has the same precedence as division
+(and, like division, is left associative), and so for example
@samp{a/b*c} will be interpreted as @samp{(a/b)*c}. The default value
of @code{calc-multiplication-has-precedence} is @code{t}.
@end defvar
you want to @samp{tar xvf} it and suggest that as the default shell
command.
-The default is mentioned in brackets and you can type @kbd{M-p} to get
+The default is mentioned in brackets and you can type @kbd{M-n} to get
the default into the minibuffer and then edit it, e.g., to change
@samp{tar xvf} to @samp{tar tvf}. If there are several commands for a given
file, e.g., @samp{xtex} and @samp{dvips} for a @file{.dvi} file, you can type
-@kbd{M-p} several times to see each of the matching commands.
+@kbd{M-n} several times to see each of the matching commands.
Dired only tries to guess a command for a single file, never for a list
of marked files.
@findex set-mark-command
@findex keyboard-quit
+To create a new spreadsheet, visit a nonexistent file whose name ends
+ with ".ses". For example, @kbd{C-x C-f test.ses RET}.
+
+
A @dfn{cell identifier} is a symbol with a column letter and a row
number. Cell B7 is the 2nd column of the 7th row. For very wide
spreadsheets, there are two column letters: cell AB7 is the 28th
-column of the 7th row.
+column of the 7th row. Super wide spreadsheets get AAA1, etc.
@table @kbd
@item j
tabs, so these are replaced with question marks.
@table @kbd
-@item C-c C-t
+@item t
Confine a cell to its own column (@code{ses-truncate-cell}). This
allows you to move point to a rightward cell that would otherwise be
covered by a spill-over. If you don't change the rightward cell, the
confined cell will spill over again the next time it is reprinted.
-@item C-c C-c
-When applied to a single cell, this command displays in the echo area any
-formula error or printer error that occurred during
-recalculation/reprinting (@code{ses-recalculate-cell}).
+@item c
+When applied to a single cell, this command displays in the echo area
+any formula error or printer error that occurred during
+recalculation/reprinting (@code{ses-recalculate-cell}). You can use
+this to undo the effect of @kbd{t}.
@end table
-When a printer function signals an error, the default printer
+When a printer function signals an error, the fallback printer
@samp{"%s"} is substituted. This is useful when your column printer
-is numeric-only and you use a string as a cell value.
+is numeric-only and you use a string as a cell value. Note that the
+standard default printer is ``%.7g'' which is numeric-only, so cells
+that are empty of contain strings will use the fallback printer.
+@kbd{c} on such cells will display ``Format specifier doesn't match
+argument type''.
@node Import and export, Virus protection, More on cell printing, Advanced Features
the data area, such as hidden constants you want to refer to in your
formulas.
-You can override the variable @code{symbolic-formulas} to be a list of
+You can override the variable @code{ses--symbolic-formulas} to be a list of
symbols (as parenthesized strings) to show as completions for the '
command. This initial completions list is used instead of the actual
set of symbols-as-formulas in the spreadsheet.
-For examples of these, see file @file{etc/ses-example.ses}.
+For an example of this, see file @file{etc/ses-example.ses}.
If (for some reason) you want your formulas or printers to save data
into variables, you must declare these variables as buffer-locals in
* Usage:: An overview of the operation of @value{tramp}.
* Bug Reports:: Reporting Bugs and Problems.
* Frequently Asked Questions:: Questions and answers from the mailing list.
+* Function Index:: @value{tramp} functions.
+* Variable Index:: User options and variables.
* Concept Index:: An item for each concept.
For the developer:
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
* Remote processes:: Integration with other @value{emacsname} packages.
+* Cleanup remote connections:: Cleanup remote connections.
The inner workings of remote version control
seconds how long passwords are cached. Setting it to @code{nil}
disables the expiration.
-@findex tramp-clear-passwd
-A password is removed from the cache if a connection isn't established
-successfully. You can remove a password from the cache also by
-executing @kbd{M-x tramp-clear-passwd} in a buffer containing a
-related remote file or directory.
-
@vindex password-cache
If you don't like this feature for security reasons, password caching
can be disabled totally by customizing the variable
@node Remote shell setup
-@comment node-name, next, previous, up
@section Remote shell setup hints
@cindex remote shell setup
@cindex @file{.profile} file
@code{shell-prompt-pattern}, which is reported to work well in many
circumstances.
+@item @var{tramp-password-prompt-regexp}
+@vindex tramp-password-prompt-regexp
+@vindex tramp-wrong-passwd-regexp
+
+During login, @value{tramp} might be forced to enter a password or a
+passphrase. The difference between both is that a password is
+requested from the shell on the remote host, while a passphrase is
+needed for accessing local authentication information, like your ssh
+key.
+
+@var{tramp-password-prompt-regexp} handles the detection of such
+requests for English environments. When you use another localization
+of your (local or remote) host, you might need to adapt this. Example:
+
+@lisp
+(setq
+ tramp-password-prompt-regexp
+ (concat
+ "^.*"
+ (regexp-opt
+ '("passphrase" "Passphrase"
+ ;; English
+ "password" "Password"
+ ;; Deutsch
+ "passwort" "Passwort"
+ ;; Fran@,{c}ais
+ "mot de passe" "Mot de passe") t)
+ ".*:\0? *"))
+@end lisp
+
+In parallel, it might also be necessary to adapt
+@var{tramp-wrong-passwd-regexp}.
+
@item @command{tset} and other questions
@cindex Unix command tset
@cindex tset Unix command
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
* Remote processes:: Integration with other @value{emacsname} packages.
+* Cleanup remote connections:: Cleanup remote connections.
@end menu
absolute file names, without any remote specification.
+@node Cleanup remote connections
+@section Cleanup remote connections.
+@cindex cleanup
+
+Sometimes it is useful to cleanup remote connections. The following
+commands support this.
+
+@deffn Command tramp-cleanup-connection vec
+This command flushes all connection related objects. @option{vec} is
+the internal representation of a remote connection. Called
+interactively, the command offers all active remote connections in the
+minibuffer as remote file name prefix like @file{@trampfn{method,
+user, host, }}. The cleanup includes password cache (@pxref{Password
+caching}), file cache, connection cache (@pxref{Connection caching}),
+connection buffers.
+@end deffn
+
+@deffn Command tramp-cleanup-all-connections
+This command flushes objects for all active remote connections. The
+same objects are removed as in @code{tramp-cleanup-connection}.
+@end deffn
+
+@deffn Command tramp-cleanup-all-buffers
+Like in @code{tramp-cleanup-all-connections}, all remote connections
+are cleaned up. Additionally all buffers, which are related to a
+remote connection, are killed.
+@end deffn
+
+
@node Bug Reports
@chapter Reporting Bugs and Problems
@cindex bug reports
@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/,
the @value{tramp} Mail Subscription Page}.
+@findex tramp-bug
To report a bug in @value{tramp}, you should execute @kbd{M-x
tramp-bug}. This will automatically generate a buffer with the details
of your system and @value{tramp} version.
@lisp
(require 'tramp)
(require 'trace)
-(mapcar 'trace-function-background
- (mapcar 'intern
- (all-completions "tramp-" obarray 'functionp)))
+(dolist (elt (all-completions "tramp-" obarray 'functionp))
+ (trace-function-background (intern elt)))
(untrace-function 'tramp-read-passwd)
(untrace-function 'tramp-gw-basic-authentication)
@end lisp
@appendix GNU Free Documentation License
@include doclicense.texi
+@node Function Index
+@unnumbered Function Index
+@printindex fn
+
+@node Variable Index
+@unnumbered Variable Index
+@printindex vr
+
@node Concept Index
-@comment node-name, next, previous, up
@unnumbered Concept Index
@printindex cp
+
@contents
@c End of tramp.texi - the TRAMP User Manual
@bye
@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.11
+@set trampver 2.1.12-pre
@c Other flags from configuration
@set instprefix /usr/local
+2007-10-25 Jonathan Yavner <jyavner@member.fsf.org>
+
+ * ses-example.ses: Get rid of silly life-universe-everything local
+ variable. `symbolic-formulas' is now `ses--symbolic-formulas'.
+
+2007-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * NEWS: Mention desktop locking.
+
2007-10-10 Eric S. Raymond <esr@snark.thyrsus.com>
* NEWS: Explain the VC fileset changes a bit better.
\f
* Changes in Specialized Modes and Packages in Emacs 23.1
+** isearch can now search through multiple ChangeLog files.
+When running isearch in a ChangeLog file, if the search fails,
+then another C-s tries searching the previous ChangeLog,
+if there is one (e.g. go from ChangeLog to ChangeLog.12).
+
+This is enabled if isearch-buffers-multi is non-nil.
+
++++
+** In Dired-x, all command guesses for ! are now added to the default
+list accessible by M-n instead of pushing all guesses temporarily into
+the history list.
+
** smerge-refine highlights word-level details of changes in conflict.
It's used automatically as you move through conflicts, see smerge-auto-refine.
** compilation-auto-jump-to-first-error tells `compile' to jump to
the first error encountered during compilations.
-** In the `copyright' package, you can specify your copyright holders's names.
+** In the `copyright' package, you can specify your copyright holders' names.
Only copyright lines with holders matching copyright-names-regexp will be
considered for update.
** eldoc highlights the function argument under point
with the face `eldoc-highlight-function-argument'.
++++
+** defcustom accepts new keyword arguments, `:safe' and `:risky', which
+set a variable's `safe-local-variable' and `risky-local-variable' property.
+
** VC
*** Clicking on the VC mode-line entry now pops the VC menu.
`string', disabled by default.
*** New variable `bibtex-cite-matcher-alist' contains rules to
-identify cited keys in BibTeX entries, used by `bibtex-find-crossref.
+identify cited keys in BibTeX entries, used by `bibtex-find-crossref'.
*** Command `bibtex-url' now allows multiple URLs per entry.
*** The variable `fortran-line-length' can change the fixed-form line-length.
++++
+*** (The increasingly misnamed) F90 mode supports Fortran 2003 syntax.
+
** Miscellaneous
*** comint-mode uses `start-file-process' now (see Lisp Changes).
\f
* Lisp Changes in Emacs 23.1
++++
+** A list of default values can be specified for the DEFAULT argument of
+functions `read-from-minibuffer', `read-string', `read-command',
+`read-variable', `read-buffer', `completing-read'. Elements of this list
+are available for inserting into the minibuffer by typing `M-n'.
+For empty input these functions return the first element of this list.
+
+** `custom-note-var-changed' tells Custom to treat the change in a certain
+variable as having been made within Custom.
+
** `frame-inherited-parameters' lets new frames inherit parameters from
the selected frame.
+
** 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
Use this instead of "~/.emacs.d".
+++
-** The new function `start-file-process is similar to `start-process',
+** The new function `start-file-process' is similar to `start-process',
but obeys file handlers. The file handler is chosen based on
`default-directory'. The functions `start-file-process-shell-command'
and `process-file-shell-command' are also new; they call internally
-`start-file-process and `process-file', respectively.
+`start-file-process' and `process-file', respectively.
+++
** `file-remote-p' has new optional parameters IDENTIFICATION and CONNECTED.
\f
* New Packages for Lisp Programming in Emacs 23.1
+** The package isearch-multi.el has been added. It implements a new mode
+`isearch-buffers-minor-mode' that allows isearch to search through
+multiple buffers. In this mode a new variable
+`isearch-buffers-next-buffer-function' defines the function to call
+to get the next buffer to search in the series of multiple buffers.
+
** The new package avl-tree.el deals with the AVL tree data structure.
\f
special steps to use them. Emacs now has the appropriate resources linked
in to make it use the scrollbars from the system theme.
-** focus-follows-mouse defaults to nil on MS Windows
+** focus-follows-mouse defaults to nil on MS Windows.
Previously this variable was incorrectly documented as having no effect
on MS Windows, and the default was inappropriate for the majority of
Windows installations. Users of software which modifies the behaviour of
was needed. In text command mode, if you have problems before execution has
started, use M-x gud-gdb.
+** desktop.el now detects conflicting uses of the desktop file.
+When loading the desktop, desktop.el can now detect that the file is already
+in use. The default behavior is to ask the user what to do, but you can
+customize it with the new option `desktop-load-locked-desktop'. When saving,
+desktop.el warns about attempts to overwrite a desktop file if it determines
+that the desktop being saved is not an update of the one on disk.
+
* New Modes and Packages in Emacs 22.2
** bibtex-style-mode helps you write BibTeX's *.bst files.
* Lisp Changes in Emacs 22.2.
-** The command `repeat' no longer attempts to repeat a command bound
- to an input event.
-
+** Frame-local variables are deprecated and are slated for removal.
+ Use frame parameters instead.
** The function invisible-p returns non-nil if the character
- after a specified position is invisible.
+after a specified position is invisible.
+++
** inhibit-modification-hooks is bound to t while running modification hooks.
of Windows. This is caused by a deficiency in the underlying system
library function.
-The functions set-time-zone-rule, and display-time-world (which uses it)
-do not work on Windows. Fixing this is difficult, since Windows uses
-localtime for the system clock, and any attempt to change the timezone
-would have to be accompanied by a clock change for the results to remain
-consistent. The way in which these functions are used is not intended to
-cause such system-wide disruption.
+The function set-time-zone-rule gives incorrect results for many
+non-US timezones. This is due to over-simplistic handling of
+daylight savings switchovers by the Windows libraries.
Files larger than 4GB cause overflow in the size (represented as a
32-bit integer) reported by `file-attributes'. This affects Dired as
Check the assignments file for other packages which might go in and
have been missed.
-** Install ruby-mode (needs assignment)?
- http://lists.gnu.org/archive/html/emacs-devel/2007-06/msg00051.html
-
** Make keymaps a first-class Lisp object (this means a rewrite of
keymap.c). What should it do apart from being opaque ?
multiple inheritance ? faster where-is ? no more fix_submap_inheritance ?
the window associated with that modeline.
http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html
-** When running isearch in a ChangeLog file, if the search fails,
- then after another C-s try searching the previous ChangeLog, if
- there is one. (e.g. go from ChangeLog to ChangeLog.12).
- http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02237.html
- Juri Linkov has a patch for this:
- http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00265.html
-
* Internal changes
** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction
(ses-cell A16 990904 990904 nil nil)
(ses-cell B16 Eastern-area (quote Eastern-area) nil (D7 C7 D6 C6 D5 C5))
-(ses-cell C16 21 (/ life-universe-everything 2) nil (D7 C7 D6 C6 D5 C5))
+(ses-cell C16 21 (/ 42 2) nil (D7 C7 D6 C6 D5 C5))
(ses-cell D16 nil nil nil nil)
(ses-cell E16 nil nil nil nil)
;;; Local Variables:
;;; mode: ses
-;;; life-universe-everything: 42
-;;; symbolic-formulas: (("Eastern area") ("West-district") ("North&South") ("Other"))
+;;; ses--symbolic-formulas: (("Eastern area") ("West-district") ("North&South") ("Other"))
;;; End:
;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+2007-10-20 Edward O'Connor <hober0@gmail.com> (tiny change)
+
+ * quail/latin-ltx.el ("\\qed"): Add this rule.
+
+2007-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * quail/indian.el (quail-indian-update-preceding-char):
+ Don't mark the variable as frame-local; it wasn't used as such.
+
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.
2007-01-30 Kenichi Handa <handa@m17n.org>
* CXTERM-DIC/CCDOSPY.tit, CXTERM-DIC/PY-b5.tit, CXTERM-DIC/SW.tit,
- CXTERM-DIC/TONEPY.tit: Add copyright and license notices.
+ * CXTERM-DIC/TONEPY.tit: Add copyright and license notices.
* MISC-DIC/pinyin.map, MISC-DIC/ziranma.cin: Add copyright and
license notices.
* CXTERM-DIC/README: New file.
* CXTERM-DIC/4Corner.tit, CXTERM-DIC/CCDOSPY.tit,
- CXTERM-DIC/PY-b5.tit, CXTERM-DIC/QJ-b5.tit, CXTERM-DIC/QJ.tit,
- CXTERM-DIC/SW.tit, CXTERM-DIC/TONEPY.tit: Updated from
+ * CXTERM-DIC/PY-b5.tit, CXTERM-DIC/QJ-b5.tit, CXTERM-DIC/QJ.tit,
+ * CXTERM-DIC/SW.tit, CXTERM-DIC/TONEPY.tit: Updated from
X11R6/contrib/programs/cxterm.
* ja-dic/ja-dic.el: Regenerated.
("\\prod" ?∏)
("\\propto" ?∝)
("\\psi" ?ψ)
+ ("\\qed" ?∎)
("\\quad" ? )
("\\rangle" ?〉)
("\\rbrace" ?})
+2007-10-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacsclient.c: Add a wrapper for getenv so it also checks the
+ registry on Windows. Suggestion and algorithm by Eli Zaretskii.
+ Code partially based on w32_get_resource and init_environment (w32.c).
+ (egetenv): New wrapper for getenv.
+ (get_current_dir_name, decode_options, get_server_config)
+ (set_local_socket, set_socket, main): Use egetenv, not getenv.
+ (w32_get_resource, w32_getenv) [WINDOWSNT]: New functions.
+
+2007-10-25 Jason Rumney <jasonr@gnu.org>
+
+ * emacsclient.c (sock_err_message): New function.
+ (set_tcp_socket): Use it.
+
2007-10-09 Juanma Barranquero <lekktu@gmail.com>
* emacsclient.c (print_help_and_exit): Fix space to improve
option.
(main) [NO_SOCKETS_IN_FILE_SYSTEM]: Don't call init_signals.
-2007-08-29 Karoly Lorentey <lorentey@elte.hu>
+2007-08-29 K\e,Aa\e(Broly L\e$,1 q\e(Brentey <lorentey@elte.hu>
* emacsclient.c (signal.h): New include.
(sys/stat.h, errno.h): Always include, even on WINDOWSNT.
char *getenv (), *getwd ();
char *(getcwd) ();
+#ifdef WINDOWSNT
+char *w32_getenv ();
+#define egetenv(VAR) w32_getenv(VAR)
+#else
+#define egetenv(VAR) getenv(VAR)
+#endif
+
#ifndef VERSION
#define VERSION "unspecified"
#endif
/* If PWD is accurate, use it instead of calling getwd. PWD is
sometimes a nicer name, and using it may avoid a fatal error if a
parent directory is searchable but not readable. */
- if ((pwd = getenv ("PWD")) != 0
+ if ((pwd = egetenv ("PWD")) != 0
&& (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
&& stat (pwd, &pwdstat) == 0
&& stat (".", &dotstat) == 0
/* Message functions. */
#ifdef WINDOWSNT
+
+#define REG_ROOT "SOFTWARE\\GNU\\Emacs"
+
+/* Retrieve an environment variable from the Emacs subkeys of the registry.
+ Return NULL if the variable was not found, or it was empty.
+ This code is based on w32_get_resource (w32.c). */
+char *
+w32_get_resource (predefined, key, type)
+ HKEY predefined;
+ char *key;
+ LPDWORD type;
+{
+ HKEY hrootkey = NULL;
+ char *result = NULL;
+ DWORD cbData;
+
+ if (RegOpenKeyEx (predefined, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS)
+ {
+ if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS)
+ {
+ result = (char *) xmalloc (cbData);
+
+ if ((RegQueryValueEx (hrootkey, key, NULL, type, result, &cbData) != ERROR_SUCCESS) ||
+ (*result == 0))
+ {
+ free (result);
+ result = NULL;
+ }
+ }
+
+ RegCloseKey (hrootkey);
+ }
+
+ return result;
+}
+
+/*
+ getenv wrapper for Windows
+
+ This is needed to duplicate Emacs's behavior, which is to look for enviroment
+ variables in the registry if they don't appear in the environment.
+*/
+char *
+w32_getenv (envvar)
+ char *envvar;
+{
+ char *value;
+ DWORD dwType;
+
+ if (value = getenv (envvar))
+ /* Found in the environment. */
+ return value;
+
+ if (! (value = w32_get_resource (HKEY_CURRENT_USER, envvar, &dwType)) &&
+ ! (value = w32_get_resource (HKEY_LOCAL_MACHINE, envvar, &dwType)))
+ /* Not found in the registry. */
+ return NULL;
+
+ if (dwType == REG_SZ)
+ /* Registry; no need to expand. */
+ return value;
+
+ if (dwType == REG_EXPAND_SZ)
+ {
+ DWORD size;
+
+ if (size = ExpandEnvironmentStrings (value, NULL, 0))
+ {
+ char *buffer = (char *) xmalloc (size);
+ if (ExpandEnvironmentStrings (value, buffer, size))
+ {
+ /* Found and expanded. */
+ free (value);
+ return buffer;
+ }
+
+ /* Error expanding. */
+ free (buffer);
+ }
+ }
+
+ /* Not the right type, or not correctly expanded. */
+ free (value);
+ return NULL;
+}
+
int
w32_window_app ()
{
int argc;
char **argv;
{
- alternate_editor = getenv ("ALTERNATE_EDITOR");
- display = getenv ("DISPLAY");
+ alternate_editor = egetenv ("ALTERNATE_EDITOR");
+ display = egetenv ("DISPLAY");
if (display && strlen (display) == 0)
display = NULL;
/* Socket used to communicate with the Emacs server process. */
HSOCKET emacs_socket = 0;
+/* On Windows, the socket library was historically separate from the standard
+ C library, so errors are handled differently. */
+void
+sock_err_message (function_name)
+ char *function_name;
+{
+#ifdef WINDOWSNT
+ char* msg = NULL;
+
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ NULL, WSAGetLastError (), 0, (LPTSTR)&msg, 0, NULL);
+
+ message (TRUE, "%s: %s: %s\n", progname, function_name, msg);
+
+ LocalFree (msg);
+#else
+ message (TRUE, "%s: %s: %s\n", progname, function_name, strerror (errno));
+#endif
+}
+
+
/* Let's send the data to Emacs when either
- the data ends in "\n", or
- the buffer is full (but this shouldn't happen)
config = fopen (server_file, "rb");
else
{
- char *home = getenv ("HOME");
+ char *home = egetenv ("HOME");
if (home)
{
config = fopen (path, "rb");
}
#ifdef WINDOWSNT
- if (!config && (home = getenv ("APPDATA")))
+ if (!config && (home = egetenv ("APPDATA")))
{
char *path = alloca (32 + strlen (home) + strlen (server_file));
sprintf (path, "%s/.emacs.d/server/%s", home, server_file);
*/
if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0)
{
- message (TRUE, "%s: socket: %s\n", progname, strerror (errno));
+ sock_err_message ("socket");
return INVALID_SOCKET;
}
*/
if (connect (s, (struct sockaddr *) &server, sizeof server) < 0)
{
- message (TRUE, "%s: connect: %s\n", progname, strerror (errno));
+ sock_err_message ("connect");
return INVALID_SOCKET;
}
associated with the name. This is reminiscent of the logic
that init_editfns uses to set the global Vuser_full_name. */
- char *user_name = (char *) getenv ("LOGNAME");
+ char *user_name = (char *) egetenv ("LOGNAME");
if (!user_name)
- user_name = (char *) getenv ("USER");
+ user_name = (char *) egetenv ("USER");
if (user_name)
{
/* Explicit --server-file arg or EMACS_SERVER_FILE variable. */
if (!server_file)
- server_file = getenv ("EMACS_SERVER_FILE");
+ server_file = egetenv ("EMACS_SERVER_FILE");
if (server_file)
{
if (tty)
{
- char *type = getenv ("TERM");
+ char *type = egetenv ("TERM");
char *tty_name = NULL;
#ifndef WINDOWSNT
tty_name = ttyname (fileno (stdin));
(pr-txt-printer-menu-modified, pr-ps-utility-menu-modified)
(pr-even-or-odd-alist): Vars definition moved.
+2007-10-26 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emulation/pc-select.el (next-line-mark, next-line-nomark)
+ (previous-line-mark, previous-line-nomark): Wrap with-no-warnings
+ around uses of previous-line and next-line.
+
+ * diff.el (diff-old-file, diff-new-file, diff-extra-args): New
+ defvars.
+
+ * textmodes/css-mode.el (comment-continue):
+ * net/browse-url.el (url-handler-regexp):
+ * progmodes/idlw-help.el (idlwave-system-routines): Pacify
+ byte-compiler.
+
+ * textmodes/fill.el (fill-nobreak-p): Replace obsolete alias
+ line-move-invisible-p it's former definition:
+ invisible-p. line-move-invisible-p was removed on 2007-08-29.
+
+2007-10-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * files.el (kill-emacs-query-functions): Doc fix;
+ `save-buffers-kill-emacs' is no longer bound to a key.
+
+2007-10-26 Richard Stallman <rms@gnu.org>
+
+ * isearch-multi.el (isearch-buffers-multi): New option.
+ (isearch-buffers-search-fun): Test it.
+
+ * progmodes/ps-mode.el (ps-mode-map): Delete C-c v binding.
+ Put ps-run-clear on C-c C-l.
+
+ * newcomment.el (comment-styles): New style indent-or-triple.
+ (comment-style): Make that the default.
+ (comment-add defvar): Doc fix.
+ (comment-add): Delete arg EXTRA.
+ (comment-region-default): Open code call to comment-add.
+ Handle indent-or-triple style which uses `multi-char' for INDENT.
+
+2007-10-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * eshell/em-unix.el (nil-blank-string): Doc fix.
+
+2007-10-26 John Wiegley <johnw@newartisans.com>
+
+ * eshell/em-unix.el (eshell/diff): Before calling the `diff'
+ function, ensure that the third argument is turned into a nil if
+ the string is otherwise completely empty (either no characters, or
+ all tabs/spaces). This fixes a bug from a user who found himself
+ unable to customize `diff-switches' and still use Eshell's diff
+ command.
+
+2007-10-26 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-warnings): Autoload the
+ safe-local-variable property.
+
+2007-10-26 Gwern Branwen <gwern0@gmail.com> (tiny change)
+
+ * net/browse-url.el (browse-url-browser-function): Delete grail.
+ (browse-url-grail): Function and variable deleted.
+ (browse-url-browser-function): Delete IXI Mosaic.
+ (browse-url-default-browser): Don't try IXI Mosaic.
+ (browse-url-iximosaic): Function deleted.
+ (browse-url-browser-function): Delete MMM.
+ (browse-url-default-browser): Don't try MMM.
+ (browse-url-mmm): Function deleted.
+
+2007-10-26 Drew Adams <drew.adams@oracle.com>
+
+ * custom.el (custom-note-var-changed): New function.
+
+2007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * emulation/edt-mapper.el (edt-emacs-variant): Replace the only
+ use with the definition. Remove.
+
+ * add-log.el (change-log-start-entry-re): New defconst.
+ (change-log-sortable-date-at): Use it.
+ (change-log-beginning-of-defun, change-log-end-of-defun):
+ New functions.
+ (change-log-mode): Use them for beginning-of-defun-function and
+ end-of-defun-function.
+
+2007-10-25 Jonathan Yavner <jyavner@member.fsf.org>
+
+ * ses.el: Make `ses--symbolic-formulas' a safe local variable.
+ (ses-mode-print-map): Add `c' and `t' (suggested by Gareth Rees).
+ (ses-recalculate-cell): Deal with point being just beyond end of
+ data area (why does this happen?)
+ (ses-set-curcell): Ditto.
+ (ses-column-letter): Handle columns beyond 702. Code written by
+ Gareth Rees.
+
+2007-10-25 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-agenda-get-restriction-and-command):
+ Use `mapc' instead of `mapcar'.
+ (org-agenda-list): Numeric prefix argument can specify the number
+ of days.
+ (remember-register, remember-buffer): Prevent byte compiler from
+ complaining.
+ (org-todo): Save and restore match data.
+ (org-no-warnings): New macro.
+ (org-columns-eval): Use `org-no-warnings'.
+
+2007-10-25 Chris Moore <christopher.ian.moore@gmail.com>
+
+ * comint.el (comint-password-prompt-regexp):
+ Handle `[sudo] password'-style prompt.
+
+2007-10-25 Glenn Morris <rgm@gnu.org>
+
+ * custom.el (custom-declare-variable): Add :risky and :safe keywords.
+ (defcustom): Doc fix.
+
+ * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re):
+ Add `non_intrinsic'.
+ (f90-constants-re): Add ieee modules.
+ (f90-typedef-matcher, f90-typedec-matcher)
+ (f90-imenu-type-matcher): New functions.
+ (f90-font-lock-keywords-1): Give module procedures function-name face.
+ Use `f90-typedef-matcher' for derived types. Fix `abstract interface'.
+ Add `use, intrinsic'.
+ (f90-font-lock-keywords-2): Use `f90-typedec-matcher' for derived types.
+ Move start of `enum' blocks to separate entry.
+ (f90-start-block-re): Fix `type', `abstract interface'.
+ (f90-imenu-generic-expression): Use `f90-imenu-type-matcher' for
+ derived types.
+ (f90-mode-abbrev-table): Add `abstract interface', `asynchronous',
+ `elemental', change `enumerator'.
+ (f90-no-block-limit): Fix `abstract interface'.
+
+ * progmodes/f90.el (f90-indented-comment-re)
+ (f90-directive-comment-re, f90-break-delimiters):
+ * progmodes/fortran.el (fortran-comment-line-start-skip)
+ (fortran-directive-re):
+ * textmodes/conf-mode.el (conf-space-keywords): Mark these regexps
+ as safe if they are strings.
+
+2007-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * startup.el (window-system): Remove. Don't make it frame-local.
+
+2007-10-24 Richard Stallman <rms@gnu.org>
+
+ * savehist.el (savehist-save): Omit unreadable elements.
+
+ * loadhist.el (unload-function-defs-list): Renamed from
+ unload-function-features-list.
+ (unload-feature-special-hooks, unload-feature): Doc fixes.
+
+ * indent.el (indent-to-left-margin): If point's in the indentation,
+ move to the end of the indentation.
+
+ * cus-edit.el (customize-changed-options): Make arg optional.
+
+2007-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs-select, bs-select-other-window): Fix typos in docstrings.
+
+2007-10-24 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * textmodes/org-publish.el (org-publish-attachment): Re-install
+ accidentally deleted change.
+
+2007-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/iris-ansi.el (iris-function-map): Move init into declaration.
+
+2007-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * buff-menu.el (Buffer-menu-sort-column): Doc fix.
+ (Buffer-menu-mode-map): Initialize in the declaration.
+ (Buffer-menu-mode): Define with `define-derived-mode'.
+
+2007-10-24 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-version): Change to 5.13e.
+ (org-agenda-file-regexp): Fix typo in docstring.
+ (org-add-planning-info): Fix bug in parenthesis settings.
+ (org-scan-tags): Catch the case of indirect buffers with no filename.
+ (org-fast-tag-selection, org-export-as-ascii, org-export-as-html):
+ Re-install switch to mapc, had been removed by accident.
+ (org-columns-map): New binding `C-c C-o'.
+ (org-columns-menu): Change menu text and added new entry.
+ (org-columns-eval): Document the use of `next-line'.
+ (org-columns-open-link): New function.
+ (org-columns-follow-link): Remove function.
+ (org-open-link-from-string): New function.
+ (org-read-date-get-relative): Fix typo in docstring.
+ (org-read-date-get-relative): Leading +/- is not optional.
+ (org-agenda-get-restriction-and-command): Always resize window on
+ first loop cycle.
+ (org-agenda-open-link): Make sure the link abbreviations are
+ present in the agenda buffer.
+ (org-agenda-copy-local-variable): New function.
+
+2007-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc.el (vc-update-changelog-rcs2log): Remove incorrect `backend' arg.
+
+2007-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (reindent-then-newline-and-indent): Use a `move after
+ insert' kind of marker in the save-excursion.
+
+2007-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el: Require CL.
+ (comment-continue): Declare.
+
+ * subr.el (make-variable-frame-localizable): Remove.
+ (make-variable-frame-local): Mark obsolete.
+
+2007-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/tex-mode.el (tex-uptodate-p): Don't signal an error if one
+ of the subdirs is unreadable.
+
+2007-10-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-set-file-uid-gid): Protect `call-process'
+ when we are local.
+
+2007-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-current-defun): Remove left-over
+ assignment to `start'.
+
+2007-10-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * ibuf-ext.el (ibuffer-auto-update-changed): Use `dolist' rather
+ than `mapcar'; return value is not used.
+
+2007-10-23 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * progmodes/gud.el (gdb-source-window, gud-tooltip-mode)
+ (hl-line-mode, hl-line-sticky-flag): Pacify byte compiler.
+
+2007-10-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * ibuf-ext.el (ibuffer-switch-to-saved-filters)
+ (ibuffer-switch-to-saved-filter-groups): Doc fixes.
+
+2007-10-23 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * term/xterm.el (terminal-init-xterm): Experiment with a longer timeout.
+
+2007-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/advice.el (ad-make-advised-docstring):
+ Add ad-advice-info text property to doc string.
+
+2007-10-23 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-do-indent, f90-if-indent)
+ (f90-type-indent, f90-program-indent, f90-associate-indent)
+ (f90-continuation-indent, f90-comment-region)
+ (f90-beginning-ampersand, f90-smart-end)
+ (f90-break-before-delimiters, f90-auto-keyword-case)
+ (f90-leave-line-no, f90-mode-hook):
+ Give an appropriate safe-local-variable property.
+
+ * progmodes/fortran.el (fortran-tab-mode-default)
+ (fortran-tab-mode-string, fortran-do-indent, fortran-if-indent)
+ (fortran-structure-indent, fortran-continuation-indent)
+ (fortran-comment-indent, fortran-comment-line-extra-indent)
+ (fortran-comment-line-start)
+ (fortran-minimum-statement-indent-fixed)
+ (fortran-minimum-statement-indent-tab)
+ (fortran-comment-indent-char, fortran-line-number-indent)
+ (fortran-check-all-num-for-matching-do)
+ (fortran-blink-matching-if, fortran-continuation-string)
+ (fortran-comment-region, fortran-electric-line-number)
+ (fortran-column-ruler-fixed, fortran-column-ruler-tab)
+ (fortran-analyze-depth, fortran-break-before-delimiters):
+ Give an appropriate safe-local-variable property.
+
+2007-10-23 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * printing.el: Move variable definitions before use.
+ (pr-menu-char-width, pr-menu-char-height): Pacify byte compiler.
+
+2007-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/tpu-edt.el (tpu-edt-old-global-values): New var.
+ (tpu-edt-off): Use it.
+ (tpu-edt-on): Set it. Make sure the tpu-global-map is not already on
+ the global-map before adding it to global-map.
+
+ * menu-bar.el (global-buffers-menu-map): New var.
+ (global-map, menu-bar-update-buffers): Use it.
+ * msb.el (msb-menu-bar-update-buffers): Use it.
+ (msb-sort-by-directory, msb--choose-menu, msb--mode-menu-cond)
+ (msb--most-recently-used-menu, msb--create-buffer-menu-2):
+ Use with-current-buffer.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * isearch-multi.el: New file.
+
+ * isearch.el (isearch-search-string): After finding the next
+ occurrence switch to buffer isearch-buffers-current-buffer when
+ isearch-buffers-next-buffer-function is non-nil and
+ isearch-buffers-current-buffer is live.
+
+ * add-log.el (change-log-mode): Make and set buffer-local variable
+ isearch-buffers-next-buffer-function to change-log-next-buffer.
+ Call isearch-buffers-minor-mode.
+ (change-log-next-buffer): New function.
+
+2007-10-22 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-read-date-get-relative): New function.
+ (org-agenda-file-regexp): New variable.
+ (org-agenda-files): Allow directories in the variable.
+ (org-agenda-get-restriction-and-command): New function.
+ (org-agenda): Use `org-agenda-get-restriction-and-command'.
+ (org-todo-blocker-hook, org-todo-trigger-hook): New hooks.
+ (org-entry-is-todo-p, org-entry-is-done-p, org-get-todo-state):
+ New functions.
+ (org-entry-add-to-multivalued-property)
+ (org-entry-remove-from-multivalued-property)
+ (org-entry-member-in-multivalued-property): New functions.
+ (org-remember-apply-template): Catch C-g and make sure window
+ configuration is restored.
+ (org-agenda-open-link): Make it work with several links in the line.
+ (org-drawers, org-set-regexps-and-options)
+ (org-get-current-options): Add support for a DRAWERS in-buffer option.
+ (org-agenda-window-frame-fractions): New option.
+ (org-fit-agenda-window): Use `org-agenda-window-frame-fractions'.
+ (org-columns-cleanup-item, org-find-entry-with-id)
+ (org-insert-columns-dblock, org-listtable-to-string)
+ (org-dblock-write:columnview, org-columns-capture-view)
+ (org-edit-headline): New functions.
+ (org-agenda-to-appt): Require calendar.
+ (org-entry-get-with-inheritance): Widen for search.
+ (org-columns-display-here): Don't mark buffer as modified when
+ adding space characters to accomodate column overlays.
+ (org-export-as-html): Better formatting of tags in the toc.
+ (org-columns-display-here): Make the ITEM column as compact as possible.
+ (org-remember-templates): Customization interface improved.
+ (org-export-with-property-drawer): Variable removed.
+ (org-export-with-drawers): New option.
+ (org-complex-heading-regexp): New variable.
+ (org-sort-entries): Rewrite using `sort-subr'.
+ (org-set-property): More appropriate completion during interactive use.
+ (org-sort-entries): Allow sorting by property.
+ (org-additional-option-like-keywords): Add more values.
+ (org-sort-entries-or-items): Rename from `org-sort-entries'.
+
+2007-10-22 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (org-get-date-from-calendar): New function.
+ (org-at-timestamp-p, org-timestamp-change)
+ (org-remember-templates): First element of each entry is now a
+ name for the template.
+ (org-store-log-note): Check for `org-note-abort'.
+ (org-kill-note-or-show-branches): New command.
+ (org-fontify-priorities): New option.
+ (org-fontify-priorities): New function.
+ (org-cut-subtree, org-copy-subtree): New argument N to
+ act on N sequential subtrees.
+ (org-paste-subtree): Fix the level at which a tree is pasted.
+ (org-fit-agenda-window): Limitations on window size removed.
+ (org-agenda-find-same-or-today-or-agenda): Rename from
+ `org-agenda-find-today-or-agenda'.
+ (org-scheduled-past-days): New option.
+ (org-agenda-scheduled-leaders)
+ (org-agenda-deadline-leaders): New options.
+ (org-agenda-get-deadlines): Use `org-agenda-deadline-leaders'.
+ (org-agenda-get-scheduled): Use `org-agenda-scheduled-leaders'.
+ (org-export-with-tags, org-export-plist-vars)
+ (org-infile-export-plist): New "tags" option.
+ (org-use-property-inheritance): New option.
+ (org-cached-entry-get): Use `org-use-property-inheritance'.
+ (org-remember-apply-template): Fix typo.
+
+2007-10-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-find-shell)
+ (tramp-open-connection-setup-interactive-shell): Improve sending
+ initial commands.
+ (tramp-action-terminal): Send debug message.
+ (tramp-wait-for-shell-prompt, tramp-send-command-internal): Remove.
+ (tramp-barf-if-no-shell-prompt): Insert code of
+ `tramp-wait-for-shell-prompt'.
+
+2007-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/AT386.el (terminal-init-AT386): Use input-decode-map.
+
+ * term/vt200.el (terminal-init-vt200):
+ * term/vt201.el (terminal-init-vt201):
+ * term/vt220.el (terminal-init-vt220):
+ * term/vt240.el (terminal-init-vt240):
+ * term/vt300.el (terminal-init-vt300):
+ * term/vt320.el (terminal-init-vt320):
+ * term/vt400.el (terminal-init-vt400):
+ * term/vt420.el (terminal-init-vt420): Use input-decode-map.
+
+ * term/wyse50.el (wyse50-terminal-map): New var.
+ (terminal-init-wyse50): Use it and input-decode-map.
+ (enable-arrow-keys): Emasculate.
+
+ * term/tvi970.el (tvi970-terminal-map): New var.
+ (terminal-init-tvi970): Use it and input-decode-map.
+ (tvi970-keypad-numeric): Remove.
+ (tvi970-set-keypad-mode): Use a terminal-parameter rather than var.
+
+ * term/sun.el (sun-raw-prefix): Fill as part of declaration.
+ (terminal-init-sun): Use it and input-decode-map.
+
+ * term/news.el (terminal-init-news):
+ * term/lk201.el (terminal-init-lk201):
+ * term/iris-ansi.el (terminal-init-iris-ansi): Use input-decode-map.
+
+2007-10-22 Sean O'Rourke <sorourke@cs.ucsd.edu>
+
+ * complete.el (PC-expand-many-files): Remove.
+ (PC-do-completion): Call file-expand-wildcards instead of
+ PC-expand-many-files.
+
+ * net/tramp.el (tramp-handle-expand-many-files): Remove.
+ (PC-expand-many-files): Remove advice.
+
+2007-10-22 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el: Remove leading "*" from defcustom doc-strings.
+ Add some support for Fortran 2003 syntax:
+ (f90-type-indent): Now also applies to `enum'.
+ (f90-associate-indent): New user option.
+ (f90-keywords-re, f90-keywords-level-3-re, f90-procedures-re):
+ Add some F2003 keywords.
+ (f90-constants-re): New constant.
+ (f90-font-lock-keywords-1): Add `associate' blocks, and `abstract
+ Interface'.
+ (f90-font-lock-keywords-2): Add `enumerator', `generic', `procedure',
+ `class'. Arguments for `type'/`class' may have spaces. Add a new
+ element for functions with specified types. Add `end enum' and
+ `select type'. Add `implicit enumerator' and `procedure'.
+ Add `class default' and `type is', `class is'. Fix `go to' regexp.
+ (f90-font-lock-keywords-3): Add `asynchronous' attribute.
+ (f90-font-lock-keywords-4): Add `f90-constants-re'.
+ (f90-blocks-re): Add `enum' and `associate'.
+ (f90-else-like-re): Add `class is', `type is', and `class default'.
+ (f90-end-type-re): Add `enum'.
+ (f90-end-associate-re, f90-typeis-re): New constants.
+ (f90-end-block-re): Add `enum' and `associate'. Change from
+ optional whitespace to end-of-word, to avoid `enumerator'.
+ (f90-start-block-re): Add `select type', `abstract interface', and
+ `enum'. Avoid `type is', and `type (sometype)'.
+ (f90-mode-abbrev-table): Add `enumerator', `protected', and `volatile'.
+ (f90-mode): Doc fix.
+ (f90-looking-at-select-case): Doc fix. Add `select type'.
+ (f90-looking-at-associate): New function.
+ (f90-looking-at-type-like): Avoid `type is' and `type (sometype)'.
+ Add `enum' and `abstract interface'.
+ (f90-no-block-limit): Add `select type' and `abstract interface'.
+ (f90-get-correct-indent, f90-calculate-indent)
+ (f90-end-of-block, f90-beginning-of-block, f90-next-block)
+ (f90-indent-region, f90-match-end): Handle `associate' blocks.
+
+2007-10-22 Martin Rudalics <rudalics@gmx.at>
+
+ * progmodes/fortran.el (fortran-mode-map, fortran-window-create):
+ Use window-full-width-p.
+
+2007-10-22 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * mail/vms-pmail.el (insert-signature): Don't use end-of-buffer.
+
+ * tooltip.el: Use featurep 'xemacs.
+
+ * printing.el: Move variable definitions before use, no code change.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * simple.el (goto-history-element): Allow minibuffer-default to be
+ a list of default values accessible by typing M-n in the minibuffer.
+
+ * dired-x.el (dired-guess-shell-command): Put all guesses to the
+ minibuffer default value list instead of pushing them temporarily
+ to the history list.
+
+2007-10-21 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * hexl.el (hexl-menu): New major mode menu.
+
+2007-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-opt.el (byte-optimize-featurep): Fix paren typo.
+
+2007-10-21 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * w32-fns.el (w32-quote-process-args):
+ * dos-w32.el (print-region-function, lpr-headers-switches)
+ (ps-print-region-function): Pacify byte-compiler.
+
+ * emulation/edt-mapper.el (function-key-map):
+ (edt-map-key): Make it a function instead of using fset.
+ Inline edt-gnu-map-key and edt-lucid-map-key. Use featurep 'xemacs.
+ (edt-gnu-map-key, edt-lucid-map-key): Remove.
+ (edt-x-emacs-p): Remove.
+ (edt-emacs-variant, edt-window-system, edt-xserver):
+ Use featurep 'xemacs.
+
+ * net/eudc.el: Use (featurep 'xemacs) instead of the string test.
+ Replace eudc-xemacs-p with its definition.
+ (eudc-xemacs-p, eudc-emacs-p, eudc-xemacs-mule-p)
+ (eudc-emacs-mule-p): Remove.
+ (eudc-install-menu, eudc-mode): Replace eudc-emacs-p and
+ eudc-xemacs-p with feature tests.
+
+ * net/eudc-bob.el (eudc-bob-generic-menu, eudc-bob-mail-keymap)
+ (eudc-bob-url-keymap, eudc-bob-sound-keymap)
+ (eudc-bob-generic-keymap, eudc-bob-popup-menu)
+ (eudc-bob-toggle-inline-display):
+ * net/eudc-hotlist.el (eudc-hotlist-emacs-menu):
+ Replace eudc-emacs-p and eudc-xemacs-p with feature tests.
+
+ * net/eudcb-ph.el (eudc-ph-open-session):
+ Replace eudc-xemacs-mule-p with its former definition.
+
+ * progmodes/octave-mod.el (octave-xemacs-p): Remove.
+ (octave-abbrev-start): Replace octave-xemacs-p with (featurep 'xemacs).
+
+ * progmodes/vera-mode.el (vera-xemacs): Remove.
+ (vera-mode-syntax-table): Replace vera-xemacs with (featurep 'xemacs).
+
+ * progmodes/vhdl-mode.el (vhdl-xemacs): Remove.
+ (vhdl-doc-mode, vhdl-doc-variable, vhdl-compile-init)
+ (vhdl-speedbar-initialize, vhdl-ps-print-init)
+ (vhdl-forward-comment, vhdl-mode-map-init, vhdl-show-messages)
+ (vhdl-emacs-22, vhdl-emacs-21): Replace vhdl-xemacs
+ with (featurep 'xemacs).
+
+ * progmodes/antlr-mode.el (cond-emacs-xemacs-macfn, defunx)
+ (save-buffer-state-x):
+ * obsolete/fast-lock.el (fast-lock-verbose):
+ * emulation/viper-init.el (viper-xemacs-p)
+ (viper-cond-compile-for-xemacs-or-emacs):
+ * emacs-lisp/checkdoc.el (checkdoc-minor-mode-map):
+ * ps-print.el (case-fold-search):
+ * ediff-hook.el (ediff-cond-compile-for-xemacs-or-emacs):
+ * calculator.el (calculator-help): Use featurep 'xemacs.
+
+ * progmodes/prolog.el: Undo previous change.
+ (comint-prompt-regexp, comint-process-echoes): Pacify byte-compiler.
+
+ * progmodes/dcl-mode.el:
+ * play/yow.el:
+ * calendar/todo-mode.el:
+ * calendar/cal-hebrew.el:
+ * vc-hg.el: Undo previous change.
+
+ * vms-patch.el: Likewise.
+ (print-region-function): Pacify byte-compiler.
+
+2007-10-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (backup-buffer-copy): Call `copy-file' with non-nil
+ preserve-uid-gid.
+
+ * net/ange-ftp.el (ange-ftp-copy-file): Add PRESERVE-UID-GID for
+ compatibility. It is not used, though.
+
+ * net/tramp.el (top): Put load of all tramp-* files into a dolist.
+ Require tramp-cmds.el.
+ (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE.
+ (tramp-handle-file-name-all-completions): Expand DIRECTORY.
+ (tramp-do-copy-or-rename-file-directly): Make more rigid checks.
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection): Use `make-temp-name'. This is
+ possible, because we don't need to create the temporary file, but
+ we need a prefix for ssh, which has its own temporary file handling.
+ (tramp-handle-delete-directory): Add "-f" to rmdir.
+ (tramp-handle-dired-recursive-delete-directory): Call "rm -rf".
+ (tramp-handle-insert-file-contents): Don't raise a tramp-error but
+ a signal, in order to give the callee a chance to suppress.
+ (tramp-handle-write-region): Set owner also in case of short
+ track. Don't use compatibility calls for `write-region' anymore.
+ (tramp-clear-passwd): Add parameter VEC. Adapt all callees.
+ (tramp-append-tramp-buffers): Apply `tramp-list-tramp-buffers'.
+
+ * net/tramp-cmds.el: New file.
+
+ * net/tramp-gw.el (tramp-gw-basic-authentication): Apply VEC to
+ `tramp-clear-passwd'.
+
+ * net/trampver.el: Update release number.
+
+2007-10-21 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * progmodes/gud.el (gud-target-name): Move definition before use.
+
+ * progmodes/dcl-mode.el: Require imenu at compile time.
+
+ * progmodes/cc-engine.el (c-maybe-stale-found-type):
+ Pacify byte-compiler.
+
+ * obsolete/fast-lock.el: Use featurep test instead of string-match.
+
+ * eshell/esh-mode.el (eshell-handle-ansi-color):
+ Require ansi-color at compile time too.
+
+ * eshell/em-unix.el (eshell/info): Require info at compile time too.
+
+ * w32-fns.el: Require w32-vars.
+
+ * diff-mode.el (diff-refine-hunk): Require smerge-mode at compile
+ time too.
+
+2007-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * double.el ([ignore]): Use `ignore'.
+ (double-setup): Inline into double-mode.
+ (double-mode): Use define-minor-mode.
+
+2007-10-21 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * textmodes/reftex.el: Move require easymenu before first use.
+ (reftex-info): Require info at compile too.
+
+ * textmodes/org-publish.el (org-publish-org-to-html)
+ (org-publish-org-to): Require org at compile time too.
+ (org-publish-attachment): Require at compile time too.
+
+ * term/tty-colors.el (w32-tty-standard-colors):
+ Pacify byte-compiler.
+
+ * term/pc-win.el (frame-creation-function-alist): Add to this
+ instead of setting frame-creation-function.
+
+ * play/blackbox.el (bb-up, bb-down): Use forward-line.
+
+ * net/rcirc.el (rcirc-markup-text-functions): Move definition earlier.
+
+ * calendar/todo-mode.el: Require calendar at compile time.
+
+ * calendar/cal-hebrew.el: Require holidays at compile time.
+
+ * w32-vars.el: Provide w32-vars.
+
+ * term/w32-win.el: Require w32-vars.
+ (w32-color-map): Pacify byte-compiler.
+
+ * loadup.el: Load w32-vars before term/w32-win.
+
+2007-10-20 Juri Linkov <juri@jurta.org>
+
+ * textmodes/fill.el (fill-paragraph): When the region is active,
+ don't try other `or' branches regardless of the value returned by
+ fill-region; just return t.
+
+2007-10-20 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc.el (vc-do-command): Condition out a misleading message when
+ running asynchronously.
+ (vc-deduce-fileset): New argument enables using an unregistered
+ visited file as a singleton fileset if nothing else is available.
+ (vc-next-action): Restore file-registering behavior.
+
+2007-10-20 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/README: Add recent news.
+
+2007-10-20 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * term/x-win.el (x-gtk-stock-map, icon-map-list)
+ (x-gtk-map-stock): Delete duplicated definitions from merge.
+
+ * progmodes/compile.el (compilation-skip-to-next-location)
+ (compilation-skip-threshold, compilation-skip-visited):
+ Move definitions earlier.
+
+ * play/decipher.el (decipher-keypress):
+ * play/zone.el (zone-fall-through-ws):
+ * play/landmark.el (lm-move-down, lm-move-up):
+ * play/handwrite.el (handwrite):
+ * mail/mspools.el (mspools-visit-spool):
+ * wdired.el (wdired-next-line, wdired-previous-line):
+ * tar-mode.el (tar-subfile-save-buffer):
+ * scroll-lock.el (scroll-lock-next-line)
+ (scroll-lock-previous-line):
+ * image-dired.el (image-dired-next-line)
+ (image-dired-previous-line):
+ * ediff-help.el (ediff-help-message-line-length):
+ Use forward-line.
+
+ * smerge-mode.el (smerge-auto-refine):
+ * diff-mode.el (diff-auto-refine): Add :group.
+
+ * play/yow.el: Require doctor at compile time.
+
+ * vmsproc.el: Provide vmsproc.
+ (command-send-input): Use forward-line.
+
+ * vms-patch.el: Require ps-print and vmsproc at compile time.
+
+ * vc-mtn.el (log-view-message-re, log-view-file-re)
+ (log-view-font-lock-keywords): Pacify byte-compiler.
+
+ * vc-hg.el: Require log-view at compile time.
+
+2007-10-20 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * log-view.el (log-view-diff): Adapt log-view-diff for new VC API.
+
+2007-10-20 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-font-lock-keywords-2)
+ (f90-looking-at-type-like): Fix regexp typos.
+
2007-10-19 Juanma Barranquero <lekktu@gmail.com>
* bs.el (bs--track-window-changes): Don't refresh the whole list.
* emacs-lisp/advice.el (documentation): Advice deleted.
Doc for advised functions is now handled at C level.
- This is now handled at C level.
(ad-stop-advice, ad-start-advice): Don't enable or disable
advice for `documentation'.
(ad-advised-definition-docstring-regexp): Var deleted.
* net/eudc-hotlist.el (eudc-edit-hotlist):
* net/eudc.el (eudc-display-records)
(eudc-filter-duplicate-attributes)
- (eudc-distribute-field-on-records, eudc-query-form)
- (eudc-process-form):
+ (eudc-distribute-field-on-records, eudc-query-form, eudc-process-form):
* net/eudcb-bbdb.el (eudc-bbdb-filter-non-matching-record)
(eudc-bbdb-query-internal):
* net/eudcb-ldap.el (eudc-ldap-simple-query-internal):
* net/socks.el (socks-build-auth-list):
* progmodes/cc-cmds.el (top level):
- * progmodes/cc-styles.el (c-make-styles-buffer-local)
- (c-set-style):
+ * progmodes/cc-styles.el (c-make-styles-buffer-local, c-set-style):
* progmodes/cperl-mode.el (top level, cperl-imenu-addback)
(cperl-write-tags, cperl-tags-treeify):
* progmodes/ebnf-yac.el (ebnf-yac-token-table):
* vc.el (vc-diff):
(vc-diff-internal): Merge a patch by Juanma Barranquero. Also,
- emporarily disable the check for his edge case of
- vc-diff (stopping it from grinding when callerd from $HOME), as
+ temporarily disable the check for his edge case of
+ vc-diff (stopping it from grinding when called from $HOME), as
it's calling some brittle code in vc-hooks.el.
(with-vc-properties): Fix evaluation time of a macro argument.
* ediff-vers.el (ediff-vc-internal):
* follow.el (follow-stop-intercept-process-output):
Use `follow-call-process-filter' rather than `process-filter'.
Simplify.
+ * vc.el (vc0iff): Prevent errors in an edge case.
2007-10-11 Eric S. Raymond <esr@snark.thyrsus.com>
- * vc.el: Address an edge case in vc-diff pointed out by
- Juanma Barranquero. This is an experimental fix and may change.
-
* vc-hooks.el (vc-registered): Robustify this function a bit
against filenames with no directory component.
2007-10-10 Carsten Dominik <dominik@science.uva.nl>
- * org.el (org-additional-option-like-keywords): New constant.
+ * textmodes/org.el (org-additional-option-like-keywords): New constant.
(org-complete): Use `org-additional-option-like-keywords'.
(org-parse-local-options): New function.
2007-10-10 Carsten Dominik <dominik@science.uva.nl>
- * org.el (org-in-clocktable-p): New function.
- (org-clock-report): Only update the table at point, or insert a
- new one.
+ * textmodes/org.el (org-in-clocktable-p): New function.
+ (org-clock-report): Only update the table at point, or insert a new one.
(org-clock-goto): New function.
(org-open-file): Use `start-process-shell-command' instead of
`shell-command' with an ampersand.
(org-remember-apply-template): Respect the dynamically scoped
selection character.
- * org.texi (Appointment reminders): New section.
-
2007-10-10 Bastien Guerry <Bastien.Guerry@ens.fr>
- * org-export-latex.el (org-export-latex-protect-string):
+ * textmodes/org-export-latex.el (org-export-latex-protect-string):
Renaming of `org-latex-protect'.
(org-export-latex-emphasis-alist): By default, don't protect
any emphasis formatter from further conversion.
2007-09-26 Bastien Guerry <bzg@altern.org>
- * org-export-latex.el (org-export-latex-tables-verbatim): New function.
+ * textmodes/org-export-latex.el (org-export-latex-tables-verbatim):
+ New function.
(org-export-latex-remove-from-headlines): Name changed because of typo.
(org-export-latex-quotation-marks-convention): Option removed.
(org-export-latex-make-preamble): Handle the DATE option.
2007-09-26 Carsten Dominik <dominik@science.uva.nl>
- * org.el (org-kill-is-subtree-p): Use `org-outline-regexp'.
+ * textmodes/org.el (org-kill-is-subtree-p): Use `org-outline-regexp'.
(org-outline-regexp): New constant.
(org-remember-handler): Throw error when the target file is not in
org-mode.
Handle escaped parens.
(latex-forward-sexp): Doc fix.
- * eshell/esh-mode.el (eshell-output-filter-functions): Add
- eshell-postoutput-scroll-to-bottom.
+ * eshell/esh-mode.el (eshell-output-filter-functions):
+ Add eshell-postoutput-scroll-to-bottom.
* loadup.el: Remove termdev.
2007-09-16 Drew Adams <drew.adams@oracle.com>
- * cus-edit (custom-face-edit-activate): Doc fix.
+ * cus-edit.el (custom-face-edit-activate): Doc fix.
2007-09-16 Glenn Morris <rgm@gnu.org>
* env.el (getenv): Pass frame to getenv-internal.
-2007-08-29 Karoly Lorentey <lorentey@elte.hu>
+2007-08-29 K\e,Aa\e(Broly L\e$,1 q\e(Brentey <lorentey@elte.hu>
* version.el (emacs-version): Show if multi-tty is present.
* cus-start.el: Remove bogus window-system reference from GTK test.
- * ebrowse.el (ebrowse-electric-list-mode-map)
+ * progmodes/ebrowse.el (ebrowse-electric-list-mode-map)
(ebrowse-electric-position-mode-map):
* ebuff-menu.el (electric-buffer-menu-mode-map):
* echistory.el (electric-history-map): Bind C-z to `suspend-frame',
2007-08-19 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.el (viper-remove-hooks): Remove some additional viper hooks
- when the user calls viper-go-away.
+ * emulation/viper.el (viper-remove-hooks): Remove some additional
+ viper hooks when the user calls viper-go-away.
(viper-go-away): Restore the default of default-major-mode.
Save the value of default-major-mode before vaperization.
- * viper-cmd.el: Replace error "" with "Viper bell".
+ * emulation/viper-cmd.el: Replace error "" with "Viper bell".
- * viper-ex.el: Replace error "" with "Viper bell".
+ * emulation/viper-ex.el: Replace error "" with "Viper bell".
* ediff-util.el (ediff-make-temp-file): Use the coding system of the
buffer for which file is created.
2007-08-17 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change)
- * progmode/cperl-mode.el (cperl-look-at-leading-count)
+ * progmodes/cperl-mode.el (cperl-look-at-leading-count)
(cperl-find-pods-heres): Fix an error when typing expressions like
`s{a}{b}'.
(org-column-menu): New menu.
(org-new-column-overlay, org-overlay-columns)
(org-overlay-columns-title, org-remove-column-overlays)
- (org-column-show-value, org-column-quit, org-column-edit): New
- functions.
+ (org-column-show-value, org-column-quit, org-column-edit):
+ New functions.
(org-columns, org-agenda-columns): New commands.
(org-get-columns-autowidth-alist): New functions.
(org-properties): New customize group.
2007-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
- * vera-mode.el (vera-mode): Fix `commend-end-skip' setting.
+ * progmodes/vera-mode.el (vera-mode): Fix `commend-end-skip' setting.
(vera-font-lock-match-item): Fix doc string.
(vera-in-comment-p): Remove unused function.
(vera-skip-forward-literal, vera-skip-backward-literal): Improve code,
(vc-bzr-dir-state): Replace its use with vc-bzr-command.
(vc-bzr-buffer-nonblank-p): New function.
(vc-bzr-state-words): New const.
- (vc-bzr-state): Look for `bzr status` keywords in output.
+ (vc-bzr-state): Look for `bzr status' keywords in output.
Display everything else as a warning message to the user.
Fix status report with bzr >= 0.15.
2007-06-14 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.el (viper-describe-key-ad, viper-describe-key-briefly-ad):
- Different advices for Emacs and XEmacs. Compile them conditionally.
+ * emulation/viper.el (viper-describe-key-ad)
+ (viper-describe-key-briefly-ad): Different advices for Emacs and XEmacs.
+ Compile them conditionally.
(viper-version): Belated version change.
2007-06-14 Juanma Barranquero <lekktu@gmail.com>
2007-06-13 Ryan Yeske <rcyeske@gmail.com>
- * rcirc.el (rcirc-format-response-string): Use rcirc-nick-syntax
+ * net/rcirc.el (rcirc-format-response-string): Use rcirc-nick-syntax
around bright and dim regexps. Make sure bright and dim matches
use word anchors. Send text through rcirc-markup functions.
(rcirc-url-regexp): Add single quote character.
* progmodes/sh-script.el: Remove unneeded * from docstrings.
Use [:alpha:] and [:alnum:] where applicable.
(sh-quoted-subshell): Rewrite to correctly
- handle nested mixes of `...` and $(...).
+ handle nested mixes of `...' and $(...).
(sh-apply-quoted-subshell): Remove.
(sh-font-lock-syntactic-keywords): Adjust call to sh-quoted-subshell.
2007-06-06 Carsten Dominik <dominik@science.uva.nl>
- * textmodes/org.el
- (org-export-region-as-html, org-replace-region-by-html)
- (org-number-to-letters, org-table-fedit-finish)
- (org-normalize-color, org-table-fedit-ref-right)
- (org-date-to-gregorian, org-table-fedit-move)
- (org-table-convert-refs-to-rc, org-calendar-holiday)
- (org-table-fedit-toggle-ref-type, org-write-agenda)
- (org-colgroup-info-to-vline-list, org-agenda-todo-previousset)
- (org-defkey, org-encode-for-stdout)
+ * textmodes/org.el (org-export-region-as-html)
+ (org-replace-region-by-html, org-number-to-letters)
+ (org-table-fedit-finish, org-normalize-color)
+ (org-table-fedit-ref-right, org-date-to-gregorian)
+ (org-table-fedit-move, org-table-convert-refs-to-rc)
+ (org-calendar-holiday, org-table-fedit-toggle-ref-type)
+ (org-write-agenda, org-colgroup-info-to-vline-list)
+ (org-agenda-todo-previousset, org-defkey, org-encode-for-stdout)
(org-indent-line-function, org-export-as-html-to-buffer)
(org-store-agenda-views, org-update-mode-line)
(org-find-if, org-delete-all)
2007-03-31 Markus Triska <markus.triska@gmx.at>
- * flymake.el (flymake-err-line-patterns): Doc fix.
+ * progmodes/flymake.el (flymake-err-line-patterns): Doc fix.
2007-03-30 Reiner Steib <Reiner.Steib@gmx.de>
2007-02-07 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * ps-print.ps: The ps-print commands without face printing should not
+ * ps-print.el: The ps-print commands without face printing should not
print background color. Reported by Leo <sdl.web@gmail.com>.
(ps-print-version): New version 6.7.3.
(ps-begin-job): New arg. Fix ps-default-background and
2007-02-02 Ulf Jasper <ulf.jasper@web.de>
- * newsticker.el (newsticker-version): Changed to "1.10".
+ * net/newsticker.el (newsticker-version): Changed to "1.10".
(newsticker--set-customvar): Doc string.
(newsticker-new-item-face): Doc string.
(newsticker-mode): Initialize `invisibility-spec' with t.
2007-01-23 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-keym.el (viper-insert-basic-map): Delete binding for S-TAB.
+ * emulation/viper-keym.el (viper-insert-basic-map):
+ Delete binding for S-TAB.
* ediff-util.el (ediff-clone-buffer-for-region-comparison): Change text
of message. Activate mark.
2007-01-20 Alin C. Soare <alinsoar@voila.fr> (tiny change)
- * lisp/emacs-lisp/lisp-mode.el (last-sexp-toggle-display):
+ * emacs-lisp/lisp-mode.el (last-sexp-toggle-display):
Fixed cursor position when toggle abbreviated display.
2007-01-20 Nick Roberts <nickrob@snap.net.nz>
2007-01-03 Alan Mackenzie <acm@muc.de>
- * progmode/cc-cmds.el (c-mask-paragraph): Fix yesterday's buggy patch.
+ * progmodes/cc-cmds.el (c-mask-paragraph): Fix yesterday's buggy patch.
2007-01-03 Chris Moore <christopher.ian.moore@gmail.com>
* ediff-diff.el (ediff-diff-options): Clarify docstring.
(ediff-setup-diff-regions): Disallow -u in ediff-diff-options.
- * viper-cmd.el (viper-post-command-sentinel): Protect against errors
- in hooks.
+ * emulation/viper-cmd.el (viper-post-command-sentinel):
+ Protect against errors in hooks.
(viper-add-newline-at-eob-if-necessary): Add newline only if we
actually modify buffer; ignore errors if occur.
* help-fns.el (help-with-tutorial): Move to tutorial.el.
* tutorial.el: New file.
- (help-with-tutorial): Move here from help-fns.el. Added help for
- rebound keys. Fixed resume of tutorial.
+ (help-with-tutorial): Move here from help-fns.el. Add help for
+ rebound keys. Fix resume of tutorial.
(tutorial--describe-nonstandard-key, tutorial--sort-keys)
(tutorial--find-changed-keys, tutorial--display-changes)
(tutorial--saved-dir, tutorial--saved-file)
2006-10-23 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-prefix-arg-com): Define gg as G0.
+ * emulation/viper-cmd.el (viper-prefix-arg-com): Define gg as G0.
- * viper-ex.el (ex-read): Quote file argument.
+ * emulation/viper-ex.el (ex-read): Quote file argument.
* ediff-diff.el (ediff-same-file-contents): Expand file names.
calling or due to edit to a buffer, install our own hook
(controlled by `cperl-hook-after-change').
(cperl-electric-pod): =cut may have been recognized as start.
- (cperl-block-p): Move, updatedfor attributes.
+ (cperl-block-p): Move, updated for attributes.
(cperl-calculate-indent): Try to allow '_' be non-word char
Support subs with attributes.
(cperl-where-am-i): Quiet (?) a warning.
2006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * progmode/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling.
+ * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling.
(ebnf-version): New version 4.3.
(ebnf-arrow-extra-width, ebnf-arrow-scale): New options.
(ebnf-prologue): Adjust PostScript programming.
2006-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.el: Bump up version/date of update to reflect the substantial
- changes done in August 2006.
+ * emulation/viper.el: Bump up version/date of update to reflect the
+ substantial changes done in August 2006.
- * viper-cmd (viper-next-line-at-bol): Make sure button-at, push-button
- are defined.
+ * emulation/viper-cmd (viper-next-line-at-bol): Make sure button-at,
+ push-button are defined.
* ediff-util.el (ediff-add-to-history): New function.
2006-09-02 Ryan Yeske <rcyeske@gmail.com>
- * rcirc.el (rcirc-keywords): New variable.
+ * net/rcirc.el (rcirc-keywords): New variable.
(rcirc-bright-nicks, rcirc-dim-nicks): New variables.
(rcirc-bright-nick-regexp, rcirc-dim-nick-regexp): Remove
variables.
2006-08-30 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-special-read-and-insert-char): Convert events to
- chars if XEmacs.
+ * emulation/viper-cmd.el (viper-special-read-and-insert-char):
+ Convert events to chars if XEmacs.
(viper-after-change-undo-hook): Check if undo-in-progress is bound.
2006-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.el (viper-set-hooks): Use frame bindings for
+ * emulation/viper.el (viper-set-hooks): Use frame bindings for
viper-vi-state-cursor-color.
(viper-non-hook-settings): Don't set default
mode-line-buffer-identification.
- * viper-util.el (viper-set-cursor-color-according-to-state): New fun.
+ * emulation/viper-util.el (viper-set-cursor-color-according-to-state):
+ New fun.
(viper-set-cursor-color-according-to-state)
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode): Make conditional on
viper-emacs-state-cursor-color.
- * viper-cmd.el (viper-envelop-ESC-key): Bug fix.
+ * emulation/viper-cmd.el (viper-envelop-ESC-key): Bug fix.
(viper-undo): Use point if undo-beg-posn is nil.
(viper-insert-state-post-command-sentinel, viper-change-state-to-emacs)
(viper-after-change-undo-hook): Don't use
viper-emacs-state-cursor-color by default.
(viper-undo): More sensible positioning after undo.
- * viper-ex.el (ex-splice-args-in-1-letr-cmd): Get rid of caddr.
+ * emulation/viper-ex.el (ex-splice-args-in-1-letr-cmd): Get rid of caddr.
(viper-emacs-state-cursor-color): Default to nil, since this feature
doesn't work well yet.
2006-07-20 Jay Belanger <belanger@truman.edu>
- * calc.el (calc-previous-alg-entry): Remove variable.
+ * calc/calc.el (calc-previous-alg-entry): Remove variable.
- * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history):
+ * calc/calc-aent.el (calc-alg-entry-history, calc-quick-calc-history):
New variables.
(calc-alg-entry): Use `calc-alg-entry-history'.
(calc-do-quick-calc): Use `calc-quick-calc-history'.
Change keybinding for `calcAlg-plus-minus', add keybindings for
`previous-history-element' and `next-history-element'.
- * calc-rewr.el (calc-match): Remove reference to
+ * calc/calc-rewr.el (calc-match): Remove reference to
`calc-previous-alg-entry'.
- * calc-sel.el (calc-selection-history): New variable.
+ * calc/calc-sel.el (calc-selection-history): New variable.
(calc-enter-selection, calc-sel-mult-both-sides)
(calc-sel-add-both-sides): Use `calc-selection-history'.
- * calc-map.el (calc-get-operator-history): New variable.
+ * calc/calc-map.el (calc-get-operator-history): New variable.
(calc-get-operator): Use `calc-get-operator-history'.
- * calcalg3.el (calc-curve-fit-history): New variable.
+ * calc/calcalg3.el (calc-curve-fit-history): New variable.
(calc-curve-fit): Use `calc-curve-fit-history'.
2006-07-20 Kenichi Handa <handa@m17n.org>
2006-06-18 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-special-read-and-insert-char):
+ * emulation/viper-cmd.el (viper-special-read-and-insert-char):
Use read-key-sequence.
(viper-after-change-undo-hook): Misc enhancements.
(viper-after-change-undo-hook): New hook.
(viper-next-line-at-bol): If point is on a widget or a button, simulate
clicking on that widget/button.
- * viper.el (viper-mode): Allow a separate cursor color in Emacs state.
+ * emulation/viper.el (viper-mode): Allow a separate cursor color
+ in Emacs state.
- * ediff-diff (ediff-test-patch-utility): Catch errors.
+ * ediff-diff.el (ediff-test-patch-utility): Catch errors.
(ediff-actual-diff-options, ediff-actual-diff3-options): New variables.
(ediff-set-actual-diff-options): New function.
(ediff-reset-diff-options, ediff-toggle-ignore-case):
2006-04-27 Jay Belanger <belanger@truman.edu>
- * calc-embed.el (calc-embedded-make-info): Use `math-read-expr' to
+ * calc/calc-embed.el (calc-embedded-make-info): Use `math-read-expr' to
read expression when `math-read-big-expr' doesn't work.
2006-04-27 Reiner Steib <Reiner.Steib@gmx.de>
2006-04-08 Ryan Yeske <rcyeske@gmail.com>
- * rcirc.el (rcirc-default-server): Rename from rcirc-server.
+ * net/rcirc.el (rcirc-default-server): Rename from rcirc-server.
(rcirc-default-port): Rename from rcirc-port.
(rcirc-default-nick): Rename from rcirc-nick.
(rcirc-default-user-name): Rename from rcirc-user-name.
2006-03-11 David Ponce <david@dponce.com>
- * ispell.el (ispell-find-aspell-dictionaries): Add aliases before
- merging elements from the standard ispell-dictionary-alist.
+ * textmodes/ispell.el (ispell-find-aspell-dictionaries): Add aliases
+ before merging elements from the standard ispell-dictionary-alist.
(ispell-aspell-add-aliases): Add aliases to the passed dictionary
alist, and return the new alist.
(c-after-change): Protect the match data with save-match-data.
It was getting corrupted by c-after-change-check-<>-operators.
- * cc-defs.el: [Supersedes patch V1.38]:
+ * progmodes/cc-defs.el: [Supersedes patch V1.38]:
(top level): Check for a buggy font-lock-compile-keywords ONLY in
XEmacs. GNU Emacs 22 now has a check which would throw an error here.
2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-insert-state-post-command-sentinel)
+ * emulation/viper-cmd.el (viper-insert-state-post-command-sentinel)
(viper-change-state-to-vi, viper-change-state-to-emacs):
Make aware of cursor coloring in the Emacs state.
(viper-special-read-and-insert-char): Use read-char-exclusive.
(viper-minibuffer-trim-tail): Workaround for fields in minibuffer.
- * viper-init.el (viper-emacs-state-cursor-color): New variable.
+ * emulation/viper-init.el (viper-emacs-state-cursor-color):
+ New variable.
- * viper-util.el (viper-save-cursor-color)
+ * emulation/viper-util.el (viper-save-cursor-color)
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode)
- (viper-restore-cursor-color): Make aware of the cursor color in Emacs
- state.
+ (viper-restore-cursor-color): Make aware of the cursor color
+ in Emacs state.
(viper-get-saved-cursor-color-in-emacs-mode): New function.
* ediff-diff.el (ediff-ignore-case, ediff-ignore-case-option)
2005-12-10 John W. Eaton <jwe@octave.org>
- * emacs/octave-mod.el (octave-electric-space): Don't indent
+ * progmodes/octave-mod.el (octave-electric-space): Don't indent
comments or strings if octave-auto-indent is nil.
2005-12-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* progmodes/cc-fix.el: Add definitions of the macros push and pop
(for GNU Emacs 20.4).
- * progmodes/cc-defs.el:
+ * progmodes/cc-defs.el
(i): Load cc-fix.elc for `push' and `pop' (for GNU Emacs 20.4).
* progmodes/cc-cmds.el (c-show-syntactic-information): Change the
2005-11-25 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-keym.el (viper-ESC-key): Use different values in terminal and
- window modes.
+ * emulation/viper-keym.el (viper-ESC-key): Use different values
+ in terminal and window modes.
- * viper.el (viper-emacs-state-mode-list): Delete mail-mode, add
- jde-javadoc-checker-report-mode.
+ * emulation/viper.el (viper-emacs-state-mode-list): Delete mail-mode,
+ add jde-javadoc-checker-report-mode.
- * ediff-wind (ediff-make-wide-display): Slight simplification.
+ * ediff-wind.el (ediff-make-wide-display): Slight simplification.
* ediff.el (ediff-date): Change the date of last update.
2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-utils.el (viper-non-word-characters-reformed-vi):
+ * emulation/viper-utils.el (viper-non-word-characters-reformed-vi):
Quote `-' in string.
- * viper.el (viper-emacs-state-mode-list): Ensure that
+ * emulation/viper.el (viper-emacs-state-mode-list): Ensure that
rcirc-mode buffers come up in Emacs state.
* ediff-util.el (ediff-make-temp-file): Use proper file-name-handler
2005-11-14 Jay Belanger <belanger@truman.edu>
- * calc-alg.el (calcFunc-write-out-power): Rename it to
+ * calc/calc-alg.el (calcFunc-write-out-power): Rename it to
calcFunc-powerexpand.
(math-write-out-power): Rename it to math-powerexpand; have it
handle negative exponents.
(calc-writeoutpower): Rename it to calc-powerexpand.
- * calc-ext.el: Change calcFunc-writeoutpower and
+ * calc/calc-ext.el: Change calcFunc-writeoutpower and
calc-writeoutpower to calcFunc-powerexpand and calc-powerexpand in
autoloads.
Add calcFunc-ldiv to autoloads.
- * calc-arith.el (calcFunc-ldiv): New function.
+ * calc/calc-arith.el (calcFunc-ldiv): New function.
- * calc.el (calc-left-divide): New function.
+ * calc/calc.el (calc-left-divide): New function.
2005-11-14 Juri Linkov <juri@jurta.org>
2005-11-04 Ulf Jasper <ulf.jasper@web.de>
- * newsticker.el: Commentary updated. Code formatting changed.
+ * net/newsticker.el: Commentary updated. Code formatting changed.
(newsticker-version): Change to "1.9".
(newsticker, newsticker-feed): Doc fix.
(newsticker-url-list): Doc fix. Add option "Weekly".
2005-11-04 Michael Kifer <kifer@cs.stonybrook.edu>
- * ediff-merge.el (ediff-merge-region-is-non-clash): Return t, if not
- merging.
+ * ediff-merg.el (ediff-merge-region-is-non-clash):
+ Return t, if not merging.
* ediff-util.el (ediff-previous-difference): Don't skip regions that
have merge clashes.
* ediff-wind.el (ediff-setup-control-frame)
(ediff-destroy-control-frame): Check the menubar feature.
- * viper-cmd.el (viper-normalize-minor-mode-map-alist)
+ * emulation/viper-cmd.el (viper-normalize-minor-mode-map-alist)
(viper-refresh-mode-line): Use make-local-variable to localize
some vars instead of make-variable-buffer-local. Suggested by
Stefan Monnier.
- * viper-init.el (viper-make-variable-buffer-local): Delete alias.
+ * emulation/viper-init.el (viper-make-variable-buffer-local):
+ Delete alias.
(viper-restore-cursor-type, viper-set-insert-cursor-type):
Use make-local-variable instead of make-variable-buffer-local.
Suggested by Stefan Monnier.
- * viper.el (viper-mode): Don't use viper-make-variable-buffer-local.
+ * emulation/viper.el (viper-mode): Don't use
+ viper-make-variable-buffer-local.
(viper-comint-mode-hook): Use make-local-variable on
require-final-newline.
(viper-non-hook-settings): Don't use make-variable-buffer-local.
2005-09-10 Alan Mackenzie <acm@muc.de>
- * page.el (narrow-to-page): Exclude _entire_ multi-line delimiter
- from the region narrowed to.
+ * textmodes/page.el (narrow-to-page): Exclude _entire_ multi-line
+ delimiter from the region narrowed to.
2005-09-10 Magnus Henoch <mange@freemail.hu>
2005-08-06 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper.el (viper-emacs-state-mode-list): Add recentf-dialog-mode.
- Change the date of last update.
+ * emulation/viper.el (viper-emacs-state-mode-list):
+ Add recentf-dialog-mode. Change the date of last update.
2005-08-06 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-harness-minor-mode, viper-exec-delete)
+ * emulation/viper-cmd.el (viper-harness-minor-mode, viper-exec-delete)
(viper-exec-yank, viper-put-back): Don't display modification msg
if in the minibuffer.
- * viper-init.el (viper-replace-overlay-cursor-color)
+ * emulation/viper-init.el (viper-replace-overlay-cursor-color)
(viper-insert-state-cursor-color, viper-vi-state-cursor-color):
Make variables frame local.
- * viper-util.el (viper-append-filter-alist): Use append instead of
- nconc.
+ * emulation/viper-util.el (viper-append-filter-alist):
+ Use append instead of nconc.
- * viper.el (viper-vi-state-mode-list)
+ * emulation/viper.el (viper-vi-state-mode-list)
(viper-emacs-state-mode-list): Move help-mode and
completion-list-mode from the first list to the second.
(viper-mode): Docstring.
2005-07-19 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-escape-to-state): Bug fix.
+ * emulation/viper-cmd.el (viper-escape-to-state): Bug fix.
(viper-envelop-ESC-key): Change the definition of fast
keysequence so it'll work with keyboard macros.
2005-07-16 Jose E. Marchesi <jemarch@gnu.org>
- * lisp/mail/smtpmail.el (smtpmail-auth-supported):
- Add plain auth method.
+ * mail/smtpmail.el (smtpmail-auth-supported): Add plain auth method.
(smtpmail-try-auth-methods): Add AUTH PLAIN dialog.
2005-07-17 Kim F. Storm <storm@cua.dk>
2005-07-10 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper--key-maps): New variable.
+ * emulation/viper-cmd.el (viper--key-maps): New variable.
(viper-normalize-minor-mode-map-alist): Use viper--key-maps and
emulation-mode-map-alists.
(viper-envelop-ESC-key): Use viper-subseq.
(viper-search-forward/backward/next): Disable debug-on-error.
- * viper-keym.el (viper-toggle-key, viper-quoted-insert-key)
+ * emulation/viper-keym.el (viper-toggle-key, viper-quoted-insert-key)
(viper-ESC-key): New defcustoms.
- * viper-macs.el (ex-map-read-args): Use viper-subseq.
+ * emulation/viper-macs.el (ex-map-read-args): Use viper-subseq.
- * viper-util.el (viper-key-to-emacs-key): Use viper-subseq.
+ * emulation/viper-util.el (viper-key-to-emacs-key): Use viper-subseq.
(viper-subseq): Copy of subseq from cl.el.
- * viper.el (viper-go-away, viper-set-hooks): Use
+ * emulation/viper.el (viper-go-away, viper-set-hooks): Use
emulation-mode-map-alists, advise self-insert-command, add-minor-mode.
- * viper-mous.el (viper-current-frame-saved): Use defvar.
+ * emulation/viper-mous.el (viper-current-frame-saved): Use defvar.
- * viper-init.el: Get rid of -face in face names.
+ * emulation/viper-init.el: Get rid of -face in face names.
* ediff-diff.el (ediff-extract-diffs, ediff-extract-diffs3):
Make it work with longlines mode.
2005-06-11 Alan Mackenzie <acm@muc.de>
- * fill.el (fill-context-prefix): Try `adaptive-fill-function'
+ * textmodes/fill.el (fill-context-prefix): Try `adaptive-fill-function'
BEFORE `adaptive-fill-regexp' when determining a fill prefix.
(adaptive-file-function): Minor amendment to doc-string.
2005-06-04 David Reitter <david.reitter@gmail.com> (tiny change)
- * url-http.el (url-http-chunked-encoding-after-change-function):
+ * url/url-http.el (url-http-chunked-encoding-after-change-function):
Use `url-http-debug' instead of `message'.
2005-06-04 Thierry Emery <thierry.emery@free.fr> (tiny change)
- * url-http.el (url-http-parse-headers): Pass redirected URL as a
- callback argument.
+ * url/url-http.el (url-http-parse-headers): Pass redirected URL
+ as a callback argument.
2005-06-04 Kim F. Storm <storm@cua.dk>
* ediff-mult.el (ediff-intersect-directories): Make sure that ".." and
"." files are deleted from all file lists before comparison.
- * viper-keym.el (viper-toggle-key, viper-quoted-insert-key)
+ * emulation/viper-keym.el (viper-toggle-key, viper-quoted-insert-key)
(viper-ESC-key): Made them customizable.
- * viper.el (viper-non-hook-settings): Fix the names of defadvices.
+ * emulation/viper.el (viper-non-hook-settings):
+ Fix the names of defadvices.
2005-06-01 Luc Teirlinck <teirllm@auburn.edu>
2005-05-29 Richard M. Stallman <rms@gnu.org>
- * flyspell.el (flyspell-version): Function deleted.
+ * textmoddes/flyspell.el (flyspell-version): Function deleted.
(flyspell-auto-correct-previous-hook): Doc fix.
* jit-lock.el (jit-lock-function, jit-lock-after-change):
2005-05-29 Peter Heslin <p.j.heslin@durham.ac.uk> (tiny change)
- * flyspell.el (flyspell-auto-correct-previous-word):
+ * textmodes/flyspell.el (flyspell-auto-correct-previous-word):
Narrow down to what's on the screen, and recenter overlays
at the end of the next word.
2005-05-29 Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
- * flyspell.el (flyspell-emacs, flyspell-use-local-map): Vars moved up.
+ * textmodes/flyspell.el (flyspell-emacs, flyspell-use-local-map):
+ 8Vars moved up.
(flyspell-default-delayed-commands): Add backward-delete-char-untabify.
(flyspell-abbrev-p): Default to nil.
(flyspell-use-global-abbrev-table-p): Doc fix.
CC Mode update to 5.30.10:
- * cc-fonts.el (c-font-lock-declarators): Fix bug where the point
- could go past the limit in decoration level 2, thereby causing
- errors during interactive fontification.
+ * progmodes/cc-fonts.el (c-font-lock-declarators): Fix bug where
+ the point could go past the limit in decoration level 2, thereby
+ causing errors during interactive fontification.
- * cc-mode.el (c-make-inherited-keymap): Fix cc-bytecomp bug when
- the file is evaluated interactively.
+ * progmodes/cc-mode.el (c-make-inherited-keymap): Fix cc-bytecomp
+ bug when the file is evaluated interactively.
- * cc-engine.el (c-guess-basic-syntax): Handle operator
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Handle operator
declarations somewhat better in C++.
- * cc-styles.el, cc-mode.el (c-run-mode-hooks): New helper macro to
- make use of `run-mode-hooks' which has been added in Emacs 21.1.
+ * progmodes/cc-styles.el, cc-mode.el (c-run-mode-hooks):
+ New helper macro to make use of `run-mode-hooks'
+ which has been added in Emacs 21.1.
(c-mode, c++-mode, objc-mode, java-mode, idl-mode, pike-mode)
(awk-mode): Use it.
(make-local-hook): Suppress warning about obsoleteness.
- * cc-engine.el, cc-align.el, cc-cmds.el
+ * progmodes/cc-engine.el, cc-align.el, cc-cmds.el
(c-append-backslashes-forward, c-delete-backslashes-forward)
(c-find-decl-spots, c-semi&comma-no-newlines-before-nonblanks):
Compensate for return value from `forward-line' when it has moved
but not to a different line due to eob.
- * cc-engine.el (c-guess-basic-syntax): Fix anchoring in
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchoring in
`objc-method-intro' and `objc-method-args-cont'.
2005-05-23 Alan Mackenzie <bug-cc-mode@gnu.org>
CC Mode update to 5.30.10:
- * cc-mode.el, cc-engine.el, cc-align.el: Change the FSF's address
- in the copyright statement. Incidentally, change "along with GNU
- Emacs" to "along with this program" where it occurs.
+ * progmodes/cc-mode.el, cc-engine.el, cc-align.el: Change the FSF's
+ address in the copyright statement. Incidentally, change "along with
+ GNU Emacs" to "along with this program" where it occurs.
- * cc-mode.el: Add a fourth parameter `t' to the awk-mode autoload,
- so that it is interactive, hence can be found by M-x awk-mode
+ * progmodes/cc-mode.el: Add a fourth parameter `t' to the awk-mode
+ autoload, so that it is interactive, hence can be found by M-x awk-mode
whilst cc-mode is yet to be loaded. Reported by Glenn Morris
<gmorris+emacs@ast.cam.ac.uk>.
- * cc-awk.el: Add character classes (e.g. "[:alpha:]") into AWK
+ * progmodes/cc-awk.el: Add character classes (e.g. "[:alpha:]") into AWK
Mode's regexps.
2005-05-23 Kevin Ryde <user42@zip.com.au>
- * cc-align.el (c-lineup-argcont): Ignore conses for {} pairs from
- c-parse-state, to avoid a lisp error (on bad code).
+ * progmodes/cc-align.el (c-lineup-argcont): Ignore conses for {} pairs
+ from c-parse-state, to avoid a lisp error (on bad code).
2005-05-23 Lute Kamstra <lute@gnu.org>
* simple.el (next-error-overlay-arrow-position): Turn off, for ttys.
- * loadup.el: load jka-comp-hook.
+ * loadup.el: Load jka-comp-hook.
* jka-compr.el: Many functions and vars moved to jka-comp-hook.el.
(jka-compr-handler): Add autoload. `put' calls moved
2005-03-30 Carsten Dominik <dominik@science.uva.nl>
- * org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset)
- (org-agenda-convert-date, org-agenda-goto-calendar): New commands.
+ * textmodes/org.el (org-agenda-phases-of-moon)
+ (org-agenda-sunrise-sunset, org-agenda-convert-date)
+ (org-agenda-goto-calendar): New commands.
(org-diary-default-entry): New function.
(org-get-entries-from-diary): Better parsing of diary entries.
(org-agenda-check-no-diary): New function.
2005-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
- * viper-cmd.el (viper-prefix-commands): Make into a defconst.
+ * emulation/viper-cmd.el (viper-prefix-commands): Make into a defconst.
(viper-exec-buffer-search): Use regexp-quote to quote buffer string.
(viper-minibuffer-setup-sentinel): Make some variables buffer-local.
(viper-skip-separators): Bug fix.
(viper-del-backward-char-in-replace): Don't put deleted char on the
kill ring.
- * viper-ex.el (viper-color-display-p): New function.
+ * emulation/viper-ex.el (viper-color-display-p): New function.
(viper-has-face-support-p): Use viper-color-display-p.
- * viper-keym.el (viper-gnus-modifier-map): New keymap.
+ * emulation/viper-keym.el (viper-gnus-modifier-map): New keymap.
- * viper-macs.el (viper-unrecord-kbd-macro): Bug fix.
+ * emulation/viper-macs.el (viper-unrecord-kbd-macro): Bug fix.
- * viper-util.el (viper-glob-unix-files): Fix shell status check.
+ * emulation/viper-util.el (viper-glob-unix-files):
+ Fix shell status check.
(viper-file-remote-p): Make equivalent to file-remote-p.
- * viper.el (viper-major-mode-modifier-list):
+ * emulation/viper.el (viper-major-mode-modifier-list):
Use viper-gnus-modifier-map.
2005-02-19 David Kastrup <dak@gnu.org>
(bibtex-parse-field-name): Fix typos in docstrings.
(bibtex-field-list, bibtex-find-crossref): Fix typos in error messages.
-2005-01-24 Carsten Dominik <dominik@science.uva.nl>
+2005-01-24 Dan Nicolaescu <dann@ics.uci.edu>
+ Juri Linkov <juri@jurta.org>
* textmodes/reftex-global.el (reftex-isearch-push-state-function)
(reftex-isearch-pop-state-function, reftex-isearch-isearch-search)
2005-01-15 Alan Mackenzie <acm@muc.de>
- * ebrowse.el (ebrowse-class-in-tree): Return the tail of the tree
- rather than the element found, thus enabling the tree to be setcar'd.
+ * progmodes/ebrowse.el (ebrowse-class-in-tree):
+ Return the tail of the tree rather than the element found,
+ thus enabling the tree to be setcar'd.
2005-01-14 Carsten Dominik <dominik@science.uva.nl>
(org-show-hierarchy-above): Use `org-show-following-heading'.
(org-cycle): Documentation fix.
- * textmodes/org.el (orgtbl-optimized): New option
+ * textmodes/org.el (orgtbl-optimized): New option.
(orgtbl-mode): New command, a minor mode.
(orgtbl-mode-map): New variable.
(turn-on-orgtbl, orgtbl-mode, orgtbl-make-binding)
'change-log-resolve-conflict)
(set (make-local-variable 'adaptive-fill-regexp) "\\s *")
(set (make-local-variable 'font-lock-defaults)
- '(change-log-font-lock-keywords t nil nil backward-paragraph)))
+ '(change-log-font-lock-keywords t nil nil backward-paragraph))
+ (set (make-local-variable 'isearch-buffers-next-buffer-function)
+ 'change-log-next-buffer)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'change-log-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'change-log-end-of-defun)
+ (isearch-buffers-minor-mode))
+
+(defun change-log-next-buffer (&optional buffer wrap)
+ "Return the next buffer in the series of ChangeLog file buffers.
+This function is used for multiple buffers isearch.
+A sequence of buffers is formed by ChangeLog files with decreasing
+numeric file name suffixes in the directory of the initial ChangeLog
+file were isearch was started."
+ (let* ((name (change-log-name))
+ (files (cons name (sort (file-expand-wildcards
+ (concat name "[-.][0-9]*"))
+ (lambda (a b)
+ (version< (substring b (length name))
+ (substring a (length name)))))))
+ (files (if isearch-forward files (reverse files))))
+ (find-file-noselect
+ (if wrap
+ (car files)
+ (cadr (member (file-name-nondirectory (buffer-file-name buffer))
+ files))))))
;; It might be nice to have a general feature to replace this. The idea I
;; have is a variable giving a regexp matching text which should not be
(change-log-get-method-definition-1 ""))
(concat change-log-get-method-definition-md "]"))))))
\f
+(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
+
(defun change-log-sortable-date-at ()
"Return date of log entry in a consistent form for sorting.
Point is assumed to be at the start of the entry."
(require 'timezone)
- (if (looking-at "^\\sw.........[0-9:+ ]*")
+ (if (looking-at change-log-start-entry-re)
(let ((date (match-string-no-properties 0)))
(if date
(if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date)
(goto-char (point-max)))
(insert-buffer-substring other-buf start)))))))
+(defun change-log-beginning-of-defun ()
+ (re-search-backward change-log-start-entry-re nil 'move))
+
+(defun change-log-end-of-defun ()
+ ;; Look back and if there is no entry there it means we are before
+ ;; the first ChangeLog entry, so go forward until finding one.
+ (unless (save-excursion (re-search-backward change-log-start-entry-re nil t))
+ (re-search-forward change-log-start-entry-re nil t))
+
+ ;; In case we are at the end of log entry going forward a line will
+ ;; make us find the next entry when searching. If we are inside of
+ ;; an entry going forward a line will still keep the point inside
+ ;; the same entry.
+ (forward-line 1)
+
+ ;; In case we are at the beginning of an entry, move past it.
+ (when (looking-at change-log-start-entry-re)
+ (goto-char (match-end 0))
+ (forward-line 1))
+
+ ;; Search for the start of the next log entry. Go to the end of the
+ ;; buffer if we could not find a next entry.
+ (when (re-search-forward change-log-start-entry-re nil 'move)
+ (goto-char (match-beginning 0))
+ (forward-line -1)))
+
(provide 'add-log)
;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762
(defun bs-select ()
"Select current line's buffer and other marked buffers.
If there are no marked buffers the window configuration before starting
-Buffer Selectin Menu will be restored.
+Buffer Selection Menu will be restored.
If there are marked buffers each marked buffer and the current line's buffer
will be selected in a window.
Leave Buffer Selection Menu."
(defun bs-select-other-window ()
"Select current line's buffer by `switch-to-buffer-other-window'.
-The window configuration before starting Buffer Selectin Menu will be restored
+The window configuration before starting Buffer Selection Menu will be restored
unless there is no other window. In this case a new window will be created.
Leave Buffer Selection Menu."
(interactive)
(defvar Buffer-menu-sort-column nil
"Which column to sort the menu on.
Use 2 to sort by buffer names, or 5 to sort by file names.
-nil means sort by visited order (the default).")
+A nil value means sort by visited order (the default).")
(defconst Buffer-menu-buffer-column 4)
-(defvar Buffer-menu-mode-map nil
- "Local keymap for `Buffer-menu-mode' buffers.")
-
(defvar Buffer-menu-files-only nil
"Non-nil if the current buffer-menu lists only file buffers.
This variable determines whether reverting the buffer lists only
file buffers. It affects both manual reverting and reverting by
Auto Revert Mode.")
+(make-variable-buffer-local 'Buffer-menu-files-only)
+
(defvar Info-current-file) ;; from info.el
(defvar Info-current-node) ;; from info.el
-(make-variable-buffer-local 'Buffer-menu-files-only)
-
-(if Buffer-menu-mode-map
- ()
- (setq Buffer-menu-mode-map (make-keymap))
- (suppress-keymap Buffer-menu-mode-map t)
- (define-key Buffer-menu-mode-map "q" 'quit-window)
- (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
- (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
- (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
- (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "e" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
- (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
- (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
- (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
- (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
- (define-key Buffer-menu-mode-map " " 'next-line)
- (define-key Buffer-menu-mode-map "n" 'next-line)
- (define-key Buffer-menu-mode-map "p" 'previous-line)
- (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
- (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
- (define-key Buffer-menu-mode-map "?" 'describe-mode)
- (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
- (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
- (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
- (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
- (define-key Buffer-menu-mode-map "b" 'Buffer-menu-bury)
- (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
- (define-key Buffer-menu-mode-map "V" 'Buffer-menu-view)
- (define-key Buffer-menu-mode-map "T" 'Buffer-menu-toggle-files-only)
- (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
- (define-key Buffer-menu-mode-map [follow-link] 'mouse-face)
-)
+(defvar Buffer-menu-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map t)
+ (define-key map "q" 'quit-window)
+ (define-key map "v" 'Buffer-menu-select)
+ (define-key map "2" 'Buffer-menu-2-window)
+ (define-key map "1" 'Buffer-menu-1-window)
+ (define-key map "f" 'Buffer-menu-this-window)
+ (define-key map "e" 'Buffer-menu-this-window)
+ (define-key map "\C-m" 'Buffer-menu-this-window)
+ (define-key map "o" 'Buffer-menu-other-window)
+ (define-key map "\C-o" 'Buffer-menu-switch-other-window)
+ (define-key map "s" 'Buffer-menu-save)
+ (define-key map "d" 'Buffer-menu-delete)
+ (define-key map "k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
+ (define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "x" 'Buffer-menu-execute)
+ (define-key map " " 'next-line)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map "\177" 'Buffer-menu-backup-unmark)
+ (define-key map "~" 'Buffer-menu-not-modified)
+ (define-key map "?" 'describe-mode)
+ (define-key map "u" 'Buffer-menu-unmark)
+ (define-key map "m" 'Buffer-menu-mark)
+ (define-key map "t" 'Buffer-menu-visit-tags-table)
+ (define-key map "%" 'Buffer-menu-toggle-read-only)
+ (define-key map "b" 'Buffer-menu-bury)
+ (define-key map "g" 'Buffer-menu-revert)
+ (define-key map "V" 'Buffer-menu-view)
+ (define-key map "T" 'Buffer-menu-toggle-files-only)
+ (define-key map [mouse-2] 'Buffer-menu-mouse-select)
+ (define-key map [follow-link] 'mouse-face)
+ map)
+ "Local keymap for `Buffer-menu-mode' buffers.")
;; Buffer Menu mode is suitable only for specially formatted data.
(put 'Buffer-menu-mode 'mode-class 'special)
-(defun Buffer-menu-mode ()
+(define-derived-mode Buffer-menu-mode nil "Buffer Menu"
"Major mode for editing a list of buffers.
Each line describes one of the buffers in Emacs.
Letters do not insert themselves; instead, they are commands.
\\[Buffer-menu-revert] -- update the list of buffers.
\\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
\\[Buffer-menu-bury] -- bury the buffer listed on this line."
- (kill-all-local-variables)
- (use-local-map Buffer-menu-mode-map)
- (setq major-mode 'Buffer-menu-mode)
- (setq mode-name "Buffer Menu")
(set (make-local-variable 'revert-buffer-function)
'Buffer-menu-revert-function)
(set (make-local-variable 'buffer-stale-function)
#'(lambda (&optional noconfirm) 'fast))
(setq truncate-lines t)
- (setq buffer-read-only t)
- (run-mode-hooks 'buffer-menu-mode-hook))
+ (setq buffer-read-only t))
;; This function exists so we can make the doc string of Buffer-menu-mode
;; look nice.
Summary of changes to "Calc"
------- -- ------- -- ----
+* Added logistic non-linear curves to curve-fitting.
+
+* Added option of plotting data points and curve when curve-fitting.
+
+* Made unit conversions exact when possible.
Version 2.1:
(and un ud
(if (and (equal (nth 4 un) (nth 4 ud))
(eq pow1 pow2))
- (math-to-standard-units (list '/ n d) nil)
+ (if (eq pow1 1)
+ (math-to-standard-units (list '/ n d) nil)
+ (list '^ (math-to-standard-units (list '/ n d) nil) pow1))
(let (ud1)
(setq un (nth 4 un)
ud (nth 4 ud))
(use-global-map calculator-saved-global-map))
(if (or (not calculator-electric-mode)
;; XEmacs has a problem with electric-describe-mode
- (string-match "XEmacs" (emacs-version)))
+ (featurep 'xemacs))
(describe-mode)
(electric-describe-mode))
(if calculator-electric-mode
;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '.
;; ssh-add prints a prompt like `Enter passphrase: '.
;; 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.
(defcustom comint-password-prompt-regexp
"\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
-Kerberos \\|CVS \\|UNIX \\| SMB \\|LDAP \\|^\\)\
+Kerberos \\|CVS \\|UNIX \\| SMB \\|LDAP \\|\\[sudo] \\|^\\)\
\[Pp]assword\\( (again)\\)?\\|\
pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\
\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'"
"*"
(substring pat p))
p (+ p 2)))
- (setq files (PC-expand-many-files (concat pat "*")))
+ (setq files (file-expand-wildcards (concat pat "*")))
(if files
(let ((dir (file-name-directory (car files)))
(p files))
(setq
basestr ""
p nil
- poss (PC-expand-many-files
+ poss (file-expand-wildcards
(concat "/"
(mapconcat #'list (match-string 1 str) "*/")
"*"))
(goto-char end)
(PC-do-completion nil beg end)))
-;; Use the shell to do globbing.
-;; This could now use file-expand-wildcards instead.
-
-(defun PC-expand-many-files (name)
- (with-current-buffer (generate-new-buffer " *Glob Output*")
- (erase-buffer)
- (when (and (file-name-absolute-p name)
- (not (file-directory-p default-directory)))
- ;; If the current working directory doesn't exist `shell-command'
- ;; signals an error. So if the file names we're looking for don't
- ;; depend on the working directory, switch to a valid directory first.
- (setq default-directory "/"))
- (shell-command (concat "echo " name) t)
- (goto-char (point-min))
- ;; CSH-style shells were known to output "No match", whereas
- ;; SH-style shells tend to simply output `name' when no match is found.
- (if (looking-at (concat ".*No match\\|\\(^\\| \\)\\("
- (regexp-quote name)
- "\\|"
- (regexp-quote (expand-file-name name))
- "\\)\\( \\|$\\)"))
- nil
- (insert "(\"")
- (while (search-forward " " nil t)
- (delete-backward-char 1)
- (insert "\" \""))
- (goto-char (point-max))
- (delete-backward-char 1)
- (insert "\")")
- (goto-char (point-min))
- (let ((files (read (current-buffer))) (p nil))
- (kill-buffer (current-buffer))
- (or (equal completion-ignored-extensions PC-ignored-extensions)
- (setq PC-ignored-regexp
- (concat "\\("
- (mapconcat
- 'regexp-quote
- (setq PC-ignored-extensions
- completion-ignored-extensions)
- "\\|")
- "\\)\\'")))
- (setq p nil)
- (while files
- ;; This whole process of going through to shell, to echo, and
- ;; finally parsing the output is a hack. It breaks as soon as
- ;; there are spaces in the file names or when the no-match
- ;; message changes. To make up for it, we check that what we read
- ;; indeed exists, so we may miss some files, but we at least won't
- ;; list non-existent ones.
- (or (not (file-exists-p (car files)))
- (string-match PC-ignored-regexp (car files))
- (setq p (cons (car files) p)))
- (setq files (cdr files)))
- p))))
-
;; Facilities for loading C header files. This is independent from the
;; main completion code. See also the variable `PC-include-file-path'
;; at top of this file.
(defalias 'customize-changed 'customize-changed-options)
;;;###autoload
-(defun customize-changed-options (since-version)
+(defun customize-changed-options (&optional since-version)
"Customize all settings whose meanings have changed in Emacs itself.
This includes new user option variables and faces, and new
customization groups, as well as older options and faces whose meanings
(put symbol 'custom-get value))
((eq keyword :require)
(push value requests))
+ ((eq keyword :risky)
+ (put symbol 'risky-local-variable value))
+ ((eq keyword :safe)
+ (put symbol 'safe-local-variable value))
((eq keyword :type)
(put symbol 'custom-type (purecopy value)))
((eq keyword :options)
VALUE should be a feature symbol. If you save a value
for this option, then when your `.emacs' file loads the value,
it does (require VALUE) first.
+:risky Set SYMBOL's `risky-local-variable' property to VALUE.
+:safe Set SYMBOL's `safe-local-variable' property to VALUE.
The following common keywords are also meaningful.
(or (get variable 'standard-value)
(get variable 'custom-autoload)))
+(defun custom-note-var-changed (variable)
+ "Inform Custom that VARIABLE has been set (changed).
+VARIABLE is a symbol that names a user option.
+The result is that the change is treated as having been made through Custom."
+ (interactive "vVariable: ")
+ (put variable 'customized-value (list (custom-quote (eval variable)))))
+ \f
+ ;;; Custom Themes
+
;;; Loading files needed to customize a symbol.
;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
(defcustom diff-auto-refine t
"Automatically highlight changes in detail as the user visits hunks."
- :type 'boolean)
+ :type 'boolean
+ :group 'diff-mode)
(defcustom diff-mode-hook nil
"Run after setting up the `diff-mode' major mode."
(defun diff-refine-hunk ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
- (require 'smerge-mode)
+ (eval-and-compile (require 'smerge-mode))
(save-excursion
(diff-beginning-of-hunk 'try-harder)
(let* ((style (diff-hunk-style)) ;Skips the hunk header as well.
(if (equal 0 code) " (no differences)" "")
(current-time-string))))))
+(defvar diff-old-file nil)
+(defvar diff-new-file nil)
+(defvar diff-extra-args nil)
+
;;;###autoload
(defun diff (old new &optional switches no-async)
"Find and display the differences between OLD and NEW files.
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
-
(let ((default (dired-guess-default files))
- default-list old-history val (failed t))
-
+ default-list val)
(if (null default)
;; Nothing to guess
(read-from-minibuffer prompt nil nil nil 'dired-shell-command-history)
-
- ;; Save current history list
- (setq old-history dired-shell-command-history)
-
(if (listp default)
-
;; More than one guess
(setq default-list default
default (car default)
prompt (concat
prompt
(format "{%d guesses} " (length default-list))))
-
;; Just one guess
(setq default-list (list default)))
-
- ;; Push all guesses onto history so that they can be retrieved with M-p
- ;; and put the first guess in the prompt but not in the initial value.
- (setq dired-shell-command-history
- (append default-list dired-shell-command-history)
- prompt (concat prompt (format "[%s] " default)))
-
- ;; The unwind-protect returns VAL, and we too.
- (unwind-protect
- ;; BODYFORM
- (progn
- (setq val (read-from-minibuffer prompt nil nil nil
- 'dired-shell-command-history)
- failed nil)
- ;; If we got a return, then use default.
- (if (equal val "")
- (setq val default))
- val)
-
- ;; UNWINDFORMS
- ;; Undo pushing onto the history list so that an aborted
- ;; command doesn't get the default in the next command.
- (setq dired-shell-command-history old-history)
- (if (not failed)
- (or (equal val (car-safe dired-shell-command-history))
- (setq dired-shell-command-history
- (cons val dired-shell-command-history))))))))
-
+ ;; Put the first guess in the prompt but not in the initial value.
+ (setq prompt (concat prompt (format "[%s] " default)))
+ ;; All guesses can be retrieved with M-n
+ (setq val (read-from-minibuffer prompt nil nil nil
+ 'dired-shell-command-history
+ default-list))
+ ;; If we got a return, then return default.
+ (if (equal val "") default val))))
;;; REDEFINE.
;;; Redefine dired-aux.el's version:
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
+(defvar print-region-function)
+(defvar lpr-headers-switches)
(setq print-region-function 'direct-print-region-function)
;; Set this to nil if you have a port of the `pr' program
(direct-print-region-helper printer start end lpr-prog
delete-text buf display rest)))
+(defvar ps-print-region-function)
(setq ps-print-region-function 'direct-ps-print-region-function)
;(setq ps-lpr-command "gs")
(string :tag "Twice"))))
(defcustom double-prefix-only t
- "*Non-nil means that Double mode mapping only works for prefix keys.
+ "Non-nil means that Double mode mapping only works for prefix keys.
That is, for any key `X' in `double-map', `X' alone will be mapped
but not `C-u X' or `ESC X' since the X is not the prefix key."
:group 'double
(message ""))
(read-event)))
-(global-set-key [ignore] '(lambda () (interactive)))
+(global-set-key [ignore] 'ignore)
(or (boundp 'isearch-mode-map)
(load-library "isearch"))
(append (substring exp 1) '(magic-start)))
(vector (aref exp 0)))))))
-;;; Key Translation Map
-
-(defun double-setup (enable-flag)
- (if enable-flag
- (progn
- ;; Set up key-translation-map as indicated by `double-map'.
- ;; XXX I don't think key-translation-map should be made local here. -- Lorentey
- (kill-local-variable 'key-translation-map)
- (make-local-variable 'key-translation-map)
- (setq key-translation-map (if (keymapp key-translation-map)
- (copy-keymap key-translation-map)
- (make-sparse-keymap)))
- (mapcar (function (lambda (entry)
- (define-key key-translation-map
- (vector (nth 0 entry))
- 'double-translate-key)))
- (append double-map '((magic-start) (magic-end)))))
- (kill-local-variable 'key-translation-map)))
-
;;; Mode
-;;;###autoload
-(defcustom double-mode nil
- "Toggle Double mode.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `double-mode'."
- :set (lambda (symbol value)
- (double-mode (if value 1 0)))
- :initialize 'custom-initialize-default
- :link '(emacs-commentary-link "double")
- :type 'boolean
- :require 'double
- :group 'double)
-(make-variable-buffer-local 'double-mode)
-
-(or (assq 'double-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(double-mode " Double") minor-mode-alist)))
-
;; This feature seemed useless and it confused describe-mode,
-;; so I deleted it.
-;;;(defvar double-mode-name "Double")
-;;;;; Name of current double mode.
-;;; (make-variable-buffer-local 'double-mode-name)
+;; so I deleted it.
+;; (defvar double-mode-name "Double")
+;; ;; Name of current double mode.
+;; (make-variable-buffer-local 'double-mode-name)
;;;###autoload
-(defun double-mode (arg)
+(define-minor-mode double-mode
"Toggle Double mode.
With prefix argument ARG, turn Double mode on if ARG is positive, otherwise
turn it off.
When Double mode is on, some keys will insert different strings
when pressed twice. See variable `double-map' for details."
- (interactive "P")
- (if (or (and (null arg) double-mode)
- (<= (prefix-numeric-value arg) 0))
- ;; Turn it off
- (if double-mode
- (progn
- (let ((double-map))
- (double-setup nil))
- (setq double-mode nil)
- (force-mode-line-update)))
- ;;Turn it on
- (if double-mode
- ()
- (double-setup t)
- (setq double-mode t)
- (force-mode-line-update))))
+ :lighter " Double"
+ :link '(emacs-commentary-link "double")
+ (kill-local-variable 'key-translation-map)
+ (when double-mode
+ ;; Set up key-translation-map as indicated by `double-map'.
+ ;; XXX I don't think key-translation-map should be made local here. -- Lorentey
+ (make-local-variable 'key-translation-map)
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map key-translation-map)
+ (setq key-translation-map map)
+ (dolist (entry (append double-map '((magic-start) (magic-end))))
+ (define-key map
+ (vector (nth 0 entry)) 'double-translate-key)))))
(provide 'double)
-;;; arch-tag: 2e170036-44cb-4493-bc32-ada0a4395221
+;; arch-tag: 2e170036-44cb-4493-bc32-ada0a4395221
;;; double.el ends here
(save-excursion
(goto-char (point-min))
(if ediff-use-long-help-message
- (next-line 1))
+ (forward-line 1))
(end-of-line)
(current-column)))
;; compiler at hand (emacs or xemacs).
;; The autoload, below, is useless in Emacs because ediff-hook.el
;; is dumped with emacs, but it is needed in XEmacs
-;;;###autoload (defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) (if (string-match "XEmacs" emacs-version) xemacs-form emacs-form))
+;;;###autoload (defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) (if (featurep 'xemacs) xemacs-form emacs-form))
(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
- (if (string-match "XEmacs" emacs-version)
+ (if (featurep 'xemacs)
xemacs-form emacs-form))
;; This autoload is useless in Emacs because ediff-hook.el is dumped with
(if advice-docstring
(push advice-docstring paragraphs))))
(setq origdoc (if paragraphs
- ;; separate paragraphs with blank lines:
- (mapconcat 'identity (nreverse paragraphs) "\n\n")))
+ (propertize
+ ;; separate paragraphs with blank lines:
+ (mapconcat 'identity (nreverse paragraphs) "\n\n")
+ 'ad-advice-info function)))
(help-add-fundoc-usage origdoc usage)))
(defun ad-make-plain-docstring (function)
(defun byte-optimize-featurep (form)
;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
;; can safely optimize away this test.
- (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs)))
+ (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
nil
form))
(const obsolete) (const noruntime)
(const cl-functions) (const interactive-only)
(const make-local) (const mapcar))))
-(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
+;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
+
;;;###autoload
(defun byte-compile-warnings-safe-p (x)
(or (booleanp x)
;; Override some bindings
(define-key map "\C-\M-x" 'checkdoc-eval-defun)
(define-key map "\C-x`" 'checkdoc-continue)
- (if (not (string-match "XEmacs" emacs-version))
+ (if (not (featurep 'xemacs))
(define-key map [menu-bar emacs-lisp eval-buffer]
'checkdoc-eval-current-buffer))
;; Add some new bindings under C-c ?
;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs).
;;; Determine Window System, and X Server Vendor (if appropriate).
;;;
-(defconst edt-x-emacs-p (string-match "XEmacs" emacs-version)
- "Non-nil if we are running XEmacs version 19, or higher.")
-
-(defconst edt-emacs-variant (if edt-x-emacs-p "xemacs" "gnu")
- "Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).")
-
-(defconst edt-window-system (if edt-x-emacs-p (console-type) window-system)
+(defconst edt-window-system (if (featurep 'xemacs) (console-type) window-system)
"Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")
(defconst edt-xserver (if (eq edt-window-system 'x)
- (if edt-x-emacs-p
+ (if (featurep 'xemacs)
;; The Cygwin window manager has a `/' in its
;; name, which breaks the generated file name of
;; the custom key map file. Replace `/' with a
;;; function-key-map.
;;;
(cond
- (edt-x-emacs-p
+ ((featurep 'xemacs)
(setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
(setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]")))
(t
;;;
;;; Key mapping functions
;;;
-(defun edt-lucid-map-key (ident descrip)
- (interactive)
- (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
- (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]"))
- (cond ((not (equal edt-key edt-return))
- (set-buffer "Keys")
- (insert (format " (\"%s\" . %s)\n" ident edt-key))
- (set-buffer "Directions"))
- ;; bogosity to get next prompt to come up, if the user hits <CR>!
- ;; check periodically to see if this is still needed...
- (t
- (set-buffer "Keys")
- (insert (format " (\"%s\" . \"\" )\n" ident))
- (set-buffer "Directions")))
- edt-key)
-
-(defun edt-gnu-map-key (ident descrip)
+(defun edt-map-key (ident descrip)
(interactive)
- (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip)))
- (cond ((not (equal edt-key edt-return))
- (set-buffer "Keys")
- (insert (if (vectorp edt-key)
- (format " (\"%s\" . %s)\n" ident edt-key)
- (format " (\"%s\" . \"%s\")\n" ident edt-key)))
- (set-buffer "Directions"))
- ;; bogosity to get next prompt to come up, if the user hits <CR>!
- ;; check periodically to see if this is still needed...
- (t
- (set-buffer "Keys")
- (insert (format " (\"%s\" . \"\" )\n" ident))
- (set-buffer "Directions")))
+ (if (featurep 'xemacs)
+ (progn
+ (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
+ (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]"))
+ (cond ((not (equal edt-key edt-return))
+ (set-buffer "Keys")
+ (insert (format " (\"%s\" . %s)\n" ident edt-key))
+ (set-buffer "Directions"))
+ ;; bogosity to get next prompt to come up, if the user hits <CR>!
+ ;; check periodically to see if this is still needed...
+ (t
+ (set-buffer "Keys")
+ (insert (format " (\"%s\" . \"\" )\n" ident))
+ (set-buffer "Directions"))))
+ (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip)))
+ (cond ((not (equal edt-key edt-return))
+ (set-buffer "Keys")
+ (insert (if (vectorp edt-key)
+ (format " (\"%s\" . %s)\n" ident edt-key)
+ (format " (\"%s\" . \"%s\")\n" ident edt-key)))
+ (set-buffer "Directions"))
+ ;; bogosity to get next prompt to come up, if the user hits <CR>!
+ ;; check periodically to see if this is still needed...
+ (t
+ (set-buffer "Keys")
+ (insert (format " (\"%s\" . \"\" )\n" ident))
+ (set-buffer "Directions"))))
edt-key)
-(fset 'edt-map-key (if edt-x-emacs-p 'edt-lucid-map-key 'edt-gnu-map-key))
(set-buffer "Keys")
(insert "
;;
;;;
;;; Restore function-key-map.
;;;
-(if (and edt-window-system (not edt-x-emacs-p))
+(if (and edt-window-system (not (featurep 'xemacs)))
(setq function-key-map edt-save-function-key-map))
(setq EDT-key-name "")
(while (not
;;; Save the key mapping file
;;;
(let ((file (concat
- "~/.edt-" edt-emacs-variant
+ "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu")
(if edt-term (concat "-" edt-term))
(if edt-xserver (concat "-" edt-xserver))
(if edt-window-system (concat "-" (upcase (symbol-name edt-window-system))))
in `goal-column', which is nil when there is none."
(interactive "p")
(ensure-mark)
- (next-line arg)
+ (with-no-warnings (next-line arg))
(setq this-command 'next-line))
(defun end-of-line-mark (&optional arg)
in `goal-column', which is nil when there is none."
(interactive "p")
(setq mark-active nil)
- (next-line arg)
+ (with-no-warnings (next-line arg))
(setq this-command 'next-line))
(defun end-of-line-nomark (&optional arg)
to use and more reliable (no dependence on goal column, etc.)."
(interactive "p")
(ensure-mark)
- (previous-line arg)
+ (with-no-warnings (previous-line arg))
(setq this-command 'previous-line))
(defun beginning-of-line-mark (&optional arg)
Then it does not try to move vertically."
(interactive "p")
(setq mark-active nil)
- (previous-line arg)
+ (with-no-warnings (previous-line arg))
(setq this-command 'previous-line))
(defun beginning-of-line-nomark (&optional arg)
;;; Code:
+(eval-when-compile (require 'cl))
;; we use picture-mode functions
(require 'picture)
(tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
(kill-buffer "*TPU-Notice*")))
+(defvar tpu-edt-old-global-values nil)
;;;
;;; Start and Stop TPU-edt
(defun tpu-edt-on ()
"Turn on TPU/edt emulation."
(interactive)
+ ;; To clean things up (and avoid cycles in the global map).
+ (tpu-edt-off)
;; First, activate tpu-global-map, while protecting the original keymap.
(set-keymap-parent tpu-global-map global-map)
(setq global-map tpu-global-map)
(tpu-set-mode-line t)
(tpu-advance-direction)
;; set page delimiter, display line truncation, and scrolling like TPU
- (setq-default page-delimiter "\f")
- (setq-default truncate-lines t)
- (setq scroll-step 1)
+ (dolist (varval '((page-delimiter . "\f")
+ (truncate-lines . t)
+ (scroll-step . 1)))
+ (push (cons (car varval) (default-value (car varval)))
+ tpu-edt-old-global-values)
+ (set-default (car varval) (cdr varval)))
(tpu-set-control-keys)
(and window-system (tpu-load-xkeys nil))
(tpu-arrow-history)
(tpu-reset-control-keys nil)
(remove-hook 'post-command-hook 'tpu-search-highlight)
(tpu-set-mode-line nil)
- (setq-default page-delimiter "^\f")
- (setq-default truncate-lines nil)
- (setq scroll-step 0)
+ (while tpu-edt-old-global-values
+ (let ((varval (pop tpu-edt-old-global-values)))
+ (set-default (car varval) (cdr varval))))
;; Remove tpu-global-map from the global map.
(let ((map global-map))
(while map
(if (eq tpu-global-map parent)
(set-keymap-parent map (keymap-parent parent))
(setq map parent)))))
- (ad-disable-regexp "\\`tpu-")
+ (ignore-errors (ad-disable-regexp "\\`tpu-"))
(setq tpu-edt-mode nil))
\f
(message "Viper version is %s" viper-version))
;; Is it XEmacs?
-(defconst viper-xemacs-p (string-match "XEmacs" emacs-version))
+(defconst viper-xemacs-p (featurep 'xemacs))
;; Is it Emacs?
(defconst viper-emacs-p (not viper-xemacs-p))
;; Tell whether we are running as a window application or on a TTY
;; compiler at hand.
;; Suggested by rms.
(defmacro viper-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
- (if (string-match "XEmacs" emacs-version)
+ (if (featurep 'xemacs)
xemacs-form emacs-form))
+2007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * erc-ibuffer.el (erc-modified-channels-alist): Pacify
+ byte-compiler.
+
2007-10-13 Glenn Morris <rgm@gnu.org>
* erc-track.el (erc-modified-channels-update): Use mapc rather
(string-match qualifier (or erc-server-announced-name
erc-session-server)))))
+(defvar erc-modified-channels-alist)
+
(define-ibuffer-column erc-modified (:name "M")
(if (and (boundp 'erc-track-mode)
erc-track-mode)
'info arg1' => OTHERWISE goes to top info window and then menu item arg1
'info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and then menu item arg2
etc."
- (require 'info)
+ (eval-and-compile (require 'info))
(let ((file (cond
((not (stringp (car args)))
nil)
(if eshell-diff-window-config
(set-window-configuration eshell-diff-window-config)))
+(defun nil-blank-string (string)
+ "Return STRING, or nil if STRING contains only non-blank characters."
+ (cond
+ ((string-match "[^[:blank:]]" string) string)
+ (nil)))
+
(defun eshell/diff (&rest args)
"Alias \"diff\" to call Emacs `diff' function."
(let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
(setcdr (last args 3) nil))
(with-current-buffer
(condition-case err
- (diff old new (eshell-flatten-and-stringify args))
+ (diff old new
+ (nil-blank-string (eshell-flatten-and-stringify args)))
(error
(throw 'eshell-replace-command
(eshell-parse-command "*diff" orig-args))))
(defun eshell-handle-ansi-color ()
"Handle ANSI color codes."
- (require 'ansi-color)
+ (eval-and-compile (require 'ansi-color))
(ansi-color-apply-on-region eshell-last-output-start
eshell-last-output-end))
(set-default-file-modes ?\700)
(when (condition-case nil
;; Try to overwrite old backup first.
- (copy-file from-name to-name t t)
+ (copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
- (copy-file from-name to-name nil t)
+ (copy-file from-name to-name nil t t)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is cancelled.
-`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
-but `kill-emacs', the low level primitive, does not.
-See also `kill-emacs-hook'.")
+`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
+the low level primitive, does not. See also `kill-emacs-hook'.")
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
+2007-10-23 Richard Stallman <rms@gnu.org>
+
+ * gnus-group.el (gnus-group-highlight): Mark as risky.
+
+2007-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-server-to-method): Return method found first in
+ gnus-newsrc-alist.
+
+2007-10-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of
+ `next-line'.
+
2007-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
* nnmail.el (nnmail-fancy-expiry-target): Use rmail-dont-reply-to to
ticked: The number of ticked articles."
:group 'gnus-group-visual
:type '(repeat (cons (sexp :tag "Form") face)))
+(put 'gnus-group-highlight 'risky-local-variable t)
(defcustom gnus-new-mail-mark ?%
"Mark used for groups with new mail."
(cadar servers)))))
(pop servers))
(car servers))
- ;; This could be some sort of foreign server that I
- ;; simply haven't opened (yet). Do a brute-force scan
- ;; of the entire gnus-newsrc-alist for the server name
- ;; of every method. As a side-effect, loads the
- ;; gnus-server-method-cache so this only happens once,
- ;; if at all.
- (let (match)
- (mapcar
- (lambda (info)
- (let ((info-method (gnus-info-method info)))
- (unless (stringp info-method)
- (let ((info-server (gnus-method-to-server info-method)))
- (when (equal server info-server)
- (setq match info-method))))))
- (cdr gnus-newsrc-alist))
- match))))
- (when result
- (push (cons server result) gnus-server-method-cache))
+ ;; This could be some sort of foreign server that I
+ ;; simply haven't opened (yet). Do a brute-force scan
+ ;; of the entire gnus-newsrc-alist for the server name
+ ;; of every method. As a side-effect, loads the
+ ;; gnus-server-method-cache so this only happens once,
+ ;; if at all.
+ (let ((alist (cdr gnus-newsrc-alist))
+ method match)
+ (while alist
+ (setq method (gnus-info-method (pop alist)))
+ (when (and (not (stringp method))
+ (equal server (gnus-method-to-server method)))
+ (setq match method
+ alist nil)))
+ match))))
+ (when result
+ (push (cons server result) gnus-server-method-cache))
result)))
(defsubst gnus-server-get-method (group method)
(setq refill-start (point))
(goto-char p2)
(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
- (next-line 1)
+ (forward-line 1)
(end-of-line)
;; refill-stop should ideally be adjusted to
;; accomodate the "<br>" strings which are removed
(+ (* (/ address 16) 68) 10 (point-min) (/ (* (% address 16) 5) 2)))
(defun hexl-goto-address (address)
- "Goto hexl-mode (decimal) address ADDRESS.
+ "Go to hexl-mode (decimal) address ADDRESS.
Signal error if ADDRESS is out of range."
(interactive "nAddress: ")
(if (or (< address 0) (> address hexl-max-address))
(define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
(define-key hexl-mode-map "\C-x\C-t" 'undefined))
+(easy-menu-define hexl-menu hexl-mode-map "Hexl Mode menu"
+ `("Hexl"
+ :help "Hexl-specific Features"
+
+ ["Backward short" hexl-backward-short
+ :help "Move to left a short"]
+ ["Forward short" hexl-forward-short
+ :help "Move to right a short"]
+ ["Backward word" hexl-backward-short
+ :help "Move to left a word"]
+ ["Forward word" hexl-forward-short
+ :help "Move to right a word"]
+ "-"
+ ["Beginning of 512b page" hexl-beginning-of-512b-page
+ :help "Go to beginning of 512 byte boundary"]
+ ["End of 512b page" hexl-end-of-512b-page
+ :help "Go to end of 512 byte boundary"]
+ ["Beginning of 1K page" hexl-beginning-of-1k-page
+ :help "Go to beginning of 1KB boundary"]
+ ["End of 1K page" hexl-end-of-1k-page
+ :help "Go to end of 1KB boundary"]
+ "-"
+ ["Go to address" hexl-goto-address
+ :help "Go to hexl-mode (decimal) address"]
+ ["Go to address" hexl-goto-hex-address
+ :help "Go to hexl-mode (hex string) address"]
+ "-"
+ ["Insert decimal char" hexl-insert-decimal-char
+ :help "Insert a character given by its decimal code"]
+ ["Insert hex char" hexl-insert-hex-char
+ :help "Insert a character given by its hexadecimal code"]
+ ["Insert octal char" hexl-insert-octal-char
+ :help "Insert a character given by its octal code"]
+ "-"
+ ["Exit hexl mode" hexl-mode-exit
+ :help "Exit hexl mode returning to previous mode"]))
+
(provide 'hexl)
;; arch-tag: d5a7aa8a-9bce-480b-bcff-6c4c7ca5ea4a
(defun ibuffer-auto-update-changed ()
(when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
- (mapcar #'(lambda (buf)
- (ignore-errors
- (with-current-buffer buf
- (when (and ibuffer-auto-mode
- (eq major-mode 'ibuffer-mode))
- (ibuffer-update nil t)))))
- (buffer-list))))
+ (dolist (buf (buffer-list))
+ (ignore-errors
+ (with-current-buffer buf
+ (when (and ibuffer-auto-mode
+ (eq major-mode 'ibuffer-mode))
+ (ibuffer-update nil t)))))))
;;;###autoload
(defun ibuffer-auto-mode (&optional arg)
(if arg
(plusp arg)
(not ibuffer-auto-mode)))
- (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
+ (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
(add-hook 'post-command-hook 'ibuffer-auto-update-changed)
(ibuffer-update-mode-name))
(cons (format "%s" mode) `((mode . ,mode))))
(let ((modes
(ibuffer-remove-duplicates
- (mapcar (lambda (buf)
+ (mapcar (lambda (buf)
(with-current-buffer buf major-mode))
(buffer-list)))))
(if ibuffer-view-ibuffer
;;;###autoload
(defun ibuffer-decompose-filter-group (group)
"Decompose the filter group GROUP into active filters."
- (interactive
+ (interactive
(list (ibuffer-read-filter-group-name "Decompose filter group: " t)))
(let ((data (cdr (assoc group ibuffer-filter-groups))))
(setq ibuffer-filter-groups (ibuffer-delete-alist
;;;###autoload
(defun ibuffer-jump-to-filter-group (name)
"Move point to the filter group whose name is NAME."
- (interactive
+ (interactive
(list (ibuffer-read-filter-group-name "Jump to filter group: ")))
(ibuffer-aif (assoc name (ibuffer-current-filter-groups-with-position))
(goto-char (cdr it))
;;;###autoload
(defun ibuffer-switch-to-saved-filter-groups (name)
"Set this buffer's filter groups to saved version with NAME.
-The value from `ibuffer-saved-filters' is used.
-If prefix argument ADD is non-nil, then add the saved filters instead
-of replacing the current filters."
+The value from `ibuffer-saved-filter-groups' is used."
(interactive
(list
(if (null ibuffer-saved-filter-groups)
(not (eq 'or (caar ibuffer-filtering-qualifiers))))
(error "Top filter is not an OR"))
(let ((lim (pop ibuffer-filtering-qualifiers)))
- (setq ibuffer-filtering-qualifiers
+ (setq ibuffer-filtering-qualifiers
(nconc (cdr lim) ibuffer-filtering-qualifiers))))
(when (< (length ibuffer-filtering-qualifiers) 2)
(error "Need two filters to OR"))
;;;###autoload
(defun ibuffer-switch-to-saved-filters (name)
- "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
-If prefix argument ADD is non-nil, then add the saved filters instead
-of replacing the current filters."
+ "Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'."
(interactive
(list
(if (null ibuffer-saved-filters)
(defun image-dired-next-line ()
"Move to next line and display properties."
(interactive)
- (next-line 1)
+ (forward-line 1)
;; If we end up in an empty spot, back up to the next thumbnail.
(if (not (image-dired-image-at-point-p))
(image-dired-backward-image))
(defun image-dired-previous-line ()
"Move to previous line and display properties."
(interactive)
- (previous-line 1)
+ (forward-line -1)
;; If we end up in an empty spot, back up to the next
;; thumbnail. This should only happen if the user deleted a
;; thumbnail and did not refresh, so it is not very common. But we
;; used in Fundamental Mode, Text Mode, etc.
(defun indent-to-left-margin ()
"Indent current line to the column given by `current-left-margin'."
- (indent-line-to (current-left-margin)))
+ (save-excursion (indent-line-to (current-left-margin)))
+ ;; If we are within the indentation, move past it.
+ (when (save-excursion
+ (skip-chars-backward " \t")
+ (bolp))
+ (skip-chars-forward " \t")))
(defun delete-to-left-margin (&optional from to)
"Remove left margin indentation from a region.
--- /dev/null
+;;; isearch-multi.el --- isearch extensions for multi-buffer search
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@jurta.org>
+;; Keywords: matching
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file adds more dimensions to the search space. It implements
+;; various features that extend isearch. One of them is an ability to
+;; search through multiple buffers.
+
+;;; Code:
+
+;;; Search multiple buffers
+
+(defgroup isearch-buffers nil
+ "Using isearch to search through multiple buffers."
+ :version "23.1"
+ :group 'isearch)
+
+(defcustom isearch-buffers-multi t
+ "Non-nil enables searching multiple related buffers, in certain modes."
+ :type 'boolean
+ :version "23.1"
+ :group 'isearch-buffers)
+
+(defcustom isearch-buffers-pause t
+ "A choice defining where to pause the search.
+If the value is nil, don't pause before going to the next buffer.
+If the value is `initial', pause only after a failing search in the
+initial buffer.
+If t, pause in all buffers that contain the search string."
+ :type '(choice
+ (const :tag "Don't pause" nil)
+ (const :tag "Only in initial buffer" initial)
+ (const :tag "All buffers" t))
+ :version "23.1"
+ :group 'isearch-buffers)
+
+;;;###autoload
+(defvar isearch-buffers-current-buffer nil
+ "The buffer where the search is currently searching.
+The value is nil when the search still is in the initial buffer.")
+
+;;;###autoload
+(defvar isearch-buffers-next-buffer-function nil
+ "Function to call to get the next buffer to search.
+
+When this variable is set to a function that returns a buffer, then
+after typing another C-s or C-r at a failing search, the search goes
+to the next buffer in the series and continues searching for the
+next occurrence.
+
+The first argument of this function is the current buffer where the
+search is currently searching. It defines the base buffer relative to
+which this function should find the next buffer. When the isearch
+direction is backward (when isearch-forward is nil), this function
+should return the previous buffer to search. If the second argument of
+this function WRAP is non-nil, then it should return the first buffer
+in the series; and for the backward search, it should return the last
+buffer in the series.")
+
+;;;###autoload
+(define-minor-mode isearch-buffers-minor-mode
+ "Minor mode for using isearch to search through multiple buffers.
+With arg, turn isearch-buffers minor mode on if arg is positive, off otherwise."
+ :group 'isearch-buffers ;; :lighter " X"
+ (if isearch-buffers-minor-mode
+ (progn
+ (add-hook 'isearch-mode-hook 'isearch-buffers-init nil t)
+ (set (make-local-variable 'isearch-search-fun-function)
+ 'isearch-buffers-search-fun)
+ (set (make-local-variable 'isearch-wrap-function)
+ 'isearch-buffers-wrap)
+ (set (make-local-variable 'isearch-push-state-function)
+ 'isearch-buffers-push-state))
+ (remove-hook 'isearch-mode-hook 'isearch-buffers-init t)
+ (kill-local-variable 'isearch-search-fun-function)
+ (kill-local-variable 'isearch-wrap-function)
+ (kill-local-variable 'isearch-push-state-function)))
+
+(defun isearch-buffers-init ()
+ "Set up isearch to search multiple buffers.
+Intended to be added to `isearch-mode-hook'."
+ (setq isearch-buffers-current-buffer nil))
+
+(defun isearch-buffers-search-fun ()
+ "Return the proper search function, for isearch in multiple buffers."
+ (lambda (string bound noerror)
+ (let ((search-fun
+ ;; Use standard functions to search within one buffer
+ (cond
+ (isearch-word
+ (if isearch-forward 'word-search-forward 'word-search-backward))
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ (t
+ (if isearch-forward 'search-forward 'search-backward))))
+ found buffer)
+ (or
+ ;; 1. First try searching in the initial buffer
+ (let ((res (funcall search-fun string bound noerror)))
+ ;; Reset wrapping for all-buffers pause after successful search
+ (if (and res (eq isearch-buffers-pause t))
+ (setq isearch-buffers-current-buffer nil))
+ res)
+ ;; 2. If the above search fails, start visiting next/prev buffers
+ ;; successively, and search the string in them. Do this only
+ ;; when bound is nil (i.e. not while lazy-highlighting search
+ ;; strings in the current buffer).
+ (when (and (not bound) isearch-buffers-multi)
+ ;; If no-pause or there was one attempt to leave the current buffer
+ (if (or (null isearch-buffers-pause)
+ (and isearch-buffers-pause isearch-buffers-current-buffer))
+ (condition-case nil
+ (progn
+ (while (not found)
+ ;; Find the next buffer to search
+ (setq buffer (funcall isearch-buffers-next-buffer-function
+ buffer))
+ (with-current-buffer buffer
+ (goto-char (if isearch-forward (point-min) (point-max)))
+ (setq isearch-barrier (point) isearch-opoint (point))
+ ;; After visiting the next/prev buffer search the
+ ;; string in it again, until the function in
+ ;; isearch-buffers-next-buffer-function raises an error
+ ;; at the beginning/end of the buffer sequence.
+ (setq found (funcall search-fun string bound noerror))))
+ ;; Set buffer for isearch-search-string to switch
+ (if buffer (setq isearch-buffers-current-buffer buffer))
+ ;; Return point of the new search result
+ found)
+ ;; Return nil when isearch-buffers-next-buffer-function fails
+ (error nil))
+ (signal 'search-failed (list string "Repeat for next buffer"))))))))
+
+(defun isearch-buffers-wrap ()
+ "Wrap the multiple buffers search when search is failed.
+Switch buffer to the first buffer for a forward search,
+or to the last buffer for a backward search.
+Set `isearch-buffers-current-buffer' to the current buffer to display
+the isearch suffix message [initial buffer] only when isearch leaves
+the initial buffer."
+ (if (or (null isearch-buffers-pause)
+ (and isearch-buffers-pause isearch-buffers-current-buffer))
+ (progn
+ (switch-to-buffer
+ (setq isearch-buffers-current-buffer
+ (funcall isearch-buffers-next-buffer-function
+ (current-buffer) t)))
+ (goto-char (if isearch-forward (point-min) (point-max))))
+ (setq isearch-buffers-current-buffer (current-buffer))
+ (setq isearch-wrapped nil)))
+
+(defun isearch-buffers-push-state ()
+ "Save a function restoring the state of multiple buffers search.
+Save the current buffer to the additional state parameter in the
+search status stack."
+ `(lambda (cmd)
+ (isearch-buffers-pop-state cmd ,(current-buffer))))
+
+(defun isearch-buffers-pop-state (cmd buffer)
+ "Restore the multiple buffers search state.
+Switch to the buffer restored from the search status stack."
+ (unless (equal buffer (current-buffer))
+ (switch-to-buffer (setq isearch-buffers-current-buffer buffer))))
+
+(provide 'isearch-multi)
+
+;; arch-tag: a6d38ffa-4d14-4e39-8ac6-46af9d6a6773
+;;; isearch-multi.el ends here
(if isearch-forward (< pos2 pos1) (> pos2 pos1))))
(setq pos1 pos2)
(set-match-data match-data)))))
- (if pos1
- (goto-char pos1))
+ (when pos1
+ ;; When using multiple buffers isearch, switch to the new buffer here,
+ ;; because `save-excursion' above doesn't allow doing it inside funcall.
+ (if (and isearch-buffers-next-buffer-function
+ (buffer-live-p isearch-buffers-current-buffer))
+ (switch-to-buffer isearch-buffers-current-buffer))
+ (goto-char pos1))
pos1))
(defun isearch-search ()
write-region-annotate-functions)
"A list of special hooks from Info node `(elisp)Standard Hooks'.
-These are symbols with hook-type values whose names don't end in
-`-hook' or `-hooks', from which `unload-feature' tries to remove
+These are symbols with hooklike values whose names don't end in
+`-hook' or `-hooks', from which `unload-feature' should try to remove
pertinent symbols.")
-(defvar unload-function-features-list nil
- "List of features of the package being unloaded.
+(defvar unload-function-defs-list nil
+ "List of defintions in the Lisp library being unloaded.
-This is meant to be used by FEATURE-unload-function, see the
+This is meant to be used by `FEATURE-unload-function'; see the
documentation of `unload-feature' for details.")
(define-obsolete-variable-alias 'unload-hook-features-list
- 'unload-function-features-list "22.2")
+ 'unload-function-defs-list "22.2")
;;;###autoload
(defun unload-feature (feature &optional force)
- "Unload the library that provided FEATURE, restoring all its autoloads.
+ "Unload the library that provided FEATURE.
If the feature is required by any other loaded code, and prefix arg FORCE
is nil, raise an error.
-This function tries to undo any modifications that the package has
-made to hook values in Emacs. Normally it does this using heuristics.
-The packages may define a hook `FEATURE-unload-hook'; if that exists,
-it is called instead of the normal heuristics.
+Standard unloading activities include restoring old autoloads for
+functions defined by the library, undoing any additions that the
+library has made to hook variables or to `auto-mode-alist', undoing
+ELP profiling of functions in that library, unproviding any features
+provided by the library, and canceling timers held in variables
+defined by the library.
-Such a hook should undo all the relevant global state changes that may
-have been made by loading the package or executing functions in it.
-It has access to the package's feature list (before anything is unbound)
-in the variable `unload-hook-features-list' and could remove features
-from it in the event that the package has done something strange,
-such as redefining an Emacs function."
+If a function `FEATURE-unload-function' is defined, this function
+calls it with no arguments, before doing anything else. That function
+can do whatever is appropriate to undo the loading of the library. If
+`FEATURE-unload-function' returns non-nil, that suppresses the
+standard unloading of the library. Otherwise the standard unloading
+proceeds.
+
+`FEATURE-unload-function' has access to the package's list of
+definitions in the variable `unload-function-defs-list' and could
+remove symbols from it in the event that the package has done
+something strange, such as redefining an Emacs function."
(interactive
(list
(read-feature "Unload feature: " t)
(when dependents
(error "Loaded libraries %s depend on %s"
(prin1-to-string dependents) file))))
- (let* ((unload-function-features-list (feature-symbols feature))
- (file (pop unload-function-features-list))
+ (let* ((unload-function-defs-list (feature-symbols feature))
+ (file (pop unload-function-defs-list))
;; If non-nil, this is a symbol for which we should
;; restore a previous autoload if possible.
restore-autoload
(or (and (consp (symbol-value x)) ; Random hooks.
(string-match "-hooks?\\'" (symbol-name x)))
(memq x unload-feature-special-hooks))) ; Known abnormal hooks etc.
- (dolist (y unload-function-features-list)
+ (dolist (y unload-function-defs-list)
(when (and (eq (car-safe y) 'defun)
(not (get (cdr y) 'autoload)))
(remove-hook x (cdr y)))))))
;; Remove any feature-symbols from auto-mode-alist as well.
- (dolist (y unload-function-features-list)
+ (dolist (y unload-function-defs-list)
(when (and (eq (car-safe y) 'defun)
(not (get (cdr y) 'autoload)))
(setq auto-mode-alist
(rassq-delete-all (cdr y) auto-mode-alist)))))
(when (fboundp 'elp-restore-function) ; remove ELP stuff first
- (dolist (elt unload-function-features-list)
+ (dolist (elt unload-function-defs-list)
(when (symbolp elt)
(elp-restore-function elt))))
- (dolist (x unload-function-features-list)
+ (dolist (x unload-function-defs-list)
(if (consp x)
(case (car x)
;; Remove any feature names that this file provided.
(load "vms-patch")))
(if (eq system-type 'windows-nt)
(progn
+ (load "w32-vars")
(load "term/w32-win")
(load "ls-lisp")
(load "disp-table") ; needed to setup ibm-pc char set, see internal.el
(load "dos-w32")
- (load "w32-vars")
(load "w32-fns")))
(if (eq system-type 'ms-dos)
(progn
(goto-char end)
(log-view-msg-next)
(setq to (log-view-current-tag))))
- (vc-version-diff (log-view-current-file) to fr)))
+ (vc-version-diff (list (log-view-current-file)) to fr)))
(provide 'log-view)
(end-of-line)
(point)))
mspools-files-len)
- (next-line (- 1 mspools-files-len)) ;back to top of list
+ (forward-line (- 1 mspools-files-len)) ;back to top of list
;; else just on to next line
- (next-line 1))
+ (forward-line 1))
;; Choose whether to use VM or RMAIL for reading folder.
(if mspools-using-vm
If that fails, try the file \"~/.signature\".
If neither file exists, fails quietly."
(interactive)
- (end-of-buffer)
+ (goto-char (point-max))
(newline)
(if (vms-system-info "LOGICAL" "MAIL$TRAILER")
(if (file-attributes (vms-system-info "LOGICAL" "MAIL$TRAILER"))
(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
;; This definition is just to show what this looks like.
-;; It gets overridden below when menu-bar-update-buffers is called.
+;; It gets modified in place when menu-bar-update-buffers is called.
+(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
(define-key global-map [menu-bar buffer]
- (cons "Buffers" (make-sparse-keymap "Buffers")))
+ (cons "Buffers" global-buffers-menu-map))
(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
(define-key global-map [menu-bar options]
(cons "Options" menu-bar-options-menu))
(or force (frame-or-buffer-changed-p))
(let ((buffers (buffer-list))
(frames (frame-list))
- buffers-menu frames-menu)
+ buffers-menu)
;; If requested, list only the N most recently selected buffers.
(if (and (integerp buffers-menu-max-size)
(> buffers-menu-max-size 1))
(setq buffers-menu
(nconc buffers-menu menu-bar-buffers-menu-command-entries))
- (setq buffers-menu (cons 'keymap (cons "Select Buffer" buffers-menu)))
- (define-key (current-global-map) [menu-bar buffer]
- ;; Call copy-sequence so the string is not pure.
- (cons (copy-sequence "Buffers") buffers-menu)))))
+ ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
+ ;; but that did not do the right thing when the [menu-bar buffer]
+ ;; entry above had been moved (e.g. to a parent keymap).
+ (setcdr global-buffers-menu-map (cons "Select Buffer" buffers-menu)))))
(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
(provide 'menu-bar)
-;;; arch-tag: 6e6a3c22-4ec4-4d3d-8190-583f8ef94ced
+;; arch-tag: 6e6a3c22-4ec4-4d3d-8190-583f8ef94ced
;;; menu-bar.el ends here
(defun msb-sort-by-directory (item1 item2)
"Sort the items ITEM1 and ITEM2 by directory name. Made for dired.
An item look like (NAME . BUFFER)."
- (string-lessp (save-excursion (set-buffer (cdr item1))
- (msb--dired-directory))
- (save-excursion (set-buffer (cdr item2))
- (msb--dired-directory))))
+ (string-lessp (with-current-buffer (cdr item1)
+ (msb--dired-directory))
+ (with-current-buffer (cdr item2)
+ (msb--dired-directory))))
;;;
;;; msb
(while rest
(let ((found-p nil)
(tmp-rest rest)
- result
- new-dir item)
+ item)
(setq item (car tmp-rest))
;; Clump together the "rest"-buffers that have a dir that is
;; a subdir of the current one.
(unless (and (not msb-display-invisible-buffers-p)
(msb-invisible-buffer-p buffer))
(condition-case nil
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; Menu found. Add to this menu
(dolist (info (msb--collect function-info-vector))
(msb--add-to-menu buffer info max-buffer-name-length)))
results in
\((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))"
(when (not (null alist))
- (let (result
- same
+ (let (same
tmp-old-car
tmp-same
(first-time-p t)
old-car (car item))
(list (cons tmp-old-car (nreverse tmp-same))))))
(sort alist (lambda (item1 item2)
- (funcall sort-predicate (car item1) (car item2))))))
+ (funcall sort-predicate
+ (car item1) (car item2))))))
(list (cons old-car (nreverse same)))))))
(sort
(let ((mode-list nil))
(dolist (buffer (cdr (buffer-list)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(when (and (not (msb-invisible-buffer-p))
(not (assq major-mode mode-list)))
(push (cons major-mode mode-name)
(most-recently-used
(loop with n = 0
for buffer in buffers
- if (save-excursion
- (set-buffer buffer)
+ if (with-current-buffer buffer
(and (not (msb-invisible-buffer-p))
(not (eq major-mode 'dired-mode))))
- collect (save-excursion
- (set-buffer buffer)
+ collect (with-current-buffer buffer
(cons (funcall msb-item-handling-function
buffer
max-buffer-name-length)
(when file-buffers
(setq file-buffers
(mapcar (lambda (buffer-list)
- (cons msb-files-by-directory-sort-key
- (cons (car buffer-list)
- (sort
- (mapcar (function
- (lambda (buffer)
- (cons (save-excursion
- (set-buffer buffer)
- (funcall msb-item-handling-function
- buffer
- max-buffer-name-length))
- buffer)))
- (cdr buffer-list))
- (function
- (lambda (item1 item2)
- (string< (car item1) (car item2))))))))
- (msb--choose-file-menu file-buffers))))
+ (list* msb-files-by-directory-sort-key
+ (car buffer-list)
+ (sort
+ (mapcar (lambda (buffer)
+ (cons (with-current-buffer buffer
+ (funcall
+ msb-item-handling-function
+ buffer
+ max-buffer-name-length))
+ buffer))
+ (cdr buffer-list))
+ (lambda (item1 item2)
+ (string< (car item1) (car item2))))))
+ (msb--choose-file-menu file-buffers))))
;; Now make the menu - a list of (TITLE . BUFFER-LIST)
(let* (menu
(most-recently-used
buffers-menu frames-menu)
;; Make the menu of buffers proper.
(setq msb--last-buffer-menu (msb--create-buffer-menu))
- (setq buffers-menu msb--last-buffer-menu)
+ ;; Skip the `keymap' symbol.
+ (setq buffers-menu (cdr msb--last-buffer-menu))
;; Make a Frames menu if we have more than one frame.
(when (cdr frames)
(let* ((frame-length (length frames))
(cons nil nil))
'menu-bar-select-frame))
frames)))))
- (define-key (current-global-map) [menu-bar buffer]
- (cons "Buffers"
+ (setcdr global-buffers-menu-map
(if (and buffers-menu frames-menu)
;; Combine Frame and Buffers menus with separator between
- (nconc (list 'keymap "Buffers and Frames" frames-menu
+ (nconc (list "Buffers and Frames" frames-menu
(and msb-separator-diff '(separator "--")))
- (cddr buffers-menu))
- (or buffers-menu 'undefined)))))))
+ (cdr buffers-menu))
+ buffers-menu)))))
;; Snarf current bindings of `mouse-buffer-menu' (normally
;; C-down-mouse-1).
(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
-;;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
+;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
;;; msb.el ends here
(ange-ftp-call-cont cont result line)))
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
- keep-date)
+ keep-date preserve-uid-gid)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
;; browse-url-cci XMosaic 2.5
;; browse-url-w3 w3 0
;; browse-url-w3-gnudoit w3 remotely
-;; browse-url-iximosaic IXI Mosaic ?
;; browse-url-lynx-* Lynx 0
-;; browse-url-grail Grail 0.3b1
-;; browse-url-mmm MMM ?
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
;; Emacs process is available from
;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
-;; Grail is the freely available WWW browser implemented in Python, a
-;; cool object-oriented freely available interpreted language. Grail
-;; 0.3b1 was the first version to have remote control as distributed.
-;; For more information on Grail see
-;; <URL:http://grail.cnri.reston.va.us/> and for more information on
-;; Python see <url:http://www.python.org/>. Grail support in
-;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.
-
;; Lynx is now distributed by the FSF. See also
;; <URL:http://lynx.browser.org/>.
(function-item :tag "Netscape" :value browse-url-netscape)
(function-item :tag "Mosaic" :value browse-url-mosaic)
(function-item :tag "Mosaic using CCI" :value browse-url-cci)
- (function-item :tag "IXI Mosaic" :value browse-url-iximosaic)
(function-item :tag "Lynx in an xterm window"
:value browse-url-lynx-xterm)
(function-item :tag "Lynx in an Emacs window"
:value browse-url-lynx-emacs)
- (function-item :tag "Grail" :value browse-url-grail)
- (function-item :tag "MMM" :value browse-url-mmm)
(function-item :tag "KDE" :value browse-url-kde)
(function-item :tag "Elinks" :value browse-url-elinks)
(function-item :tag "Specified by `Browse Url Generic Program'"
used instead of `browse-url-new-window-flag'.
The order attempted is gnome-moz-remote, Mozilla, Firefox,
-Galeon, Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an
-xterm, MMM, and then W3."
+Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
(apply
(cond
((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-kde-program) 'browse-url-kde)
((executable-find browse-url-netscape-program) 'browse-url-netscape)
((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find "tellw3b") 'browse-url-iximosaic)
((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
- ((executable-find "mmm") 'browse-url-mmm)
((locate-library "w3") 'browse-url-w3)
(t
(lambda (&ignore args) (error "No usable browser found"))))
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
+(defvar url-handler-regexp)
+
;;;###autoload
(defun browse-url-emacs (url &optional new-window)
"Ask Emacs to load URL into a buffer and show it in another window."
(append browse-url-mosaic-arguments (list url)))
(message "Starting %s...done" browse-url-mosaic-program))))
-;; --- Grail ---
-
-(defvar browse-url-grail
- (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
- "Location of Grail remote control client script `rcgrail.py'.
-Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
-
-;;;###autoload
-(defun browse-url-grail (url &optional new-window)
- "Ask the Grail WWW browser to load URL.
-Default to the URL around or before point. Runs the program in the
-variable `browse-url-grail'."
- (interactive (browse-url-interactive-arg "Grail URL: "))
- (message "Sending URL to Grail...")
- (with-current-buffer (get-buffer-create " *Shell Command Output*")
- (erase-buffer)
- ;; don't worry about this failing.
- (if (browse-url-maybe-new-window new-window)
- (call-process browse-url-grail nil 0 nil "-b" url)
- (call-process browse-url-grail nil 0 nil url))
- (message "Sending URL to Grail... done")))
-
;; --- Mosaic using CCI ---
;;;###autoload
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
-;; --- IXI Mosaic ---
-
-;;;###autoload
-(defun browse-url-iximosaic (url &optional new-window)
- ;; new-window ignored
- "Ask the IXIMosaic WWW browser to load URL.
-Default to the URL around or before point."
- (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
- (start-process "tellw3b" nil "tellw3b"
- "-service WWW_BROWSER ixi_showurl " url))
-
;; --- W3 ---
;;;###autoload
url
"\r")))))
-;; --- MMM ---
-
-;;;###autoload
-(defun browse-url-mmm (url &optional new-window)
- "Ask the MMM WWW browser to load URL.
-Default to the URL around or before point."
- (interactive (browse-url-interactive-arg "MMM URL: "))
- (message "Sending URL to MMM...")
- (with-current-buffer (get-buffer-create " *Shell Command Output*")
- (erase-buffer)
- ;; mmm_remote just SEGVs if the file isn't there...
- (if (or (file-exists-p (expand-file-name "~/.mmm_remote"))
- ;; location in v 0.4:
- (file-exists-p (expand-file-name "~/.mmm/remote")))
- (call-process "mmm_remote" nil 0 nil url)
- (call-process "mmm" nil 0 nil "-external" url))
- (message "Sending URL to MMM... done")))
-
;; --- mailto ---
(autoload 'rfc2368-parse-mailto-url "rfc2368")
"Toggle inline display of an image."
(interactive)
(when (eudc-bob-can-display-inline-images)
- (cond (eudc-xemacs-p
+ (cond ((featurep 'xemacs)
(let ((overlays (append (overlays-at (1- (point)))
(overlays-at (point))))
overlay glyph)
(interactive "@e")
(run-hooks 'activate-menubar-hook)
(eudc-jump-to-event event)
- (if eudc-xemacs-p
+ (if (featurep 'xemacs)
(progn
(run-hooks 'activate-popup-menu-hook)
(popup-menu (eudc-bob-menu)))
(let ((map (make-sparse-keymap)))
(define-key map "s" 'eudc-bob-save-object)
(define-key map "!" 'eudc-bob-pipe-object-to-external-program)
- (define-key map (if eudc-xemacs-p
+ (define-key map (if (featurep 'xemacs)
[button3]
[down-mouse-3]) 'eudc-bob-popup-menu)
map))
(setq eudc-bob-sound-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'eudc-bob-play-sound-at-point)
- (define-key map (if eudc-xemacs-p
+ (define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'eudc-bob-play-sound-at-mouse)
map))
(setq eudc-bob-url-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'browse-url-at-point)
- (define-key map (if eudc-xemacs-p
+ (define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'browse-url-at-mouse)
map))
(setq eudc-bob-mail-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'goto-address-at-point)
- (define-key map (if eudc-xemacs-p
+ (define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'goto-address-at-mouse)
map))
(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
-(if eudc-emacs-p
- (progn
- (easy-menu-define eudc-bob-generic-menu
- eudc-bob-generic-keymap
- ""
- eudc-bob-generic-menu)
- (easy-menu-define eudc-bob-image-menu
- eudc-bob-image-keymap
- ""
- eudc-bob-image-menu)
- (easy-menu-define eudc-bob-sound-menu
- eudc-bob-sound-keymap
- ""
- eudc-bob-sound-menu)))
+(when (not (featurep 'xemacs))
+ (easy-menu-define eudc-bob-generic-menu
+ eudc-bob-generic-keymap
+ ""
+ eudc-bob-generic-menu)
+ (easy-menu-define eudc-bob-image-menu
+ eudc-bob-image-keymap
+ ""
+ eudc-bob-image-menu)
+ (easy-menu-define eudc-bob-sound-menu
+ eudc-bob-sound-keymap
+ ""
+ eudc-bob-sound-menu))
;;;###autoload
(defun eudc-display-generic-binary (data)
["Save and Quit" eudc-hotlist-quit-edit t]
["Exit without Saving" kill-this-buffer t]))
-(if eudc-emacs-p
- (easy-menu-define eudc-hotlist-emacs-menu
- eudc-hotlist-mode-map
- ""
- eudc-hotlist-menu))
+(when (not (featurep 'xemacs))
+ (easy-menu-define eudc-hotlist-emacs-menu
+ eudc-hotlist-mode-map
+ ""
+ eudc-hotlist-menu))
;;; arch-tag: 9b633ab3-6a6e-4b46-b12e-d96739a7e0e8
;;; eudc-hotlist.el ends here
;;{{{ Internal variables and compatibility tricks
-(defconst eudc-xemacs-p (string-match "XEmacs" emacs-version))
-(defconst eudc-emacs-p (not eudc-xemacs-p))
-(defconst eudc-xemacs-mule-p (and eudc-xemacs-p
- (featurep 'mule)))
-(defconst eudc-emacs-mule-p (and eudc-emacs-p
- (featurep 'mule)))
-
(defvar eudc-form-widget-list nil)
(defvar eudc-mode-map nil)
(setq major-mode 'eudc-mode)
(setq mode-name "EUDC")
(use-local-map eudc-mode-map)
- (if eudc-emacs-p
+ (if (not (featurep 'xemacs))
(easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))
(setq mode-popup-menu (eudc-menu)))
(run-mode-hooks 'eudc-mode-hook))
(defun eudc-install-menu ()
(cond
- ((and eudc-xemacs-p (featurep 'menubar))
+ ((and (featurep 'xemacs) (featurep 'menubar))
(add-submenu '("Tools") (eudc-menu)))
- (eudc-emacs-p
+ ((not (featurep 'xemacs))
(cond
((fboundp 'easy-menu-create-menu)
(define-key
nil)
;;;###autoload
-(cond ((not (string-match "XEmacs" emacs-version))
+(cond ((not (featurep 'xemacs))
(defvar eudc-tools-menu (make-sparse-keymap "Directory Search"))
(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))
(define-key eudc-tools-menu [phone]
["Get Email" eudc-get-email t]
["Get Phone" eudc-get-phone t])))
(if (not (featurep 'eudc-autoloads))
- (if eudc-xemacs-p
+ (if (featurep 'xemacs)
(if (and (featurep 'menubar)
(not (featurep 'infodock)))
(add-submenu '("Tools") menu))
(set-buffer eudc-ph-process-buffer)
(erase-buffer)
(setq eudc-ph-read-point (point))
- (and eudc-xemacs-mule-p
+ (and (featurep 'xemacs) (featurep 'mule)
(set-buffer-file-coding-system 'binary t)))
(setq process (open-network-stream "ph" eudc-ph-process-buffer host port))
(if (null process)
:type 'boolean
:group 'rcirc)
+(defvar rcirc-markup-text-functions
+ '(rcirc-markup-attributes
+ rcirc-markup-my-nick
+ rcirc-markup-urls
+ rcirc-markup-keywords
+ rcirc-markup-bright-nicks
+ rcirc-markup-fill)
+
+ "List of functions used to manipulate text before it is printed.
+
+Each function takes two arguments, SENDER, RESPONSE. The buffer
+is narrowed with the text to be printed and the point is at the
+beginning of the `rcirc-text' propertized text.")
+
(defun rcirc-print (process sender response target text &optional activity)
"Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
(rcirc-browse-url-at-point (posn-point position)))))
\f
-(defvar rcirc-markup-text-functions
- '(rcirc-markup-attributes
- rcirc-markup-my-nick
- rcirc-markup-urls
- rcirc-markup-keywords
- rcirc-markup-bright-nicks
- rcirc-markup-fill)
-
- "List of functions used to manipulate text before it is printed.
-
-Each function takes two arguments, SENDER, RESPONSE. The buffer
-is narrowed with the text to be printed and the point is at the
-beginning of the `rcirc-text' propertized text.")
-
(defun rcirc-markup-timestamp (sender response)
(goto-char (point-min))
(insert (rcirc-facify (format-time-string rcirc-time-format)
--- /dev/null
+;;; tramp-cmds.el --- Interactive commands for Tramp
+
+;; Copyright (C) 2007 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides all interactive commands which are releated
+;; to Tramp.
+
+;;; Code:
+
+(require 'tramp)
+
+(defun tramp-list-tramp-buffers ()
+ "Return a list of all Tramp connection buffers."
+ (append
+ (all-completions
+ "*tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))
+ (all-completions
+ "*debug tramp" (mapcar 'list (mapcar 'buffer-name (buffer-list))))))
+
+(defun tramp-list-remote-buffers ()
+ "Return a list of all buffers with remote default-directory."
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (with-current-buffer x
+ (when (and (stringp default-directory)
+ (file-remote-p default-directory))
+ x)))
+ (buffer-list))))
+
+(defun tramp-cleanup-connection (vec)
+ "Flush all connection related objects.
+This includes password cache, file cache, connection cache, buffers.
+When called interactively, a Tramp connection has to be selected."
+ (interactive
+ ;; When interactive, select the Tramp remote identification.
+ ;; Return nil when there is no Tramp connection.
+ (list
+ (let ((connections
+ (mapcar
+ (lambda (x)
+ (with-current-buffer x (list (file-remote-p default-directory))))
+ ;; We shall not count debug buffers, because their
+ ;; default-directory is random. It could be even a remote
+ ;; one from another connection.
+ (all-completions
+ "*tramp" (mapcar 'list (tramp-list-tramp-buffers)))))
+ name)
+
+ (when connections
+ (setq name
+ (completing-read
+ "Enter Tramp connection: " connections nil t
+ (try-completion "" connections)))
+ (when (and name (file-remote-p name))
+ (with-parsed-tramp-file-name name nil v))))))
+
+ (if (not vec)
+ ;; Nothing to do.
+ (message "No Tramp connection found.")
+
+ ;; Flush password cache.
+ (tramp-clear-passwd vec)
+
+ ;; Flush file cache.
+ (tramp-flush-directory-property vec "/")
+
+ ;; Flush connection cache.
+ (tramp-flush-connection-property (tramp-get-connection-process vec) nil)
+ (tramp-flush-connection-property vec nil)
+
+ ;; Remove buffers.
+ (dolist
+ (buf (list (get-buffer (tramp-buffer-name vec))
+ (get-buffer (tramp-debug-buffer-name vec))
+ (tramp-get-connection-property vec "process-buffer" nil)))
+ (when (bufferp buf) (kill-buffer buf)))))
+
+(defun tramp-cleanup-all-connections ()
+ "Flush all Tramp internal objects.
+This includes password cache, file cache, connection cache, buffers."
+ (interactive)
+
+ ;; Flush password cache.
+ (when (functionp 'password-reset)
+ (funcall (symbol-function 'password-reset)))
+
+ ;; Flush file and connection cache.
+ (clrhash tramp-cache-data)
+
+ ;; Remove buffers.
+ (dolist (name (tramp-list-tramp-buffers))
+ (when (bufferp (get-buffer name)) (kill-buffer name))))
+
+(defun tramp-cleanup-all-buffers ()
+ "Kill all remote buffers."
+ (interactive)
+
+ ;; Remove all Tramp related buffers.
+ (tramp-cleanup-all-connections)
+
+ ;; Remove all buffers with a remote default-directory.
+ (dolist (name (tramp-list-remote-buffers))
+ (when (bufferp (get-buffer name)) (kill-buffer name))))
+
+(provide 'tramp-cmds)
+
+;;; TODO:
+
+;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
+;; * WIBNI there was an interactive command prompting for tramp
+;; method, hostname, username and filename and translates the user
+;; input into the correct filename syntax (depending on the Emacs
+;; flavor) (Reiner Steib)
+;; * Let the user edit the connection properties interactively.
+;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
+;; * It's just that when I come to Customize `tramp-default-user-alist'
+;; I'm presented with a mismatch and raw lisp for a value. It is my
+;; understanding that a variable declared with defcustom is a User
+;; Option and should not be modified by the code. add-to-list is
+;; called in several places. One way to handle that is to have a new
+;; ordinary variable that gets its initial value from
+;; tramp-default-user-alist and then is added to. (Pete Forman)
+
+;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c
+;;; tramp-cmds.el ends here
or an Authorization header. If PW-CACHE is non-nil, check for
password in password cache. This is done for the first try only."
- ;; `tramp-current-*' must be set for `tramp-read-passwd' and
- ;; `tramp-clear-passwd'.
+ ;; `tramp-current-*' must be set for `tramp-read-passwd'.
(let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector))
(tramp-current-user (tramp-file-name-user tramp-gw-gw-vector))
(tramp-current-host (tramp-file-name-host tramp-gw-gw-vector)))
- (unless pw-cache (tramp-clear-passwd))
+ (unless pw-cache (tramp-clear-passwd tramp-gw-gw-vector))
;; We are already in the right buffer.
(tramp-message
tramp-gw-vector 5 "%s required"
;; The following Tramp packages must be loaded after Tramp, because
;; they require Tramp as well.
(eval-after-load "tramp"
- '(progn
+ '(dolist
+ (feature
+ (list
+
+ ;; Tramp commands.
+ 'tramp-cmds
+
+ ;; Load foreign FTP method.
+ (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
+
+ ;; tramp-smb uses "smbclient" from Samba. Not available
+ ;; under Cygwin and Windows, because they don't offer
+ ;; "smbclient". And even not necessary there, because Emacs
+ ;; supports UNC file names like "//host/share/localname".
+ (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
+
+ ;; Load foreign FISH method.
+ 'tramp-fish
- ;; Load foreign FTP method.
- (let ((feature (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)))
+ ;; Load gateways. It needs `make-network-process' from Emacs 22.
+ (when (functionp 'make-network-process) 'tramp-gw)))
+
+ (when feature
(require feature)
(add-hook 'tramp-unload-hook
`(lambda ()
(when (featurep ,feature)
- (unload-feature ,feature 'force)))))
-
- ;; tramp-smb uses "smbclient" from Samba. Not available under
- ;; Cygwin and Windows, because they don't offer "smbclient". And
- ;; even not necessary there, because Emacs supports UNC file names
- ;; like "//host/share/localname".
- (unless (memq system-type '(cygwin windows-nt))
- (require 'tramp-smb)
- (add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-smb)
- (unload-feature 'tramp-smb 'force)))))
-
- ;; Load foreign FISH method.
- (require 'tramp-fish)
- (add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-fish)
- (unload-feature 'tramp-fish 'force))))
-
- ;; Load gateways. It needs `make-network-process' from Emacs 22.
- (when (functionp 'make-network-process)
- (require 'tramp-gw)
- (add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-gw)
- (unload-feature 'tramp-gw 'force)))))))
+ (unload-feature ,feature 'force)))))))
;;; User Customizable Internal Variables:
(put 'tramp-let-maybe 'lisp-indent-function 2)
(put 'tramp-let-maybe 'edebug-form-spec t)
-(defsubst tramp-make-tramp-temp-file (vec &optional dont-create)
+(defsubst tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
-Return the local name of the temporary file.
-If DONT-CREATE is non-nil, just the file name is returned without
-creation of the temporary file. This is not the preferred way to run,
-but it is necessary during connection setup, because we cannot create
-a remote file at this time. This parameter shall NOT be set to
-non-nil else."
- (if dont-create
- ;; It sounds a little bit stupid to create a LOCAL file name.
- ;; But we intend to use the remote directory "/tmp", and we have
- ;; no chance to check whether a temporary file exists already
- ;; remotely, because we have no working connection yet.
- (make-temp-name (expand-file-name tramp-temp-name-prefix "/tmp"))
-
- (let ((prefix
- (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (expand-file-name tramp-temp-name-prefix "/tmp")))
- result)
- (while (not result)
- ;; `make-temp-file' would be the first choice for
- ;; implementation. But it calls `write-region' internally,
- ;; which also needs a temporary file - we would end in an
- ;; infinite loop.
- (setq result (make-temp-name prefix))
- (if (file-exists-p result)
- (setq result nil)
- ;; This creates the file by side effect.
- (set-file-times result)
- (set-file-modes result (tramp-octal-to-decimal "0700"))))
-
- ;; Return the local part.
- (with-parsed-tramp-file-name result nil localname))))
+Return the local name of the temporary file."
+ (let ((prefix
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (expand-file-name tramp-temp-name-prefix "/tmp")))
+ result)
+ (while (not result)
+ ;; `make-temp-file' would be the natural choice for
+ ;; implementation. But it calls `write-region' internally,
+ ;; which also needs a temporary file - we would end in an
+ ;; infinite loop.
+ (setq result (make-temp-name prefix))
+ (if (file-exists-p result)
+ (setq result nil)
+ ;; This creates the file by side effect.
+ (set-file-times result)
+ (set-file-modes result (tramp-octal-to-decimal "0700"))))
+
+ ;; Return the local part.
+ (with-parsed-tramp-file-name result nil localname)))
;;; Config Manipulation Functions:
;; We handle also the local part, because there doesn't exist
;; `set-file-uid-gid'.
(let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (integerp gid) gid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))
(default-directory (tramp-compat-temporary-file-directory)))
- (call-process
- "chown" nil nil nil
- (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))
+ ;; "chown" might not exist, for example on Win32.
+ (condition-case nil
+ (call-process
+ "chown" nil nil nil
+ (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))
+ (error nil)))))
;; Simple functions using the `test' command.
(defun tramp-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
- (with-parsed-tramp-file-name directory nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
(all-completions
filename
(mapcar
(cond
;; We can do it directly.
((and (file-readable-p localname1)
- (file-writable-p (file-name-directory localname2)))
+ (file-writable-p (file-name-directory localname2))
+ (or (file-directory-p localname2)
+ (file-writable-p localname2)))
(if (eq op 'copy)
(tramp-compat-copy-file
localname1 localname2 ok-if-already-exists
;; Compose copy command.
(setq spec `((?h . ,host) (?u . ,user) (?p . ,port)
- (?t . ,(tramp-make-tramp-temp-file v 'dont-create))
+ (?t . ,(tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" ""))
(?k . ,(if keep-date " " "")))
copy-program (tramp-get-method-parameter
method 'tramp-copy-program)
;; " " is indication for keep-date argument.
x (delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
(unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter
- method 'tramp-copy-args))))
+ (tramp-get-method-parameter method 'tramp-copy-args))))
;; Check for program.
(when (and (fboundp 'executable-find)
(save-excursion
(tramp-barf-unless-okay
v
- (format " %s %s"
+ (format "%s %s"
(if parents "mkdir -p" "mkdir")
(tramp-shell-quote-argument localname))
"Couldn't make directory %s" dir))))
(tramp-flush-directory-property v localname)
(unless (zerop (tramp-send-command-and-check
v
- (format "rmdir %s"
+ (format "rmdir -f %s"
(tramp-shell-quote-argument localname))))
(tramp-error v 'file-error "Couldn't delete %s" directory))))
;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
(tramp-send-command
v
- (format "rm -r %s" (tramp-shell-quote-argument localname))
+ (format "rm -rf %s" (tramp-shell-quote-argument localname))
;; Don't read the output, do it explicitely.
nil t)
;; Wait for the remote system to return to us...
(setq buffer-file-name filename)
(set-visited-file-modtime)
(set-buffer-modified-p nil))
- (tramp-error
- v 'file-error "File %s not found on remote host" filename)
+ ;; We don't raise a Tramp error, because it might be
+ ;; suppressed, like in `find-file-noselect-1'.
+ (signal 'file-error (list "File not found on remote host" filename))
(list (expand-file-name filename) 0))
(if (and (tramp-local-host-p v)
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
(tramp-error v 'file-error "File not overwritten")))
- (if (and (tramp-local-host-p v)
- (file-writable-p (file-name-directory localname)))
- ;; Short track: if we are on the local host, we can run directly.
- (if confirm
- (write-region
- start end localname append 'no-message lockname confirm)
- (write-region start end localname append 'no-message lockname))
-
- (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
- (loc-enc (tramp-get-local-coding v "local-encoding"))
- (modes (save-excursion (file-modes filename)))
- ;; We use this to save the value of `last-coding-system-used'
- ;; after writing the tmp file. At the end of the function,
- ;; we set `last-coding-system-used' to this saved value.
- ;; This way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose this
- ;; variable. This approach was snarfed from ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really needed if we
- ;; use an encoding function, but currently we use it always
- ;; because this makes the logic simpler.
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; We say `no-message' here because we don't want the visited file
- ;; modtime data to be clobbered from the temp file. We call
- ;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- 'write-region
- (if confirm ; don't pass this arg unless defined for backward compat.
- (list start end tmpfile append 'no-message lockname confirm)
- (list start end tmpfile append 'no-message lockname)))
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used (symbol-value 'last-coding-system-used)))
- ;; The permissions of the temporary file should be set. If
- ;; filename does not exist (eq modes nil) it has been renamed to
- ;; the backup file. This case `save-buffer' handles
- ;; permissions.
- (when modes (set-file-modes tmpfile modes))
-
- ;; This is a bit lengthy due to the different methods possible for
- ;; file transfer. First, we check whether the method uses an rcp
- ;; program. If so, we call it. Otherwise, both encoding and
- ;; decoding command must be specified. However, if the method
- ;; _also_ specifies an encoding function, then that is used for
- ;; encoding the contents of the tmp file.
- (cond
- ;; `rename-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (and (tramp-method-out-of-band-p v)
- (integerp start)
- (> (- end start) tramp-copy-size-limit)))
- (rename-file tmpfile filename t))
-
- ;; Use inline file transfer
- (rem-dec
- ;; Encode tmpfile
- (tramp-message v 5 "Encoding region...")
- (unwind-protect
- (with-temp-buffer
- ;; Use encoding function or command.
- (if (and (symbolp loc-enc) (fboundp loc-enc))
- (progn
- (tramp-message
- v 5 "Encoding region using function `%s'..."
- (symbol-name loc-enc))
- (let ((coding-system-for-read 'binary))
- (insert-file-contents-literally tmpfile))
- ;; CCC. The following `let' is a workaround for
- ;; the base64.el that comes with pgnus-0.84. If
- ;; both of the following conditions are
- ;; satisfied, it tries to write to a local file
- ;; in default-directory, but at this point,
- ;; default-directory is remote.
- ;; (CALL-PROCESS-REGION can't write to remote
- ;; files, it seems.) The file in question is a
- ;; tmp file anyway.
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (funcall loc-enc (point-min) (point-max))))
+ (let ((uid (or (nth 2 (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (nth 3 (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer))))
+
+ (if (and (tramp-local-host-p v)
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
+ ;; Short track: if we are on the local host, we can run directly.
+ (write-region start end localname append 'no-message lockname confirm)
+
+ (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
+ (loc-enc (tramp-get-local-coding v "local-encoding"))
+ (modes (save-excursion (file-modes filename)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp file.
+ ;; At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler.
+ (tmpfile (tramp-compat-make-temp-file filename)))
+
+ ;; We say `no-message' here because we don't want the
+ ;; visited file modtime data to be clobbered from the temp
+ ;; file. We call `set-visited-file-modtime' ourselves later
+ ;; on.
+ (tramp-run-real-handler
+ 'write-region
+ (list start end tmpfile append 'no-message lockname confirm))
+ ;; Now, `last-coding-system-used' has the right value. Remember it.
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used (symbol-value 'last-coding-system-used)))
+ ;; The permissions of the temporary file should be set. If
+ ;; filename does not exist (eq modes nil) it has been
+ ;; renamed to the backup file. This case `save-buffer'
+ ;; handles permissions.
+ (when modes (set-file-modes tmpfile modes))
+
+ ;; This is a bit lengthy due to the different methods
+ ;; possible for file transfer. First, we check whether the
+ ;; method uses an rcp program. If so, we call it.
+ ;; Otherwise, both encoding and decoding command must be
+ ;; specified. However, if the method _also_ specifies an
+ ;; encoding function, then that is used for encoding the
+ ;; contents of the tmp file.
+ (cond
+ ;; `rename-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (and (tramp-method-out-of-band-p v)
+ (integerp start)
+ (> (- end start) tramp-copy-size-limit)))
+ (rename-file tmpfile filename t))
+
+ ;; Use inline file transfer
+ (rem-dec
+ ;; Encode tmpfile
+ (tramp-message v 5 "Encoding region...")
+ (unwind-protect
+ (with-temp-buffer
+ ;; Use encoding function or command.
+ (if (and (symbolp loc-enc) (fboundp loc-enc))
+ (progn
+ (tramp-message
+ v 5 "Encoding region using function `%s'..."
+ (symbol-name loc-enc))
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents-literally tmpfile))
+ ;; CCC. The following `let' is a workaround
+ ;; for the base64.el that comes with
+ ;; pgnus-0.84. If both of the following
+ ;; conditions are satisfied, it tries to write
+ ;; to a local file in default-directory, but
+ ;; at this point, default-directory is remote.
+ ;; (CALL-PROCESS-REGION can't write to remote
+ ;; files, it seems.) The file in question is
+ ;; a tmp file anyway.
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (funcall loc-enc (point-min) (point-max))))
+ (tramp-message
+ v 5 "Encoding region using command `%s'..." loc-enc)
+ (unless (equal 0 (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ "Cannot write to `%s', local encoding command `%s' failed"
+ filename loc-enc)))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (goto-char (point-max))
+ (unless (bolp) (newline))
(tramp-message
- v 5 "Encoding region using command `%s'..." loc-enc)
- (unless (equal 0 (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- "Cannot write to `%s', local encoding command `%s' failed"
- filename loc-enc)))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on the
- ;; remote host, we cannot use the function.
- (goto-char (point-max))
- (unless (bolp) (newline))
- (tramp-message
- v 5 "Decoding region into remote file %s..." filename)
- (tramp-send-command
- v
- (format
- "%s >%s <<'EOF'\n%sEOF"
- rem-dec
- (tramp-shell-quote-argument localname)
- (buffer-string)))
- (tramp-barf-unless-okay
- v nil
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (zerop (call-process "cksum" tmpfile t)))
- ;; cksum runs remotely
- (zerop
- (tramp-send-command-and-check
- v
- (format "cksum <%s" (tramp-shell-quote-argument localname))))
- ;; ... they are different
- (not
- (string-equal
- (buffer-string)
- (with-current-buffer (tramp-get-buffer v) (buffer-string))))
- (tramp-error
- v 'file-error
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed")
- filename rem-dec)))
- (tramp-message
- v 5 "Decoding region into remote file %s...done" filename)
- (tramp-flush-file-property v localname))
+ v 5 "Decoding region into remote file %s..." filename)
+ (tramp-send-command
+ v
+ (format
+ "%s >%s <<'EOF'\n%sEOF"
+ rem-dec
+ (tramp-shell-quote-argument localname)
+ (buffer-string)))
+ (tramp-barf-unless-okay
+ v nil
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region is
+ ;; written to a temporary file. Check that the
+ ;; checksum is equal to that from the local tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (zerop (call-process "cksum" tmpfile t)))
+ ;; cksum runs remotely
+ (zerop
+ (tramp-send-command-and-check
+ v
+ (format
+ "cksum <%s" (tramp-shell-quote-argument localname))))
+ ;; ... they are different
+ (not
+ (string-equal
+ (buffer-string)
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string))))
+ (tramp-error
+ v 'file-error
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
+ filename rem-dec)))
+ (tramp-message
+ v 5 "Decoding region into remote file %s...done" filename)
+ (tramp-flush-file-property v localname))
- ;; Save exit.
- (delete-file tmpfile)))
+ ;; Save exit.
+ (delete-file tmpfile)))
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an rcp program")
- method)))
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an rcp program")
+ method)))
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (set 'last-coding-system-used coding-system-used)))
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (set 'last-coding-system-used coding-system-used))))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- ;; We must pass modtime explicitely, because filename can be different
- ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
+ ;; We must pass modtime explicitely, because filename can
+ ;; be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
(nth 5 (file-attributes filename))))
+
;; Set the ownership.
- (tramp-set-file-uid-gid filename)
+ (tramp-set-file-uid-gid filename uid gid)
(when (or (eq visit t) (null visit) (stringp visit))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
-;;; Interactions with other packages:
-
-;; -- complete.el --
-
-;; This function contributed by Ed Sabol
-(defun tramp-handle-expand-many-files (name)
- "Like `PC-expand-many-files' for Tramp files."
- (with-parsed-tramp-file-name name nil
- (save-match-data
- (if (or (string-match "\\*" name)
- (string-match "\\?" name)
- (string-match "\\[.*\\]" name))
- (progn
- (let (bufstr)
- ;; CCC: To do it right, we should quote certain characters
- ;; in the file name, but since the echo command is going to
- ;; break anyway when there are spaces in the file names, we
- ;; don't bother.
- ;;-(let ((comint-file-name-quote-list
- ;;- (set-difference tramp-file-name-quote-list
- ;;- '(?\* ?\? ?[ ?]))))
- ;;- (tramp-send-command
- ;;- method user host
- ;;- (format "echo %s" (comint-quote-filename localname))))
- (tramp-send-command v (format "echo %s" localname))
- (setq bufstr (buffer-substring
- (point-min) (tramp-compat-line-end-position)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (if (string-equal localname bufstr)
- nil
- (insert "(\"")
- (while (search-forward " " nil t)
- (delete-backward-char 1)
- (insert "\" \""))
- (goto-char (point-max))
- (delete-backward-char 1)
- (insert "\")")
- (goto-char (point-min))
- (mapcar
- (function (lambda (x)
- (tramp-make-tramp-file-name method user host x)))
- (read (current-buffer)))))))
- (list (expand-file-name name))))))
-
-(eval-after-load "complete"
- '(progn
- (defadvice PC-expand-many-files
- (around tramp-advice-PC-expand-many-files (name) activate)
- "Invoke `tramp-handle-expand-many-files' for Tramp files."
- (if (tramp-tramp-file-p name)
- (setq ad-return-value (tramp-handle-expand-many-files name))
- ad-do-it))
- (add-hook 'tramp-unload-hook
- '(lambda () (ad-unadvise 'PC-expand-many-files)))))
-
;;; File name handler functions for completion mode.
(defvar tramp-completion-mode nil
(unless (tramp-get-connection-property vec "remote-shell" nil)
(let (shell)
(with-current-buffer (tramp-get-buffer vec)
- (tramp-send-command vec "echo ~root")
+ (tramp-send-command vec "echo ~root" t)
(cond
((string-match "^~root$" (buffer-string))
(setq shell
(when extra-args (setq shell (concat shell " " extra-args))))
(tramp-message
vec 5 "Starting remote shell `%s' for tilde expansion..." shell)
- (tramp-send-command-internal
- vec (concat "PROMPT_COMMAND='' PS1='$ ' exec " shell))
+ (tramp-message
+ vec 6 (format "PROMPT_COMMAND='' PS1='$ ' exec %s" shell))
+ ;; We just send a string only without checking resulting prompt.
+ (tramp-send-string
+ vec (format "PROMPT_COMMAND='' PS1='$ ' exec %s" shell))
(tramp-message vec 5 "Setting remote shell prompt...")
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the
(format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''"
tramp-rsh-end-of-line
tramp-end-of-output
- tramp-rsh-end-of-line))
+ tramp-rsh-end-of-line)
+ t)
(tramp-message vec 5 "Setting remote shell prompt...done"))
(t (tramp-message
vec 5 "Remote `%s' groks tilde expansion, good"
"Tell the remote host which terminal type to use.
The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec tramp-terminal-type))
(defun tramp-action-process-alive (proc vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(unless (eq exit 'ok)
- (tramp-clear-passwd)
+ (tramp-clear-passwd vec)
(tramp-error-with-buffer
nil vec 'file-error
(cond
(tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
found)))
-(defun tramp-wait-for-shell-prompt (proc timeout)
- "Wait for the shell prompt to appear from process PROC within TIMEOUT seconds.
-See `tramp-wait-for-regexp' for more details.
-Shell prompt pattern is determined by variables `shell-prompt-pattern'
-and `tramp-shell-prompt-pattern'."
- (tramp-wait-for-regexp
- proc timeout
- (format "\\(%s\\|%s\\)\\'"
- shell-prompt-pattern tramp-shell-prompt-pattern)))
-
(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
"Wait for shell prompt and barf if none appears.
Looks at process PROC to see if a shell prompt appears in TIMEOUT
seconds. If not, it produces an error message with the given ERROR-ARGS."
- (unless (tramp-wait-for-shell-prompt proc timeout)
+ (unless
+ (tramp-wait-for-regexp
+ proc timeout
+ (format
+ "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
(apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
-;; We don't call `tramp-send-string' in order to hide the password from the
-;; debug buffer, and because end-of-line handling of the string.
-(defun tramp-enter-password (p)
+;; We don't call `tramp-send-string' in order to hide the password
+;; from the debug buffer, and because end-of-line handling of the
+;; string.
+(defun tramp-enter-password (proc)
"Prompt for a password and send it to the remote end."
(process-send-string
- p (concat (tramp-read-passwd p)
- (or (tramp-get-method-parameter
- tramp-current-method
- 'tramp-password-end-of-line)
- tramp-default-password-end-of-line))))
+ proc (concat (tramp-read-passwd proc)
+ (or (tramp-get-method-parameter
+ tramp-current-method
+ 'tramp-password-end-of-line)
+ tramp-default-password-end-of-line))))
(defun tramp-open-connection-setup-interactive-shell (proc vec)
"Set up an interactive shell.
;; called as sh) on startup; this way, we avoid the startup file
;; clobbering $PS1. $PROMP_COMMAND is another way to set the prompt
;; in /bin/bash, it must be discarded as well.
- (tramp-send-command-internal
+ (tramp-message
+ vec 6 (format "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' %s"
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-sh)))
+ ;; We just send a string only without checking resulting prompt.
+ (tramp-send-string
vec
(format "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' %s"
(tramp-get-method-parameter
(tramp-file-name-method vec) 'tramp-remote-sh)))
+ (tramp-message vec 5 "Setting shell prompt")
+ ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must
+ ;; use "\n" here, not tramp-rsh-end-of-line.
+ (tramp-send-command
+ vec
+ (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''"
+ tramp-rsh-end-of-line
+ tramp-end-of-output
+ tramp-rsh-end-of-line)
+ t)
(tramp-message vec 5 "Setting up remote shell environment")
- (tramp-send-command-internal vec "stty -inlcr -echo kill '^U' erase '^H'")
+ (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
;; Check whether the echo has really been disabled. Some
;; implementations, like busybox of embedded GNU/Linux, don't
;; support disabling.
- (tramp-send-command-internal vec "echo foo")
+ (tramp-send-command vec "echo foo" t)
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(when (looking-at "echo foo")
(tramp-message vec 5 "Remote echo still on. Ok.")
;; Make sure backspaces and their echo are enabled and no line
;; width magic interferes with them.
- (tramp-send-command-internal vec "stty icanon erase ^H cols 32767")))
+ (tramp-send-command vec "stty icanon erase ^H cols 32767" t)))
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
(tramp-message vec 5 "Determining coding system")
- (tramp-send-command-internal vec "echo foo ; echo bar")
+ (tramp-send-command vec "echo foo ; echo bar" t)
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(if (featurep 'mule)
;; We have found a ^M but cannot frob the process coding system
;; because we're running on a non-MULE Emacs. Let's try
;; stty, instead.
- (tramp-send-command-internal vec "stty -onlcr"))))
- (tramp-send-command-internal vec "set +o vi +o emacs")
- (tramp-message vec 5 "Setting shell prompt")
- ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must
- ;; use "\n" here, not tramp-rsh-end-of-line.
- (tramp-send-command
- vec
- (format "PROMPT_COMMAND=''; PS1='%s%s%s'; PS2=''; PS3=''"
- tramp-rsh-end-of-line
- tramp-end-of-output
- tramp-rsh-end-of-line))
+ (tramp-send-command vec "stty -onlcr" t))))
+ (tramp-send-command vec "set +o vi +o emacs" t)
;; Check whether the remote host suffers from buggy `send-process-string'.
;; This is known for FreeBSD (see comment in `send_process', file process.c).
;; I've tested sending 624 bytes successfully, sending 625 bytes failed.
;; ksh. Whee...
(tramp-find-shell vec)
;; Disable unexpected output.
- (tramp-send-command vec "mesg n; biff n")
+ (tramp-send-command vec "mesg n; biff n" t)
;; Set the environment.
(tramp-message vec 5 "Setting default environment")
(let ((env (copy-sequence tramp-remote-process-environment))
(setq item (split-string (car env) "="))
(if (and (stringp (cadr item)) (not (string-equal (cadr item) "")))
(tramp-send-command
- vec (format "%s=%s; export %s" (car item) (cadr item) (car item)))
+ vec (format "%s=%s; export %s" (car item) (cadr item) (car item)) t)
(push (car item) unset))
(setq env (cdr env)))
(when unset
(tramp-send-command
- vec (format "unset %s" (mapconcat 'identity unset " "))))))
+ vec (format "unset %s" (mapconcat 'identity unset " "))))) t)
;; CCC: We should either implement a Perl version of base64 encoding
;; and decoding. Then we just use that in the last item. The other
(g-user (and gw (tramp-file-name-user gw)))
(g-host (and gw (tramp-file-name-host gw)))
(command login-program)
+ ;; We don't create the temporary file. In fact, it
+ ;; is just a prefix for the ControlPath option of
+ ;; ssh; the real temporary file has another name, and
+ ;; it is created and protected by ssh. It is also
+ ;; removed by ssh, when the connection is closed.
+ (tmpfile
+ (tramp-set-connection-property
+ p "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
spec)
;; Add gateway arguments if necessary.
l-user (or l-user "")
l-port (or l-port "")
spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port)
- (?t . ,(tramp-make-tramp-temp-file vec 'dont-create)))
+ (?t . ,tmpfile))
command
(concat
command " "
(tramp-send-string vec command)
(unless nooutput (tramp-wait-for-output p))))
-(defun tramp-send-command-internal (vec command)
- "Send command to remote host and wait for success.
-Sends COMMAND, then waits 30 seconds for shell prompt."
- (let ((p (tramp-get-connection-process vec)))
- (when (tramp-get-connection-property vec "remote-echo" nil)
- ;; We mark the command string that it can be erased in the output buffer.
- (tramp-set-connection-property p "check-remote-echo" t)
- (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (tramp-barf-if-no-shell-prompt
- p 30 "Couldn't `%s', see buffer `%s'" command (buffer-name))))
-
(defun tramp-wait-for-output (proc &optional timeout)
"Wait for output from remote rsh command."
(with-current-buffer (process-buffer proc)
password)
(read-passwd pw-prompt))))
-(defun tramp-clear-passwd ()
- "Clear password cache for connection related to current-buffer.
-If METHOD, USER or HOST is given, take then for computing the key."
- (interactive)
+(defun tramp-clear-passwd (vec)
+ "Clear password cache for connection related to VEC."
(when (functionp 'password-cache-remove)
- (funcall (symbol-function 'password-cache-remove)
- (tramp-make-tramp-file-name
- tramp-current-method
- tramp-current-user
- tramp-current-host
- ""))))
+ (funcall
+ (symbol-function 'password-cache-remove)
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ ""))))
;; Snarfed code from time-date.el and parse-time.el
(boundp 'mml-mode)
(symbol-value 'mml-mode))
- (let* ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
- (buffer-list
- (delq nil
- (mapcar '(lambda (b)
- (when (string-match tramp-buf-regexp (buffer-name b)) b))
- (buffer-list))))
- (curbuf (current-buffer)))
+ (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
+ (buffer-list (funcall (symbol-function 'tramp-list-tramp-buffers)))
+ (curbuf (current-buffer)))
;; There is at least one Tramp buffer.
(when buffer-list
(dolist (buffer buffer-list)
(funcall (symbol-function 'mml-insert-empty-tag)
'part 'type "text/plain" 'encoding "base64"
- 'disposition "attachment" 'buffer (buffer-name buffer)
- 'description (buffer-name buffer)))
+ 'disposition "attachment" 'buffer buffer
+ 'description buffer))
(set-buffer-modified-p nil))
;; Don't send. Delete the message buffer.
;; around one of the loops that calls accept-process-output)
;; (Stefan Monnier).
;; * Autodetect if remote `ls' groks the "--dired" switch.
-;; * Add fallback for inline encodings. This should be used
-;; if the remote end doesn't support mimencode or a similar program.
-;; For reading files from the remote host, we can just parse the output
-;; of `od -b'. For writing files to the remote host, we construct
-;; a shell program which contains only "safe" ascii characters
-;; and which writes the right bytes to the file. We can use printf(1)
-;; or "echo -e" or the printf function in awk and use octal escapes
-;; for the "dangerous" characters. The null byte might be a problem.
-;; On some systems, the octal escape doesn't work. So we try the following
-;; two commands to write a null byte:
-;; dd if=/dev/zero bs=1 count=1
-;; echo | tr '\n' '\000'
-;; * Cooperate with PCL-CVS. It uses start-process, which doesn't
-;; work for remote files.
;; * Rewrite `tramp-shell-quote-argument' to abstain from using
;; `shell-quote-argument'.
;; * Completion gets confused when you leave out the method name.
;; (Francesco Potortì)
;; * Make it work for different encodings, and for different file name
;; encodings, too. (Daniel Pittman)
-;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
;; * Progress reports while copying files. (Michael Kifer)
;; * Don't search for perl5 and perl. Instead, only search for perl and
;; then look if it's the right version (with `perl -v').
;; something. (David Kastrup)
;; * Could Tramp reasonably look for a prompt after ^M rather than
;; only after ^J ? (Stefan Monnier)
-;; * WIBNI there was an interactive command prompting for tramp
-;; method, hostname, username and filename and translates the user
-;; input into the correct filename syntax (depending on the Emacs
-;; flavor) (Reiner Steib)
-;; * Let the user edit the connection properties interactively.
-;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
;; * Reconnect directly to a compliant shell without first going
;; through the user's default shell. (Pete Forman)
-;; * It's just that when I come to Customize `tramp-default-user-alist'
-;; I'm presented with a mismatch and raw lisp for a value. It is my
-;; understanding that a variable declared with defcustom is a User
-;; Option and should not be modified by the code. add-to-list is
-;; called in several places. One way to handle that is to have a new
-;; ordinary variable that gets its initial value from
-;; tramp-default-user-alist and then is added to. (Pete Forman)
;; * Make `tramp-default-user' obsolete.
;; Functions for file-name-handler-alist:
;; "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.11"
+(defconst tramp-version "2.1.12-pre"
"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.11 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-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok")))
(unless (string-match "\\`ok\\'" x) (error x)))
(provide 'trampver)
(defvar comment-add 0
"How many more comment chars should be inserted by `comment-region'.
This determines the default value of the numeric argument of `comment-region'.
+The `plain' comment style doubles this value.
+
This should generally stay 0, except for a few modes like Lisp where
-it can be convenient to set it to 1 so that regions are commented with
-two semi-colons.")
+it is 1 so that regions are commented with two or three semi-colons.")
(defconst comment-styles
'((plain . (nil nil nil nil))
(indent . (nil nil nil t))
+ (indent-or-triple
+ . (nil nil nil multi-char))
(aligned . (nil t nil t))
(multi-line . (t nil nil t))
(extra-line . (t nil t t))
EXTRA specifies that an extra line should be used before and after the
region to comment (to put the `comment-end' and `comment-start').
INDENT specifies that the `comment-start' markers should not be put at the
- left margin but at the current indentation of the region to comment.")
+ left margin but at the current indentation of the region to comment.
+If INDENT is `multi-char', that means indent multi-character
+ comment starters, but not one-character comment starters.")
;;;###autoload
-(defcustom comment-style 'plain
+(defcustom comment-style 'indent-or-triple
"Style to be used for `comment-region'.
See `comment-styles' for a list of available styles."
:type (if (boundp 'comment-styles)
(delete-char n)
(setq ,bindent (- ,bindent n)))))))))))
-;; Compute the number of extra semicolons to add to the comment starter
-;; in Lisp mode, extra stars in C mode, etc.
+;; Compute the number of extra comment starter characters
+;; (extra semicolons in Lisp mode, extra stars in C mode, etc.)
;; If ARG is non-nil, just follow ARG.
;; If the comment-starter is multi-char, just follow ARG.
;; Otherwise obey comment-add, and double it if EXTRA is non-nil.
-(defun comment-add (arg &optional extra)
+(defun comment-add (arg)
(if (and (null arg) (= (string-match "[ \t]*\\'" comment-start) 1))
- (* comment-add (if extra 2 1))
+ (* comment-add 1)
(1- (prefix-numeric-value arg))))
(defun comment-region-internal (beg end cs ce
((consp arg) (uncomment-region beg end))
((< numarg 0) (uncomment-region beg end (- numarg)))
(t
- ;; Add an extra semicolon in Lisp and similar modes.
- ;; If STYLE doesn't specify indenting the comments,
- ;; then double the value of `comment-add'.
- (setq numarg (comment-add arg (null (nth 3 style))))
- (comment-region-internal
- beg end
- (let ((s (comment-padright comment-start numarg)))
- (if (string-match comment-start-skip s) s
- (comment-padright comment-start)))
- (let ((s (comment-padleft comment-end numarg)))
- (and s (if (string-match comment-end-skip s) s
- (comment-padright comment-end))))
- (if multi (comment-padright comment-continue numarg))
- (if multi
- (comment-padleft (comment-string-reverse comment-continue) numarg))
- block
- lines
- (nth 3 style))))))
+ (let ((multi-char (/= (string-match "[ \t]*\\'" comment-start) 1))
+ indent)
+ (if (eq (nth 3 style) 'multi-char)
+ (setq indent multi-char)
+ (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 (1- (prefix-numeric-value arg))))
+
+ (comment-region-internal
+ beg end
+ (let ((s (comment-padright comment-start numarg)))
+ (if (string-match comment-start-skip s) s
+ (comment-padright comment-start)))
+ (let ((s (comment-padleft comment-end numarg)))
+ (and s (if (string-match comment-end-skip s) s
+ (comment-padright comment-end))))
+ (if multi (comment-padright comment-continue numarg))
+ (if multi
+ (comment-padleft (comment-string-reverse comment-continue) numarg))
+ block
+ lines
+ indent))))))
;;;###autoload
(defun comment-box (beg end &optional arg)
:group 'fast-lock)
(defvar fast-lock-save-faces
- (when (save-match-data (string-match "XEmacs" (emacs-version)))
+ (when (featurep 'xemacs)
;; XEmacs uses extents for everything, so we have to pick the right ones.
font-lock-face-list)
"Faces that will be saved in a Font Lock cache file.
\f
;; Functions for XEmacs:
-(when (save-match-data (string-match "XEmacs" (emacs-version)))
+(when (featurep 'xemacs)
;;
;; It would be better to use XEmacs' `map-extents' over extents with a
;; `font-lock' property, but `face' properties are on different extents.
(defun bb-up (count)
(interactive "p")
(while (and (> count 0) (> bb-y -1))
- (previous-line 1)
+ (forward-line -1)
(setq bb-y (1- bb-y))
(setq count (1- count))))
(defun bb-down (count)
(interactive "p")
(while (and (> count 0) (< bb-y 8))
- (next-line 1)
+ (forward-line 1)
(setq bb-y (1+ bb-y))
(setq count (1- count))))
(t
(error "Bad location")))))
(let (goal-column)
- (previous-line 1)))
+ (forward-line -1)))
(let ((char-a (following-char))
(char-b (decipher-last-command-char)))
(or (and (not (= ?w (char-syntax char-a)))
(forward-line 1)
))
(switch-to-buffer ps-buf-name)
- (next-line 1)
+ (forward-line 1)
(insert "showpage exec Hwsave restore\n\n")
(insert "%%Pages " (number-to-string ipage) " 0\n")
(insert "%%EOF\n")
"Move point down one row on the Lm board."
(interactive)
(if (< (lm-point-y) lm-board-height)
- (next-line 1)));;; lm-square-height)))
+ (forward-line 1)));;; lm-square-height)))
(defun lm-move-up ()
"Move point up one row on the Lm board."
(interactive)
(if (> (lm-point-y) 1)
- (previous-line lm-square-height)))
+ (forward-line (- lm-square-height))))
(defun lm-move-ne ()
"Move point North East on the Lm board."
(wait 0.15)
newpos fall-p)
(while (when (save-excursion
- (next-line 1)
+ (forward-line 1)
(and (= col (current-column))
(setq newpos (point))
(string= spaces (buffer-substring-no-properties
(and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
(setq args (cdr args)
msg "(:@ ....) must return exactly one element"))
- (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS))
+ (let ((ignore (if (featurep 'xemacs) :EMACS :XEMACS))
(mode :BOTH) code)
(while (consp args)
(if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
;; existing functions when they are `fboundp', provide shortcuts if they are
;; known to be defined in a specific Emacs branch (for short .elc)
(defmacro defunx (name arglist &rest definition)
- (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses)
+ (let ((xemacsp (featurep 'xemacs)) reuses)
(while (memq (car definition)
'(:try :emacs-and-try :xemacs-and-try))
(if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try))
(defmacro ignore-errors-x (&rest body)
(let ((specials '((scan-sexps . 4) (scan-lists . 5)))
spec nils)
- (if (and (string-match "XEmacs" emacs-version)
+ (if (and (featurep 'xemacs)
(null (cdr body)) (consp (car body))
(setq spec (assq (caar body) specials))
(>= (setq nils (- (cdr spec) (length (car body)))) 0))
`(let ((,modified (buffer-modified-p)))
(unwind-protect
(let ((buffer-undo-list t) (inhibit-read-only t)
- ,@(unless (string-match "XEmacs" emacs-version)
+ ,@(unless (featurep 'xemacs)
'((inhibit-point-motion-hooks t) deactivate-mark))
before-change-functions after-change-functions
buffer-file-name buffer-file-truename)
c-found-types)
(sort type-list 'string-lessp)))
+;; Shut up the byte compiler.
+(defvar c-maybe-stale-found-type)
+
(defun c-trim-found-types (beg end old-len)
;; An after change function which, in conjunction with the info in
;; c-maybe-stale-found-type (set in c-before-change), removes a type
"If non-nil, automatically jump to the next error encountered.")
(make-variable-buffer-local 'compilation-auto-jump-to-next)
+
+(defvar compilation-skip-to-next-location t
+ "*If non-nil, skip multiple error messages for the same source location.")
+
+(defcustom compilation-skip-threshold 1
+ "Compilation motion commands skip less important messages.
+The value can be either 2 -- skip anything less than error, 1 --
+skip anything less than warning or 0 -- don't skip any messages.
+Note that all messages not positively identified as warning or
+info, are considered errors."
+ :type '(choice (const :tag "Warnings and info" 2)
+ (const :tag "Info" 1)
+ (const :tag "None" 0))
+ :group 'compilation
+ :version "22.1")
+
+(defcustom compilation-skip-visited nil
+ "Compilation motion commands skip visited messages if this is t.
+Visited messages are ones for which the file, line and column have been jumped
+to from the current content in the current compilation buffer, even if it was
+from a different message."
+ :type 'boolean
+ :group 'compilation
+ :version "22.1")
+
(defun compilation-face (type)
(or (and (car type) (match-end (car type)) compilation-warning-face)
(and (cdr type) (match-end (cdr type)) compilation-info-face)
(put 'compilation-mode 'mode-class 'special)
-(defvar compilation-skip-to-next-location t
- "*If non-nil, skip multiple error messages for the same source location.")
-
-(defcustom compilation-skip-threshold 1
- "Compilation motion commands skip less important messages.
-The value can be either 2 -- skip anything less than error, 1 --
-skip anything less than warning or 0 -- don't skip any messages.
-Note that all messages not positively identified as warning or
-info, are considered errors."
- :type '(choice (const :tag "Warnings and info" 2)
- (const :tag "Info" 1)
- (const :tag "None" 0))
- :group 'compilation
- :version "22.1")
-
-(defcustom compilation-skip-visited nil
- "Compilation motion commands skip visited messages if this is t.
-Visited messages are ones for which the file, line and column have been jumped
-to from the current content in the current compilation buffer, even if it was
-from a different message."
- :type 'boolean
- :group 'compilation
- :version "22.1")
-
;;;###autoload
(defun compilation-mode (&optional name-of-mode)
"Major mode for compilation log buffers.
(require 'tempo)
-
;;; *** Customization *****************************************************
;; Major mode for editing F90 programs in FREE FORMAT.
;; The minor language revision F95 is also supported (with font-locking).
+;; Some/many (?) aspects of F2003 are supported.
;; Knows about continuation lines, named structured statements, and other
;; features in F90 including HPF (High Performance Fortran) structures.
;; (f90-add-imenu-menu) ; extra menu with functions etc.
;; (if f90-auto-keyword-case ; change case of all keywords on startup
;; (f90-change-keywords f90-auto-keyword-case))
-;; ))
+;; ))
;;
;; in your .emacs file. You can also customize the lists
;; f90-font-lock-keywords, etc.
;;; Code:
;; TODO
-;; Support for align.
-;; OpenMP, preprocessor highlighting.
+;; 1. Any missing F2003 syntax?
+;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes
+;; "f95-mode", "f2003-mode" for the language revisions.
+;; 3. Support for align.
+;; Font-locking:
+;; 1. OpenMP, OpenMPI?, preprocessor highlighting.
+;; 2. interface blah - Highlight "blah" in function-name face?
+;; Need to avoid "interface operator (+)" etc.
+;; 3. integer_name = 1
+;; 4. Labels for "else" statements (F2003)?
(defvar comment-auto-fill-only-comments)
(defvar font-lock-keywords)
(defcustom f90-do-indent 3
- "*Extra indentation applied to DO blocks."
+ "Extra indentation applied to DO blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-do-indent 'safe-local-variable 'integerp)
(defcustom f90-if-indent 3
- "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
+ "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-if-indent 'safe-local-variable 'integerp)
(defcustom f90-type-indent 3
- "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks."
+ "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-type-indent 'safe-local-variable 'integerp)
(defcustom f90-program-indent 2
- "*Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
+ "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
:type 'integer
:group 'f90-indent)
+(put 'f90-program-indent 'safe-local-variable 'integerp)
+
+(defcustom f90-associate-indent 2
+ "Extra indentation applied to ASSOCIATE blocks."
+ :type 'integer
+ :group 'f90-indent
+ :version "23.1")
+(put 'f90-associate-indent 'safe-local-variable 'integerp)
(defcustom f90-continuation-indent 5
- "*Extra indentation applied to continuation lines."
+ "Extra indentation applied to continuation lines."
:type 'integer
:group 'f90-indent)
+(put 'f90-continuation-indent 'safe-local-variable 'integerp)
(defcustom f90-comment-region "!!$"
- "*String inserted by \\[f90-comment-region] at start of each line in region."
+ "String inserted by \\[f90-comment-region] at start of each line in region."
:type 'string
:group 'f90-indent)
+(put 'f90-comment-region 'safe-local-variable 'stringp)
(defcustom f90-indented-comment-re "!"
- "*Regexp matching comments to indent as code."
+ "Regexp matching comments to indent as code."
:type 'regexp
:group 'f90-indent)
+(put 'f90-indented-comment-re 'safe-local-variable 'stringp)
(defcustom f90-directive-comment-re "!hpf\\$"
- "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
+ "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
:type 'regexp
:group 'f90-indent)
+(put 'f90-directive-comment-re 'safe-local-variable 'stringp)
(defcustom f90-beginning-ampersand t
- "*Non-nil gives automatic insertion of \& at start of continuation line."
+ "Non-nil gives automatic insertion of \& at start of continuation line."
:type 'boolean
:group 'f90)
+(put 'f90-beginning-ampersand 'safe-local-variable 'booleanp)
(defcustom f90-smart-end 'blink
- "*Qualification of END statements according to the matching block start.
+ "Qualification of END statements according to the matching block start.
For example, the END that closes an IF block is changed to END
IF. If the block has a label, this is added as well. Allowed
values are 'blink, 'no-blink, and nil. If nil, nothing is done.
additionally blinks the cursor to the start of the block."
:type '(choice (const blink) (const no-blink) (const nil))
:group 'f90)
+(put 'f90-smart-end 'safe-local-variable
+ (lambda (value) (memq value '(blink no-blink nil))))
(defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
- "*Regexp matching delimiter characters at which lines may be broken.
+ "Regexp matching delimiter characters at which lines may be broken.
There are certain tokens comprised entirely of characters
matching this regexp that should not be split, and these are
specified by the constant `f90-no-break-re'."
:type 'regexp
:group 'f90)
+(put 'f90-break-delimiters 'safe-local-variable 'stringp)
(defcustom f90-break-before-delimiters t
- "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
+ "Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
:type 'boolean
:group 'f90)
+(put 'f90-break-before-delimiters 'safe-local-variable 'booleanp)
(defcustom f90-auto-keyword-case nil
- "*Automatic case conversion of keywords.
+ "Automatic case conversion of keywords.
The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
:type '(choice (const downcase-word) (const upcase-word)
(const capitalize-word) (const nil))
:group 'f90)
+(put 'f90-auto-keyword-case 'safe-local-variable
+ (lambda (value) (memq value '(downcase-word
+ capitalize-word upcase-word nil))))
(defcustom f90-leave-line-no nil
- "*If non-nil, line numbers are not left justified."
+ "If non-nil, line numbers are not left justified."
:type 'boolean
:group 'f90)
+(put 'f90-leave-line-no 'safe-local-variable 'booleanp)
(defcustom f90-mode-hook nil
"Hook run when entering F90 mode."
:type 'hook
:options '(f90-add-imenu-menu)
:group 'f90)
+(put 'f90-mode-hook 'safe-local-variable
+ (lambda (value) (member value '((f90-add-imenu-menu) nil))))
;; User options end here.
(defconst f90-keywords-re
(regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace"
- "block" "call" "case" "character" "close" "common" "complex"
- "contains" "continue" "cycle" "data" "deallocate"
- "dimension" "do" "double" "else" "elseif" "elsewhere" "end"
- "enddo" "endfile" "endif" "entry" "equivalence" "exit"
- "external" "forall" "format" "function" "goto" "if"
- "implicit" "include" "inquire" "integer" "intent"
- "interface" "intrinsic" "logical" "module" "namelist" "none"
- "nullify" "only" "open" "operator" "optional" "parameter"
- "pause" "pointer" "precision" "print" "private" "procedure"
- "program" "public" "read" "real" "recursive" "result" "return"
- "rewind" "save" "select" "sequence" "stop" "subroutine"
- "target" "then" "type" "use" "where" "while" "write"
- ;; F95 keywords.
- "elemental" "pure") 'words)
+ "block" "call" "case" "character" "close" "common" "complex"
+ "contains" "continue" "cycle" "data" "deallocate"
+ "dimension" "do" "double" "else" "elseif" "elsewhere" "end"
+ "enddo" "endfile" "endif" "entry" "equivalence" "exit"
+ "external" "forall" "format" "function" "goto" "if"
+ "implicit" "include" "inquire" "integer" "intent"
+ "interface" "intrinsic" "logical" "module" "namelist" "none"
+ "nullify" "only" "open" "operator" "optional" "parameter"
+ "pause" "pointer" "precision" "print" "private" "procedure"
+ "program" "public" "read" "real" "recursive" "result" "return"
+ "rewind" "save" "select" "sequence" "stop" "subroutine"
+ "target" "then" "type" "use" "where" "while" "write"
+ ;; F95 keywords.
+ "elemental" "pure"
+ ;; F2003
+ "abstract" "associate" "asynchronous" "bind" "class"
+ "deferred" "enum" "enumerator" "extends" "extends_type_of"
+ "final" "generic" "import" "non_intrinsic" "non_overridable"
+ "nopass" "pass" "protected" "same_type_as" "value" "volatile"
+ ) 'words)
"Regexp used by the function `f90-change-keywords'.")
(defconst f90-keywords-level-3-re
'("allocatable" "allocate" "assign" "assignment" "backspace"
"close" "deallocate" "dimension" "endfile" "entry" "equivalence"
"external" "inquire" "intent" "intrinsic" "nullify" "only" "open"
+ ;; FIXME operator and assignment should be F2003 procedures?
"operator" "optional" "parameter" "pause" "pointer" "print" "private"
"public" "read" "recursive" "result" "rewind" "save" "select"
"sequence" "target" "write"
;; F95 keywords.
- "elemental" "pure") 'words)
+ "elemental" "pure"
+ ;; F2003. asynchronous separate.
+ "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
+ "nopass" "pass" "protected" "value" "volatile"
+ ) 'words)
"Keyword-regexp for font-lock level >= 3.")
(defconst f90-procedures-re
"sum" "system_clock" "tan" "tanh" "tiny" "transfer"
"transpose" "trim" "ubound" "unpack" "verify"
;; F95 intrinsic functions.
- "null" "cpu_time") t)
+ "null" "cpu_time"
+ ;; F2003.
+ "move_alloc" "command_argument_count" "get_command"
+ "get_command_argument" "get_environment_variable"
+ "selected_char_kind" "wait" "flush" "new_line"
+ "extends" "extends_type_of" "same_type_as" "bind"
+ ;; F2003 ieee_arithmetic intrinsic module.
+ "ieee_support_underflow_control" "ieee_get_underflow_mode"
+ "ieee_set_underflow_mode"
+ ;; F2003 iso_c_binding intrinsic module.
+ "c_loc" "c_funloc" "c_associated" "c_f_pointer"
+ "c_f_procpointer"
+ ) t)
;; A left parenthesis to avoid highlighting non-procedures.
"[ \t]*(")
"Regexp whose first part matches F90 intrinsic procedures.")
"block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words)
"Regexp for all HPF keywords, procedures and directives.")
-;; Highlighting patterns.
+(defconst f90-constants-re
+ (regexp-opt '( ;; F2003 iso_fortran_env constants.
+ "iso_fortran_env"
+ "input_unit" "output_unit" "error_unit"
+ "iostat_end" "iostat_eor"
+ "numeric_storage_size" "character_storage_size"
+ "file_storage_size"
+ ;; F2003 iso_c_binding constants.
+ "iso_c_binding"
+ "c_int" "c_short" "c_long" "c_long_long" "c_signed_char"
+ "c_size_t"
+ "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t"
+ "c_int_least8_t" "c_int_least16_t" "c_int_least32_t"
+ "c_int_least64_t"
+ "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t"
+ "c_int_fast64_t"
+ "c_intmax_t" "c_intptr_t"
+ "c_float" "c_double" "c_long_double"
+ "c_float_complex" "c_double_complex" "c_long_double_complex"
+ "c_bool" "c_char"
+ "c_null_char" "c_alert" "c_backspace" "c_form_feed"
+ "c_new_line" "c_carriage_return" "c_horizontal_tab"
+ "c_vertical_tab"
+ "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr"
+ "ieee_exceptions"
+ "ieee_arithmetic"
+ "ieee_features"
+ ) 'words)
+ "Regexp for Fortran intrinsic constants.")
+
+;; cf f90-looking-at-type-like.
+(defun f90-typedef-matcher (limit)
+ "Search for the start/end of the definition of a derived type, up to LIMIT.
+Set the match data so that subexpression 1,2 are the TYPE, and
+type-name parts, respectively."
+ (let (found l)
+ (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)[ \t]*"
+ limit t)
+ (not (setq found
+ (progn
+ (setq l (match-data))
+ (unless (looking-at "\\(is\\>\\|(\\)")
+ (when (if (looking-at "\\(\\sw+\\)")
+ (goto-char (match-end 0))
+ (re-search-forward
+ "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))
+ ;; 0 is wrong, but we don't use it.
+ (set-match-data
+ (append l (list (match-beginning 1)
+ (match-end 1))))
+ t)))))))
+ found))
(defvar f90-font-lock-keywords-1
(list
;; Special highlighting of "module procedure".
- '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face))
+ '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
;; Highlight definition of derived type.
- '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face))
+;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
+;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face))
+ '(f90-typedef-matcher
+ (1 font-lock-keyword-face) (2 font-lock-function-name-face))
;; Other functions and declarations.
- '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\
+ '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\
subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
- "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
+ ;; F2003.
+ '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\
+\\(\\sw+\\)"
+ (1 font-lock-keyword-face) (2 font-lock-keyword-face)
+ (3 font-lock-function-name-face))
+ "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\|\
+end[ \t]*interface\\)\\>"
+ ;; "abstract interface" is F2003. Must come after previous entry.
+ '("\\<\\(\\(?:abstract[ \t]*\\)?interface\\)\\>"
+ ;; [ \t]*\\(\\(\\sw+\\)[ \t]*[^(]\\)?"
+ ;; (2) messes up "interface operator ()", etc.
+ (1 font-lock-keyword-face))) ;(2 font-lock-function-name-face nil t)))
"This does fairly subdued highlighting of comments and function calls.")
+;; NB not explicitly handling this, yet it seems to work.
+;; type(...) function foo()
+(defun f90-typedec-matcher (limit)
+ "Search for the declaration of variables of derived type, up to LIMIT.
+Set the match data so that subexpression 1,2 are the TYPE(...),
+and variable-name parts, respectively."
+ ;; Matcher functions must return nil only when there are no more
+ ;; matches within the search range.
+ (let (found l)
+ (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t)
+ (not
+ (setq found
+ (condition-case nil
+ (progn
+ ;; Set l after this to just highlight
+ ;; the "type" part.
+ (backward-char 1)
+ ;; Needed for: type( foo(...) ) :: bar
+ (forward-sexp)
+ (setq l (list (match-beginning 0) (point)))
+ (skip-chars-forward " \t")
+ (when
+ (re-search-forward
+ ;; type (foo) bar, qux
+ (if (looking-at "\\sw+")
+ "\\([^&!\n]+\\)"
+ ;; type (foo), stuff :: bar, qux
+ "::[ \t]*\\([^&!\n]+\\)")
+ (line-end-position) t)
+ (set-match-data
+ (append (list (car l) (match-end 1))
+ l (list (match-beginning 1)
+ (match-end 1))))
+ t))
+ (error nil))))))
+ found))
+
(defvar f90-font-lock-keywords-2
(append
f90-font-lock-keywords-1
(list
;; Variable declarations (avoid the real function call).
- '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
-logical\\|double[ \t]*precision\\|*type[ \t]*(\\sw+)\\)\
+ ;; NB by accident (?), this correctly fontifies the "integer" in:
+ ;; integer () function foo ()
+ ;; because "() function foo ()" matches \\3.
+ ;; The "pure" part does not really belong here, but was added to
+ ;; exploit that hack.
+ ;; The "function foo" bit is correctly fontified by keywords-1.
+ ;; TODO ? actually check for balanced parens in that case.
+ '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\
+\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
+enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\)\
\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)"
(1 font-lock-type-face t) (4 font-lock-variable-name-face t))
- ;; do, if, select, where, and forall constructs.
- '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\
+ ;; Derived type/class variables.
+ ;; TODO ? If we just highlighted the "type" part, rather than
+ ;; "type(...)", this could be in the previous expression. And this
+ ;; would be consistent with integer( kind=8 ), etc.
+ '(f90-typedec-matcher
+ (1 font-lock-type-face) (2 font-lock-variable-name-face))
+ ;; "real function foo (args)". Must override previous. Note hack
+ ;; to get "args" unhighlighted again. Might not always be right,
+ ;; but probably better than leaving them as variables.
+ ;; NB not explicitly handling this case:
+ ;; integer( kind=1 ) function foo()
+ ;; thanks to the happy accident described above.
+ ;; Not anchored, so don't need to worry about "pure" etc.
+ '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
+logical\\|double[ \t]*precision\\|\
+\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\
+\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)"
+ (1 font-lock-type-face t) (4 font-lock-keyword-face t)
+ (5 font-lock-function-name-face t) (6 'default t))
+ ;; enum (F2003; cf type in -1).
+ '("\\<\\(enum\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-face))
+ ;; end do, enum (F2003), if, select, where, and forall constructs.
+ '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\
\\([ \t]+\\(\\sw+\\)\\)?"
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\
-do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>"
+do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
+forall\\)\\)\\>"
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
;; Implicit declaration.
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
-\\|logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
+\\|enumerator\\|procedure\\|\
+logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
(1 font-lock-keyword-face) (2 font-lock-type-face))
'("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
- '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
+ ;; F2003 "class default".
+ '("\\<\\(class\\)[ \t]*default" . 1)
+ ;; F2003 "type is" in a "select type" block.
+ '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t))
+ '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
;; Line numbers (lines whose first character after number is letter).
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))))
f90-keywords-level-3-re
f90-operators-re
(list f90-procedures-re '(1 font-lock-keyword-face keep))
- "\\<real\\>" ; avoid overwriting real defs
+ "\\<real\\>" ; avoid overwriting real defs
+ ;; As an attribute, but not as an optional argument.
+ '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1)
))
"Highlights all F90 keywords and intrinsic procedures.")
(defvar f90-font-lock-keywords-4
(append f90-font-lock-keywords-3
- (list f90-hpf-keywords-re))
- "Highlights all F90 and HPF keywords.")
+ (list (cons f90-constants-re 'font-lock-constant-face)
+ f90-hpf-keywords-re))
+ "Highlights all F90 and HPF keywords and constants.")
(defvar f90-font-lock-keywords
f90-font-lock-keywords-2
(defconst f90-blocks-re
(concat "\\(block[ \t]*data\\|"
(regexp-opt '("do" "if" "interface" "function" "module" "program"
- "select" "subroutine" "type" "where" "forall"))
+ "select" "subroutine" "type" "where" "forall"
+ ;; F2003.
+ "enum" "associate"))
"\\)\\>")
"Regexp potentially indicating a \"block\" of F90 code.")
(regexp-opt '("program" "module" "subroutine" "function") 'paren)
"Regexp used to locate the start/end of a \"subprogram\".")
+;; "class is" is F2003.
(defconst f90-else-like-re
- "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)"
- "Regexp matching an ELSE IF, ELSEWHERE, CASE statement.")
+ "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\
+\\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)"
+ "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.")
(defconst f90-end-if-re
(concat "end[ \t]*"
"Regexp matching the end of an IF, SELECT, WHERE, FORALL block.")
(defconst f90-end-type-re
- "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)\\>"
- "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.")
+ "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>"
+ "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.")
+
+(defconst f90-end-associate-re
+ "end[ \t]*associate\\>"
+ "Regexp matching the end of an ASSOCIATE block.")
+;; This is for a TYPE block, not a variable of derived TYPE.
+;; Hence no need to add CLASS for F2003.
(defconst f90-type-def-re
+ ;; type word
+ ;; type :: word
+ ;; type, stuff :: word
+ ;; NOT "type ("
"\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
"Regexp matching the definition of a derived type.")
+(defconst f90-typeis-re
+ "\\<\\(class\\|type\\)[ \t]*is[ \t]*("
+ "Regexp matching a CLASS/TYPE IS statement.")
+
(defconst f90-no-break-re
(regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren)
"Regexp specifying where not to break lines when filling.
(concat "^[ \t0-9]*\\<end[ \t]*"
(regexp-opt '("do" "if" "forall" "function" "interface"
"module" "program" "select" "subroutine"
- "type" "where" ) t)
- "[ \t]*\\sw*")
+ "type" "where" "enum" "associate") t)
+ "\\>")
"Regexp matching the end of an F90 \"block\", from the line start.
Used in the F90 entry in `hs-special-modes-alist'.")
"^[ \t0-9]*" ; statement number
"\\(\\("
"\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label
- "\\(do\\|select[ \t]*case\\|"
+ "\\(do\\|select[ \t]*\\(case\\|type\\)\\|"
;; See comments in fortran-start-block-re for the problems of IF.
"if[ \t]*(\\(.*\\|"
".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
;; Distinguish WHERE block from isolated WHERE.
"\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
"\\|"
- "program\\|interface\\|module\\|type\\|function\\|subroutine"
+ ;; Avoid F2003 "type is" in "select type",
+ ;; and also variables of derived type "type (foo)".
+ ;; "type, foo" must be a block (?).
+ "type[ \t,]\\("
+ "[^i(!\n\"\& \t]\\|" ; not-i(
+ "i[^s!\n\"\& \t]\\|" ; i not-s
+ "is\\sw\\)\\|"
+ ;; "abstract interface" is F2003.
+ "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|"
+ ;; "enum", but not "enumerator".
+ "function\\|subroutine\\|enum[^e]\\|associate"
"\\)"
"[ \t]*")
"Regexp matching the start of an F90 \"block\", from the line start.
\f
;; Imenu support.
+;; FIXME trivial to extend this to enum. Worth it?
+(defun f90-imenu-type-matcher ()
+ "Search backward for the start of a derived type.
+Set subexpression 1 in the match-data to the name of the type."
+ (let (found l)
+ (while (and (re-search-backward "^[ \t0-9]*type[ \t]*" nil t)
+ (not (setq found
+ (save-excursion
+ (goto-char (match-end 0))
+ (unless (looking-at "\\(is\\>\\|(\\)")
+ (or (looking-at "\\(\\sw+\\)")
+ (re-search-forward
+ "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))))))))
+ found))
+
(defvar f90-imenu-generic-expression
(let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
- (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
+ (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")
+ (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]"))
(list
'(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
'("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
- '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
+ (list "Types" 'f90-imenu-type-matcher 1)
+ ;; Does not handle: "type[, stuff] :: foo".
+;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)"
+;;; not-ib not-s)
+;;; 1)
+ ;; Can't get the subexpression numbers to match in the two branches.
+;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s)
+;;; 3)
(list
"Procedures"
(concat
(append element '(nil 0)))))))
'(("`al" "allocate" )
("`ab" "allocatable" )
+ ("`ai" "abstract interface")
("`as" "assignment" )
+ ("`asy" "asynchronous" )
("`ba" "backspace" )
("`bd" "block data" )
("`c" "character" )
("`el" "else" )
("`eli" "else if" )
("`elw" "elsewhere" )
+ ("`em" "elemental" )
+ ("`e" "enumerator" )
("`eq" "equivalence" )
("`ex" "external" )
("`ey" "entry" )
("`pr" "print" )
("`pi" "private" )
("`pm" "program" )
+ ("`pr" "protected" )
("`pu" "public" )
("`r" "real" )
("`rc" "recursive" )
("`ta" "target" )
("`tr" ".true." )
("`t" "type" )
+ ("`vo" "volatile" )
("`wh" "where" )
("`wr" "write" ))))
`f90-do-indent'
Extra indentation within do blocks (default 3).
`f90-if-indent'
- Extra indentation within if/select case/where/forall blocks (default 3).
+ Extra indentation within if/select/where/forall blocks (default 3).
`f90-type-indent'
- Extra indentation within type/interface/block-data blocks (default 3).
+ Extra indentation within type/enum/interface/block-data blocks (default 3).
`f90-program-indent'
Extra indentation within program/module/subroutine/function blocks
(default 2).
Checks from `point-min', or `f90-cache-position', if that is non-nil
and lies before point."
(let ((beg-pnt
- (if (and f90-cache-position (> (point) f90-cache-position))
- f90-cache-position
- (point-min))))
+ (if (and f90-cache-position (> (point) f90-cache-position))
+ f90-cache-position
+ (point-min))))
(nth 3 (parse-partial-sexp beg-pnt (point)))))
(defsubst f90-in-comment ()
Checks from `point-min', or `f90-cache-position', if that is non-nil
and lies before point."
(let ((beg-pnt
- (if (and f90-cache-position (> (point) f90-cache-position))
- f90-cache-position
- (point-min))))
+ (if (and f90-cache-position (> (point) f90-cache-position))
+ f90-cache-position
+ (point-min))))
(nth 4 (parse-partial-sexp beg-pnt (point)))))
(defsubst f90-line-continued ()
(list (match-string 3) (match-string 2))))
(defsubst f90-looking-at-select-case ()
- "Return (\"select\" NAME) if a select-case statement starts after point.
+ "Return (\"select\" NAME) if a select statement starts after point.
NAME is nil if the statement has no label."
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
-\\(select\\)[ \t]*case[ \t]*(")
+\\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(")
(list (match-string 3) (match-string 2))))
(defsubst f90-looking-at-if-then ()
(looking-at "then\\>")))
(list struct label))))))
+;; FIXME label?
+(defsubst f90-looking-at-associate ()
+ "Return (\"associate\") if an associate block starts after point."
+ (if (looking-at "\\<\\(associate\\)[ \t]*(")
+ (list (match-string 1))))
+
(defsubst f90-looking-at-where-or-forall ()
"Return (KIND NAME) if a where or forall block starts after point.
NAME is nil if the statement has no label."
(if (looking-at "\\(!\\|$\\)") (list struct label))))))
(defsubst f90-looking-at-type-like ()
- "Return (KIND NAME) if a type/interface/block-data block starts after point.
+ "Return (KIND NAME) if a type/enum/interface/block-data starts after point.
NAME is non-nil only for type."
(cond
- ((looking-at f90-type-def-re)
- (list (match-string 1) (match-string 2)))
- ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
+ ((save-excursion
+ (and (looking-at "\\<type[ \t]*")
+ (goto-char (match-end 0))
+ (not (looking-at "\\(is\\>\\|(\\)"))
+ (or (looking-at "\\(\\sw+\\)")
+ (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)"
+ (line-end-position) t))))
+ (list "type" (match-string 1)))
+;;; ((and (not (looking-at f90-typeis-re))
+;;; (looking-at f90-type-def-re))
+;;; (list (match-string 1) (match-string 2)))
+ ((looking-at "\\(enum\\|interface\\|block[ \t]*data\\)\\>")
+ (list (match-string 1) nil))
+ ((looking-at "abstract[ \t]*\\(interface\\)\\>")
(list (match-string 1) nil))))
(defsubst f90-looking-at-program-block-start ()
((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
(list (match-string 1) (match-string 2)))
((and (not (looking-at "module[ \t]*procedure\\>"))
- (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
+ (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
(list (match-string 1) (match-string 2)))
((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
- (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
+ (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
\\(\\sw+\\)"))
(list (match-string 1) (match-string 2)))))
;; Following will match an un-named main program block; however
(defsubst f90-looking-at-program-block-end ()
"Return (KIND NAME) if a block with name NAME ends after point."
(if (looking-at (concat "end[ \t]*" f90-blocks-re
- "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
+ "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
(list (match-string 1) (match-string 3))))
(defsubst f90-comment-indent ()
`f90-indented-comment-re' (if not trailing code) calls `f90-calculate-indent'.
All others return `comment-column', leaving at least one space after code."
(cond ((looking-at "!!!") 0)
- ((and f90-directive-comment-re
- (looking-at f90-directive-comment-re)) 0)
- ((looking-at (regexp-quote f90-comment-region)) 0)
- ((and (looking-at f90-indented-comment-re)
- ;; Don't attempt to indent trailing comment as code.
- (save-excursion
- (skip-chars-backward " \t")
- (bolp)))
- (f90-calculate-indent))
- (t (save-excursion
+ ((and f90-directive-comment-re
+ (looking-at f90-directive-comment-re)) 0)
+ ((looking-at (regexp-quote f90-comment-region)) 0)
+ ((and (looking-at f90-indented-comment-re)
+ ;; Don't attempt to indent trailing comment as code.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+ (f90-calculate-indent))
+ (t (save-excursion
(skip-chars-backward " \t")
(max (if (bolp) 0 (1+ (current-column))) comment-column)))))
(setq pcont (if (f90-previous-statement) (f90-line-continued))))
(setq cont (f90-line-continued))
(cond ((and (not pcont) (not cont)) 'single)
- ((and (not pcont) cont) 'begin)
- ((and pcont (not cont)) 'end)
- ((and pcont cont) 'middle)
- (t (error "The impossible occurred")))))
+ ((and (not pcont) cont) 'begin)
+ ((and pcont (not cont)) 'end)
+ ((and pcont cont) 'middle)
+ (t (error "The impossible occurred")))))
(defsubst f90-indent-line-no ()
"If `f90-leave-line-no' is nil, left-justify a line number.
(save-excursion
(not (or (looking-at "end")
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
-\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
- (looking-at "\\(program\\|module\\|interface\\|\
-block[ \t]*data\\)\\>")
+\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>")
+ (looking-at "\\(program\\|module\\|\
+\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>")
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
(looking-at f90-type-def-re)
(re-search-forward "\\(function\\|subroutine\\)"
(let ((epnt (line-end-position)) icol cont)
(save-excursion
(while (and (f90-previous-statement)
- (or (progn
- (setq cont (f90-present-statement-cont))
- (or (eq cont 'end) (eq cont 'middle)))
- (looking-at "[ \t]*[0-9]"))))
+ (or (progn
+ (setq cont (f90-present-statement-cont))
+ (or (eq cont 'end) (eq cont 'middle)))
+ (looking-at "[ \t]*[0-9]"))))
(setq icol (current-indentation))
(beginning-of-line)
(when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
((or (f90-looking-at-if-then)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
- (setq icol (+ icol f90-if-indent))))
+ (setq icol (+ icol f90-if-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent))))
(end-of-line))
(while (re-search-forward
- "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
- (beginning-of-line)
+ "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
+ (beginning-of-line)
(skip-chars-forward " \t0-9")
- (cond ((f90-looking-at-do)
+ (cond ((f90-looking-at-do)
(setq icol (+ icol f90-do-indent)))
((or (f90-looking-at-if-then)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case))
(setq icol (+ icol f90-if-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent)))
((looking-at f90-end-if-re)
(setq icol (- icol f90-if-indent)))
+ ((looking-at f90-end-associate-re)
+ (setq icol (- icol f90-associate-indent)))
((looking-at "end[ \t]*do\\>")
(setq icol (- icol f90-do-indent))))
- (end-of-line))
+ (end-of-line))
icol)))
(defun f90-calculate-indent ()
(if (not (f90-previous-statement))
;; If f90-previous-statement returns nil, we must have been
;; called from on or before the first line of the first statement.
- (setq icol (if (save-excursion
+ (setq icol (if (save-excursion
;; f90-previous-statement has moved us over
;; comment/blank lines, so we need to get
;; back to the first code statement.
0
;; No explicit PROGRAM start statement.
f90-program-indent))
- (setq cont (f90-present-statement-cont))
- (if (eq cont 'end)
- (while (not (eq 'begin (f90-present-statement-cont)))
- (f90-previous-statement)))
- (cond ((eq cont 'begin)
- (setq icol (+ (f90-current-indentation)
- f90-continuation-indent)))
- ((eq cont 'middle) (setq icol (current-indentation)))
- (t (setq icol (f90-current-indentation))
- (skip-chars-forward " \t")
- (if (looking-at "[0-9]")
- (setq icol (f90-get-correct-indent))
- (cond ((or (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)
- (f90-looking-at-select-case)
- (looking-at f90-else-like-re))
- (setq icol (+ icol f90-if-indent)))
- ((f90-looking-at-do)
- (setq icol (+ icol f90-do-indent)))
- ((f90-looking-at-type-like)
- (setq icol (+ icol f90-type-indent)))
- ((or (f90-looking-at-program-block-start)
- (looking-at "contains[ \t]*\\($\\|!\\)"))
- (setq icol (+ icol f90-program-indent)))))
- (goto-char pnt)
- (beginning-of-line)
- (cond ((looking-at "[ \t]*$"))
- ((looking-at "[ \t]*#") ; check for cpp directive
- (setq icol 0))
- (t
- (skip-chars-forward " \t0-9")
- (cond ((or (looking-at f90-else-like-re)
- (looking-at f90-end-if-re))
- (setq icol (- icol f90-if-indent)))
- ((looking-at "end[ \t]*do\\>")
- (setq icol (- icol f90-do-indent)))
- ((looking-at f90-end-type-re)
- (setq icol (- icol f90-type-indent)))
- ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
- (f90-looking-at-program-block-end))
- (setq icol (- icol f90-program-indent))))))
- ))))
+ (setq cont (f90-present-statement-cont))
+ (if (eq cont 'end)
+ (while (not (eq 'begin (f90-present-statement-cont)))
+ (f90-previous-statement)))
+ (cond ((eq cont 'begin)
+ (setq icol (+ (f90-current-indentation)
+ f90-continuation-indent)))
+ ((eq cont 'middle) (setq icol (current-indentation)))
+ (t (setq icol (f90-current-indentation))
+ (skip-chars-forward " \t")
+ (if (looking-at "[0-9]")
+ (setq icol (f90-get-correct-indent))
+ (cond ((or (f90-looking-at-if-then)
+ (f90-looking-at-where-or-forall)
+ (f90-looking-at-select-case)
+ (looking-at f90-else-like-re))
+ (setq icol (+ icol f90-if-indent)))
+ ((f90-looking-at-do)
+ (setq icol (+ icol f90-do-indent)))
+ ((f90-looking-at-type-like)
+ (setq icol (+ icol f90-type-indent)))
+ ((f90-looking-at-associate)
+ (setq icol (+ icol f90-associate-indent)))
+ ((or (f90-looking-at-program-block-start)
+ (looking-at "contains[ \t]*\\($\\|!\\)"))
+ (setq icol (+ icol f90-program-indent)))))
+ (goto-char pnt)
+ (beginning-of-line)
+ (cond ((looking-at "[ \t]*$"))
+ ((looking-at "[ \t]*#") ; check for cpp directive
+ (setq icol 0))
+ (t
+ (skip-chars-forward " \t0-9")
+ (cond ((or (looking-at f90-else-like-re)
+ (looking-at f90-end-if-re))
+ (setq icol (- icol f90-if-indent)))
+ ((looking-at "end[ \t]*do\\>")
+ (setq icol (- icol f90-do-indent)))
+ ((looking-at f90-end-type-re)
+ (setq icol (- icol f90-type-indent)))
+ ((looking-at f90-end-associate-re)
+ (setq icol (- icol f90-associate-indent)))
+ ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
+ (f90-looking-at-program-block-end))
+ (setq icol (- icol f90-program-indent))))))
+ ))))
icol))
\f
(defun f90-previous-statement ()
(let (not-first-statement)
(beginning-of-line)
(while (and (setq not-first-statement (zerop (forward-line -1)))
- (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
+ (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
not-first-statement))
(defun f90-next-statement ()
(let (not-last-statement)
(beginning-of-line)
(while (and (setq not-last-statement
- (and (zerop (forward-line 1))
- (not (eobp))))
- (looking-at "[ \t0-9]*\\(!\\|$\\)")))
+ (and (zerop (forward-line 1))
+ (not (eobp))))
+ (looking-at "[ \t0-9]*\\(!\\|$\\)")))
not-last-statement))
(defun f90-beginning-of-subprogram ()
(let ((count 1) (case-fold-search t) matching-beg)
(beginning-of-line)
(while (and (> count 0)
- (re-search-backward f90-program-block-re nil 'move))
+ (re-search-backward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
(cond ((setq matching-beg (f90-looking-at-program-block-start))
(setq count (1+ count)))))
(beginning-of-line)
(if (zerop count)
- matching-beg
+ matching-beg
;; Note this includes the case of an un-named main program,
;; in which case we go to (point-min).
(message "No beginning found.")
Return (TYPE NAME), or nil if not found."
(interactive)
(let ((case-fold-search t)
- (count 1)
+ (count 1)
matching-end)
(end-of-line)
(while (and (> count 0)
- (re-search-forward f90-program-block-re nil 'move))
+ (re-search-forward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
(cond ((f90-looking-at-program-block-start)
- (setq count (1+ count)))
- ((setq matching-end (f90-looking-at-program-block-end))
- (setq count (1- count))))
+ (setq count (1+ count)))
+ ((setq matching-end (f90-looking-at-program-block-end))
+ (setq count (1- count))))
(end-of-line))
;; This means f90-end-of-subprogram followed by f90-start-of-subprogram
;; has a net non-zero effect, which seems odd.
;;; (forward-line 1)
(if (zerop count)
- matching-end
+ matching-end
(message "No end found.")
nil)))
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall))
(goto-char beg-region)
(beginning-of-line)
(if (looking-at (regexp-quote f90-comment-region))
- (delete-region (point) (match-end 0))
+ (delete-region (point) (match-end 0))
(insert f90-comment-region))
(while (and (zerop (forward-line 1))
- (< (point) end))
+ (< (point) end))
(if (looking-at (regexp-quote f90-comment-region))
- (delete-region (point) (match-end 0))
- (insert f90-comment-region)))
+ (delete-region (point) (match-end 0))
+ (insert f90-comment-region)))
(set-marker end nil)))
(defun f90-indent-line (&optional no-update)
(setq no-line-number t)
(skip-chars-forward " \t"))
(if (looking-at "!")
- (setq indent (f90-comment-indent))
+ (setq indent (f90-comment-indent))
(and f90-smart-end (looking-at "end")
(f90-match-end))
(setq indent (f90-calculate-indent)))
(beginning-of-line) ; reindent where likely to be needed
(f90-indent-line) ; calls indent-line-no, update-line
(end-of-line)
- (delete-horizontal-space) ; destroy trailing whitespace
+ (delete-horizontal-space) ; destroy trailing whitespace
(let ((string (f90-in-string))
(cont (f90-line-continued)))
(and string (not cont) (insert "&"))
(let ((end-region-mark (copy-marker end-region))
(save-point (point-marker))
(case-fold-search t)
- block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct)
+ block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct)
(goto-char beg-region)
;; First find a line which is not a continuation line or comment.
(beginning-of-line)
(while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)")
- (progn (f90-indent-line 'no-update)
- (zerop (forward-line 1)))
- (< (point) end-region-mark)))
+ (progn (f90-indent-line 'no-update)
+ (zerop (forward-line 1)))
+ (< (point) end-region-mark)))
(setq cont (f90-present-statement-cont))
(while (and (or (eq cont 'middle) (eq cont 'end))
- (f90-previous-statement))
+ (f90-previous-statement))
(setq cont (f90-present-statement-cont)))
;; Process present line for beginning of block.
(setq f90-cache-position (point))
(skip-chars-forward " \t0-9")
(setq struct nil
ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
- ((or (setq struct (f90-looking-at-if-then))
- (setq struct (f90-looking-at-select-case))
- (setq struct (f90-looking-at-where-or-forall))
- (looking-at f90-else-like-re))
- f90-if-indent)
- ((setq struct (f90-looking-at-type-like))
- f90-type-indent)
- ((or (setq struct (f90-looking-at-program-block-start))
+ ((or (setq struct (f90-looking-at-if-then))
+ (setq struct (f90-looking-at-select-case))
+ (setq struct (f90-looking-at-where-or-forall))
+ (looking-at f90-else-like-re))
+ f90-if-indent)
+ ((setq struct (f90-looking-at-type-like))
+ f90-type-indent)
+ ((setq struct (f90-looking-at-associate))
+ f90-associate-indent)
+ ((or (setq struct (f90-looking-at-program-block-start))
(looking-at "contains[ \t]*\\($\\|!\\)"))
- f90-program-indent)))
+ f90-program-indent)))
(if ind-b (setq ind-lev (+ ind-lev ind-b)))
(if struct (setq block-list (cons struct block-list)))
(while (and (f90-line-continued) (zerop (forward-line 1))
- (< (point) end-region-mark))
+ (< (point) end-region-mark))
(if (looking-at "[ \t]*!")
(f90-indent-to (f90-comment-indent))
(or (= (current-indentation)
(f90-indent-line-no)
(setq f90-cache-position (point))
(cond ((looking-at "[ \t]*$") (setq ind-curr 0))
- ((looking-at "[ \t]*#") (setq ind-curr 0))
- ((looking-at "!") (setq ind-curr (f90-comment-indent)))
- ((f90-no-block-limit) (setq ind-curr ind-lev))
- ((looking-at f90-else-like-re) (setq ind-curr
- (- ind-lev f90-if-indent)))
- ((looking-at "contains[ \t]*\\($\\|!\\)")
- (setq ind-curr (- ind-lev f90-program-indent)))
- ((setq ind-b
- (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
- ((or (setq struct (f90-looking-at-if-then))
- (setq struct (f90-looking-at-select-case))
- (setq struct (f90-looking-at-where-or-forall)))
- f90-if-indent)
- ((setq struct (f90-looking-at-type-like))
- f90-type-indent)
- ((setq struct (f90-looking-at-program-block-start))
- f90-program-indent)))
- (setq ind-curr ind-lev)
- (if ind-b (setq ind-lev (+ ind-lev ind-b)))
- (setq block-list (cons struct block-list)))
- ((setq end-struct (f90-looking-at-program-block-end))
- (setq beg-struct (car block-list)
- block-list (cdr block-list))
- (if f90-smart-end
- (save-excursion
- (f90-block-match (car beg-struct) (car (cdr beg-struct))
- (car end-struct) (car (cdr end-struct)))))
- (setq ind-b
- (cond ((looking-at f90-end-if-re) f90-if-indent)
- ((looking-at "end[ \t]*do\\>") f90-do-indent)
- ((looking-at f90-end-type-re) f90-type-indent)
- ((f90-looking-at-program-block-end)
- f90-program-indent)))
- (if ind-b (setq ind-lev (- ind-lev ind-b)))
- (setq ind-curr ind-lev))
- (t (setq ind-curr ind-lev)))
+ ((looking-at "[ \t]*#") (setq ind-curr 0))
+ ((looking-at "!") (setq ind-curr (f90-comment-indent)))
+ ((f90-no-block-limit) (setq ind-curr ind-lev))
+ ((looking-at f90-else-like-re) (setq ind-curr
+ (- ind-lev f90-if-indent)))
+ ((looking-at "contains[ \t]*\\($\\|!\\)")
+ (setq ind-curr (- ind-lev f90-program-indent)))
+ ((setq ind-b
+ (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
+ ((or (setq struct (f90-looking-at-if-then))
+ (setq struct (f90-looking-at-select-case))
+ (setq struct (f90-looking-at-where-or-forall)))
+ f90-if-indent)
+ ((setq struct (f90-looking-at-type-like))
+ f90-type-indent)
+ ((setq struct (f90-looking-at-associate))
+ f90-associate-indent)
+ ((setq struct (f90-looking-at-program-block-start))
+ f90-program-indent)))
+ (setq ind-curr ind-lev)
+ (if ind-b (setq ind-lev (+ ind-lev ind-b)))
+ (setq block-list (cons struct block-list)))
+ ((setq end-struct (f90-looking-at-program-block-end))
+ (setq beg-struct (car block-list)
+ block-list (cdr block-list))
+ (if f90-smart-end
+ (save-excursion
+ (f90-block-match (car beg-struct) (car (cdr beg-struct))
+ (car end-struct) (car (cdr end-struct)))))
+ (setq ind-b
+ (cond ((looking-at f90-end-if-re) f90-if-indent)
+ ((looking-at "end[ \t]*do\\>") f90-do-indent)
+ ((looking-at f90-end-type-re) f90-type-indent)
+ ((looking-at f90-end-associate-re)
+ f90-associate-indent)
+ ((f90-looking-at-program-block-end)
+ f90-program-indent)))
+ (if ind-b (setq ind-lev (- ind-lev ind-b)))
+ (setq ind-curr ind-lev))
+ (t (setq ind-curr ind-lev)))
;; Do the indentation if necessary.
(or (= ind-curr (current-column))
- (f90-indent-to ind-curr))
+ (f90-indent-to ind-curr))
(while (and (f90-line-continued) (zerop (forward-line 1))
- (< (point) end-region-mark))
+ (< (point) end-region-mark))
(if (looking-at "[ \t]*!")
(f90-indent-to (f90-comment-indent))
(or (= (current-indentation)
(set-marker end-region-mark nil)
(set-marker save-point nil)
(if (fboundp 'zmacs-deactivate-region)
- (zmacs-deactivate-region)
+ (zmacs-deactivate-region)
(deactivate-mark))))
(defun f90-indent-subprogram ()
(save-excursion
(let ((program (f90-mark-subprogram)))
(if program
- (progn
- (message "Indenting %s %s..."
- (car program) (car (cdr program)))
- (indent-region (point) (mark) nil)
- (message "Indenting %s %s...done"
- (car program) (car (cdr program))))
- (message "Indenting the whole file...")
- (indent-region (point) (mark) nil)
- (message "Indenting the whole file...done")))))
+ (progn
+ (message "Indenting %s %s..."
+ (car program) (car (cdr program)))
+ (indent-region (point) (mark) nil)
+ (message "Indenting %s %s...done"
+ (car program) (car (cdr program))))
+ (message "Indenting the whole file...")
+ (indent-region (point) (mark) nil)
+ (message "Indenting the whole file...done")))))
(defun f90-break-line (&optional no-update)
"Break line at point, insert continuation marker(s) and indent.
(interactive "*r")
(let ((end-region-mark (copy-marker end-region))
(go-on t)
- f90-smart-end f90-auto-keyword-case auto-fill-function)
+ f90-smart-end f90-auto-keyword-case auto-fill-function)
(goto-char beg-region)
(while go-on
;; Join as much as possible.
(f90-join-lines 'forward))
;; Chop the line if necessary.
(while (> (save-excursion (end-of-line) (current-column))
- fill-column)
- (move-to-column fill-column)
- (f90-find-breakpoint)
- (f90-break-line 'no-update))
+ fill-column)
+ (move-to-column fill-column)
+ (f90-find-breakpoint)
+ (f90-break-line 'no-update))
(setq go-on (and (< (point) end-region-mark)
(zerop (forward-line 1)))
f90-cache-position (point)))
(setq f90-cache-position nil)
(set-marker end-region-mark nil)
(if (fboundp 'zmacs-deactivate-region)
- (zmacs-deactivate-region)
+ (zmacs-deactivate-region)
(deactivate-mark))))
\f
(defun f90-block-match (beg-block beg-name end-block end-name)
(interactive)
(let ((count 1)
(top-of-window (window-start))
- (end-point (point))
+ (end-point (point))
(case-fold-search t)
- matching-beg beg-name end-name beg-block end-block end-struct)
+ matching-beg beg-name end-name beg-block end-block end-struct)
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
(setq end-struct (f90-looking-at-program-block-end)))
(setq end-block (car end-struct)
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
+ (f90-looking-at-associate)
(f90-looking-at-program-block-start)
;; Interpret a single END without a block
;; start to be the END of a program block
(if (fboundp 'next-command-event) ; XEmacs
(setq event (next-command-event)
char (and (fboundp 'event-to-character)
- (event-to-character event)))
+ (event-to-character event)))
(setq event (read-event)
char event))
;; Insert char if not equal to `?', or if abbrev-mode is off.
(if (and abbrev-mode (or (eq char ??) (eq char help-char)))
- (f90-abbrev-help)
+ (f90-abbrev-help)
(setq unread-command-events (list event)))))
(defun f90-abbrev-help ()
(setq beg (or beg (point-min))
end (or end (point-max)))
(let ((keyword-re
- (concat "\\("
- f90-keywords-re "\\|" f90-procedures-re "\\|"
- f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
- (ref-point (point-min))
- (modified (buffer-modified-p))
+ (concat "\\("
+ f90-keywords-re "\\|" f90-procedures-re "\\|"
+ f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
+ (ref-point (point-min))
+ (modified (buffer-modified-p))
state saveword back-point)
(goto-char beg)
(unwind-protect
- (while (re-search-forward keyword-re end t)
- (unless (progn
+ (while (re-search-forward keyword-re end t)
+ (unless (progn
(setq state (parse-partial-sexp ref-point (point)))
(or (nth 3 state) (nth 4 state)
;; GM f90-directive-comment-re?
(beginning-of-line)
(skip-chars-forward " \t0-9")
(looking-at "#"))))
- (setq ref-point (point)
- back-point (save-excursion (backward-word 1) (point))
+ (setq ref-point (point)
+ back-point (save-excursion (backward-word 1) (point))
saveword (buffer-substring back-point ref-point))
- (funcall change-word -1)
- (or (string= saveword (buffer-substring back-point ref-point))
- (setq modified t))))
- (or modified (set-buffer-modified-p nil))))))
+ (funcall change-word -1)
+ (or (string= saveword (buffer-substring back-point ref-point))
+ (setq modified t))))
+ (or modified (set-buffer-modified-p nil))))))
(defun f90-current-defun ()
with a character in column 6."
:type 'boolean
:group 'fortran-indent)
+(put 'fortran-tab-mode-default 'safe-local-variable 'booleanp)
;; TODO add more detail of what tab mode is to doc string.
(defcustom fortran-tab-mode-string
"String to appear in mode line in TAB format buffers."
:type 'string
:group 'fortran-indent)
-
-(put 'fortran-tab-mode-string 'risky-local-variable t)
+(put 'fortran-tab-mode-string 'safe-local-variable 'stringp)
(defcustom fortran-do-indent 3
"Extra indentation applied to DO blocks."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-do-indent 'safe-local-variable 'integerp)
(defcustom fortran-if-indent 3
"Extra indentation applied to IF, SELECT CASE and WHERE blocks."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-if-indent 'safe-local-variable 'integerp)
(defcustom fortran-structure-indent 3
"Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-structure-indent 'safe-local-variable 'integerp)
(defcustom fortran-continuation-indent 5
"Extra indentation applied to continuation lines."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-continuation-indent 'safe-local-variable 'integerp)
(defcustom fortran-comment-indent-style 'fixed
"How to indent comments.
`fortran-comment-line-extra-indent'."
:type '(radio (const :tag "Untouched" nil) (const fixed) (const relative))
:group 'fortran-indent)
+(put 'fortran-comment-indent 'safe-local-variable
+ (lambda (value) (memq value '(nil fixed relative))))
(defcustom fortran-comment-line-extra-indent 0
"Amount of extra indentation for text within full-line comments."
:type 'integer
:group 'fortran-indent
:group 'fortran-comment)
+(put 'fortran-comment-line-extra-indent 'safe-local-variable 'integerp)
(defcustom fortran-comment-line-start "C"
"Delimiter inserted to start new full-line comment.
:version "21.1"
:type 'string
:group 'fortran-comment)
+(put 'fortran-comment-line-start 'safe-local-variable 'stringp)
;; This used to match preprocessor lines too, but that messes up
;; filling and doesn't seem to be necessary.
:version "21.1"
:type 'regexp
:group 'fortran-comment)
+(put 'fortran-comment-line-start-skip 'safe-local-variable 'stringp)
(defcustom fortran-directive-re
"^[ \t]*#.*"
:version "22.1"
:type 'regexp
:group 'fortran-indent)
+(put 'fortran-directive-re 'safe-local-variable 'stringp)
(defcustom fortran-minimum-statement-indent-fixed 6
"Minimum statement indentation for fixed format continuation style."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-minimum-statement-indent-fixed 'safe-local-variable 'integerp)
(defcustom fortran-minimum-statement-indent-tab (max tab-width 6)
"Minimum statement indentation for TAB format continuation style."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-minimum-statement-indent-tab 'safe-local-variable 'integerp)
;; Note that this is documented in the v18 manuals as being a string
;; of length one rather than a single character.
Normally a space."
:type 'string
:group 'fortran-comment)
+(put 'fortran-comment-indent-char 'safe-local-variable
+ (lambda (value) (or (char-valid-p value)
+ (and (stringp value)
+ (= (length value) 1)))))
(defcustom fortran-line-number-indent 1
"Maximum indentation for Fortran line numbers.
5 means right-justify them within their five-column field."
:type 'integer
:group 'fortran-indent)
+(put 'fortran-line-number-indent 'safe-local-variable 'integerp)
(defcustom fortran-check-all-num-for-matching-do nil
"Non-nil causes all numbered lines to be treated as possible DO loop ends."
:type 'boolean
:group 'fortran)
+(put 'fortran-check-all-num-for-matching-do 'safe-local-variable 'booleanp)
(defcustom fortran-blink-matching-if nil
"Non-nil causes \\[fortran-indent-line] on ENDIF to blink on matching IF.
Also, from an ENDDO statement blink on matching DO [WHILE] statement."
:type 'boolean
:group 'fortran)
+(put 'fortran-blink-matching-if 'safe-local-variable 'booleanp)
(defcustom fortran-continuation-string "$"
"Single-character string used for Fortran continuation lines.
appropriate style. Normally $."
:type 'string
:group 'fortran)
+(put 'fortran-continuation-string 'safe-local-variable
+ (lambda (value) (and (stringp value)
+ (= (length value) 1))))
(defcustom fortran-comment-region "c$$$"
"String inserted by \\[fortran-comment-region] at start of each \
line in region."
:type 'string
:group 'fortran-comment)
+(put 'fortran-comment-region 'safe-local-variable 'stringp)
(defcustom fortran-electric-line-number t
"Non-nil causes line numbers to be moved to the correct column as typed."
:type 'boolean
:group 'fortran)
+(put 'fortran-electric-line-number 'safe-local-variable 'booleanp)
;; TODO use fortran-line-length, somehow.
(defcustom fortran-column-ruler-fixed
See the variable `fortran-column-ruler-tab' for TAB format mode."
:type 'string
:group 'fortran)
+(put 'fortran-column-ruler-fixed 'safe-local-variable 'stringp)
;; TODO use fortran-line-length, somehow.
(defcustom fortran-column-ruler-tab
See the variable `fortran-column-ruler-fixed' for fixed format mode."
:type 'string
:group 'fortran)
+(put 'fortran-column-ruler-tab 'safe-local-variable 'stringp)
(defcustom fortran-analyze-depth 100
"Number of lines to scan to identify fixed or TAB format style."
:type 'integer
:group 'fortran)
+(put 'fortran-analyze-depth 'safe-local-variable 'integerp)
(defcustom fortran-break-before-delimiters t
"Non-nil causes filling to break lines before delimiters.
Delimiters are characters matching the regexp `fortran-break-delimiters-re'."
:type 'boolean
:group 'fortran)
+(put 'fortran-break-before-delimiters 'safe-local-variable 'booleanp)
;; TODO 0 as no-limit, as per g77.
(defcustom fortran-line-length 72
Used in the Fortran entry in `hs-special-modes-alist'.")
(add-to-list 'hs-special-modes-alist
- `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re
+ `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re
"^[cC*!]" fortran-end-of-block nil))
\f
["72-column window" fortran-window-create t]
["Full Width Window"
(enlarge-window-horizontally (- (frame-width) (window-width)))
- (< (window-width) (frame-width))]
+ (not (window-full-width-p))]
["Momentary 72-column window" fortran-window-create-momentarily t]
"--"
["Break Line at Point" fortran-split-line t]
`fortran-minimum-statement-indent-tab' (TAB format),
depending on the continuation format in use.
relative indent to `fortran-comment-line-extra-indent' beyond the
- indentation for a line of code.
+ indentation for a line of code.
(default 'fixed)
`fortran-comment-indent-char'
Single-character string to be inserted instead of space for
(beginning-of-line)
;; Recognize existing comments of either kind.
(cond ((fortran-find-comment-start-skip 'all)
- (goto-char (match-beginning 0))
- (if (bolp)
- (fortran-indent-line)
- (unless (= (current-column) (fortran-comment-indent))
+ (goto-char (match-beginning 0))
+ (if (bolp)
+ (fortran-indent-line)
+ (unless (= (current-column) (fortran-comment-indent))
(delete-horizontal-space)
(indent-to (fortran-comment-indent)))))
- ;; No existing comment.
- ;; If side-by-side comments are defined, insert one,
- ;; unless line is now blank.
- ((and comment-start (not (looking-at "[ \t]*$"))
- (string-match comment-start-skip (concat " " comment-start)))
- (end-of-line)
- (delete-horizontal-space)
- (indent-to (fortran-comment-indent))
- (insert comment-start))
- ;; Else insert separate-line comment, making a new line if nec.
- (t
- (if (looking-at "^[ \t]*$")
- (delete-horizontal-space)
- (beginning-of-line)
- (insert ?\n)
- (forward-char -1))
- (insert fortran-comment-line-start)
- (insert-char (if (stringp fortran-comment-indent-char)
- (aref fortran-comment-indent-char 0)
- fortran-comment-indent-char)
- (- (fortran-calculate-indent) (current-column))))))
+ ;; No existing comment.
+ ;; If side-by-side comments are defined, insert one,
+ ;; unless line is now blank.
+ ((and comment-start (not (looking-at "[ \t]*$"))
+ (string-match comment-start-skip (concat " " comment-start)))
+ (end-of-line)
+ (delete-horizontal-space)
+ (indent-to (fortran-comment-indent))
+ (insert comment-start))
+ ;; Else insert separate-line comment, making a new line if nec.
+ (t
+ (if (looking-at "^[ \t]*$")
+ (delete-horizontal-space)
+ (beginning-of-line)
+ (insert ?\n)
+ (forward-char -1))
+ (insert fortran-comment-line-start)
+ (insert-char (if (stringp fortran-comment-indent-char)
+ (aref fortran-comment-indent-char 0)
+ fortran-comment-indent-char)
+ (- (fortran-calculate-indent) (current-column))))))
(defun fortran-comment-region (beg-region end-region arg)
"Comment every line in the region.
With non-nil ARG, uncomments the region."
(interactive "*r\nP")
(let ((end-region-mark (copy-marker end-region))
- (save-point (point-marker)))
+ (save-point (point-marker)))
(goto-char beg-region)
(beginning-of-line)
(if arg
;; Insert char if not equal to `?', or if abbrev-mode is off.
(if (and abbrev-mode (or (eq char ??) (eq char help-char)
(memq event help-event-list)))
- (fortran-abbrev-help)
+ (fortran-abbrev-help)
(push event unread-command-events))))
(defun fortran-abbrev-help ()
(save-excursion
(beginning-of-line)
(if (eq (window-start (selected-window))
- (window-point (selected-window)))
- (line-beginning-position 2)
+ (window-point (selected-window)))
+ (line-beginning-position 2)
(point)))
nil "Type SPC or any command to erase ruler."))
See also `fortran-window-create-momentarily'."
(interactive)
(let ((window-min-width 2))
- (if (< (window-width) (frame-width))
- (enlarge-window-horizontally (- (frame-width)
- (window-width) 1)))
+ (unless (window-full-width-p)
+ (enlarge-window-horizontally (- (frame-width)
+ (window-width) 1)))
(let* ((window-edges (window-edges))
- (scroll-bar-width (- (nth 2 window-edges)
- (car window-edges)
- (window-width))))
+ (scroll-bar-width (- (nth 2 window-edges)
+ (car window-edges)
+ (window-width))))
(split-window-horizontally (+ fortran-line-length scroll-bar-width)))
(other-window 1)
(switch-to-buffer " fortran-window-extra" t)
See also `fortran-window-create'."
(interactive "p")
(if (or (not arg)
- (= arg 1))
+ (= arg 1))
(save-window-excursion
- (progn
- (condition-case nil
- (fortran-window-create)
- (error (error "No room for Fortran window")))
- (message "Type SPC to continue editing.")
- (let ((char (read-event)))
- (or (equal char ?\s)
- (setq unread-command-events (list char))))))
+ (progn
+ (condition-case nil
+ (fortran-window-create)
+ (error (error "No room for Fortran window")))
+ (message "Type SPC to continue editing.")
+ (let ((char (read-event)))
+ (or (equal char ?\s)
+ (setq unread-command-events (list char))))))
(fortran-window-create)))
(defun fortran-split-line ()
(interactive "*")
(delete-horizontal-space)
(if (save-excursion
- (let ((pos (point)))
- (beginning-of-line)
- (and (fortran-find-comment-start-skip 'all)
- (< (match-beginning 0) pos))))
+ (let ((pos (point)))
+ (beginning-of-line)
+ (and (fortran-find-comment-start-skip 'all)
+ (< (match-beginning 0) pos))))
(insert ?\n (match-string 0))
(if indent-tabs-mode
- (insert ?\n ?\t (fortran-numerical-continuation-char))
+ (insert ?\n ?\t (fortran-numerical-continuation-char))
(insert "\n " fortran-continuation-string))) ; space after \n important
(fortran-indent-line)) ; when cont string is C, c or *
(save-excursion
(forward-line -1)
(if (looking-at "\t[1-9]")
- (+ ?1 (% (- (char-after (1+ (point))) ?0) 9))
+ (+ ?1 (% (- (char-after (1+ (point))) ?0) 9))
?1)))
(put 'fortran-electric-line-number 'delete-selection t)
(interactive "*P")
(if (or arg (not fortran-electric-line-number))
(if arg
- (self-insert-command (prefix-numeric-value arg))
- (self-insert-command 1))
+ (self-insert-command (prefix-numeric-value arg))
+ (self-insert-command 1))
(if (or (and (= 5 (current-column))
- (save-excursion
- (beginning-of-line)
+ (save-excursion
+ (beginning-of-line)
;; In col 5 with only spaces to the left.
- (looking-at " \\{5\\}")))
- (and (= (if indent-tabs-mode
- fortran-minimum-statement-indent-tab
- fortran-minimum-statement-indent-fixed) (current-column))
+ (looking-at " \\{5\\}")))
+ (and (= (if indent-tabs-mode
+ fortran-minimum-statement-indent-tab
+ fortran-minimum-statement-indent-fixed) (current-column))
;; In col 8 with a single tab to the left.
- (eq ?\t (char-after (line-beginning-position)))
- (not (or (eq last-command 'fortran-indent-line)
- (eq last-command
- 'fortran-indent-new-line))))
- (save-excursion
- (re-search-backward "[^ \t0-9]"
- (line-beginning-position)
- t)) ; not a line number
- (looking-at "[0-9]")) ; within a line number
- (self-insert-command (prefix-numeric-value arg))
+ (eq ?\t (char-after (line-beginning-position)))
+ (not (or (eq last-command 'fortran-indent-line)
+ (eq last-command
+ 'fortran-indent-new-line))))
+ (save-excursion
+ (re-search-backward "[^ \t0-9]"
+ (line-beginning-position)
+ t)) ; not a line number
+ (looking-at "[0-9]")) ; within a line number
+ (self-insert-command (prefix-numeric-value arg))
(skip-chars-backward " \t")
(insert last-command-char)
(fortran-indent-line))))
;; match of whitespace, avoiding possible column 73+ stuff.
(save-match-data
(string-match "^\\s-*\\(\\'\\|\\s<\\)"
- (buffer-substring (match-end 0)
- (min (line-end-position)
- (+ fortran-line-length
+ (buffer-substring (match-end 0)
+ (min (line-end-position)
+ (+ fortran-line-length
(line-beginning-position)))))))
;; Note that you can't just check backwards for `subroutine' &c in
(let ((case-fold-search t))
(beginning-of-line -1)
(if (catch 'ok
- (while (re-search-backward fortran-end-prog-re nil 'move)
- (if (fortran-check-end-prog-re)
- (throw 'ok t))))
- (forward-line)))))
+ (while (re-search-backward fortran-end-prog-re nil 'move)
+ (if (fortran-check-end-prog-re)
+ (throw 'ok t))))
+ (forward-line)))))
(defun fortran-end-of-subprogram ()
"Move point to the end of the current Fortran subprogram."
(interactive)
(save-match-data
(let ((case-fold-search t))
- (if (save-excursion ; on END
- (beginning-of-line)
- (and (looking-at fortran-end-prog-re)
- (fortran-check-end-prog-re)))
- (forward-line)
- (beginning-of-line 2)
- (catch 'ok
- (while (re-search-forward fortran-end-prog-re nil 'move)
- (if (fortran-check-end-prog-re)
- (throw 'ok t))))
- (goto-char (match-beginning 0))
- (forward-line)))))
+ (if (save-excursion ; on END
+ (beginning-of-line)
+ (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re)))
+ (forward-line)
+ (beginning-of-line 2)
+ (catch 'ok
+ (while (re-search-forward fortran-end-prog-re nil 'move)
+ (if (fortran-check-end-prog-re)
+ (throw 'ok t))))
+ (goto-char (match-beginning 0))
+ (forward-line)))))
(defun fortran-previous-statement ()
"Move point to beginning of the previous Fortran statement.
(let (not-first-statement continue-test)
(beginning-of-line)
(setq continue-test
- (and
- (not (looking-at fortran-comment-line-start-skip))
+ (and
+ (not (looking-at fortran-comment-line-start-skip))
(not (looking-at fortran-directive-re))
- (or (looking-at
- (concat "[ \t]*"
- (regexp-quote fortran-continuation-string)))
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))))
+ (or (looking-at
+ (concat "[ \t]*"
+ (regexp-quote fortran-continuation-string)))
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))))
(while (and (setq not-first-statement (zerop (forward-line -1)))
- (or (looking-at fortran-comment-line-start-skip)
+ (or (looking-at fortran-comment-line-start-skip)
(looking-at fortran-directive-re)
(looking-at
(concat "[ \t]*"
(regexp-quote fortran-continuation-string)))
- (looking-at "[ \t]*$\\| \\{5\\}[^ 0\n]\\|\t[1-9]")
- (looking-at (concat "[ \t]*" comment-start-skip)))))
+ (looking-at "[ \t]*$\\| \\{5\\}[^ 0\n]\\|\t[1-9]")
+ (looking-at (concat "[ \t]*" comment-start-skip)))))
(cond ((and continue-test
- (not not-first-statement))
- (message "Incomplete continuation statement."))
- (continue-test
- (fortran-previous-statement))
- ((not not-first-statement)
- 'first-statement))))
+ (not not-first-statement))
+ (message "Incomplete continuation statement."))
+ (continue-test
+ (fortran-previous-statement))
+ ((not not-first-statement)
+ 'first-statement))))
(defun fortran-next-statement ()
"Move point to beginning of the next Fortran statement.
(let (not-last-statement)
(beginning-of-line)
(while (and (setq not-last-statement
- (and (zerop (forward-line 1))
- (not (eobp))))
- (or (looking-at fortran-comment-line-start-skip)
+ (and (zerop (forward-line 1))
+ (not (eobp))))
+ (or (looking-at fortran-comment-line-start-skip)
(looking-at fortran-directive-re)
- (looking-at "[ \t]*$\\| [^ 0\n]\\|\t[1-9]")
- (looking-at (concat "[ \t]*" comment-start-skip)))))
+ (looking-at "[ \t]*$\\| [^ 0\n]\\|\t[1-9]")
+ (looking-at (concat "[ \t]*" comment-start-skip)))))
(if (not not-last-statement)
- 'last-statement)))
+ 'last-statement)))
(defun fortran-looking-at-if-then ()
"Return non-nil if at the start of a line with an IF ... THEN statement."
"From a line matching REGEX, blink matching KEYWORD statement line.
Use function FIND-BEGIN to match it."
(let ((top-of-window (window-start))
- (end-point (point))
- (case-fold-search t)
- matching
- message)
+ (end-point (point))
+ (case-fold-search t)
+ matching
+ message)
(when (save-excursion
(beginning-of-line)
(skip-chars-forward " \t0-9")
(defun fortran-blink-matching-if ()
"From an ENDIF or ELSE statement, blink the matching IF statement."
(fortran-blink-match "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b"
- "if" #'fortran-beginning-if))
+ "if" #'fortran-beginning-if))
(defun fortran-blink-matching-do ()
"From an ENDDO statement, blink the matching DO or DO WHILE statement."
Return point or nil."
(let ((case-fold-search t))
(if (save-excursion (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (looking-at "end[ \t]*do\\b"))
- ;; Sitting on one.
- (match-beginning 0)
+ (skip-chars-forward " \t0-9")
+ (looking-at "end[ \t]*do\\b"))
+ ;; Sitting on one.
+ (match-beginning 0)
;; Search for one.
(save-excursion
- (let ((count 1))
- (while (and (not (zerop count))
- (not (eq (fortran-next-statement) 'last-statement))
- ;; Keep local to subprogram.
- (not (and (looking-at fortran-end-prog-re)
- (fortran-check-end-prog-re))))
- (skip-chars-forward " \t0-9")
- (cond ((looking-at "end[ \t]*do\\b")
- (setq count (1- count)))
- ((looking-at
- "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]")
- (setq count (1+ count)))))
- (and (zerop count)
- ;; All pairs accounted for.
- (point)))))))
+ (let ((count 1))
+ (while (and (not (zerop count))
+ (not (eq (fortran-next-statement) 'last-statement))
+ ;; Keep local to subprogram.
+ (not (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at "end[ \t]*do\\b")
+ (setq count (1- count)))
+ ((looking-at
+ "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]")
+ (setq count (1+ count)))))
+ (and (zerop count)
+ ;; All pairs accounted for.
+ (point)))))))
(defun fortran-beginning-do ()
"Search backwards for first unmatched DO [WHILE].
(let ((case-fold-search t)
(dostart-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]"))
(if (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (looking-at dostart-re))
- ;; Sitting on one.
- (match-beginning 0)
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (looking-at dostart-re))
+ ;; Sitting on one.
+ (match-beginning 0)
;; Search for one.
(save-excursion
- (let ((count 1))
- (while (and (not (zerop count))
- (not (eq (fortran-previous-statement) 'first-statement))
- ;; Keep local to subprogram.
- (not (and (looking-at fortran-end-prog-re)
- (fortran-check-end-prog-re))))
- (skip-chars-forward " \t0-9")
- (cond ((looking-at dostart-re)
- (setq count (1- count)))
+ (let ((count 1))
+ (while (and (not (zerop count))
+ (not (eq (fortran-previous-statement) 'first-statement))
+ ;; Keep local to subprogram.
+ (not (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at dostart-re)
+ (setq count (1- count)))
;; Note labelled loop ends not considered.
- ((looking-at "end[ \t]*do\\b")
- (setq count (1+ count)))))
- (and (zerop count)
- ;; All pairs accounted for.
- (point)))))))
+ ((looking-at "end[ \t]*do\\b")
+ (setq count (1+ count)))))
+ (and (zerop count)
+ ;; All pairs accounted for.
+ (point)))))))
(defun fortran-mark-if ()
"Put mark at end of Fortran IF-ENDIF construct, point at beginning.
Return point or nil."
(let ((case-fold-search t))
(if (save-excursion (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (looking-at "end[ \t]*if\\b"))
- ;; Sitting on one.
- (match-beginning 0)
+ (skip-chars-forward " \t0-9")
+ (looking-at "end[ \t]*if\\b"))
+ ;; Sitting on one.
+ (match-beginning 0)
;; Search for one. The point has been already been moved to first
;; letter on line but this should not cause troubles.
(save-excursion
- (let ((count 1))
- (while (and (not (zerop count))
- (not (eq (fortran-next-statement) 'last-statement))
- ;; Keep local to subprogram.
- (not (and (looking-at fortran-end-prog-re)
- (fortran-check-end-prog-re))))
- (skip-chars-forward " \t0-9")
- (cond ((looking-at "end[ \t]*if\\b")
- (setq count (1- count)))
- ((looking-at fortran-if-start-re)
- (save-excursion
- (if (or
- (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
- (let (then-test) ; multi-line if-then
- (while
- (and
- (zerop (forward-line 1))
- ;; Search forward for then.
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
- (not
- (setq then-test
- (looking-at
- ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
- then-test))
- (setq count (1+ count)))))))
- (and (zerop count)
- ;; All pairs accounted for.
- (point)))))))
+ (let ((count 1))
+ (while (and (not (zerop count))
+ (not (eq (fortran-next-statement) 'last-statement))
+ ;; Keep local to subprogram.
+ (not (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at "end[ \t]*if\\b")
+ (setq count (1- count)))
+ ((looking-at fortran-if-start-re)
+ (save-excursion
+ (if (or
+ (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
+ (let (then-test) ; multi-line if-then
+ (while
+ (and
+ (zerop (forward-line 1))
+ ;; Search forward for then.
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
+ (not
+ (setq then-test
+ (looking-at
+ ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
+ then-test))
+ (setq count (1+ count)))))))
+ (and (zerop count)
+ ;; All pairs accounted for.
+ (point)))))))
(defun fortran-beginning-if ()
"Search backwards for first unmatched IF-THEN.
Return point or nil."
(let ((case-fold-search t))
(if (save-excursion
- ;; May be sitting on multi-line if-then statement, first
- ;; move to beginning of current statement. Note:
- ;; `fortran-previous-statement' moves to previous statement
- ;; *unless* current statement is first one. Only move
- ;; forward if not first-statement.
- (if (not (eq (fortran-previous-statement) 'first-statement))
- (fortran-next-statement))
- (skip-chars-forward " \t0-9")
- (and
- (looking-at fortran-if-start-re)
- (save-match-data
- (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
- ;; Multi-line if-then.
- (let (then-test)
- (while
+ ;; May be sitting on multi-line if-then statement, first
+ ;; move to beginning of current statement. Note:
+ ;; `fortran-previous-statement' moves to previous statement
+ ;; *unless* current statement is first one. Only move
+ ;; forward if not first-statement.
+ (if (not (eq (fortran-previous-statement) 'first-statement))
+ (fortran-next-statement))
+ (skip-chars-forward " \t0-9")
+ (and
+ (looking-at fortran-if-start-re)
+ (save-match-data
+ (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
+ ;; Multi-line if-then.
+ (let (then-test)
+ (while
(and (zerop (forward-line 1))
- ;; Search forward for then.
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
- (not
- (setq then-test
- (looking-at
- ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
- then-test)))))
- ;; Sitting on one.
- (match-beginning 0)
+ ;; Search forward for then.
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
+ (not
+ (setq then-test
+ (looking-at
+ ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
+ then-test)))))
+ ;; Sitting on one.
+ (match-beginning 0)
;; Search for one.
(save-excursion
- (let ((count 1))
- (while (and (not (zerop count))
- (not (eq (fortran-previous-statement) 'first-statement))
- ;; Keep local to subprogram.
- (not (and (looking-at fortran-end-prog-re)
- (fortran-check-end-prog-re))))
- (skip-chars-forward " \t0-9")
- (cond ((looking-at fortran-if-start-re)
- (save-excursion
- (if (or
- (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
- (let (then-test) ; multi-line if-then
- (while
- (and
- (zerop (forward-line 1))
- ;; Search forward for then.
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
- (not
- (setq then-test
- (looking-at
- (concat ".*then\\b[ \t]*"
- "[^ \t(=a-z0-9]"))))))
- then-test))
- (setq count (1- count)))))
- ((looking-at "end[ \t]*if\\b")
- (setq count (1+ count)))))
- (and (zerop count)
- ;; All pairs accounted for.
- (point)))))))
+ (let ((count 1))
+ (while (and (not (zerop count))
+ (not (eq (fortran-previous-statement) 'first-statement))
+ ;; Keep local to subprogram.
+ (not (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at fortran-if-start-re)
+ (save-excursion
+ (if (or
+ (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
+ (let (then-test) ; multi-line if-then
+ (while
+ (and
+ (zerop (forward-line 1))
+ ;; Search forward for then.
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
+ (not
+ (setq then-test
+ (looking-at
+ (concat ".*then\\b[ \t]*"
+ "[^ \t(=a-z0-9]"))))))
+ then-test))
+ (setq count (1- count)))))
+ ((looking-at "end[ \t]*if\\b")
+ (setq count (1+ count)))))
+ (and (zerop count)
+ ;; All pairs accounted for.
+ (point)))))))
\f
(defun fortran-indent-line ()
(save-excursion
(beginning-of-line)
(if (or (not (= cfi (fortran-current-line-indentation)))
- (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t)
- (not (fortran-line-number-indented-correctly-p))))
- (fortran-indent-to-column cfi)
- (beginning-of-line)
- (if (fortran-find-comment-start-skip)
- (fortran-indent-comment))))
+ (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t)
+ (not (fortran-line-number-indented-correctly-p))))
+ (fortran-indent-to-column cfi)
+ (beginning-of-line)
+ (if (fortran-find-comment-start-skip)
+ (fortran-indent-comment))))
;; Never leave point in left margin.
(if (< (current-column) cfi)
- (move-to-column cfi))
+ (move-to-column cfi))
(and auto-fill-function
(> (save-excursion (end-of-line) (current-column))
fill-column)
"Function to use for `normal-auto-fill-function' in Fortran mode."
(if (> (current-column) (current-fill-column))
(let ((cfi (fortran-calculate-indent)))
- (save-excursion
- (beginning-of-line)
- (if (or (not (= cfi (fortran-current-line-indentation)))
- (and (re-search-forward "^[ \t]*[0-9]+"
- (+ (point) 4) t)
- (not (fortran-line-number-indented-correctly-p))))
- (fortran-indent-to-column cfi)
- (beginning-of-line)
- (if (fortran-find-comment-start-skip)
- (fortran-indent-comment))))
- (fortran-fill)
- ;; Never leave point in left margin.
- (if (< (current-column) cfi)
- (move-to-column cfi)))))
+ (save-excursion
+ (beginning-of-line)
+ (if (or (not (= cfi (fortran-current-line-indentation)))
+ (and (re-search-forward "^[ \t]*[0-9]+"
+ (+ (point) 4) t)
+ (not (fortran-line-number-indented-correctly-p))))
+ (fortran-indent-to-column cfi)
+ (beginning-of-line)
+ (if (fortran-find-comment-start-skip)
+ (fortran-indent-comment))))
+ (fortran-fill)
+ ;; Never leave point in left margin.
+ (if (< (current-column) cfi)
+ (move-to-column cfi)))))
;; Historically this was a separate function which advertised itself
;; as reindenting but only did so where `most likely to be necessary'.
(defun fortran-calculate-indent ()
"Calculates the Fortran indent column based on previous lines."
(let (icol first-statement (case-fold-search t)
- (fortran-minimum-statement-indent
- (if indent-tabs-mode
- fortran-minimum-statement-indent-tab
- fortran-minimum-statement-indent-fixed)))
+ (fortran-minimum-statement-indent
+ (if indent-tabs-mode
+ fortran-minimum-statement-indent-tab
+ fortran-minimum-statement-indent-fixed)))
(save-excursion
(setq first-statement (fortran-previous-statement))
(if first-statement
- (setq icol fortran-minimum-statement-indent)
+ (setq icol fortran-minimum-statement-indent)
(if (= (point) (point-min))
(setq icol fortran-minimum-statement-indent)
(setq icol (fortran-current-line-indentation)))
(skip-chars-forward " \t0-9")
(cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(")
(if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]")
- (let (then-test) ; multi-line if-then
+ (let (then-test) ; multi-line if-then
(while (and (zerop (forward-line 1))
;; Search forward for then.
(looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]")
(beginning-of-line)
(cond ((looking-at "[ \t]*$"))
;; Check for directive before comment, so as not to indent.
- ((looking-at fortran-directive-re)
- (setq fortran-minimum-statement-indent 0 icol 0))
- ((looking-at fortran-comment-line-start-skip)
- (cond ((eq fortran-comment-indent-style 'relative)
- (setq icol (+ icol fortran-comment-line-extra-indent)))
- ((eq fortran-comment-indent-style 'fixed)
- (setq icol (+ fortran-minimum-statement-indent
- fortran-comment-line-extra-indent))))
- (setq fortran-minimum-statement-indent 0))
- ((or (looking-at (concat "[ \t]*"
- (regexp-quote
- fortran-continuation-string)))
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
+ ((looking-at fortran-directive-re)
+ (setq fortran-minimum-statement-indent 0 icol 0))
+ ((looking-at fortran-comment-line-start-skip)
+ (cond ((eq fortran-comment-indent-style 'relative)
+ (setq icol (+ icol fortran-comment-line-extra-indent)))
+ ((eq fortran-comment-indent-style 'fixed)
+ (setq icol (+ fortran-minimum-statement-indent
+ fortran-comment-line-extra-indent))))
+ (setq fortran-minimum-statement-indent 0))
+ ((or (looking-at (concat "[ \t]*"
+ (regexp-quote
+ fortran-continuation-string)))
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
(skip-chars-forward " \t")
;; Do not introduce extra whitespace into a broken string.
(setq icol
(if (fortran-is-in-string-p (point))
6
(+ icol fortran-continuation-indent))))
- (first-statement)
- ((and fortran-check-all-num-for-matching-do
- (looking-at "[ \t]*[0-9]+")
- (fortran-check-for-matching-do))
- (setq icol (- icol fortran-do-indent)))
- (t
- (skip-chars-forward " \t0-9")
- (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b")
- (setq icol (- icol fortran-if-indent)))
- ((looking-at "else\\(if\\)?\\b")
- (setq icol (- icol fortran-if-indent)))
+ (first-statement)
+ ((and fortran-check-all-num-for-matching-do
+ (looking-at "[ \t]*[0-9]+")
+ (fortran-check-for-matching-do))
+ (setq icol (- icol fortran-do-indent)))
+ (t
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b")
+ (setq icol (- icol fortran-if-indent)))
+ ((looking-at "else\\(if\\)?\\b")
+ (setq icol (- icol fortran-if-indent)))
((looking-at "case[ \t]*\\((.*)\\|default\\>\\)")
- (setq icol (- icol fortran-if-indent)))
- ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b")
- (setq icol (- icol fortran-if-indent)))
- ((and (looking-at "continue\\b")
- (fortran-check-for-matching-do))
- (setq icol (- icol fortran-do-indent)))
- ((looking-at "end[ \t]*do\\b")
- (setq icol (- icol fortran-do-indent)))
- ((looking-at "end[ \t]*\
+ (setq icol (- icol fortran-if-indent)))
+ ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b")
+ (setq icol (- icol fortran-if-indent)))
+ ((and (looking-at "continue\\b")
+ (fortran-check-for-matching-do))
+ (setq icol (- icol fortran-do-indent)))
+ ((looking-at "end[ \t]*do\\b")
+ (setq icol (- icol fortran-do-indent)))
+ ((looking-at "end[ \t]*\
\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]")
- (setq icol (- icol fortran-structure-indent)))
- ((and (looking-at fortran-end-prog-re1)
- (fortran-check-end-prog-re)
- (not (= icol fortran-minimum-statement-indent)))
- (message "Warning: `end' not in column %d. Probably\
+ (setq icol (- icol fortran-structure-indent)))
+ ((and (looking-at fortran-end-prog-re1)
+ (fortran-check-end-prog-re)
+ (not (= icol fortran-minimum-statement-indent)))
+ (message "Warning: `end' not in column %d. Probably\
an unclosed block." fortran-minimum-statement-indent))))))
(max fortran-minimum-statement-indent icol)))
(save-excursion
(beginning-of-line)
(cond ((looking-at fortran-comment-line-start-skip)
- (goto-char (match-end 0))
- (skip-chars-forward
- (if (stringp fortran-comment-indent-char)
- fortran-comment-indent-char
- (char-to-string fortran-comment-indent-char))))
- ((or (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
- (goto-char (match-end 0)))
- (t
- ;; Move past line number.
- (skip-chars-forward "[ \t0-9]")))
+ (goto-char (match-end 0))
+ (skip-chars-forward
+ (if (stringp fortran-comment-indent-char)
+ fortran-comment-indent-char
+ (char-to-string fortran-comment-indent-char))))
+ ((or (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
+ (goto-char (match-end 0)))
+ (t
+ ;; Move past line number.
+ (skip-chars-forward "[ \t0-9]")))
;; Move past whitespace.
(skip-chars-forward " \t")
(current-column)))
(save-excursion
(beginning-of-line)
(if (looking-at fortran-comment-line-start-skip)
- (if fortran-comment-indent-style
- (let* ((char (if (stringp fortran-comment-indent-char)
- (aref fortran-comment-indent-char 0)
- fortran-comment-indent-char))
- (chars (string ?\s ?\t char)))
- (goto-char (match-end 0))
- (skip-chars-backward chars)
- (delete-region (point) (progn (skip-chars-forward chars)
- (point)))
- (insert-char char (- col (current-column)))))
+ (if fortran-comment-indent-style
+ (let* ((char (if (stringp fortran-comment-indent-char)
+ (aref fortran-comment-indent-char 0)
+ fortran-comment-indent-char))
+ (chars (string ?\s ?\t char)))
+ (goto-char (match-end 0))
+ (skip-chars-backward chars)
+ (delete-region (point) (progn (skip-chars-forward chars)
+ (point)))
+ (insert-char char (- col (current-column)))))
(if (looking-at "\t[1-9]")
- (if indent-tabs-mode
- (goto-char (match-end 0))
- (delete-char 2)
- (insert-char ?\s 5)
- (insert fortran-continuation-string))
- (if (looking-at " \\{5\\}[^ 0\n]")
- (if indent-tabs-mode
- (progn (delete-char 6)
- (insert ?\t (fortran-numerical-continuation-char) 1))
- (forward-char 6))
- (delete-horizontal-space)
- ;; Put line number in columns 0-4, or
+ (if indent-tabs-mode
+ (goto-char (match-end 0))
+ (delete-char 2)
+ (insert-char ?\s 5)
+ (insert fortran-continuation-string))
+ (if (looking-at " \\{5\\}[^ 0\n]")
+ (if indent-tabs-mode
+ (progn (delete-char 6)
+ (insert ?\t (fortran-numerical-continuation-char) 1))
+ (forward-char 6))
+ (delete-horizontal-space)
+ ;; Put line number in columns 0-4, or
;; continuation character in column 5.
- (cond ((eobp))
- ((looking-at (regexp-quote fortran-continuation-string))
- (if indent-tabs-mode
- (progn
- (indent-to
- (if indent-tabs-mode
- fortran-minimum-statement-indent-tab
- fortran-minimum-statement-indent-fixed))
- (delete-char 1)
- (insert-char (fortran-numerical-continuation-char) 1))
- (indent-to 5)
- (forward-char 1)))
- ((looking-at "[0-9]+")
- (let ((extra-space (- 5 (- (match-end 0) (point)))))
- (if (< extra-space 0)
- (message "Warning: line number exceeds 5-digit limit.")
- (indent-to (min fortran-line-number-indent extra-space))))
- (skip-chars-forward "0-9")))))
+ (cond ((eobp))
+ ((looking-at (regexp-quote fortran-continuation-string))
+ (if indent-tabs-mode
+ (progn
+ (indent-to
+ (if indent-tabs-mode
+ fortran-minimum-statement-indent-tab
+ fortran-minimum-statement-indent-fixed))
+ (delete-char 1)
+ (insert-char (fortran-numerical-continuation-char) 1))
+ (indent-to 5)
+ (forward-char 1)))
+ ((looking-at "[0-9]+")
+ (let ((extra-space (- 5 (- (match-end 0) (point)))))
+ (if (< extra-space 0)
+ (message "Warning: line number exceeds 5-digit limit.")
+ (indent-to (min fortran-line-number-indent extra-space))))
+ (skip-chars-forward "0-9")))))
;; Point is now after any continuation character or line number.
;; Put body of statement where specified.
(delete-horizontal-space)
(beginning-of-line)
(skip-chars-forward " \t")
(and (<= (current-column) fortran-line-number-indent)
- (or (= (current-column) fortran-line-number-indent)
- (progn (skip-chars-forward "0-9")
- (= (current-column) 5))))))
+ (or (= (current-column) fortran-line-number-indent)
+ (progn (skip-chars-forward "0-9")
+ (= (current-column) 5))))))
(defun fortran-check-for-matching-do ()
"When called from a numbered statement, return t if matching DO is found.
Otherwise return nil."
(let ((case-fold-search t)
- charnum)
+ charnum)
(save-excursion
(beginning-of-line)
(when (looking-at "[ \t]*[0-9]+")
(skip-chars-forward " \t")
- (skip-chars-forward "0") ; skip past leading zeros
+ (skip-chars-forward "0") ; skip past leading zeros
(setq charnum
(buffer-substring (point) (progn
(skip-chars-forward "0-9")
;; (comment-search-forward (line-end-position) t))
(when (or all comment-start-skip)
(let ((pos (point))
- (css (if comment-start-skip
- (concat fortran-comment-line-start-skip
- "\\|" comment-start-skip)
- fortran-comment-line-start-skip)))
+ (css (if comment-start-skip
+ (concat fortran-comment-line-start-skip
+ "\\|" comment-start-skip)
+ fortran-comment-line-start-skip)))
(when (re-search-forward css (line-end-position) t)
- (if (and (or all (> (match-beginning 0) (line-beginning-position)))
- (or (save-match-data
- (not (fortran-is-in-string-p (match-beginning 0))))
- ;; Recurse for rest of line.
- (fortran-find-comment-start-skip all)))
- (point)
- (goto-char pos)
- nil)))))
+ (if (and (or all (> (match-beginning 0) (line-beginning-position)))
+ (or (save-match-data
+ (not (fortran-is-in-string-p (match-beginning 0))))
+ ;; Recurse for rest of line.
+ (fortran-find-comment-start-skip all)))
+ (point)
+ (goto-char pos)
+ nil)))))
;; From: ralf@up3aud1.gwdg.de (Ralf Fassel)
;; Test if TAB format continuation lines work.
(save-excursion
(goto-char where)
(cond
- ((bolp) nil) ; bol is never inside a string
- ((save-excursion ; comment lines too
- (beginning-of-line)
- (looking-at fortran-comment-line-start-skip)) nil)
+ ((bolp) nil) ; bol is never inside a string
+ ((save-excursion ; comment lines too
+ (beginning-of-line)
+ (looking-at fortran-comment-line-start-skip)) nil)
(t (let ((parse-state '(0 nil nil nil nil nil 0))
- (quoted-comment-start (if comment-start
- (regexp-quote comment-start)))
- (not-done t)
- parse-limit end-of-line)
- ;; Move to start of current statement.
- (fortran-next-statement)
- (fortran-previous-statement)
- ;; Now parse up to WHERE.
- (while not-done
- (if (or ;; Skip to next line if:
- ;; - comment line?
- (looking-at fortran-comment-line-start-skip)
- ;; - at end of line?
- (eolp)
- ;; - not in a string and after comment-start?
- (and (not (nth 3 parse-state))
- comment-start
- (equal comment-start
- (char-to-string (preceding-char)))))
- (if (> (forward-line) 0)
- (setq not-done nil))
- ;; else:
- ;; If we are at beginning of code line, skip any
- ;; whitespace, labels and tab continuation markers.
- (if (bolp) (skip-chars-forward " \t0-9"))
- ;; If we are in column <= 5 now, check for continuation char.
- (cond ((= 5 (current-column)) (forward-char 1))
- ((and (< (current-column) 5)
- (equal fortran-continuation-string
- (char-to-string (following-char)))
- (forward-char 1))))
- ;; Find out parse-limit from here.
- (setq end-of-line (line-end-position))
- (setq parse-limit (min where end-of-line))
- ;; Parse max up to comment-start, if non-nil and in current line.
- (if comment-start
- (save-excursion
- (if (re-search-forward quoted-comment-start end-of-line t)
- (setq parse-limit (min (point) parse-limit)))))
- ;; Now parse if still in limits.
- (if (< (point) where)
- (setq parse-state (parse-partial-sexp
- (point) parse-limit nil nil parse-state))
- (setq not-done nil))))
- ;; Result.
- (nth 3 parse-state))))))
+ (quoted-comment-start (if comment-start
+ (regexp-quote comment-start)))
+ (not-done t)
+ parse-limit end-of-line)
+ ;; Move to start of current statement.
+ (fortran-next-statement)
+ (fortran-previous-statement)
+ ;; Now parse up to WHERE.
+ (while not-done
+ (if (or ;; Skip to next line if:
+ ;; - comment line?
+ (looking-at fortran-comment-line-start-skip)
+ ;; - at end of line?
+ (eolp)
+ ;; - not in a string and after comment-start?
+ (and (not (nth 3 parse-state))
+ comment-start
+ (equal comment-start
+ (char-to-string (preceding-char)))))
+ (if (> (forward-line) 0)
+ (setq not-done nil))
+ ;; else:
+ ;; If we are at beginning of code line, skip any
+ ;; whitespace, labels and tab continuation markers.
+ (if (bolp) (skip-chars-forward " \t0-9"))
+ ;; If we are in column <= 5 now, check for continuation char.
+ (cond ((= 5 (current-column)) (forward-char 1))
+ ((and (< (current-column) 5)
+ (equal fortran-continuation-string
+ (char-to-string (following-char)))
+ (forward-char 1))))
+ ;; Find out parse-limit from here.
+ (setq end-of-line (line-end-position))
+ (setq parse-limit (min where end-of-line))
+ ;; Parse max up to comment-start, if non-nil and in current line.
+ (if comment-start
+ (save-excursion
+ (if (re-search-forward quoted-comment-start end-of-line t)
+ (setq parse-limit (min (point) parse-limit)))))
+ ;; Now parse if still in limits.
+ (if (< (point) where)
+ (setq parse-state (parse-partial-sexp
+ (point) parse-limit nil nil parse-state))
+ (setq not-done nil))))
+ ;; Result.
+ (nth 3 parse-state))))))
;; From old version.
(defalias 'fortran-auto-fill-mode 'auto-fill-mode)
(defun fortran-fill ()
"Fill the current line at an appropriate point(s)."
(let* ((auto-fill-function #'fortran-auto-fill)
- (opoint (point))
- (bol (line-beginning-position))
- (eol (line-end-position))
- (bos (min eol (+ bol (fortran-current-line-indentation))))
+ (opoint (point))
+ (bol (line-beginning-position))
+ (eol (line-end-position))
+ (bos (min eol (+ bol (fortran-current-line-indentation))))
;; If in a string at fill-column, break it either before the
;; initial quote, or at fill-col (if string is too long).
- (quote
- (save-excursion
- (goto-char bol)
- ;; OK to break quotes on comment lines.
- (unless (looking-at fortran-comment-line-start-skip)
+ (quote
+ (save-excursion
+ (goto-char bol)
+ ;; OK to break quotes on comment lines.
+ (unless (looking-at fortran-comment-line-start-skip)
(let (fcpoint start)
(move-to-column fill-column)
(when (fortran-is-in-string-p (setq fcpoint (point)))
(- fill-column 6 fortran-continuation-indent))
fcpoint
start))))))
- ;; Decide where to split the line. If a position for a quoted
- ;; string was found above then use that, else break the line
- ;; before/after the last delimiter.
- (fill-point
- (or quote
- (save-excursion
+ ;; Decide where to split the line. If a position for a quoted
+ ;; string was found above then use that, else break the line
+ ;; before/after the last delimiter.
+ (fill-point
+ (or quote
+ (save-excursion
;; If f-b-b-d is t, have an extra column to play with,
;; since delimiter gets shifted to new line.
(move-to-column (if fortran-break-before-delimiters
(or (looking-at fortran-no-break-re)
(forward-char)))))
;; Line indented beyond fill-column?
- (when (<= (point) bos)
+ (when (<= (point) bos)
(move-to-column (1+ fill-column))
;; What is this doing???
(or (re-search-forward "[\t\n,'+-/*)=]" eol t)
(goto-char bol)))
- (if (bolp)
- (re-search-forward "[ \t]" opoint t))
+ (if (bolp)
+ (re-search-forward "[ \t]" opoint t))
(point)))))
;; If we are in an in-line comment, don't break unless the
;; line of code is longer than it should be. Otherwise
;; Need to use fortran-find-comment-start-skip to make sure that
;; quoted !'s don't prevent a break.
(when (and (save-excursion
- (beginning-of-line)
- (if (not (fortran-find-comment-start-skip))
+ (beginning-of-line)
+ (if (not (fortran-find-comment-start-skip))
t
- (goto-char (match-beginning 0))
- (>= (point) fill-point)))
- (save-excursion
- (goto-char fill-point)
- (not (bolp)))
- (> (save-excursion
- (goto-char opoint)
- (current-column))
- (min (1+ fill-column)
- (+ (fortran-calculate-indent)
- fortran-continuation-indent))))
+ (goto-char (match-beginning 0))
+ (>= (point) fill-point)))
+ (save-excursion
+ (goto-char fill-point)
+ (not (bolp)))
+ (> (save-excursion
+ (goto-char opoint)
+ (current-column))
+ (min (1+ fill-column)
+ (+ (fortran-calculate-indent)
+ fortran-continuation-indent))))
(goto-char fill-point)
(fortran-break-line)
(end-of-line))))
(defun fortran-break-line ()
"Call `fortran-split-line'. Joins continuation lines first, then refills."
(let ((bol (line-beginning-position))
- (comment-string
- (save-excursion
- (if (fortran-find-comment-start-skip)
- (delete-and-extract-region
- (match-beginning 0) (line-end-position))))))
+ (comment-string
+ (save-excursion
+ (if (fortran-find-comment-start-skip)
+ (delete-and-extract-region
+ (match-beginning 0) (line-end-position))))))
;; Forward line 1 really needs to go to next non white line.
(if (save-excursion (forward-line)
- (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
- (progn
- (end-of-line)
- (delete-region (point) (match-end 0))
- (delete-horizontal-space)
- (fortran-fill))
+ (looking-at " \\{5\\}[^ 0\n]\\|\t[1-9]"))
+ (progn
+ (end-of-line)
+ (delete-region (point) (match-end 0))
+ (delete-horizontal-space)
+ (fortran-fill))
(fortran-split-line))
(if comment-string
- (save-excursion
- (goto-char bol)
- (end-of-line)
- (delete-horizontal-space)
- (indent-to (fortran-comment-indent))
- (insert comment-string)))))
+ (save-excursion
+ (goto-char bol)
+ (end-of-line)
+ (delete-horizontal-space)
+ (indent-to (fortran-comment-indent))
+ (insert comment-string)))))
(defun fortran-analyze-file-format ()
"Return nil if fixed format is used, t if TAB formatting is used.
(save-excursion
(goto-char (point-min))
(while (not (or
- (eobp)
- (eq (char-after) ?\t)
- (looking-at " \\{6\\}")
- (> i fortran-analyze-depth)))
- (forward-line)
- (setq i (1+ i)))
+ (eobp)
+ (eq (char-after) ?\t)
+ (looking-at " \\{6\\}")
+ (> i fortran-analyze-depth)))
+ (forward-line)
+ (setq i (1+ i)))
(cond
((eq (char-after) ?\t) t)
((looking-at " \\{6\\}") nil)
(save-excursion
;; We must be inside function body for this to work.
(fortran-beginning-of-subprogram)
- (let ((case-fold-search t)) ; case-insensitive
+ (let ((case-fold-search t)) ; case-insensitive
;; Search for fortran subprogram start.
(if (re-search-forward
(concat "^[ \t]*\\(program\\|subroutine\\|function"
(defvar gdb-macro-info)
(defvar gdb-server-prefix)
(defvar gdb-show-changed-values)
+(defvar gdb-source-window)
(defvar gdb-var-list)
(defvar gdb-speedbar-auto-raise)
+(defvar gud-tooltip-mode)
+(defvar hl-line-mode)
+(defvar hl-line-sticky-flag)
(defvar tool-bar-map)
+
;; ======================================================================
;; GUD commands must be visible in C buffers visited by GUD
(defvar gdb-ready nil)
+(defvar gud-target-name "--unknown--"
+ "The apparent name of the program being debugged in a gud buffer.")
+
;; Use existing Info buffer, if possible.
(defun gud-goto-info ()
"Go to relevant Emacs info node."
:group 'gud
:type 'boolean)
-(defvar gud-target-name "--unknown--"
- "The apparent name of the program being debugged in a gud buffer.")
-
;; Perform initializations common to all debuggers.
;; The first arg is the specified command line,
;; which starts with the program to debug.
(defvar idlwave-help-assistant-help-with-topic-history nil
"The history of help topics selected with the minibuffer.")
+(defvar idlwave-system-routines)
+
(defun idlwave-help-assistant-help-with-topic (&optional topic)
"Prompt for and provide help with TOPIC."
(interactive)
(delete-horizontal-space)
(insert (concat " " octave-continuation-string))))
-(defvar octave-xemacs-p
- (string-match "XEmacs\\|Lucid" emacs-version))
-
;;; Comments
(defun octave-comment-region (beg end &optional arg)
"Comment or uncomment each line in the region as Octave code.
(self-insert-command 1)
(let (c)
(insert last-command-char)
- (if (if octave-xemacs-p
+ (if (if (featurep 'xemacs)
(or (eq (event-to-character (setq c (next-event))) ??)
(eq (event-to-character c) help-char))
(or (eq (setq c (read-event)) ??)
;;; Code:
-(eval-when-compile (require 'comint))
-
+(defvar comint-prompt-regexp)
+(defvar comint-process-echoes)
(defgroup prolog nil
"Major mode for editing and running Prolog under Emacs."
(unless ps-mode-map
(setq ps-mode-map (make-sparse-keymap))
- (define-key ps-mode-map "\C-cv" 'ps-mode-show-version)
(define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox)
(define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region)
(define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich)
(define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region)
(define-key ps-mode-map "\C-c\C-k" 'ps-run-kill)
(define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline)
- (define-key ps-mode-map "\C-c\C-c" 'ps-run-clear)
+ (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear)
(define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer)
(define-key ps-mode-map ">" 'ps-mode-r-gt)
(define-key ps-mode-map "]" 'ps-mode-r-angle)
(while (or (null length-limit)
(null (cdr accum))
(< length length-limit))
- (setq start nil)
(let ((started-from (point)))
(python-beginning-of-block)
(end-of-line)
;;; Code:
-;; XEmacs handling
-(defconst vera-xemacs (string-match "XEmacs" emacs-version)
- "Non-nil if XEmacs is used.")
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(modify-syntax-entry ?\{ "(}" syntax-table)
(modify-syntax-entry ?\} "){" syntax-table)
;; comment
- (if vera-xemacs
+ (if (featurep 'xemacs)
(modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs
(modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs
(modify-syntax-entry ?\* ". 23" syntax-table)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; XEmacs compatibility
-(when vera-xemacs
+(when (featurep 'xemacs)
(require 'font-lock)
(copy-face 'font-lock-reference-face 'font-lock-constant-face)
(copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face))
;;; Code:
-;; XEmacs handling
-(defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
- "Non-nil if XEmacs is used.")
;; Emacs 21+ handling
-(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs))
+(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 21, 22, ... is used.")
-(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs))
+(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 22, ... is used.")
(defvar compilation-file-regexp-alist)
;; add related general customizations
(custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
-(if vhdl-xemacs
+(if (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
(custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
(custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
(custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
-(unless vhdl-xemacs
+(unless (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
(custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
newstr)))
;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
-(when (and vhdl-xemacs (string< itimer-version "1.09")
+(when (and (featurep 'xemacs) (string< itimer-version "1.09")
(not noninteractive))
(load "itimer")
(when (string< itimer-version "1.09")
(defun vhdl-show-messages ()
"Get *Messages* buffer to show recent messages."
(interactive)
- (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*")))
+ (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*")))
(defun vhdl-use-direct-instantiation ()
"Return whether direct instantiation is used."
(define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
(define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
(define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
- (unless vhdl-xemacs ; would override `M-backspace' in XEmacs
+ (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
(define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
(define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
(define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
(define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
(define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
(define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
- (if vhdl-xemacs ; `... C-g' not allowed in XEmacs
+ (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
(define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
(define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
(define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
(skip-chars-forward " \t\n"))))
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
-(unless (and vhdl-xemacs (string< "21.2" emacs-version))
+(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
(defalias 'vhdl-forward-comment 'forward-comment))
;; This is the best we can do in Win-Emacs.
(defun vhdl-ps-print-init ()
"Initialize postscript printing."
- (if vhdl-xemacs
+ (if (featurep 'xemacs)
(when (boundp 'ps-print-color-p)
(vhdl-ps-print-settings))
(make-local-variable 'ps-print-hook)
(save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
["Rescan Directory" vhdl-speedbar-rescan-hierarchy
:active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
- ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)]
+ ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)]
["Rescan Project" vhdl-speedbar-rescan-hierarchy
:active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
- ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects]
+ ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects]
["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
;; hook-ups
(speedbar-add-expansion-list
(assoc (car sublist) regexp-alist))
(setq regexp-alist (cons (list (nth 0 sublist)
(if (= 0 (nth 1 sublist))
- (if vhdl-xemacs 9 nil)
+ (if (featurep 'xemacs) 9 nil)
(nth 1 sublist))
(nth 2 sublist) (nth 3 sublist))
regexp-alist)))
(defun vhdl-doc-variable (variable)
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
- (unless vhdl-xemacs
+ (unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(defun vhdl-doc-mode ()
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
- (unless vhdl-xemacs
+ (unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(let ((case-fold-search t))
- (cond ((string-match "XEmacs" emacs-version))
+ (cond ((featurep 'xemacs))
((string-match "Lucid" emacs-version)
(error "`ps-print' doesn't support Lucid"))
((string-match "Epoch" emacs-version)
(insert ?\n)
(dolist (symbol savehist-minibuffer-history-variables)
(when (boundp symbol)
- (let ((value (savehist-trim-history (symbol-value symbol))))
- (when value ; don't save empty histories
- (prin1 `(setq ,symbol ',value) (current-buffer))
- (insert ?\n))))))
+ (let ((value (savehist-trim-history (symbol-value symbol)))
+ excess-space)
+ (when value ; Don't save empty histories.
+ (insert "(setq ")
+ (prin1 symbol (current-buffer))
+ (insert " '(")
+ ;; We will print an extra space before the first element.
+ ;; Record where that is.
+ (setq excess-space (point))
+ ;; Print elements of VALUE one by one, carefully.
+ (dolist (elt value)
+ (let ((start (point)))
+ (insert " ")
+ (prin1 elt (current-buffer))
+ ;; Try to read the element we just printed.
+ (condition-case nil
+ (save-excursion
+ (goto-char start)
+ (read (current-buffer)))
+ (error
+ ;; If reading it gets an error, comment it out.
+ (goto-char start)
+ (insert "\n")
+ (while (not (eobp))
+ (insert ";;; ")
+ (forward-line 1))
+ (insert "\n")))
+ (goto-char (point-max))))
+ ;; Delete the extra space before the first element.
+ (save-excursion
+ (goto-char excess-space)
+ (if (eq (following-char) ?\s)
+ (delete-region (point) (1+ (point)))))
+ (insert "))\n"))))))
;; Save the additional variables.
(dolist (symbol savehist-additional-variables)
(when (boundp symbol)
(or arg (setq arg 1))
(scroll-lock-update-goal-column)
(if (pos-visible-in-window-p (point-max))
- (next-line arg)
+ (forward-line arg)
(scroll-up arg))
(scroll-lock-move-to-column scroll-lock-temporary-goal-column))
(scroll-lock-update-goal-column)
(condition-case nil
(scroll-down arg)
- (beginning-of-buffer (previous-line arg)))
+ (beginning-of-buffer (forward-line (- arg))))
(scroll-lock-move-to-column scroll-lock-temporary-goal-column))
(defun scroll-lock-forward-paragraph (&optional arg)
"\"" ses-read-cell
"'" ses-read-symbol
"=" ses-edit-cell
+ "c" ses-recalculate-cell
"j" ses-jump
"p" ses-read-cell-printer
+ "t" ses-truncate-cell
"w" ses-set-column-width
"x" ses-export-keymap
"\M-p" ses-read-column-printer))
(make-local-variable x)
(set x nil)))
+;;;This variable is documented as being permitted in file-locals:
+(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
+
(defconst ses-paramlines-plist
'(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3
ses--header-row -2 ses--file-format 1 ses--numrows 2
(list (symbol-name (cadr formula))))))
(defun ses-column-letter (col)
- "Converts a column number to A..Z or AA..ZZ"
- (if (< col 26)
- (char-to-string (+ ?A col))
- (string (+ ?@ (/ col 26)) (+ ?A (% col 26)))))
+ "Return the alphabetic name of column number COL.
+0-25 become A-Z; 26-701 become AA-ZZ, and so on."
+ (let ((units (char-to-string (+ ?A (% col 26)))))
+ (if (< col 26)
+ units
+ (concat (ses-column-letter (1- (/ col 26))) units))))
(defun ses-create-cell-symbol (row col)
"Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1."
;;Range
(let ((bcell (get-text-property (region-beginning) 'intangible))
(ecell (get-text-property (1- (region-end)) 'intangible)))
+ (when (= (region-end) ses--data-marker)
+ ;;Correct for overflow
+ (setq ecell (get-text-property (- (region-end) 2) 'intangible)))
(setq ses--curcell (if (and bcell ecell)
(cons bcell ecell)
nil))))
(defun ses-copy-region (beg end)
"Treat the region as rectangular. Convert the intangible attributes to
SES attributes recording the contents of the cell as of the time of copying."
+ (when (= end ses--data-marker)
+ ;;Avoid overflow situation
+ (setq end (1- ses--data-marker)))
(let* ((inhibit-point-motion-hooks t)
(x (mapconcat 'ses-copy-region-helper
(extract-rectangle beg (1- end)) "\n")))
(newline)
(save-excursion
(goto-char pos)
- ;; Usually indent-according-to-mode should "preserve" point, but it is
- ;; not guaranteed; e.g. indent-to-left-margin doesn't.
- (save-excursion (indent-according-to-mode))
+ ;; We are at EOL before the call to indent-according-to-mode, and
+ ;; after it we usually are as well, but not always. We tried to
+ ;; address it with `save-excursion' but that uses a normal marker
+ ;; whereas we need `move after insertion', so we do the save/restore
+ ;; by hand.
+ (setq pos (copy-marker pos t))
+ (indent-according-to-mode)
+ (goto-char pos)
+ ;; Remove the trailing white-space after indentation because
+ ;; indentation may introduce the whitespace.
(delete-horizontal-space t))
(indent-according-to-mode)))
"Puts element of the minibuffer history in the minibuffer.
The argument NABS specifies the absolute history position."
(interactive "p")
- (let ((minimum (if minibuffer-default -1 0))
+ (let ((minimum (if minibuffer-default
+ (- (if (listp minibuffer-default)
+ (length minibuffer-default)
+ 1))
+ 0))
elt minibuffer-returned-to-present)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
(goto-char (point-max))
(delete-minibuffer-contents)
(setq minibuffer-history-position nabs)
- (cond ((= nabs -1)
- (setq elt minibuffer-default))
+ (cond ((< nabs 0)
+ (setq elt (if (listp minibuffer-default)
+ (nth (1- (abs nabs)) minibuffer-default)
+ minibuffer-default)))
((= nabs 0)
(setq elt (or minibuffer-text-before-history ""))
(setq minibuffer-returned-to-present t)
(defcustom smerge-auto-refine t
"Automatically highlight changes in detail as the user visits conflicts."
+ :group 'smerge
:type 'boolean)
(defface smerge-mine
(defvar command-line-processed nil
"Non-nil once command line has been processed.")
-(defvar window-system initial-window-system
- "Name of window system the selected frame is displaying through.
-The value is a symbol--for instance, `x' for X windows.
-The value is nil if the selected frame is on a text-only-terminal.")
-
-(make-variable-frame-local 'window-system)
-
(defgroup initialization nil
"Emacs start-up procedure."
:group 'environment)
(make-obsolete 'focus-frame "it does nothing." "22.1")
(defalias 'unfocus-frame 'ignore "")
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
-
+(make-obsolete 'make-variable-frame-local "use a frame-parameter instead" "22.2")
\f
;;;; Obsolescence declarations for variables, and aliases.
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
(defalias 'int-to-string 'number-to-string)
(defalias 'store-match-data 'set-match-data)
-(defalias 'make-variable-frame-localizable 'make-variable-frame-local)
;; These are the XEmacs names:
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
;;
(let ((position (- (length tar-parse-info) (length head))))
(goto-char (point-min))
- (next-line position)
+ (forward-line position)
(beginning-of-line)
(let ((p (point))
after
(defun terminal-init-AT386 ()
"Terminal initialization function for AT386."
- (let ((AT386-keypad-map (lookup-key local-function-key-map "\e[")))
+ (let ((AT386-keypad-map (lookup-key input-decode-map "\e[")))
;; The terminal initialization should already have set up some keys
(if (not (keymapp AT386-keypad-map))
(error "What? Your AT386 termcap/terminfo has no keycaps in it"))
(define-key AT386-keypad-map "T" [kp-add])
;; Arrange for the ALT key to be equivalent to ESC
- (define-key local-function-key-map "\eN" [27]) ; ALT map
+ (define-key input-decode-map "\eN" [ALT])
+ (define-key local-function-key-map [ALT] [27])
))
-;;; arch-tag: abec1b03-582f-49f8-b8cb-e2fd52ea4bd7
+;; arch-tag: abec1b03-582f-49f8-b8cb-e2fd52ea4bd7
;;; AT386.el ends here
;;; Code:
-(defvar iris-function-map (make-sparse-keymap)
- "Function key definitions for SGI xwsh and winterm apps.")
-
-(define-key iris-function-map "\e[120q" [S-escape])
-(define-key iris-function-map "\e[121q" [C-escape])
+(defvar iris-function-map
+ (let ((map (make-sparse-keymap)))
-(define-key iris-function-map "\e[001q" [f1])
-(define-key iris-function-map "\e[013q" [S-f1])
-(define-key iris-function-map "\e[025q" [C-f1])
+ (define-key map "\e[120q" [S-escape])
+ (define-key map "\e[121q" [C-escape])
+ (define-key map "\e[001q" [f1])
+ (define-key map "\e[013q" [S-f1])
+ (define-key map "\e[025q" [C-f1])
-(define-key iris-function-map "\e[002q" [f2])
-(define-key iris-function-map "\e[014q" [S-f2])
-(define-key iris-function-map "\e[026q" [C-f2])
-(define-key iris-function-map "\e[038q" [M-f2])
-(define-key iris-function-map "\e[003q" [f3])
-(define-key iris-function-map "\e[015q" [S-f3])
-(define-key iris-function-map "\e[027q" [C-f3])
+ (define-key map "\e[002q" [f2])
+ (define-key map "\e[014q" [S-f2])
+ (define-key map "\e[026q" [C-f2])
+ (define-key map "\e[038q" [M-f2])
+ (define-key map "\e[003q" [f3])
+ (define-key map "\e[015q" [S-f3])
+ (define-key map "\e[027q" [C-f3])
-(define-key iris-function-map "\e[004q" [f4])
-(define-key iris-function-map "\e[016q" [S-f4])
-(define-key iris-function-map "\e[028q" [C-f4])
+ (define-key map "\e[004q" [f4])
+ (define-key map "\e[016q" [S-f4])
+ (define-key map "\e[028q" [C-f4])
-(define-key iris-function-map "\e[005q" [f5])
-(define-key iris-function-map "\e[017q" [S-f5])
-(define-key iris-function-map "\e[029q" [C-f5])
+ (define-key map "\e[005q" [f5])
+ (define-key map "\e[017q" [S-f5])
+ (define-key map "\e[029q" [C-f5])
-(define-key iris-function-map "\e[006q" [f6])
-(define-key iris-function-map "\e[018q" [S-f6])
-(define-key iris-function-map "\e[030q" [C-f6])
+ (define-key map "\e[006q" [f6])
+ (define-key map "\e[018q" [S-f6])
+ (define-key map "\e[030q" [C-f6])
-(define-key iris-function-map "\e[007q" [f7])
-(define-key iris-function-map "\e[019q" [S-f7])
-(define-key iris-function-map "\e[031q" [C-f7])
+ (define-key map "\e[007q" [f7])
+ (define-key map "\e[019q" [S-f7])
+ (define-key map "\e[031q" [C-f7])
-(define-key iris-function-map "\e[008q" [f8])
-(define-key iris-function-map "\e[020q" [S-f8])
-(define-key iris-function-map "\e[032q" [C-f8])
+ (define-key map "\e[008q" [f8])
+ (define-key map "\e[020q" [S-f8])
+ (define-key map "\e[032q" [C-f8])
-(define-key iris-function-map "\e[009q" [f9])
-(define-key iris-function-map "\e[021q" [S-f9])
-(define-key iris-function-map "\e[033q" [C-f9])
+ (define-key map "\e[009q" [f9])
+ (define-key map "\e[021q" [S-f9])
+ (define-key map "\e[033q" [C-f9])
-(define-key iris-function-map "\e[010q" [f10])
-(define-key iris-function-map "\e[022q" [S-f10])
-(define-key iris-function-map "\e[034q" [C-f10])
+ (define-key map "\e[010q" [f10])
+ (define-key map "\e[022q" [S-f10])
+ (define-key map "\e[034q" [C-f10])
-(define-key iris-function-map "\e[011q" [f11])
-(define-key iris-function-map "\e[023q" [S-f11])
-(define-key iris-function-map "\e[035q" [C-f11])
-(define-key iris-function-map "\e[047q" [M-f11])
-(define-key iris-function-map "\e[012q" [f12])
-(define-key iris-function-map "\e[024q" [S-f12])
-(define-key iris-function-map "\e[036q" [C-f12])
-(define-key iris-function-map "\e[048q" [M-f12])
+ (define-key map "\e[011q" [f11])
+ (define-key map "\e[023q" [S-f11])
+ (define-key map "\e[035q" [C-f11])
+ (define-key map "\e[047q" [M-f11])
+ (define-key map "\e[012q" [f12])
+ (define-key map "\e[024q" [S-f12])
+ (define-key map "\e[036q" [C-f12])
+ (define-key map "\e[048q" [M-f12])
-(define-key iris-function-map "\e[057q" [?\C-`])
-(define-key iris-function-map "\e[115q" [?\M-`])
-(define-key iris-function-map "\e[049q" [?\C-1])
-(define-key iris-function-map "\e[058q" [?\M-1])
+ (define-key map "\e[057q" [?\C-`])
+ (define-key map "\e[115q" [?\M-`])
+ (define-key map "\e[049q" [?\C-1])
+ (define-key map "\e[058q" [?\M-1])
-(define-key iris-function-map "\e[059q" [?\M-2])
-(define-key iris-function-map "\e[050q" [?\C-3])
-(define-key iris-function-map "\e[060q" [?\M-3])
+ (define-key map "\e[059q" [?\M-2])
-(define-key iris-function-map "\e[051q" [?\C-4])
-(define-key iris-function-map "\e[061q" [?\M-4])
+ (define-key map "\e[050q" [?\C-3])
+ (define-key map "\e[060q" [?\M-3])
-(define-key iris-function-map "\e[052q" [?\C-5])
-(define-key iris-function-map "\e[062q" [?\M-5])
+ (define-key map "\e[051q" [?\C-4])
+ (define-key map "\e[061q" [?\M-4])
+ (define-key map "\e[052q" [?\C-5])
+ (define-key map "\e[062q" [?\M-5])
-(define-key iris-function-map "\e[063q" [?\M-6])
-(define-key iris-function-map "\e[053q" [?\C-7])
-(define-key iris-function-map "\e[064q" [?\M-7])
+ (define-key map "\e[063q" [?\M-6])
-(define-key iris-function-map "\e[054q" [?\C-8])
-(define-key iris-function-map "\e[065q" [?\M-8])
+ (define-key map "\e[053q" [?\C-7])
+ (define-key map "\e[064q" [?\M-7])
-(define-key iris-function-map "\e[055q" [?\C-9])
-(define-key iris-function-map "\e[066q" [?\M-9])
+ (define-key map "\e[054q" [?\C-8])
+ (define-key map "\e[065q" [?\M-8])
-(define-key iris-function-map "\e[056q" [?\C-0])
-(define-key iris-function-map "\e[067q" [?\M-0])
+ (define-key map "\e[055q" [?\C-9])
+ (define-key map "\e[066q" [?\M-9])
-(define-key iris-function-map "\e[068q" [?\M--])
+ (define-key map "\e[056q" [?\C-0])
+ (define-key map "\e[067q" [?\M-0])
-(define-key iris-function-map "\e[069q" [?\C-=])
-(define-key iris-function-map "\e[070q" [?\M-=])
+ (define-key map "\e[068q" [?\M--])
-;; I don't know what to do with those.
-;;(define-key iris-function-map "^H" [<del>])
-;;(define-key iris-function-map "^H" [S-<del>])
-;;(define-key iris-function-map "\177" [C-<del>])
-;;(define-key iris-function-map "\e[071q" [M-<del>])
+ (define-key map "\e[069q" [?\C-=])
+ (define-key map "\e[070q" [?\M-=])
-(define-key iris-function-map "\e[Z" [?\S-\t])
-(define-key iris-function-map "\e[072q" [?\C-\t])
-;; This only works if you remove the M-TAB keybing from the system.4Dwmrc
-;; our your ~/.4Dwmrc, if you use the 4Dwm window manager.
-(define-key iris-function-map "\e[073q" [?\M-\t])
+ ;; I don't know what to do with those.
+ ;;(define-key map "^H" [<del>])
+ ;;(define-key map "^H" [S-<del>])
+ ;;(define-key map "\177" [C-<del>])
+ ;;(define-key map "\e[071q" [M-<del>])
-(define-key iris-function-map "\e[074q" [?\M-q])
+ (define-key map "\e[Z" [?\S-\t])
+ (define-key map "\e[072q" [?\C-\t])
+ ;; This only works if you remove the M-TAB keybing from the system.4Dwmrc
+ ;; our your ~/.4Dwmrc, if you use the 4Dwm window manager.
+ (define-key map "\e[073q" [?\M-\t])
-(define-key iris-function-map "\e[075q" [?\M-w])
+ (define-key map "\e[074q" [?\M-q])
-(define-key iris-function-map "\e[076q" [?\M-e])
+ (define-key map "\e[075q" [?\M-w])
-(define-key iris-function-map "\e[077q" [?\M-r])
+ (define-key map "\e[076q" [?\M-e])
-(define-key iris-function-map "\e[078q" [?\M-t])
+ (define-key map "\e[077q" [?\M-r])
-(define-key iris-function-map "\e[079q" [?\M-y])
+ (define-key map "\e[078q" [?\M-t])
-(define-key iris-function-map "\e[080q" [?\M-u])
+ (define-key map "\e[079q" [?\M-y])
-(define-key iris-function-map "\e[081q" [?\M-i])
+ (define-key map "\e[080q" [?\M-u])
-(define-key iris-function-map "\e[082q" [?\M-o])
+ (define-key map "\e[081q" [?\M-i])
-(define-key iris-function-map "\e[083q" [?\M-p])
+ (define-key map "\e[082q" [?\M-o])
-(define-key iris-function-map "\e[084q" [?\M-\[])
+ (define-key map "\e[083q" [?\M-p])
-(define-key iris-function-map "\e[085q" [?\M-\]])
+ (define-key map "\e[084q" [?\M-\[])
-(define-key iris-function-map "\e[086q" [?\M-\\])
+ (define-key map "\e[085q" [?\M-\]])
-(define-key iris-function-map "\e[087q" [?\M-a])
+ (define-key map "\e[086q" [?\M-\\])
-(define-key iris-function-map "\e[088q" [?\M-s])
+ (define-key map "\e[087q" [?\M-a])
-(define-key iris-function-map "\e[089q" [?\M-d])
+ (define-key map "\e[088q" [?\M-s])
-(define-key iris-function-map "\e[090q" [?\M-f])
+ (define-key map "\e[089q" [?\M-d])
-(define-key iris-function-map "\e[091q" [?\M-g])
+ (define-key map "\e[090q" [?\M-f])
-(define-key iris-function-map "\e[092q" [?\M-h])
+ (define-key map "\e[091q" [?\M-g])
-(define-key iris-function-map "\e[093q" [?\M-j])
+ (define-key map "\e[092q" [?\M-h])
-(define-key iris-function-map "\e[094q" [?\M-k])
+ (define-key map "\e[093q" [?\M-j])
-(define-key iris-function-map "\e[095q" [?\M-l])
+ (define-key map "\e[094q" [?\M-k])
-(define-key iris-function-map "\e[096q" [?\C-\;])
-(define-key iris-function-map "\e[097q" [?\M-:]) ;; we are cheating
- ;; here, this is realy
- ;; M-;, but M-:
- ;; generates the same
- ;; string and is more
- ;; usefull.
+ (define-key map "\e[095q" [?\M-l])
-(define-key iris-function-map "\e[098q" [?\C-'])
-(define-key iris-function-map "\e[099q" [?\M-'])
+ (define-key map "\e[096q" [?\C-\;])
+ ;; We are cheating here, this is really M-;, but M-: generates the same
+ ;; string and is more useful.
+ (define-key map "\e[097q" [?\M-:])
-(define-key iris-function-map "\e[100q" [?\M-\n])
+ (define-key map "\e[098q" [?\C-'])
+ (define-key map "\e[099q" [?\M-'])
-(define-key iris-function-map "\e[101q" [?\M-z])
+ (define-key map "\e[100q" [?\M-\n])
-(define-key iris-function-map "\e[102q" [?\M-x])
+ (define-key map "\e[101q" [?\M-z])
-(define-key iris-function-map "\e[103q" [?\M-c])
+ (define-key map "\e[102q" [?\M-x])
-(define-key iris-function-map "\e[104q" [?\M-v])
+ (define-key map "\e[103q" [?\M-c])
-(define-key iris-function-map "\e[105q" [?\M-b])
+ (define-key map "\e[104q" [?\M-v])
-(define-key iris-function-map "\e[106q" [M-n])
+ (define-key map "\e[105q" [?\M-b])
-(define-key iris-function-map "\e[107q" [M-m])
+ (define-key map "\e[106q" [M-n])
-(define-key iris-function-map "\e[108q" [?\C-,])
-(define-key iris-function-map "\e[109q" [?\M-,])
+ (define-key map "\e[107q" [M-m])
-(define-key iris-function-map "\e[110q" [?\C-.])
-(define-key iris-function-map "\e[111q" [?\M-.])
+ (define-key map "\e[108q" [?\C-,])
+ (define-key map "\e[109q" [?\M-,])
-(define-key iris-function-map "\e[112q" [?\C-/])
-(define-key iris-function-map "\e[113q" [?\M-/])
+ (define-key map "\e[110q" [?\C-.])
+ (define-key map "\e[111q" [?\M-.])
-(define-key iris-function-map "\e[139q" [insert])
-(define-key iris-function-map "\e[139q" [S-insert])
-(define-key iris-function-map "\e[140q" [C-insert])
-(define-key iris-function-map "\e[141q" [M-insert])
+ (define-key map "\e[112q" [?\C-/])
+ (define-key map "\e[113q" [?\M-/])
-(define-key iris-function-map "\e[H" [home])
-(define-key iris-function-map "\e[143q" [S-home])
-(define-key iris-function-map "\e[144q" [C-home])
+ (define-key map "\e[139q" [insert])
+ (define-key map "\e[139q" [S-insert])
+ (define-key map "\e[140q" [C-insert])
+ (define-key map "\e[141q" [M-insert])
+ (define-key map "\e[H" [home])
+ (define-key map "\e[143q" [S-home])
+ (define-key map "\e[144q" [C-home])
-(define-key iris-function-map "\e[150q" [prior])
-(define-key iris-function-map "\e[151q" [S-prior]) ;; those don't seem
- ;; to generate
- ;; anything
-(define-key iris-function-map "\e[152q" [C-prior])
+ (define-key map "\e[150q" [prior])
+ (define-key map "\e[151q" [S-prior]) ;Those don't seem to generate anything.
+ (define-key map "\e[152q" [C-prior])
-;; (define-key iris-function-map "^?" [delete]) ?? something else seems to take care of this.
-(define-key iris-function-map "\e[P" [S-delete])
-(define-key iris-function-map "\e[142q" [C-delete])
-(define-key iris-function-map "\e[M" [M-delete])
-(define-key iris-function-map "\e[146q" [end])
-(define-key iris-function-map "\e[147q" [S-end]) ;; those don't seem to
- ;; generate anything
-(define-key iris-function-map "\e[148q" [C-end])
+ ;; (define-key map "^?" [delete]) ?? something else seems to take care of this.
+ (define-key map "\e[P" [S-delete])
+ (define-key map "\e[142q" [C-delete])
+ (define-key map "\e[M" [M-delete])
-(define-key iris-function-map "\e[154q" [next])
-(define-key iris-function-map "\e[155q" [S-next])
-(define-key iris-function-map "\e[156q" [C-next])
+ (define-key map "\e[146q" [end])
+ (define-key map "\e[147q" [S-end]) ; Those don't seem to generate anything.
+ (define-key map "\e[148q" [C-end])
+ (define-key map "\e[154q" [next])
+ (define-key map "\e[155q" [S-next])
+ (define-key map "\e[156q" [C-next])
-(define-key iris-function-map "\e[161q" [S-up])
-(define-key iris-function-map "\e[162q" [C-up])
-(define-key iris-function-map "\e[163q" [M-up])
-(define-key iris-function-map "\e[158q" [S-left])
-(define-key iris-function-map "\e[159q" [C-left])
-(define-key iris-function-map "\e[160q" [M-left])
+ (define-key map "\e[161q" [S-up])
+ (define-key map "\e[162q" [C-up])
+ (define-key map "\e[163q" [M-up])
-(define-key iris-function-map "\e[164q" [S-down])
-(define-key iris-function-map "\e[165q" [C-down])
-(define-key iris-function-map "\e[166q" [M-down])
+ (define-key map "\e[158q" [S-left])
+ (define-key map "\e[159q" [C-left])
+ (define-key map "\e[160q" [M-left])
-(define-key iris-function-map "\e[167q" [S-right])
-(define-key iris-function-map "\e[168q" [C-right])
-(define-key iris-function-map "\e[169q" [M-right])
+ (define-key map "\e[164q" [S-down])
+ (define-key map "\e[165q" [C-down])
+ (define-key map "\e[166q" [M-down])
-;; Keypad functions, most of those are untested.
-(define-key iris-function-map "\e[179q" [?\C-/])
-(define-key iris-function-map "\e[180q" [?\M-/])
+ (define-key map "\e[167q" [S-right])
+ (define-key map "\e[168q" [C-right])
+ (define-key map "\e[169q" [M-right])
-(define-key iris-function-map "\e[187q" [?\C-*])
-(define-key iris-function-map "\e[188q" [?\M-*])
+ ;; Keypad functions, most of those are untested.
+ (define-key map "\e[179q" [?\C-/])
+ (define-key map "\e[180q" [?\M-/])
-(define-key iris-function-map "\e[198q" [?\C--])
-(define-key iris-function-map "\e[199q" [?\M--])
+ (define-key map "\e[187q" [?\C-*])
+ (define-key map "\e[188q" [?\M-*])
-;; Something else takes care of home, up, prior, down, left, right, next
-;(define-key iris-function-map "\e[H" [home])
-(define-key iris-function-map "\e[172q" [C-home])
+ (define-key map "\e[198q" [?\C--])
+ (define-key map "\e[199q" [?\M--])
-;(define-key iris-function-map "\e[A" [up])
-(define-key iris-function-map "\e[182q" [C-up])
+ ;; Something else takes care of home, up, prior, down, left, right, next
+ ;;(define-key map "\e[H" [home])
+ (define-key map "\e[172q" [C-home])
+ ;;(define-key map "\e[A" [up])
+ (define-key map "\e[182q" [C-up])
-;(define-key iris-function-map "\e[150q" [prior])
-(define-key iris-function-map "\e[190q" [C-prior])
+ ;;(define-key map "\e[150q" [prior])
+ (define-key map "\e[190q" [C-prior])
-(define-key iris-function-map "\e[200q" [?\C-+])
-(define-key iris-function-map "\e[201q" [?\M-+])
-;(define-key iris-function-map "\e[D" [left])
-(define-key iris-function-map "\e[174q" [C-left])
+ (define-key map "\e[200q" [?\C-+])
+ (define-key map "\e[201q" [?\M-+])
+ ;;(define-key map "\e[D" [left])
+ (define-key map "\e[174q" [C-left])
-(define-key iris-function-map "\e[000q" [begin])
-(define-key iris-function-map "\e[184q" [C-begin])
+ (define-key map "\e[000q" [begin])
+ (define-key map "\e[184q" [C-begin])
-;(define-key iris-function-map "\e[C" [right])
-(define-key iris-function-map "\e[192q" [C-right])
-;(define-key iris-function-map "\e[146q" [end])
-(define-key iris-function-map "\e[176q" [C-end])
+ ;;(define-key map "\e[C" [right])
+ (define-key map "\e[192q" [C-right])
-;(define-key iris-function-map "\e[B" [down])
-(define-key iris-function-map "\e[186q" [C-down])
+ ;;(define-key map "\e[146q" [end])
+ (define-key map "\e[176q" [C-end])
-;(define-key iris-function-map "\e[154q" [next])
-(define-key iris-function-map "\e[194q" [C-next])
+ ;;(define-key map "\e[B" [down])
+ (define-key map "\e[186q" [C-down])
+ ;;(define-key map "\e[154q" [next])
+ (define-key map "\e[194q" [C-next])
-(define-key iris-function-map "\e[100q" [M-enter])
+ (define-key map "\e[100q" [M-enter])
-(define-key iris-function-map "\e[139q" [insert])
-(define-key iris-function-map "\e[178q" [C-inset])
+ (define-key map "\e[139q" [insert])
+ (define-key map "\e[178q" [C-inset])
-(define-key iris-function-map "\e[P" [delete])
-(define-key iris-function-map "\e[196q" [C-delete])
-(define-key iris-function-map "\e[197q" [M-delete])
+ (define-key map "\e[P" [delete])
+ (define-key map "\e[196q" [C-delete])
+ (define-key map "\e[197q" [M-delete])
+ map)
+ "Function key definitions for SGI xwsh and winterm apps.")
(defun terminal-init-iris-ansi ()
"Terminal initialization function for iris-ansi."
;; This way we don't override terminfo-derived settings or settings
;; made in the .emacs file.
(let ((m (copy-keymap iris-function-map)))
- (set-keymap-parent m (keymap-parent local-function-key-map))
- (set-keymap-parent local-function-key-map m)))
+ (set-keymap-parent m (keymap-parent input-decode-map))
+ (set-keymap-parent input-decode-map m)))
-;;; arch-tag: b1d0e73a-bb7d-47be-9fb2-6fb126469a1b
+;; arch-tag: b1d0e73a-bb7d-47be-9fb2-6fb126469a1b
;;; iris-ansi.el ends here
;; This way we don't override terminfo-derived settings or settings
;; made in the .emacs file.
(let ((m (copy-keymap lk201-function-map)))
- (set-keymap-parent m (keymap-parent local-function-key-map))
- (set-keymap-parent local-function-key-map m)))
+ (set-keymap-parent m (keymap-parent input-decode-map))
+ (set-keymap-parent input-decode-map m)))
-;;; arch-tag: 7ffb4444-6a23-43e1-b457-43cf4f673c0d
+;; arch-tag: 7ffb4444-6a23-43e1-b457-43cf4f673c0d
;;; lk201.el ends here
(defun terminal-init-news ()
"Terminal initialization function for news."
;; The terminal initialization should already have set up some keys
- (let ((news-fkey-prefix (lookup-key local-function-key-map "\eO")))
+ (let ((news-fkey-prefix (lookup-key input-decode-map "\eO")))
(if (not (keymapp news-fkey-prefix))
(error "What? Your news termcap/terminfo has no keycaps in it"))
(define-key news-fkey-prefix "x" [kp-8])
))
-;;; arch-tag: bfe141a0-623b-4b42-b753-5d9353776c5e
+;; arch-tag: bfe141a0-623b-4b42-b753-5d9353776c5e
;;; news.el ends here
(unless success (delete-frame frame)))
frame))
-(setq frame-creation-function 'make-msdos-frame)
+(add-to-list 'frame-creation-function-alist '(pc . make-msdos-frame))
;; ---------------------------------------------------------------------------
;; More or less useful imitations of certain X-functions. A lot of the
;; so we ignore them on the way down
;;
-(defvar sun-raw-prefix (make-sparse-keymap))
+(defvar sun-raw-prefix
+ (let ((map (make-sparse-keymap)))
+ (define-key map "210z" [r3])
+ (define-key map "213z" [r6])
+ (define-key map "214z" [r7])
+ (define-key map "216z" [r9])
+ (define-key map "218z" [r11])
+ (define-key map "220z" [r13])
+ (define-key map "222z" [r15])
+ (define-key map "193z" [redo])
+ (define-key map "194z" [props])
+ (define-key map "195z" [undo])
+ ;; (define-key map "196z" 'ignore) ; Expose-down
+ ;; (define-key map "197z" [put])
+ ;; (define-key map "198z" 'ignore) ; Open-down
+ ;; (define-key map "199z" [get])
+ (define-key map "200z" [find])
+ ;; (define-key map "201z" 'kill-region-and-unmark) ; Delete
+ (define-key map "224z" [f1])
+ (define-key map "225z" [f2])
+ (define-key map "226z" [f3])
+ (define-key map "227z" [f4])
+ (define-key map "228z" [f5])
+ (define-key map "229z" [f6])
+ (define-key map "230z" [f7])
+ (define-key map "231z" [f8])
+ (define-key map "232z" [f9])
+ (define-key map "233z" [f10])
+ (define-key map "234z" [f11])
+ (define-key map "235z" [f12])
+ (define-key map "A" [up]) ; R8
+ (define-key map "B" [down]) ; R14
+ (define-key map "C" [right]) ; R12
+ (define-key map "D" [left]) ; R10
+ map))
;; Since .emacs gets loaded before this file, a hook is supplied
;; for you to put your own bindings in.
(defun terminal-init-sun ()
"Terminal initialization function for sun."
- (define-key local-function-key-map "\e[" sun-raw-prefix)
-
- (define-key sun-raw-prefix "210z" [r3])
- (define-key sun-raw-prefix "213z" [r6])
- (define-key sun-raw-prefix "214z" [r7])
- (define-key sun-raw-prefix "216z" [r9])
- (define-key sun-raw-prefix "218z" [r11])
- (define-key sun-raw-prefix "220z" [r13])
- (define-key sun-raw-prefix "222z" [r15])
- (define-key sun-raw-prefix "193z" [redo])
- (define-key sun-raw-prefix "194z" [props])
- (define-key sun-raw-prefix "195z" [undo])
- ;; (define-key sun-raw-prefix "196z" 'ignore) ; Expose-down
- ;; (define-key sun-raw-prefix "197z" [put])
- ;; (define-key sun-raw-prefix "198z" 'ignore) ; Open-down
- ;; (define-key sun-raw-prefix "199z" [get])
- (define-key sun-raw-prefix "200z" [find])
- ;; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark) ; Delete
- (define-key sun-raw-prefix "224z" [f1])
- (define-key sun-raw-prefix "225z" [f2])
- (define-key sun-raw-prefix "226z" [f3])
- (define-key sun-raw-prefix "227z" [f4])
- (define-key sun-raw-prefix "228z" [f5])
- (define-key sun-raw-prefix "229z" [f6])
- (define-key sun-raw-prefix "230z" [f7])
- (define-key sun-raw-prefix "231z" [f8])
- (define-key sun-raw-prefix "232z" [f9])
- (define-key sun-raw-prefix "233z" [f10])
- (define-key sun-raw-prefix "234z" [f11])
- (define-key sun-raw-prefix "235z" [f12])
- (define-key sun-raw-prefix "A" [up]) ; R8
- (define-key sun-raw-prefix "B" [down]) ; R14
- (define-key sun-raw-prefix "C" [right]) ; R12
- (define-key sun-raw-prefix "D" [left]) ; R10
+ (define-key input-decode-map "\e[" sun-raw-prefix)
(global-set-key [r3] 'backward-page)
(global-set-key [r6] 'forward-page)
(eval (car hooks))
(setq hooks (cdr hooks))))))
-;;; arch-tag: db761d47-fd7d-42b4-aae1-04fa116b6ba6
+;; arch-tag: db761d47-fd7d-42b4-aae1-04fa116b6ba6
;;; sun.el ends here
;;; Code:
(defvar msdos-color-values)
+(defvar w32-tty-standard-colors)
;; The following list is taken from rgb.txt distributed with X.
;;
;;; Code:
+(defvar tvi970-terminal-map
+ (let ((map (make-sparse-keymap)))
+
+ ;; Miscellaneous keys
+ (dolist (key-binding
+ '(;; These are set up by termcap or terminfo
+ ;; ("\eOP" [kp-f1])
+ ;; ("\eOQ" [kp-f2])
+ ;; ("\eOR" [kp-f3])
+ ;; ("\eOS" [kp-f4])
+
+ ;; These might bre set by terminfo.
+ ("\e[H" [home])
+ ("\e[Z" [backtab])
+ ("\e[i" [print])
+ ("\e[@" [insert])
+ ("\e[L" [insertline])
+ ("\e[M" [deleteline])
+ ("\e[U" [next]) ;; actually the `page' key
+
+ ;; These won't be set up by either
+ ("\eOm" [kp-subtract])
+ ("\eOl" [kp-separator])
+ ("\eOn" [kp-decimal])
+ ("\eOM" [kp-enter])
+
+ ;; These won't be set up by either either
+ ("\e[K" [key_eol]) ;; Not an X keysym
+ ("\e[J" [key_eos]) ;; Not an X keysym
+ ("\e[2J" [key_clear]) ;; Not an X keysym
+ ("\e[P" [key_dc]) ;; Not an X keysym
+ ("\e[g" [S-tab]) ;; Not an X keysym
+ ("\e[2N" [clearentry]) ;; Not an X keysym
+ ("\e[2K" [S-clearentry]) ;; Not an X keysym
+ ("\e[E" [?\C-j]) ;; Not an X keysym
+ ("\e[g" [S-backtab]) ;; Not an X keysym
+ ("\e[?1i" [key_sprint]) ;; Not an X keysym
+ ("\e[4h" [key_sic]) ;; Not an X keysym
+ ("\e[4l" [S-delete]) ;; Not an X keysym
+ ("\e[Q" [S-insertline]) ;; Not an X keysym
+ ("\e[1Q" [key_sdl]) ;; Not an X keysym
+ ("\e[19l" [key_seol]) ;; Not an X keysym
+ ("\e[19h" [S-erasepage]) ;; Not an X keysym
+ ("\e[V" [S-page]) ;; Not an X keysym
+ ("\eS" [send]) ;; Not an X keysym
+ ("\e5" [S-send]) ;; Not an X keysym
+ ))
+ (define-key map (car key-binding) (nth 1 key-binding)))
+
+
+ ;; The numeric keypad keys.
+ (dotimes (i 10)
+ (define-key map (format "\eO%c" (+ i ?p))
+ (vector (intern (format "kp-%d" i)))))
+ ;; The numbered function keys.
+ (dotimes (i 16)
+ (define-key map (format "\e?%c" (+ i ?a))
+ (vector (intern (format "f%d" (1+ i)))))
+ (define-key map (format "\e?%c" (+ i ?A))
+ (vector (intern (format "S-f%d" (1+ i))))))
+ map))
+
(defun terminal-init-tvi970 ()
"Terminal initialization function for tvi970."
- (or (lookup-key local-function-key-map "\e[")
- (define-key local-function-key-map "\e[" (make-keymap)))
- ;; (or (lookup-key local-function-key-map "\eO")
- ;; (define-key local-function-key-map "\eO" (make-keymap)))
-
- ;; Miscellaneous keys
- (mapc (function (lambda (key-binding)
- (define-key local-function-key-map
- (car key-binding) (nth 1 key-binding))))
- '(
- ;; These are set up by termcap or terminfo
- ;; ("\eOP" [kp-f1])
- ;; ("\eOQ" [kp-f2])
- ;; ("\eOR" [kp-f3])
- ;; ("\eOS" [kp-f4])
-
- ;; These might br set by terminfo
- ("\e[H" [home])
- ("\e[Z" [backtab])
- ("\e[i" [print])
- ("\e[@" [insert])
- ("\e[L" [insertline])
- ("\e[M" [deleteline])
- ("\e[U" [next]) ;; actually the `page' key
-
- ;; These won't be set up by either
- ("\eOm" [kp-subtract])
- ("\eOl" [kp-separator])
- ("\eOn" [kp-decimal])
- ("\eOM" [kp-enter])
-
- ;; These won't be set up by either either
- ("\e[K" [key_eol]) ;; Not an X keysym
- ("\e[J" [key_eos]) ;; Not an X keysym
- ("\e[2J" [key_clear]) ;; Not an X keysym
- ("\e[P" [key_dc]) ;; Not an X keysym
- ("\e[g" [S-tab]) ;; Not an X keysym
- ("\e[2N" [clearentry]) ;; Not an X keysym
- ("\e[2K" [S-clearentry]) ;; Not an X keysym
- ("\e[E" [?\C-j]) ;; Not an X keysym
- ("\e[g" [S-backtab]) ;; Not an X keysym
- ("\e[?1i" [key_sprint]) ;; Not an X keysym
- ("\e[4h" [key_sic]) ;; Not an X keysym
- ("\e[4l" [S-delete]) ;; Not an X keysym
- ("\e[Q" [S-insertline]) ;; Not an X keysym
- ("\e[1Q" [key_sdl]) ;; Not an X keysym
- ("\e[19l" [key_seol]) ;; Not an X keysym
- ("\e[19h" [S-erasepage]) ;; Not an X keysym
- ("\e[V" [S-page]) ;; Not an X keysym
- ("\eS" [send]) ;; Not an X keysym
- ("\e5" [S-send]) ;; Not an X keysym
- ))
-
- ;; The numeric keypad keys.
- (let ((i 0))
- (while (< i 10)
- (define-key local-function-key-map
- (format "\eO%c" (+ i ?p))
- (vector (intern (format "kp-%d" i))))
- (setq i (1+ i))))
- ;; The numbered function keys.
- (let ((i 0))
- (while (< i 16)
- (define-key local-function-key-map
- (format "\e?%c" (+ i ?a))
- (vector (intern (format "f%d" (1+ i)))))
- (define-key local-function-key-map
- (format "\e?%c" (+ i ?A))
- (vector (intern (format "S-f%d" (1+ i)))))
- (setq i (1+ i))))
-
+ ;; Use inheritance to let the main keymap override these defaults.
+ ;; This way we don't override terminfo-derived settings or settings
+ ;; made in the .emacs file.
+ (let ((m (copy-keymap tvi970-terminal-map)))
+ (set-keymap-parent m (keymap-parent input-decode-map))
+ (set-keymap-parent input-decode-map m))
(tvi970-set-keypad-mode 1))
\f
-;;; Should keypad numbers send ordinary digits or distinct escape sequences?
-(defvar tvi970-keypad-numeric nil
- "Non-nil means the terminal should be in numeric keypad mode.
-Do not set this variable! Call the function `tvi970-set-keypad-mode'.")
-
+;; Should keypad numbers send ordinary digits or distinct escape sequences?
(defun tvi970-set-keypad-mode (&optional arg)
"Set the current mode of the TVI 970 numeric keypad.
In ``numeric keypad mode'', the number keys on the keypad act as
With a positive argument, select alternate keypad mode.
With a negative argument, select numeric keypad mode."
(interactive "P")
- (setq tvi970-keypad-numeric
- (if (null arg)
- (not tvi970-keypad-numeric)
- (> (prefix-numeric-value arg) 0)))
- (send-string-to-terminal (if tvi970-keypad-numeric "\e=" "\e>")))
+ (let ((newval (if (null arg)
+ (not (terminal-parameter nil 'tvi970-keypad-numeric))
+ (> (prefix-numeric-value arg) 0))))
+ (set-terminal-parameter nil 'tvi970-keypad-numeric newval)
+ (send-string-to-terminal (if newval "\e=" "\e>"))))
-;;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0
+;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0
;;; tvi970.el ends here
"Terminal initialization function for vt200."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: 0f78f583-9f32-4237-b106-28bcfff21d89
+;; arch-tag: 0f78f583-9f32-4237-b106-28bcfff21d89
;;; vt200.el ends here
"Terminal initialization function for vt201."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: a6abb38f-60ea-449e-a9e9-3fb8572c52ae
+;; arch-tag: a6abb38f-60ea-449e-a9e9-3fb8572c52ae
;;; vt201.el ends here
"Terminal initialization function for vt220."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: 98fc4867-a20d-46a1-a276-d7be31e49871
+;; arch-tag: 98fc4867-a20d-46a1-a276-d7be31e49871
;;; vt220.el ends here
"Terminal initialization function for vt240."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: d9f88e9c-02dc-49ff-871c-a415f08e4eb7
+;; arch-tag: d9f88e9c-02dc-49ff-871c-a415f08e4eb7
;;; vt240.el ends here
"Terminal initialization function for vt300."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: 876831c9-a6f2-444a-b033-706e6fbc149f
+;; arch-tag: 876831c9-a6f2-444a-b033-706e6fbc149f
;;; vt300.el ends here
"Terminal initialization function for vt320."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: f9f4c954-0b9e-45f9-b450-a320d32abd9c
+;; arch-tag: f9f4c954-0b9e-45f9-b450-a320d32abd9c
;;; vt320.el ends here
"Terminal initialization function for vt400."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: a70809c5-6b21-42cc-ba20-536683e5e7d5
+;; arch-tag: a70809c5-6b21-42cc-ba20-536683e5e7d5
;;; vt400.el ends here
"Terminal initialization function for vt420."
(tty-run-terminal-initialization (selected-frame) "vt100")
;; Make F11 an escape key.
- (define-key local-function-key-map "\e[23~" [?\e]))
+ (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
+ (define-key local-function-key-map [f11] [?\e]))
-;;; arch-tag: df2f897c-3a12-4b3c-9259-df089f96c160
+;; arch-tag: df2f897c-3a12-4b3c-9259-df089f96c160
;;; vt420.el ends here
(require 'select)
(require 'menu-bar)
(require 'dnd)
+(require 'w32-vars)
;; Keep an obsolete alias for w32-focus-frame in case it is used by code
;; outside Emacs.
(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1")
(defvar xlfd-regexp-registry-subnum)
+(defvar w32-color-map) ;; defined in w32fns.c
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
(if (fboundp 'new-fontset)
;;; Code:
+(defvar wyse50-terminal-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key-definition
+ '( ;; These might be set up by termcap and terminfo
+ ("\C-k" [up])
+ ("\C-j" [down])
+ ("\C-l" [right])
+ ("\C-h" [left])
+ ("\^a@\^m" [f1])
+ ("\^aA\^m" [f2])
+ ("\^aB\^m" [f3])
+ ("\^aC\^m" [f4])
+ ("\^aD\^m" [f5])
+ ("\^aE\^m" [f6])
+ ("\^aF\^m" [f7])
+ ("\^aG\^m" [f8])
+ ("\^aH\^m" [f9])
+
+ ;; These might be set up by terminfo
+ ("\eK" [next])
+ ("\eT" [clearline])
+ ("\^^" [home])
+ ("\e\^^" [end])
+ ("\eQ" [insert])
+ ("\eE" [insertline])
+ ("\eR" [deleteline])
+ ("\eP" [print])
+ ("\er" [replace])
+ ("\^aI\^m" [f10])
+ ("\^aJ\^m" [f11])
+ ("\^aK\^m" [f12])
+ ("\^aL\^m" [f13])
+ ("\^aM\^m" [f14])
+ ("\^aN\^m" [f15])
+ ("\^aO\^m" [f16])
+ ("\^a`\^m" [f17])
+ ("\^aa\^m" [f18])
+ ("\^ab\^m" [f19])
+ ("\^ac\^m" [f20])
+ ("\^ad\^m" [f21])
+ ("\^ae\^m" [f22])
+ ("\^af\^m" [f23])
+ ("\^ag\^m" [f24])
+ ("\^ah\^m" [f25])
+ ("\^ai\^m" [f26])
+ ("\^aj\^m" [f27])
+ ("\^ak\^m" [f28])
+ ("\^al\^m" [f29])
+ ("\^am\^m" [f30])
+ ("\^an\^m" [f31])
+ ("\^ao\^m" [f32])
+
+ ;; Terminfo may know about these, but X won't
+ ("\eI" [key-stab]) ;; Not an X keysym
+ ("\eJ" [key-snext]) ;; Not an X keysym
+ ("\eY" [key-clear]) ;; Not an X keysym
+
+ ;; These are totally strange :-)
+ ("\eW" [?\C-?]) ;; Not an X keysym
+ ("\^a\^k\^m" [funct-up]) ;; Not an X keysym
+ ("\^a\^j\^m" [funct-down]) ;; Not an X keysym
+ ("\^a\^l\^m" [funct-right]) ;; Not an X keysym
+ ("\^a\^h\^m" [funct-left]) ;; Not an X keysym
+ ("\^a\^m\^m" [funct-return]) ;; Not an X keysym
+ ("\^a\^i\^m" [funct-tab]) ;; Not an X keysym
+ ))
+ (define-key map
+ (car key-definition) (nth 1 key-definition)))
+ map))
+
(defun terminal-init-wyse50 ()
"Terminal initialization function for wyse50."
- (define-key local-function-key-map "\C-a" (make-keymap))
- (mapcar (function (lambda (key-definition)
- (define-key local-function-key-map
- (car key-definition) (nth 1 key-definition))))
- '(
- ;; These might be set up by termcap and terminfo
- ("\C-k" [up])
- ("\C-j" [down])
- ("\C-l" [right])
- ("\C-h" [left])
- ("\^a@\^m" [f1])
- ("\^aA\^m" [f2])
- ("\^aB\^m" [f3])
- ("\^aC\^m" [f4])
- ("\^aD\^m" [f5])
- ("\^aE\^m" [f6])
- ("\^aF\^m" [f7])
- ("\^aG\^m" [f8])
- ("\^aH\^m" [f9])
-
- ;; These might be set up by terminfo
- ("\eK" [next])
- ("\eT" [clearline])
- ("\^^" [home])
- ("\e\^^" [end])
- ("\eQ" [insert])
- ("\eE" [insertline])
- ("\eR" [deleteline])
- ("\eP" [print])
- ("\er" [replace])
- ("\^aI\^m" [f10])
- ("\^aJ\^m" [f11])
- ("\^aK\^m" [f12])
- ("\^aL\^m" [f13])
- ("\^aM\^m" [f14])
- ("\^aN\^m" [f15])
- ("\^aO\^m" [f16])
- ("\^a`\^m" [f17])
- ("\^aa\^m" [f18])
- ("\^ab\^m" [f19])
- ("\^ac\^m" [f20])
- ("\^ad\^m" [f21])
- ("\^ae\^m" [f22])
- ("\^af\^m" [f23])
- ("\^ag\^m" [f24])
- ("\^ah\^m" [f25])
- ("\^ai\^m" [f26])
- ("\^aj\^m" [f27])
- ("\^ak\^m" [f28])
- ("\^al\^m" [f29])
- ("\^am\^m" [f30])
- ("\^an\^m" [f31])
- ("\^ao\^m" [f32])
-
- ;; Terminfo may know about these, but X won't
- ("\eI" [key-stab]) ;; Not an X keysym
- ("\eJ" [key-snext]) ;; Not an X keysym
- ("\eY" [key-clear]) ;; Not an X keysym
-
- ;; These are totally strange :-)
- ("\eW" [?\C-?]) ;; Not an X keysym
- ("\^a\^k\^m" [funct-up]) ;; Not an X keysym
- ("\^a\^j\^m" [funct-down]) ;; Not an X keysym
- ("\^a\^l\^m" [funct-right]) ;; Not an X keysym
- ("\^a\^h\^m" [funct-left]) ;; Not an X keysym
- ("\^a\^m\^m" [funct-return]) ;; Not an X keysym
- ("\^a\^i\^m" [funct-tab]) ;; Not an X keysym
- ))
+ ;; Use inheritance to let the main keymap override these defaults.
+ ;; This way we don't override terminfo-derived settings or settings
+ ;; made in the .emacs file.
+ (let ((m (copy-keymap wyse50-terminal-map)))
+ (set-keymap-parent m (keymap-parent input-decode-map))
+ (set-keymap-parent input-decode-map m))
;; Miscellaneous hacks
(concat "\ea23R" (1+ (frame-width)) "C\eG0"))))))
(defun enable-arrow-keys ()
- "To be called by term-setup-hook. Overrides 6 Emacs standard keys
+ "To be called by `term-setup-hook'. Overrides 6 Emacs standard keys
whose functions are then typed as follows:
C-a Funct Left-arrow
C-h M-?
LFD Funct Return, some modes override down-arrow via LFD
C-k CLR Line
C-l Scrn CLR
-M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar
-"
+M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar"
(interactive)
- (mapcar (function (lambda (key-definition)
- (global-set-key (car key-definition)
- (nth 1 key-definition))))
- ;; By unsetting C-a and then binding it to a prefix, we
- ;; allow the rest of the function keys which start with C-a
- ;; to be recognized.
- '(("\C-a" nil)
- ("\C-k" nil)
- ("\C-j" nil)
- ("\C-l" nil)
- ("\C-h" nil)
- ("\er" nil)))
+ ;; Not needed any more now that we use input-decode-map.
+ ;; (dolist (key-definition
+ ;; ;; By unsetting C-a and then binding it to a prefix, we
+ ;; ;; allow the rest of the function keys which start with C-a
+ ;; ;; to be recognized.
+ ;; '(("\C-a" nil)
+ ;; ("\C-k" nil)
+ ;; ("\C-j" nil)
+ ;; ("\C-l" nil)
+ ;; ("\C-h" nil)
+ ;; ("\er" nil)))
+ ;; (global-set-key (car key-definition)
+ ;; (nth 1 key-definition)))
(fset 'enable-arrow-keys nil))
-;;; arch-tag: b6a05d37-eead-4cf6-b997-0f956c68881c
+;; arch-tag: b6a05d37-eead-4cf6-b997-0f956c68881c
;;; wyse50.el ends here
(provide 'x-win)
-(defcustom x-gtk-stock-map
- '(
- ("etc/images/new" . "gtk-new")
- ("etc/images/open" . "gtk-open")
- ("etc/images/diropen" . "n:system-file-manager")
- ("etc/images/close" . "gtk-close")
- ("etc/images/save" . "gtk-save")
- ("etc/images/saveas" . "gtk-save-as")
- ("etc/images/undo" . "gtk-undo")
- ("etc/images/cut" . "gtk-cut")
- ("etc/images/copy" . "gtk-copy")
- ("etc/images/paste" . "gtk-paste")
- ("etc/images/search" . "gtk-find")
- ("etc/images/print" . "gtk-print")
- ("etc/images/preferences" . "gtk-preferences")
- ("etc/images/help" . "gtk-help")
- ("etc/images/left-arrow" . "gtk-go-back")
- ("etc/images/right-arrow" . "gtk-go-forward")
- ("etc/images/home" . "gtk-home")
- ("etc/images/jump-to" . "gtk-jump-to")
- ("etc/images/index" . "gtk-index")
- ("etc/images/search" . "gtk-find")
- ("etc/images/exit" . "gtk-quit"))
- "How icons for tool bars are mapped to Gtk+ stock items.
-Emacs must be compiled with the Gtk+ toolkit for this to have any effect.
-A value that begins with n: denotes a named icon instead of a stock icon."
- :version "22.2"
- :type 'alist
- :group 'x)
-
-(defvar icon-map-list nil
- "*A list of alists that maps icon file names to stock/named icons.
-The alists are searched in the order they appear. The first match is used.
-The keys in the alists are file names without extension and with two directory
-components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm
-to stock item gtk-open, use:
-
- (\"etc/images/open\" . \"gtk-open\")
-
-Themes also have named icons. To map to one of those, use n: before the name:
-
- (\"etc/images/diropen\" . \"n:system-file-manager\")
-
-The list elements are either the symbol name for the alist or the alist itself.")
-
-(defun x-gtk-map-stock (file)
- "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'."
- (let* ((file-sans (file-name-sans-extension file))
- (key (and (string-match "/\\([^/]+/[^/]+/[^/]+$\\)" file-sans)
- (match-string 1 file-sans)))
- (value))
- (mapc (lambda (elem)
- (let ((assoc (if (symbolp elem) (symbol-value elem) elem)))
- (or value (setq value (assoc-string (or key file-sans) assoc)))))
- icon-map-list)
- (and value (cdr value))))
-
;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
;;; x-win.el ends here
(send-string-to-terminal "\e[>0c")
;; The reply should be of the form: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
- (when (equal (read-event nil nil 0.1) ?\e)
- (when (equal (read-event nil nil 0.1) ?\[)
- (while (not (equal (setq chr (read-event nil nil 0.1)) ?c))
+ ;; If the timeout is completely removed for read-event, this
+ ;; might hang for terminals that pretend to be xterm, but don't
+ ;; respond to this escape sequence. RMS' opinion was to remove
+ ;; it completely. That might be right, but let's first try to
+ ;; see if by using a longer timeout we get rid of most issues.
+ (when (equal (read-event nil nil 2) ?\e)
+ (when (equal (read-event nil nil 2) ?\[)
+ (while (not (equal (setq chr (read-event nil nil 2)) ?c))
(setq str (concat str (string chr))))
(when (string-match ">0;\\([0-9]+\\);0" str)
;; NUMBER2 is the xterm version number, look for something
keyword var value
This variable is best set in the file local variables, or through
`conf-space-keywords-alist'.")
+(put 'conf-space-keywords 'safe-local-variable 'stringp)
(defvar conf-space-font-lock-keywords
`(;; [section] (do this first because it may look like a parameter)
"Cascading Style Sheets (CSS) editing mode."
:group 'languages)
+(eval-when-compile (require 'cl))
+
(defun css-extract-keyword-list (res)
(with-temp-buffer
(url-insert-file-contents "http://www.w3.org/TR/REC-CSS2/css2.txt")
(aset fc c 'indent-according-to-mode))
(set (make-local-variable 'auto-fill-chars) fc))))
+(defvar comment-continue)
+
(defun css-fill-paragraph (&optional justify)
(save-excursion
(let ((ppss (syntax-ppss))
;; css-mode but for all modes.
(save-restriction
(narrow-to-region (nth 8 ppss) eol)
- (comment-normalize-vars)
+ (comment-normalize-vars) ;Will define comment-continue.
(let ((fill-paragraph-function nil)
(paragraph-separate
(if (and comment-continue
Can be customized with the variables `fill-nobreak-predicate'
and `fill-nobreak-invisible'."
(or
- (and fill-nobreak-invisible (line-move-invisible-p (point)))
+ (and fill-nobreak-invisible (invisible-p (point)))
(unless (bolp)
(or
;; Don't break after a period followed by just one space.
;; 1. Fill the region if it is active when called interactively.
(and region transient-mark-mode mark-active
(not (eq (region-beginning) (region-end)))
- (fill-region (region-beginning) (region-end) justify))
+ (or (fill-region (region-beginning) (region-end) justify) t))
;; 2. Try fill-paragraph-function.
(and (not (eq fill-paragraph-function t))
(or fill-paragraph-function
;;; org-export-latex.el --- LaTeX exporter for org-mode
;;
-;; Copyright (C) 2007 Free Software Foundation, Inc.
+;; copyright (c) 2007 free software foundation, inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: org-export-latex.el
-;; Version: 5.11
+;; Version: 5.12
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
;; Keywords: org, wp, tex
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
-;;
+;;
;; You should have received a copy of the GNU General Public License along
;; with GNU Emacs; see the file COPYING. If not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
(defvar org-latex-add-level 0)
(defvar org-latex-sectioning-depth 0)
(defvar org-export-latex-list-beginning-re
- "^\\([ \t]*\\)\\([-+]\\|[0-9]+\\(?:\\.\\|)\\)\\) *?")
+ "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?")
(defvar org-latex-special-string-regexps
'(org-ts-regexp
;; insert the title
(format
"\\title{%s}\n"
- (or (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name)))
- "UNTITLED"))
+ ;; convert the title
+ (org-export-latex-content
+ (or (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED")))
;; insert author info
(if (plist-get opt-plist :author-info)
formatting string like %%%%s if we want to comment them out."
(save-excursion
(goto-char (point-min))
- (let* ((end (if (re-search-forward "^\\*" nil t)
+ (let* ((pt (point))
+ (end (if (and (re-search-forward "^\\*" nil t)
+ (not (eq pt (match-beginning 0))))
(goto-char (match-beginning 0))
(goto-char (point-max)))))
(org-export-latex-content
(let* ((beg (org-table-begin))
(end (org-table-end))
(raw-table (buffer-substring-no-properties beg end))
- fnum line lines olines gr colgropen line-fmt alignment)
+ fnum fields line lines olines gr colgropen line-fmt align)
(if org-export-latex-tables-verbatim
(let* ((tbl (concat "\\begin{verbatim}\n" raw-table
"\\end{verbatim}\n")))
(when (and (re-search-forward (regexp-quote foot-prefix) nil t))
(replace-match "")
(let ((end (save-excursion
- (if (re-search-forward "^$\\|\\[[0-9]+\\]" nil t)
+ (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t)
(match-beginning 0) (point-max)))))
(setq footnote
(concat
;; Author: David O'Toole <dto@gnu.org>
;; Keywords: hypermedia, outlines
-;; Version: 1.80
+;; Version: 1.80a
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
(defun org-publish-get-plist-from-filename (filename)
"Return publishing configuration plist for file FILENAME."
(let ((found nil))
- (mapc
+ (mapcar
(lambda (plist)
(let ((files (org-publish-get-base-files plist)))
(if (member (expand-file-name filename) files)
;;;; Pluggable publishing back-end functions
-
-(defun org-publish-org-to-html (plist filename)
- "Publish an org file to HTML.
-PLIST is the property list for the given project.
-FILENAME is the filename of the org file to be published."
- (require 'org)
- (let* ((arg (plist-get plist :headline-levels)))
- (progn
- (find-file filename)
- (org-export-as-html arg nil plist)
- ;; get rid of HTML buffer
- (kill-buffer (current-buffer)))))
-
-
(defun org-publish-org-to-latex (plist filename)
"Publish an org file to LaTeX."
(org-publish-org-to "latex" plist filename))
PLIST is the property list for the given project.
FILENAME is the filename of the file to be published."
;; make sure eshell/cp code is loaded
- (require 'eshell)
- (require 'esh-maint)
- (require 'em-unix)
+ (eval-and-compile
+ (require 'eshell)
+ (require 'esh-maint)
+ (require 'em-unix))
(let ((destination (file-name-as-directory (plist-get plist :publishing-directory))))
(eshell/cp filename destination)))
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 5.11b
+;; Version: 5.13g
;;
;; This file is part of GNU Emacs.
;;
;;; Version
-(defconst org-version "5.11"
+(defconst org-version "5.13g"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
"Define a key, possibly translated, as returned by `org-key'."
(define-key keymap (org-key key) def))
-(defcustom org-ellipsis nil
+(defcustom org-ellipsis 'org-ellipsis
"The ellipsis to use in the Org-mode outline.
When nil, just use the standard three dots. When a string, use that instead,
When a face, use the standart 3 dots, but with the specified face.
.....
:END:
The drawer \"PROPERTIES\" is special for capturing properties through
-the property API."
+the property API.
+
+Drawers can be defined on the per-file basis with a line like:
+
+#+DRAWERS: HIDDEN STATE PROPERTIES"
:group 'org-structure
:type '(repeat (string :tag "Drawer Name")))
(defcustom org-confirm-shell-link-function 'yes-or-no-p
"Non-nil means, ask for confirmation before executing shell links.
-Shell links can be dangerous, just thing about a link
+Shell links can be dangerous: just think about a link
[[shell:rm -rf ~/*][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\"
+This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
-Therefore I *definitely* advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a single key press
-rather than having to type \"yes\"."
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' of you want to confirm with a
+single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
(const :tag "with yes-or-no (safer)" yes-or-no-p)
(const :tag "no confirmation (dangerous)" nil)))
(defcustom org-confirm-elisp-link-function 'yes-or-no-p
- "Non-nil means, ask for confirmation before executing elisp links.
-Elisp links can be dangerous, just think about a link
+ "Non-nil means, ask for confirmation before executing Emacs Lisp links.
+Elisp links can be dangerous: just think about a link
[[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\"
+This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
-Therefore I *definitely* advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a single key press
-rather than having to type \"yes\"."
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' of you want to confirm with a
+single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
(const :tag "with yes-or-no (safer)" yes-or-no-p)
(defcustom org-remember-templates nil
"Templates for the creation of remember buffers.
When nil, just let remember make the buffer.
-When not nil, this is a list of 4-element lists. In each entry, the first
-element is a character, a unique key to select this template.
-The second element is the template. The third element is optional and can
+When not nil, this is a list of 5-element lists. In each entry, the first
+element is a the name of the template, It should be a single short word.
+The second element is a character, a unique key to select this template.
+The third element is the template. The forth element is optional and can
specify a destination file for remember items created with this template.
-The default file is given by `org-default-notes-file'. An optional forth
+The default file is given by `org-default-notes-file'. An optional fifth
element can specify the headline in that file that should be offered
first when the user is asked to file the entry. The default headline is
given in the variable `org-remember-default-headline'.
info | %:type %:file %:node
calendar | %:type %:date"
:group 'org-remember
- :get (lambda (var) ; Make sure all entries have 4 elements
+ :get (lambda (var) ; Make sure all entries have 5 elements
(mapcar (lambda (x)
- (cond ((= (length x) 3) (append x '("")))
- ((= (length x) 2) (append x '("" "")))
+ (if (not (stringp (car x))) (setq x (cons "" x)))
+ (cond ((= (length x) 4) (append x '("")))
+ ((= (length x) 3) (append x '("" "")))
(t x)))
(default-value var)))
:type '(repeat
:tag "enabled"
- (list :value (?a "\n" nil nil)
+ (list :value ("" ?a "\n" nil nil)
+ (string :tag "Name")
(character :tag "Selection Key")
(string :tag "Template")
- (file :tag "Destination file (optional)")
- (string :tag "Destination headline (optional)"))))
+ (choice
+ (file :tag "Destination file")
+ (const :tag "Prompt for file" nil))
+ (choice
+ (string :tag "Destination headline")
+ (const :tag "Selection interface for heading")))))
(defcustom org-reverse-note-order nil
"Non-nil means, store new notes at the beginning of a file or entry.
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-deadline-warning-days 14
- "No. of days before expiration during which a deadline becomes active.
-This variable governs the display in sparse trees and in the agenda.
-When negative, it means use this number (the absolute value of it)
-even if a deadline has a different individual lead time specified."
- :group 'org-time
- :type 'number)
-
(defcustom org-popup-calendar-for-date-prompt t
"Non-nil means, pop up a calendar when prompting for a date.
In the calendar, the date can be selected with mouse-1. However, the
:group 'org-properties
:type 'string)
+(defcustom org-use-property-inheritance nil
+ "Non-nil means, properties apply also for sublevels.
+This can cause significant overhead when doing a search, so this is turned
+off by default.
+When nil, only the properties directly given in the current entry count.
+
+However, note that some special properties use inheritance under special
+circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
+and the properties ending in \"_ALL\" when they are used as descriptor
+for valid values of a property."
+ :group 'org-properties
+ :type 'boolean)
+
(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
"The default column format, if no other format has been defined.
This variable can be set on the per-file basis by inserting a line
Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
\\[org-remove-file]. You can also use customize to edit the list.
+If an entry is a directory, all files in that directory that are matched by
+`org-agenda-file-regexp' will be part of the file list.
+
If the value of the variable is not a list but a single file name, then
the list of agenda files is actually stored and maintained in that file, one
agenda file per line."
:group 'org-agenda
:type '(choice
- (repeat :tag "List of files" file)
+ (repeat :tag "List of files and directories" file)
(file :tag "Store list in a file\n" :value "~/.agenda_files")))
+(defcustom org-agenda-file-regexp "\\.org\\'"
+ "Regular expression to match files for `org-agenda-files'.
+If any element in the list in that variable contains a directory instead
+of a normal file, all files in that directory that are matched by this
+regular expression will be included."
+ :group 'org-agenda
+ :type 'regexp)
+
(defcustom org-agenda-skip-unavailable-files nil
"t means to just skip non-reachable files in `org-agenda-files'.
Nil means to remove them, after a query, from the list."
:group 'org-agenda
:type 'boolean)
+(defcustom org-agenda-multi-occur-extra-files nil
+ "List of extra files to be searched by `org-occur-in-agenda-files'.
+The files in `org-agenda-files' are always searched."
+ :group 'org-agenda
+ :type '(repeat file))
+
(defcustom org-agenda-confirm-kill 1
"When set, remote killing from the agenda buffer needs confirmation.
When t, a confirmation is always needed. When a number N, confirmation is
These commands will be offered on the splash screen displayed by the
agenda dispatcher \\[org-agenda]. Each entry is a list like this:
- (key type match options files)
+ (key desc type match options files)
-key The key (a single char as a string) to be associated with the command.
+key The key (one or more characters as a string) to be associated
+ with the command.
+desc A description of the commend, when omitted or nil, a default
+ description is built using MATCH.
type The command type, any of the following symbols:
todo Entries with a specific TODO keyword, in all agenda files.
tags Tags match in all agenda files.
todo-tree Sparse tree of specific TODO keyword in *current* file.
tags-tree Sparse tree with all tags matches in *current* file.
occur-tree Occur sparse tree for *current* file.
+ ... A user-defined function.
match What to search for:
- a single keyword for TODO keyword searches
- a tags match expression for tags searches
Each command can carry a list of options, and another set of options can be
given for the whole set of commands. Individual command options take
-precedence over the general options."
+precedence over the general options.
+
+When using several characters as key to a command, the first characters
+are prefix commands. For the dispatcher to display useful information, you
+should provide a description for the prefix, like
+
+ (setq org-agenda-custom-commands
+ '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
+ (\"hl\" tags \"+HOME+Lisa\")
+ (\"hp\" tags \"+HOME+Peter\")
+ (\"hk\" tags \"+HOME+Kim\")))"
:group 'org-agenda-custom-commands
:type '(repeat
- (choice :value ("a" tags "" nil)
+ (choice :value ("a" "" tags "" nil)
(list :tag "Single command"
- (string :tag "Key")
+ (string :tag "Access Key(s) ")
+ (option (string :tag "Description"))
(choice
(const :tag "Agenda" agenda)
(const :tag "TODO list" alltodo)
(const :tag "Tags sparse tree (current buffer)" tags-tree)
(const :tag "TODO keyword tree (current buffer)" todo-tree)
(const :tag "Occur tree (current buffer)" occur-tree)
- (symbol :tag "Other, user-defined function"))
+ (sexp :tag "Other, user-defined function"))
(string :tag "Match")
(repeat :tag "Local options"
(list (variable :tag "Option") (sexp :tag "Value")))
(option (repeat :tag "Export" (file :tag "Export to"))))
(list :tag "Command series, all agenda files"
- (string :tag "Key")
- (string :tag "Description")
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")
(repeat
(choice
(const :tag "Agenda" (agenda))
(repeat :tag "General options"
(list (variable :tag "Option")
(sexp :tag "Value")))
- (option (repeat :tag "Export" (file :tag "Export to")))))))
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (cons :tag "Prefix key documentation"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")))))
(defcustom org-stuck-projects
'("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
:group 'org-todo
:type 'boolean)
+(defcustom org-agenda-todo-ignore-with-date nil
+ "Non-nil means, don't show entries with a date in the global todo list.
+You can use this if you prefer to mark mere appointments with a TODO keyword,
+but don't want them to show up in the TODO list.
+When this is set, it also covers deadlines and scheduled items, the settings
+of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
+will be ignored."
+ :group 'org-agenda-skip
+ :group 'org-todo
+ :type 'boolean)
+
(defcustom org-agenda-todo-ignore-scheduled nil
"Non-nil means, don't show scheduled entries in the global todo list.
The idea behind this is that by scheduling it, you have already taken care
-of this item."
+of this item.
+See also `org-agenda-todo-ignore-with-date'."
:group 'org-agenda-skip
:group 'org-todo
:type 'boolean)
(defcustom org-agenda-todo-ignore-deadlines nil
"Non-nil means, don't show near deadline entries in the global todo list.
Near means closer than `org-deadline-warning-days' days.
-The idea behind this is that such items will appear in the agenda anyway."
+The idea behind this is that such items will appear in the agenda anyway.
+See also `org-agenda-todo-ignore-with-date'."
:group 'org-agenda-skip
:group 'org-todo
:type 'boolean)
(const other-window)
(const reorganize-frame)))
+(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
+ "The min and max height of the agenda window as a fraction of frame height.
+The value of the variable is a cons cell with two numbers between 0 and 1.
+It only matters if `org-agenda-window-setup' is `reorganize-frame'."
+ :group 'org-agenda-windows
+ :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
+
(defcustom org-agenda-restore-windows-after-quit nil
"Non-nil means, restore window configuration open exiting agenda.
Before the window configuration is changed for displaying the agenda,
:group 'org-agenda-daily/weekly
:type 'boolean)
+(defcustom org-deadline-warning-days 14
+ "No. of days before expiration during which a deadline becomes active.
+This variable governs the display in sparse trees and in the agenda.
+When negative, it means use this number (the absolute value of it)
+even if a deadline has a different individual lead time specified."
+ :group 'org-time
+ :group 'org-agenda-daily/weekly
+ :type 'number)
+
+(defcustom org-scheduled-past-days 10000
+ "No. of days to continue listing scheduled items that are not marked DONE.
+When an item is scheduled on a date, it shows up in the agenda on this
+day and will be listed until it is marked done for the number of days
+given here."
+ :group 'org-agenda-daily/weekly
+ :type 'number)
+
(defgroup org-agenda-time-grid nil
"Options concerning the time grid in the Org-mode Agenda."
:tag "Org Agenda Time Grid"
"The compiled version of the most recently used prefix format.
See the variable `org-agenda-prefix-format'.")
+(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
+ "Text preceeding scheduled items in the agenda view.
+THis is a list with two strings. The first applies when the item is
+scheduled on the current day. The second applies when it has been scheduled
+previously, it may contain a %d to capture how many days ago the item was
+scheduled."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Scheduled today ")
+ (string :tag "Scheduled previously")))
+
+(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ")
+ "Text preceeding deadline items in the agenda view.
+This is a list with two strings. The first applies when the item has its
+deadline on the current day. The second applies when it is in the past or
+in the future, it may contain %d to capture how many days away the deadline
+is (was)."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Deadline today ")
+ (string :tag "Deadline relative")))
+
(defcustom org-agenda-remove-times-when-in-prefix t
"Non-nil means, remove duplicate time specifications in agenda items.
When the format `org-agenda-prefix-format' contains a `%t' specifier, a
(if (fboundp 'defvaralias)
(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
+(defcustom org-agenda-fontify-priorities t
+ "Non-nil means, highlight low and high priorities in agenda.
+When t, the highest priority entries are bold, lowest priority italic.
+This may also be an association list of priority faces. The face may be
+a names face, or a list like `(:background \"Red\")'."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Defaults" t)
+ (repeat :tag "Specify"
+ (list (character :tag "Priority" :value ?A)
+ (sexp :tag "face")))))
+
(defgroup org-latex nil
"Options for embedding LaTeX code into Org-mode"
:tag "Org LaTeX"
(defcustom org-export-with-tags 'not-in-toc
"If nil, do not export tags, just remove them from headlines.
If this is the symbol `not-in-toc', tags will be removed from table of
-contents entries, but still be shown in the headlines of the document."
+contents entries, but still be shown in the headlines of the document.
+
+This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
:group 'org-export-general
:type '(choice
(const :tag "Off" nil)
(const :tag "Not in TOC" not-in-toc)
(const :tag "On" t)))
-(defcustom org-export-with-property-drawer nil
- "Non-nil means, export property drawers.
-When nil, these drawers are removed before export.
-
-This option can also be set with the +OPTIONS line, e.g. \"p:t\"."
+(defcustom org-export-with-drawers nil
+ "Non-nil means, export with drawers like the property drawer.
+When t, all drawers are exported. This may also be a list of
+drawer names to export."
:group 'org-export-general
- :type 'boolean)
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))))
(defgroup org-export-translation nil
"Options for translating special ascii sequences for the export backends."
"Face for links."
:group 'org-faces)
+(defface org-ellipsis
+ '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t))
+ (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t))
+ (t (:strike-through t)))
+ "Face for the ellipsis in folded text."
+ :group 'org-faces)
+
(defface org-target
'((((class color) (background light)) (:underline t))
(((class color) (background dark)) (:underline t))
(defvar org-todo-line-regexp nil
"Matches a headline and puts TODO state into group 2 if present.")
(make-variable-buffer-local 'org-todo-line-regexp)
+(defvar org-complex-heading-regexp nil
+ "Matches a headline and puts everything into groups:
+group 1: the stars
+group 2: The todo keyword, maybe
+group 3: Priority cookie
+group 4: True headline
+group 5: Tags")
+(make-variable-buffer-local 'org-complex-heading-regexp)
(defvar org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
(let ((re (org-make-options-regexp
'("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS"
"STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES"
- "CONSTANTS" "PROPERTY")))
+ "CONSTANTS" "PROPERTY" "DRAWERS")))
(splitre "[ \t]+")
kwds kws0 kwsa key value cat arch tags const links hw dws
- tail sep kws1 prio props
- ex log note)
+ tail sep kws1 prio props drawers
+ ex log)
(save-excursion
(save-restriction
(widen)
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
(push (cons (match-string 1 value) (match-string 2 value))
props)))
+ ((equal key "DRAWERS")
+ (setq drawers (org-split-string value splitre)))
((equal key "CONSTANTS")
(setq const (append const (org-split-string value splitre))))
((equal key "STARTUP")
(org-set-local 'org-lowest-priority (nth 1 prio))
(org-set-local 'org-default-priority (nth 2 prio)))
(and props (org-set-local 'org-local-properties (nreverse props)))
+ (and drawers (org-set-local 'org-drawers drawers))
(and arch (org-set-local 'org-archive-location arch))
(and links (setq org-link-abbrev-alist-local (nreverse links)))
;; Process the TODO keywords
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)\\>\\)?[ \t]*\\(.*\\)")
+ org-complex-heading-regexp
+ (concat "^\\(\\*+\\)\\(?:[ \t]+\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
+ "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
org-nl-done-regexp
(concat "\n\\*+[ \t]+"
"\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
(defvar texmathp-why)
(defvar remember-save-after-remembering)
(defvar remember-data-file)
+(defvar remember-register)
+(defvar remember-buffer)
(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
(defvar org-latex-regexps)
(defconst org-nonsticky-props
'(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
+
(defun org-activate-plain-links (limit)
"Run through the buffer and add overlays to links."
(catch 'exit
))
(throw 'exit t))))))
+(defun org-activate-code (limit)
+ (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t)
+ (unless (get-text-property (match-beginning 1) 'face)
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ t)))
+
(defun org-activate-angle-links (limit)
"Run through the buffer and add overlays to links."
(if (re-search-forward org-angle-link-re limit t)
(2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
;; Table lines
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
- (1 'org-table))
+ (1 'org-table t))
+ ;; Table internals
+ '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
+ '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
+ '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
+ ;; Drawers
+ (list org-drawer-regexp '(0 'org-special-keyword t))
+ (list "^[ \t]*:END:" '(0 'org-special-keyword t))
+ ;; Properties
+ (list org-property-re
+ '(1 'org-special-keyword t)
+ '(3 'org-property-value t))
+ (if org-format-transports-properties-p
+ '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
;; Links
(if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
(if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
(if (featurep 'xemacs)
'(org-do-emphasis-faces (0 nil append))
'(org-do-emphasis-faces)))
- ;; Checkboxes, similar to Frank Ruell's org-checklet.el
+ ;; Checkboxes
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
2 'bold prepend)
(if org-provide-checkbox-statistics
"\\|" org-quote-string "\\)\\>")
'(1 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
- ;; Code
- '("^[ \t]*\\(:.*\\)" (1 'org-code t))
- ;; Table internals
- '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
- '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
- '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
- ;; Drawers
- (list org-drawer-regexp '(0 'org-special-keyword t))
- (list "^[ \t]*:END:" '(0 'org-special-keyword t))
- ;; Properties
- (list org-property-re
- '(1 'org-special-keyword t)
- '(3 'org-property-value t))
- (if org-format-transports-properties-p
- '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
'("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
+ ;; Code
+ '(org-activate-code (1 'org-code t))
)))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
;; Now set the full font-lock-keywords
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*\\*+ " nil t)
- (setq n (/ (length (1- (match-string 0))) 2))
+ (setq n (/ (1- (length (match-string 0))) 2))
(while (>= (setq n (1- n)) 0)
(org-promote))
(end-of-line 1))))))
"Was the last copied subtree folded?
This is used to fold the tree back after pasting.")
-(defun org-cut-subtree ()
+(defun org-cut-subtree (&optional n)
"Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
This is a short-hand for marking the subtree and then cutting it."
- (interactive)
- (org-copy-subtree 'cut))
+ (interactive "p")
+ (org-copy-subtree n 'cut))
-(defun org-copy-subtree (&optional cut)
+(defun org-copy-subtree (&optional n cut)
"Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
This is a short-hand for marking the subtree and then copying it.
If CUT is non-nil, actually cut the subtree."
- (interactive)
+ (interactive "p")
(let (beg end folded)
(if (interactive-p)
(org-back-to-heading nil) ; take what looks like a subtree
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (org-invisible-p)))
- (outline-end-of-subtree))
- (if (equal (char-after) ?\n) (forward-char 1))
+ (condition-case nil
+ (outline-forward-same-level (1- n))
+ (error nil))
+ (org-end-of-subtree t t))
(setq end (point))
(goto-char beg)
(when (> end beg)
(setq org-subtree-clip-folded folded)
(if cut (kill-region beg end) (copy-region-as-kill beg end))
(setq org-subtree-clip (current-kill 0))
- (message "%s: Subtree with %d characters"
+ (message "%s: Subtree(s) with %d characters"
(if cut "Cut" "Copied")
(length org-subtree-clip)))))
(let* ((txt (or tree (and kill-ring (current-kill 0))))
(^re (concat "^\\(" outline-regexp "\\)"))
(re (concat "\\(" outline-regexp "\\)"))
- (^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
+ (^re_ (concat "\\(\\*+\\)[ \t]*"))
(old-level (if (string-match ^re txt)
(- (match-end 0) (match-beginning 0) 1)
(force-level (cond (level (prefix-numeric-value level))
((string-match
^re_ (buffer-substring (point-at-bol) (point)))
- (- (match-end 0) (match-beginning 0)))
+ (- (match-end 1) (match-beginning 1)))
(t nil)))
(previous-level (save-excursion
(condition-case nil
(progn
(outline-previous-visible-heading 1)
(if (looking-at re)
- (- (match-end 0) (match-beginning 0))
+ (- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
(next-level (save-excursion
(condition-case nil
(progn
- (outline-next-visible-heading 1)
+ (or (looking-at outline-regexp)
+ (outline-next-visible-heading 1))
(if (looking-at re)
- (- (match-end 0) (match-beginning 0))
+ (- (match-end 0) (match-beginning 0) 1)
1))
(error 1))))
(new-level (or force-level (max previous-level next-level)))
(= old-level new-level))
0
(- new-level old-level)))
- (shift1 shift)
(delta (if (> shift 0) -1 1))
(func (if (> shift 0) 'org-demote 'org-promote))
(org-odd-levels-only nil)
;;; Outline Sorting
(defun org-sort (with-case)
- "Call `org-sort-entries' or `org-table-sort-lines', depending on context."
+ "Call `org-sort-entries-or-items' or `org-table-sort-lines'.
+Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
(if (org-at-table-p)
(org-call-with-arg 'org-table-sort-lines with-case)
- (org-call-with-arg 'org-sort-entries with-case)))
+ (org-call-with-arg 'org-sort-entries-or-items with-case)))
-(defun org-sort-entries (&optional with-case sorting-type)
+(defvar org-priority-regexp) ; defined later in the file
+
+(defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property)
"Sort entries on a certain level of an outline tree.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
Sorting can be alphabetically, numerically, and by date/time as given by
the first time stamp in the entry. The command prompts for the sorting
type unless it has been given to the function through the SORTING-TYPE
-argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T).
+argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F).
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
+called with point at the beginning of the record. It must return either
+a string or a number that should serve as the sorting key for that record.
Comparing entries ignores case by default. However, with an optional argument
-WITH-CASE, the sorting considers case as well. With two prefix arguments
-`C-u C-u', sorting is case-sensitive and duplicate entries will be removed."
+WITH-CASE, the sorting considers case as well."
(interactive "P")
- (let ((unique (equal with-case '(16)))
- start beg end entries stars re re2 p nentries (nremoved 0)
- last txt what)
+ (let ((case-func (if with-case 'identity 'downcase))
+ start beg end stars re re2
+ txt what tmp plain-list-p)
;; Find beginning and end of region to sort
(cond
((org-region-active-p)
;; we will sort the region
(setq end (region-end)
- what "region")
+ what "region")
(goto-char (region-beginning))
(if (not (org-on-heading-p)) (outline-next-heading))
(setq start (point)))
+ ((org-at-item-p)
+ ;; we will sort this plain list
+ (org-beginning-of-item-list) (setq start (point))
+ (org-end-of-item-list) (setq end (point))
+ (goto-char start)
+ (setq plain-list-p t
+ what "plain list"))
((or (org-on-heading-p)
- (condition-case nil (progn (org-back-to-heading) t) (error nil)))
+ (condition-case nil (progn (org-back-to-heading) t) (error nil)))
;; we will sort the children of the current headline
(org-back-to-heading)
(setq start (point) end (org-end-of-subtree) what "children")
(setq start (point) end (point-max) what "top-level")
(goto-char start)
(show-all)))
- (setq beg (point))
- (if (>= (point) end) (error "Nothing to sort"))
- (looking-at "\\(\\*+\\)")
- (setq stars (match-string 1)
- re (concat "^" (regexp-quote stars) " +")
- re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
- txt (buffer-substring beg end))
- (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
- (if (and (not (equal stars "*")) (string-match re2 txt))
- (error "Region to sort contains a level above the first entry"))
- ;; Make a list that can be sorted.
- ;; The car is the string for comparison, the cdr is the subtree
- (message "Sorting entries...")
- (setq entries
- (mapcar
- (lambda (x)
- (string-match "^.*\\(\n.*\\)?" x) ; take two lines
- (cons (match-string 0 x) x))
- (org-split-string txt re)))
- ;; Sort the list
- (save-excursion
- (goto-char start)
- (setq entries (org-do-sort entries what with-case sorting-type)))
+ (setq beg (point))
+ (if (>= beg end) (error "Nothing to sort"))
+
+ (unless plain-list-p
+ (looking-at "\\(\\*+\\)")
+ (setq stars (match-string 1)
+ re (concat "^" (regexp-quote stars) " +")
+ re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
+ txt (buffer-substring beg end))
+ (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
+ (if (and (not (equal stars "*")) (string-match re2 txt))
+ (error "Region to sort contains a level above the first entry")))
+
+ (unless sorting-type
+ (message
+ (if plain-list-p
+ "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
+ "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:")
+ what)
+ (setq sorting-type (read-char-exclusive))
+
+ (and (= (downcase sorting-type) ?f)
+ (setq getkey-func
+ (completing-read "Sort using function: "
+ obarray 'fboundp t nil nil))
+ (setq getkey-func (intern getkey-func)))
+
+ (and (= (downcase sorting-type) ?r)
+ (setq property
+ (completing-read "Property: "
+ (mapcar 'list (org-buffer-property-keys t))
+ nil t))))
- ;; Delete the old stuff
- (goto-char beg)
- (kill-region beg end)
- (setq nentries (length entries))
- ;; Insert the sorted entries, and remove duplicates if this is required
- (while (setq p (pop entries))
- (if (and unique (equal last (setq last (org-trim (cdr p)))))
- (setq nremoved (1+ nremoved)) ; same entry as before, skip it
- (insert stars " " (cdr p))))
- (goto-char start)
- (message "Sorting entries...done (%d entries%s)"
- nentries
- (if unique (format ", %d duplicates removed" nremoved) ""))))
+ (message "Sorting entries...")
-(defvar org-priority-regexp) ; defined later in the file
+ (save-restriction
+ (narrow-to-region start end)
+
+ (let ((dcst (downcase sorting-type))
+ (now (current-time)))
+ (sort-subr
+ (/= dcst sorting-type)
+ ;; This function moves to the beginning character of the "record" to
+ ;; be sorted.
+ (if plain-list-p
+ (lambda nil
+ (if (org-at-item-p) t (goto-char (point-max))))
+ (lambda nil
+ (if (re-search-forward re nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))))
+ ;; This function moves to the last character of the "record" being
+ ;; sorted.
+ (if plain-list-p
+ 'org-end-of-item
+ (lambda nil
+ (save-match-data
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error
+ (goto-char (point-max)))))))
+
+ ;; This function returns the value that gets sorted against.
+ (if plain-list-p
+ (lambda nil
+ (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+")
+ (cond
+ ((= dcst ?n)
+ (string-to-number (buffer-substring (match-end 0)
+ (line-end-position))))
+ ((= dcst ?a)
+ (buffer-substring (match-end 0) (line-end-position)))
+ ((= dcst ?t)
+ (if (re-search-forward org-ts-regexp
+ (line-end-position) t)
+ (org-time-string-to-time (match-string 0))
+ now))
+ ((= dcst ?f)
+ (if getkey-func
+ (progn
+ (setq tmp (funcall getkey-func))
+ (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ tmp)
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))
+ (lambda nil
+ (cond
+ ((= dcst ?n)
+ (if (looking-at outline-regexp)
+ (string-to-number (buffer-substring (match-end 0)
+ (line-end-position)))
+ nil))
+ ((= dcst ?a)
+ (funcall case-func (buffer-substring (line-beginning-position)
+ (line-end-position))))
+ ((= dcst ?t)
+ (if (re-search-forward org-ts-regexp
+ (save-excursion
+ (forward-line 2)
+ (point)) t)
+ (org-time-string-to-time (match-string 0))
+ now))
+ ((= dcst ?p)
+ (if (re-search-forward org-priority-regexp (line-end-position) t)
+ (string-to-char (match-string 2))
+ org-default-priority))
+ ((= dcst ?r)
+ (or (org-entry-get nil property) ""))
+ ((= dcst ?f)
+ (if getkey-func
+ (progn
+ (setq tmp (funcall getkey-func))
+ (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ tmp)
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))
+ nil
+ (cond
+ ((= dcst ?a) 'string<)
+ ((= dcst ?t) 'time-less-p)
+ (t nil)))))
+ (message "Sorting entries...done")))
(defun org-do-sort (table what &optional with-case sorting-type)
"Sort TABLE of WHAT according to SORTING-TYPE.
If WITH-CASE is non-nil, the sorting will be case-sensitive."
(unless sorting-type
(message
- "Sort %s: [a]lphabetic. [n]umeric. [t]ime [p]riority. A/N/T/P means reversed:"
+ "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:"
what)
(setq sorting-type (read-char-exclusive)))
(let ((dcst (downcase sorting-type))
(org-time-string-to-time (match-string 0 x)))
0))
comparefun (if (= dcst sorting-type) '< '>)))
- ((= dcst ?p)
- (setq extractfun
- (lambda (x)
- (if (string-match org-priority-regexp x)
- (string-to-char (match-string 2 x))
- org-default-priority))
- comparefun (if (= dcst sorting-type) '< '>)))
(t (error "Invalid sorting type `%c'" sorting-type)))
(sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
(org-beginning-of-item-list)
(org-at-item-p)
(beginning-of-line 1)
- (let ((current (match-string 0)) new)
+ (let ((current (match-string 0))
+ (prevp (eq which 'previous))
+ new)
(setq new (cond
- ((and which (nth (1- which) '("-" "+" "*" "1." "1)"))))
- ((string-match "-" current) "+")
+ ((and (numberp which)
+ (nth (1- which) '("-" "+" "*" "1." "1)"))))
+ ((string-match "-" current) (if prevp "1)" "+"))
((string-match "\\+" current)
- (if (looking-at "\\S-") "1." "*"))
- ((string-match "\\*" current) "1.")
- ((string-match "\\." current) "1)")
- ((string-match ")" current) "-")
+ (if prevp "-" (if (looking-at "\\S-") "1." "*")))
+ ((string-match "\\*" current) (if prevp "+" "1."))
+ ((string-match "\\." current) (if prevp "*" "1)"))
+ ((string-match ")" current) (if prevp "1." "-"))
(t (error "This should not happen"))))
(and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new)))
(org-fix-bullet-type)
(when (org-at-item-p) (setq pos (point-at-bol)))))))
(goto-char pos)))
+
+(defun org-end-of-item-list ()
+ "Go to the end of the current item list.
+I.e. to the text after the last item."
+ (interactive)
+ (org-beginning-of-item)
+ (let ((pos (point-at-bol))
+ (ind (org-get-indentation))
+ ind1)
+ ;; find where this list begins
+ (catch 'exit
+ (while t
+ (catch 'next
+ (beginning-of-line 2)
+ (if (looking-at "[ \t]*$")
+ (throw (if (eobp) 'exit 'next) t))
+ (skip-chars-forward " \t") (setq ind1 (current-column))
+ (if (or (< ind1 ind)
+ (and (= ind1 ind)
+ (not (org-at-item-p)))
+ (eobp))
+ (progn
+ (setq pos (point-at-bol))
+ (throw 'exit t))))))
+ (goto-char pos)))
+
+
(defvar org-last-indent-begin-marker (make-marker))
(defvar org-last-indent-end-marker (make-marker))
(this-buffer (current-buffer))
(org-archive-location org-archive-location)
(re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ ;; start of variables that will be used for savind context
(file (abbreviate-file-name (buffer-file-name)))
(time (format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)
(current-time)))
afile heading buffer level newfile-p
- category todo priority ltags itags prop)
+ category todo priority
+ ;; start of variables that will be used for savind context
+ ltags itags prop)
;; Try to find a local archive location
(save-excursion
(setq res t)
(push tag current))))
(end-of-line 1)
- (when current
- (insert " :" (mapconcat 'identity (nreverse current) ":") ":"))
- (org-set-tags nil t)
- res)
- (run-hooks 'org-after-tags-change-hook)))
+ (if current
+ (progn
+ (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
+ (org-set-tags nil t))
+ (delete-horizontal-space))
+ (run-hooks 'org-after-tags-change-hook))
+ res))
(defun org-toggle-archive-tag (&optional arg)
"Toggle the archive tag for the current headline.
(interactive "rP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
- sep-re re)
+ re)
(goto-char beg)
(beginning-of-line 1)
(setq beg (move-marker (make-marker) (point)))
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline)))
-
(defun org-table-sort-lines (with-case &optional sorting-type)
"Sort table lines according to the column at point.
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
- (let ((start 0) a (f1 f))
+ (message "form %s" f) (sit-for 1)
+ (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
;; First, check for column names
(while (setq start (string-match org-table-column-name-regexp f start))
(setq start (1+ start))
(setq start (1+ start))
(if (setq a (save-match-data
(org-table-get-constant (match-string 1 f))))
- (setq f (replace-match (concat "(" a ")") t t f))))
+ (setq f (replace-match
+ (concat (if pp "(") a (if pp ")")) t t f))))
(if org-table-formula-debug
(put-text-property 0 (length f) :orig-formula f1 f))
f))
(defun org-table-fedit-line-down ()
"Move cursor one line down in the window showing the table."
(interactive)
- (org-table-fedit-move 'next-line))
+ (org-table-fedit-move 'next-line))
(defun org-table-fedit-move (command)
"Move the cursor in the window shoinw the table.
(elmo-msgdb-overview-get-entity
msgnum (wl-summary-buffer-msgdb))))
(from (wl-summary-line-from))
- (to (car (elmo-message-entity-field wl-message-entity 'to)))
+ (to (elmo-message-entity-field wl-message-entity 'to))
(subject (let (wl-thr-indent-string wl-parent-message-entity)
(wl-summary-line-subject))))
(org-store-link-props :type "wl" :from from :to to
(browse-url-at-point)))))
(move-marker org-open-link-marker nil))
-
;;; File search
(defvar org-create-file-search-functions nil
This function should be placed into `remember-mode-hook' and in fact requires
to be run from that hook to fucntion properly."
(if org-remember-templates
-
- (let* ((char (or use-char
+ (let* ((templates (mapcar (lambda (x)
+ (if (stringp (car x))
+ (append (list (nth 1 x) (car x)) (cddr x))
+ (append (list (car x) "") (cdr x))))
+ org-remember-templates))
+ (char (or use-char
(cond
- ((= (length org-remember-templates) 1)
- (caar org-remember-templates))
+ ((= (length templates) 1)
+ (caar templates))
((and (boundp 'org-force-remember-template-char)
org-force-remember-template-char)
- (if (string-p org-force-remember-template-char)
+ (if (stringp org-force-remember-template-char)
(string-to-char org-force-remember-template-char)
org-force-remember-template-char))
(t
(message "Select template: %s"
(mapconcat
- (lambda (x) (char-to-string (car x)))
- org-remember-templates " "))
- (read-char-exclusive)))))
- (entry (cdr (assoc char org-remember-templates)))
+ (lambda (x)
+ (cond
+ ((not (string-match "\\S-" (nth 1 x)))
+ (format "[%c]" (car x)))
+ ((equal (downcase (car x))
+ (downcase (aref (nth 1 x) 0)))
+ (format "[%c]%s" (car x) (substring (nth 1 x) 1)))
+ (t (format "[%c]%s" (car x) (nth 1 x)))))
+ templates " "))
+ (let ((inhibit-quit t) (char0 (read-char-exclusive)))
+ (when (equal char0 ?\C-g)
+ (jump-to-register remember-register)
+ (kill-buffer remember-buffer))
+ char0)))))
+ (entry (cddr (assoc char templates)))
(tpl (car entry))
(plist-p (if org-store-link-plist t nil))
(file (if (and (nth 1 entry) (stringp (nth 1 entry))
(v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
(v-u (concat "[" (substring v-t 1 -1) "]"))
(v-U (concat "[" (substring v-T 1 -1) "]"))
- (v-i initial) ; defined in `remember-mode'
- (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise
+ ;; `initial' and `annotation' are bound in `remember'
+ (v-i (if (boundp 'initial) initial))
+ (v-a (if (and (boundp 'annotation) annotation)
+ (if (equal annotation "[[]]") "" annotation)
+ ""))
(v-A (if (and v-a
(string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
(replace-match "[\\1[%^{Link description}]]" nil nil v-a)
## %s to select file and header location interactively.
## %s \"%s\" -> \"* %s\"
## C-u C-u C-c C-c \"%s\" -> \"* %s\"
-## To switch templates, use `\\[org-remember]'.\n\n"
+## To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n"
(if org-remember-store-without-prompt " C-u C-c C-c" " C-c C-c")
(if org-remember-store-without-prompt " C-c C-c" " C-u C-c C-c")
(abbreviate-file-name (or file org-default-notes-file))
(remember (buffer-substring (point) (mark)))
(call-interactively 'remember))))
+(defvar org-note-abort nil) ; dynamically scoped
+
;;;###autoload
(defun org-remember-handler ()
"Store stuff from remember.el into an org file.
(goto-char (point-max))
(unless (equal (char-before) ?\n) (insert "\n"))
(catch 'quit
+ (if org-note-abort (throw 'quit nil))
(let* ((txt (buffer-substring (point-min) (point-max)))
(fastp (org-xor (equal current-prefix-arg '(4))
org-remember-store-without-prompt))
(defconst org-additional-option-like-keywords
'("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
- "ORGTBL" "HTML:" "LaTeX:"))
+ "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:"))
(defun org-complete (&optional arg)
"Perform completion on word at point.
(save-excursion
(org-back-to-heading)
(if (looking-at (concat outline-regexp
- "\\( *\\<" org-comment-string "\\>\\)"))
+ "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at outline-regexp)
(progn
(read prop)
(symbol-value var))))
+(defun org-parse-local-options (string var)
+ "Parse STRING for startup setting relevant for variable VAR."
+ (let ((rtn (symbol-value var))
+ e opts)
+ (save-match-data
+ (if (or (not string) (not (string-match "\\S-" string)))
+ rtn
+ (setq opts (delq nil (mapcar (lambda (x)
+ (setq e (assoc x org-startup-options))
+ (if (eq (nth 1 e) var) e nil))
+ (org-split-string string "[ \t]+"))))
+ (if (not opts)
+ rtn
+ (setq rtn nil)
+ (while (setq e (pop opts))
+ (if (not (nth 3 e))
+ (setq rtn (nth 2 e))
+ (if (not (listp rtn)) (setq rtn nil))
+ (push (nth 2 e) rtn)))
+ rtn)))))
+
+(defvar org-blocker-hook nil
+ "Hook for functions that are allowed to block a state change.
+
+Each function gets as its single argument a property list, see
+`org-trigger-hook' for more information about this list.
+
+If any of the functions in this hook returns nil, the state change
+is blocked.")
+
+(defvar org-trigger-hook nil
+ "Hook for functions that are triggered by a state change.
+
+Each function gets as its single argument a property list with at least
+the following elements:
+
+ (:type type-of-change :position pos-at-entry-start
+ :from old-state :to new-state)
+
+Depending on the type, more properties may be present.
+
+This mechanism is currently implemented for:
+
+TODO state changes
+------------------
+:type todo-state-change
+:from previous state (keyword as a string), or nil
+:to new state (keyword as a string), or nil")
+
+
(defun org-todo (&optional arg)
"Change the TODO state of an item.
The state of an item is given by a keyword at the start of the heading,
really is a member of `org-todo-keywords'."
(interactive "P")
(save-excursion
- (org-back-to-heading)
- (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp " *"))
- (looking-at " *"))
- (let* ((logging (save-match-data (org-entry-get nil "LOGGING" t)))
- (org-log-done (org-parse-local-options logging 'org-log-done))
- (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection 'prefix)))))
- ;; Use fast selection
- (org-fast-todo-selection))
- ((and (equal arg '(4))
- (or (not org-use-fast-todo-selection)
- (not org-todo-key-trigger)))
- ;; Read a state with completion
- (completing-read "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (catch 'exit
+ (org-back-to-heading)
+ (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp " *"))
+ (looking-at " *"))
+ (let* ((match-data (match-data))
+ (startpos (line-beginning-position))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t)))
+ (org-log-done (org-parse-local-options logging 'org-log-done))
+ (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((and (equal arg '(4))
+ (or (not org-use-fast-todo-selection)
+ (not org-todo-key-trigger)))
+ ;; Read a state with completion
+ (completing-read "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
(if this
- (nth (- (length org-todo-keywords-1) (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
- (arg
- ;; user or caller requests a specific state
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1) (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
(or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads))))
- ((car (member arg org-todo-keywords-1)))
- ((nth (1- (prefix-numeric-value arg))
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads))))
+ ((car (member arg org-todo-keywords-1)))
+ ((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
- ((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;; -> make empty
- ((null tail) nil) ;; -> first entry
- ((eq interpret 'sequence)
- (car tail))
- ((memq interpret '(type priority))
- (if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
- (or done-word (car org-done-keywords))
- nil)))
- (t nil)))
- (next (if state (concat " " state " ") " "))
- dostates)
- (replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
- (unless head
- (setq head (org-get-todo-sequence-head state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member state org-done-keywords)))
- (when (and org-log-done (not (memq arg '(nextset previousset))))
- (setq dostates (and (listp org-log-done) (memq 'state org-log-done)
- (or (not org-todo-log-states)
- (member state org-todo-log-states))))
+ ((null member) (or head (car org-todo-keywords-1)))
+ ((equal this final-done-word) nil) ;; -> make empty
+ ((null tail) nil) ;; -> first entry
+ ((eq interpret 'sequence)
+ (car tail))
+ ((memq interpret '(type priority))
+ (if (eq this-command last-command)
+ (car tail)
+ (if (> (length tail) 0)
+ (or done-word (car org-done-keywords))
+ nil)))
+ (t nil)))
+ (next (if state (concat " " state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to state
+ :position startpos))
+ dostates)
+ (when org-blocker-hook
+ (unless (save-excursion
+ (save-match-data
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist)))
+ (if (interactive-p)
+ (error "TODO state change from %s to %s blocked" this state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this state)
+ (throw 'exit nil))))
+ (store-match-data match-data)
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc state org-todo-sets) " ")))
+ (setq org-last-todo-state-is-todo
+ (not (member state org-done-keywords)))
+ (when (and org-log-done (not (memq arg '(nextset previousset))))
+ (setq dostates (and (listp org-log-done) (memq 'state org-log-done)
+ (or (not org-todo-log-states)
+ (member state org-todo-log-states))))
- (cond
- ((and state (member state org-not-done-keywords)
- (not (member this org-not-done-keywords)))
- ;; This is now a todo state and was not one before
- ;; Remove any CLOSED timestamp, and possibly log the state change
- (org-add-planning-info nil nil 'closed)
- (and dostates (org-add-log-maybe 'state state 'findpos)))
- ((and state dostates)
- ;; This is a non-nil state, and we need to log it
- (org-add-log-maybe 'state state 'findpos))
- ((and (member state org-done-keywords)
- (not (member this org-done-keywords)))
- ;; It is now done, and it was not done before
- (org-add-planning-info 'closed (org-current-time))
- (org-add-log-maybe 'done state 'findpos))))
- ;; Fixup tag positioning
- (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
- (run-hooks 'org-after-todo-state-change-hook)
- (and (member state org-done-keywords) (org-auto-repeat-maybe))
- (if (and arg (not (member state org-done-keywords)))
- (setq head (org-get-todo-sequence-head state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (just-one-space))))
+ (cond
+ ((and state (member state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; Remove any CLOSED timestamp, and possibly log the state change
+ (org-add-planning-info nil nil 'closed)
+ (and dostates (org-add-log-maybe 'state state 'findpos)))
+ ((and state dostates)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-maybe 'state state 'findpos))
+ ((and (member state org-done-keywords)
+ (not (member this org-done-keywords)))
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-time))
+ (org-add-log-maybe 'done state 'findpos))))
+ ;; Fixup tag positioning
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (and (member state org-done-keywords) (org-auto-repeat-maybe))
+ (if (and arg (not (member state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (just-one-space)))
+ (when org-trigger-hook
+ (save-excursion
+ (run-hook-with-args 'org-trigger-hook change-plist)))))))
(defun org-get-todo-sequence-head (kwd)
"Return the head of the TODO sequence to which KWD belongs.
(lambda (x)
(if (stringp (car x)) (string-width (car x)) 0))
fulltable)))
- (buf (current-buffer))
(expert nil)
(fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth))
- tg cnt e c char c1 c2 ntable tbl rtn
+ tg cnt e c tbl
groups ingroup)
(save-window-excursion
(if expert
(set-buffer (get-buffer-create " *Org todo*"))
; (delete-other-windows)
; (split-window-vertically)
- (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
(erase-buffer)
(org-set-local 'org-done-keywords done-keywords)
- (setq tbl fulltable char ?a cnt 0)
+ (setq tbl fulltable cnt 0)
(while (setq e (pop tbl))
(cond
((equal e '(:startgroup))
(goto-char (match-end 1))
(setq col (current-column))
(goto-char (match-end 0))
- (if (eobp) (insert "\n"))
- (forward-char 1)
+ (if (eobp) (insert "\n") (forward-char 1))
(if (and (not (looking-at outline-regexp))
(looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
"[^\r\n]*"))
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
(let ((org-inhibit-startup t)) (org-mode))
- (insert (format "# Insert note for %s, finish with C-c C-c, or cancel with C-u C-c C-c.\n\n"
+ (insert (format "# Insert note for %s.
+# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
(cond
((eq org-log-note-purpose 'clock-out) "stopped clock")
((eq org-log-note-purpose 'done) "closed todo item")
- ((eq org-log-note-purpose 'state) "state change")
+ ((eq org-log-note-purpose 'state)
+ (format "state change to \"%s\"" org-log-note-state))
(t (error "This should not happen")))))
(org-set-local 'org-finish-function 'org-store-log-note))
(note (cdr (assq org-log-note-purpose org-log-note-headings)))
lines ind)
(kill-buffer (current-buffer))
- (if (string-match "^#.*\n[ \t\n]*" txt)
- (setq txt (replace-match "" t t txt)))
+ (while (string-match "\\`#.*\n[ \t\n]*" txt)
+ (setq txt (replace-match "" t t txt)))
(if (string-match "\\s-+\\'" txt)
(setq txt (replace-match "" t t txt)))
(setq lines (org-split-string txt "\n"))
"")))))
(if lines (setq note (concat note " \\\\")))
(push note lines))
- (when current-prefix-arg (setq lines nil))
+ (when (or current-prefix-arg org-note-abort) (setq lines nil))
(when lines
(save-excursion
(set-buffer (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(move-marker org-log-note-marker nil)
(end-of-line 1)
- (if (not (bolp)) (insert "\n")) (indent-relative nil)
+ (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
+ (indent-relative nil)
(insert " - " (pop lines))
(org-indent-line-function)
(beginning-of-line 1)
(move-marker org-log-note-return-to nil)
(and org-log-post-message (message org-log-post-message)))
+;; FIXME: what else would be useful?
+;; - priority
+;; - date
+
+(defun org-sparse-tree (&optional arg)
+ "Create a sparse tree, prompt for the details.
+This command can create sparse trees. You first need to select the type
+of match used to create the tree:
+
+t Show entries with a specific TODO keyword.
+T Show entries selected by a tags match.
+p Enter a property name and its value (both with completion on existing
+ names/values) and show entries with that property.
+r Show entries matching a regular expression"
+ (interactive "P")
+ (let (ans kwd value)
+ (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty")
+ (setq ans (read-char-exclusive))
+ (cond
+ ((equal ans ?t)
+ (org-show-todo-tree '(4)))
+ ((equal ans ?T)
+ (call-interactively 'org-tags-sparse-tree))
+ ((member ans '(?p ?P))
+ (setq kwd (completing-read "Property: "
+ (mapcar 'list (org-buffer-property-keys))))
+ (setq value (completing-read "Value: "
+ (mapcar 'list (org-property-values kwd))))
+ (unless (string-match "\\`{.*}\\'" value)
+ (setq value (concat "\"" value "\"")))
+ (org-tags-sparse-tree arg (concat kwd "=" value)))
+ ((member ans '(?r ?R))
+ (call-interactively 'org-occur))
+ (t (error "No such sparse tree command \"%c\"" ans)))))
+
(defvar org-occur-highlights nil)
(make-variable-buffer-local 'org-occur-highlights)
'keymap org-agenda-keymap
'help-echo
(format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
+ (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (buffer-name (buffer-base-buffer)))))))
(case-fold-search nil)
lspos
tags tags-list tags-alist (llast 0) rtn level category i txt
todo marker entry priority)
(save-excursion
(goto-char (point-min))
- (when (eq action 'sparse-tree) (org-overview))
+ (when (eq action 'sparse-tree)
+ (org-overview)
+ (org-remove-occur-highlights))
(while (re-search-forward re nil t)
(catch :skip
(setq todo (if (match-end 1) (match-string 2))
(not (member org-archive-tag tags-list))))
(and (eq action 'agenda) (org-agenda-skip))
;; list this headline
+
(if (eq action 'sparse-tree)
(progn
+ (and org-highlight-sparse-tree-matches
+ (org-get-heading) (match-end 0)
+ (org-highlight-new-match
+ (match-beginning 0) (match-beginning 1)))
(org-show-context 'tags-tree))
(setq txt (org-format-agenda-item
""
(defvar org-cached-props nil)
(defun org-cached-entry-get (pom property)
- (cdr (assoc property (or org-cached-props
- (setq org-cached-props
- (org-entry-properties pom))))))
+ (if org-use-property-inheritance
+ ;; Caching is not possible, check it directly
+ (org-entry-get pom property 'inherit)
+ ;; Get all properties, so that we can do complicated checks easily
+ (cdr (assoc property (or org-cached-props
+ (setq org-cached-props
+ (org-entry-properties pom)))))))
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files."
;; Parse the string and create a lisp form
(let ((match0 match)
- (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
+ (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
minus tag mm
tagsmatch todomatch tagsmatcher todomatcher kwd matcher
orterms term orlist re-p level-p prop-p pn pv)
re-p (equal (string-to-char pv) ?{)
pv (substring pv 1 -1))
(if re-p
- `(string-match ,pv (org-cached-entry-get nil ,pn))
+ `(string-match ,pv (or (org-cached-entry-get nil ,pn) ""))
`(equal ,pv (org-cached-entry-get nil ,pn))))
(t `(member ,(downcase tag) tags-list)))
mm (if minus (list 'not mm) mm)
These are properties that are not defined in the property drawer,
but in some other way.")
+(defconst org-default-properties
+ '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION"
+ "LOCATION" "LOGGING" "COLUMNS")
+ "Some properties that are used by Org-mode for various purposes.
+Being in this list makes sure that they are offered for completion.")
+
(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
"Regular expression matching the first line of a property drawer.")
(defun org-property-action ()
"Do an action on properties."
(interactive)
- (let (c prop)
+ (let (c)
(org-at-property-p)
- (setq prop (match-string 2))
(message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
(setq c (read-char-exclusive))
(cond
t)
nil)))))
+;; Multi-values properties are properties that contain multiple values
+;; These values are assumed to be single words, separated by whitespace.
+(defun org-entry-add-to-multivalued-property (pom property value)
+ "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (unless (member value values)
+ (setq values (cons value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-remove-from-multivalued-property (pom property value)
+ "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (when (member value values)
+ (setq values (delete value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-member-in-multivalued-property (pom property value)
+ "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (member value values)))
+
(defvar org-entry-property-inherited-from (make-marker))
(defun org-entry-get-with-inheritance (property)
"Get entry property, and search higher levels if not present."
(let (tmp)
(save-excursion
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property))
- (org-back-to-heading t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (org-up-heading-safe) (throw 'ex nil)))))
- (or tmp (cdr (assoc property org-local-properties))
- (cdr (assoc property org-global-properties)))))
+ (save-restriction
+ (widen)
+ (catch 'ex
+ (while t
+ (when (setq tmp (org-entry-get nil property))
+ (org-back-to-heading t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'ex tmp))
+ (or (org-up-heading-safe) (throw 'ex nil)))))
+ (or tmp (cdr (assoc property org-local-properties))
+ (cdr (assoc property org-global-properties))))))
(defun org-entry-put (pom property value)
"Set PROPERTY to VALUE for entry at point-or-marker POM."
(cdr range) t)
(add-to-list 'rtn (org-match-string-no-properties 1)))
(outline-next-heading))))
+
(when include-specials
(setq rtn (append org-special-properties rtn)))
+
(when include-defaults
- (add-to-list rtn "CATEGORY")
- (add-to-list rtn "ARCHIVE"))
+ (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties))
+
(sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
+(defun org-property-values (key)
+ "Return a list of all values of property KEY."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)"))
+ values)
+ (while (re-search-forward re nil t)
+ (add-to-list 'values (org-trim (match-string 1))))
+ (delete "" values)))))
+
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
(interactive)
(org-back-to-heading t)
- (let ((beg (point))
+ (looking-at outline-regexp)
+ (let ((indent (- (match-end 0)(match-beginning 0)))
+ (beg (point))
(re (concat "^[ \t]*" org-keyword-time-regexp))
end hiddenp)
(outline-next-heading)
(while (re-search-forward re end t))
(setq hiddenp (org-invisible-p))
(end-of-line 1)
- (and (= (char-after) ?\n) (forward-char 1))
+ (and (equal (char-after) ?\n) (forward-char 1))
(org-skip-over-state-notes)
- (end-of-line 0)
- (insert "\n:PROPERTIES:\n:END:")
+ (skip-chars-backward " \t\n\r")
+ (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
(beginning-of-line 0)
- (org-indent-line-function)
+ (indent-to-column indent)
(beginning-of-line 2)
- (org-indent-line-function)
+ (indent-to-column indent)
(beginning-of-line 0)
(if hiddenp
(save-excursion
(org-flag-drawer t))))
(defun org-set-property (property value)
- "In the current entry, set PROPERTY to VALUE."
+ "In the current entry, set PROPERTY to VALUE.
+When called interactively, this will prompt for a property name, offering
+completion on existing and default properties. And then it will prompt
+for a value, offering competion either on allowed values (via an inherited
+xxx_ALL property) or on existing values in other instances of this property
+in the current file."
(interactive
- (let* ((prop (completing-read "Property: "
- (mapcar 'list (org-buffer-property-keys))))
+ (let* ((prop (completing-read
+ "Property: " (mapcar 'list (org-buffer-property-keys nil t))))
(cur (org-entry-get nil prop))
(allowed (org-property-get-allowed-values nil prop 'table))
+ (existing (mapcar 'list (org-property-values prop)))
(val (if allowed
(completing-read "Value: " allowed nil 'req-match)
- (read-string
+ (completing-read
(concat "Value" (if (and cur (string-match "\\S-" cur))
(concat "[" cur "]") "")
": ")
- "" cur))))
+ existing nil nil "" nil cur))))
(list prop (if (equal val "") cur val))))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value)))
(beginning-of-line 1)
(skip-chars-forward " \t")))
+(defun org-find-entry-with-id (ident)
+ "Locate the entry that contains the ID property with exact value IDENT.
+IDENT can be a string, a symbol or a number, this function will search for
+the string representation of it.
+Return the position where this entry starts, or nil if there is no such entry."
+ (let ((id (cond
+ ((stringp ident) ident)
+ ((symbol-name ident) (symbol-name ident))
+ ((numberp ident) (number-to-string ident))
+ (t (error "IDENT %s must be a string, symbol or number" ident))))
+ (case-fold-search nil))
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
+ nil t)
+ (org-back-to-heading)
+ (point))))))
+
;;; Column View
(defvar org-columns-overlays nil
(defvar org-columns-current-fmt-compiled nil
"Local variable, holds the currently active column format.
This is the compiled version of the format.")
+(defvar org-columns-current-widths nil
+ "Loval variable, holds the currently widths of fields.")
(defvar org-columns-current-maxwidths nil
"Loval variable, holds the currently active maximum column widths.")
(defvar org-columns-begin-marker (make-marker)
(org-defkey org-columns-map "c" 'org-columns-content)
(org-defkey org-columns-map "o" 'org-overview)
(org-defkey org-columns-map "e" 'org-columns-edit-value)
+(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
+(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle)
+(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
(org-defkey org-columns-map "v" 'org-columns-show-value)
(org-defkey org-columns-map "q" 'org-columns-quit)
(org-defkey org-columns-map "r" 'org-columns-redo)
(org-defkey org-columns-map [left] 'backward-char)
+(org-defkey org-columns-map "\M-b" 'backward-char)
(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
-(org-defkey org-columns-map [right] 'forward-char)
+(org-defkey org-columns-map "\M-f" (lambda () (interactive) (goto-char (1+ (point)))))
(org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point)))))
(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
-(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value)
(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
["Next allowed value" org-columns-next-allowed-value t]
["Previous allowed value" org-columns-previous-allowed-value t]
["Show full value" org-columns-show-value t]
- ["Edit allowed" org-columns-edit-allowed t]
+ ["Edit allowed values" org-columns-edit-allowed t]
"--"
["Edit column attributes" org-columns-edit-attributes t]
["Increase column width" org-columns-widen t]
["OVERVIEW" org-overview t]
["Refresh columns display" org-columns-redo t]
"--"
+ ["Open link" org-columns-open-link t]
+ "--"
["Quit" org-columns-quit t]))
(defun org-columns-new-overlay (beg end &optional string face)
(org-get-level-face 2))))
(color (list :foreground
(face-attribute (or level-face 'default) :foreground)))
- props pom property ass width f string ov column)
+ props pom property ass width f string ov column val modval)
;; Check if the entry is in another buffer.
(unless props
(if (eq major-mode 'org-agenda-mode)
(point-at-bol) (point-at-eol))))))
(assoc property props))
width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column))
+ (nth 2 column)
+ (length property))
f (format "%%-%d.%ds | " width width)
- string (format f (or (cdr ass) "")))
+ val (or (cdr ass) "")
+ modval (if (equal property "ITEM")
+ (org-columns-cleanup-item val org-columns-current-fmt-compiled))
+ string (format f (or modval val)))
;; Create the overlay
(org-unmodified
(setq ov (org-columns-new-overlay
(org-overlay-put ov 'keymap org-columns-map)
(org-overlay-put ov 'org-columns-key property)
(org-overlay-put ov 'org-columns-value (cdr ass))
+ (org-overlay-put ov 'org-columns-value-modified modval)
(org-overlay-put ov 'org-columns-pom pom)
(org-overlay-put ov 'org-columns-format f))
(if (or (not (char-after beg))
(let ((inhibit-read-only t))
(save-excursion
(goto-char beg)
- (insert " ")))))
+ (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
;; Make the rest of the line disappear.
(org-unmodified
(setq ov (org-columns-new-overlay beg (point-at-eol)))
(defvar org-columns-inhibit-recalculation nil
"Inhibit recomputing of columns on column view startup.")
+
(defvar header-line-format)
(defun org-columns-display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
(let ((fmt org-columns-current-fmt-compiled)
string (title "")
- property width f column str)
+ property width f column str widths)
(while (setq column (pop fmt))
(setq property (car column)
str (or (nth 1 column) property)
width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column))
+ (nth 2 column)
+ (length str))
+ widths (push width widths)
f (format "%%-%d.%ds | " width width)
string (format f str)
title (concat title string)))
(org-add-props " " nil 'display '(space :align-to 0))
(org-add-props title nil 'face '(:weight bold :underline t))))
(org-set-local 'org-previous-header-line-format header-line-format)
+ (org-set-local 'org-columns-current-widths (nreverse widths))
(setq header-line-format title)))
(defun org-columns-remove-overlays ()
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t)))))))
+(defun org-columns-cleanup-item (item fmt)
+ "Remove from ITEM what is a column in the format FMT."
+ (if (not org-complex-heading-regexp)
+ item
+ (when (string-match org-complex-heading-regexp item)
+ (concat
+ (org-add-props (concat (match-string 1 item) " ") nil
+ 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+ (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+ " " (match-string 4 item)
+ (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
+
(defun org-columns-show-value ()
"Show the full value of the property."
(interactive)
(get-char-property 0 'org-computed val))
(error "This value is computed from the entry's children"))))
-(defun org-columns-edit-value ()
+(defun org-columns-todo (&optional arg)
+ "Change the TODO state during column view."
+ (interactive "P")
+ (org-columns-edit-value "TODO"))
+
+(defun org-columns-set-tags-or-toggle (&optional arg)
+ "Toggle checkbox at point, or set tags for current headline."
+ (interactive "P")
+ (if (string-match "\\`\\[[ xX-]\\]\\'"
+ (get-char-property (point) 'org-columns-value))
+ (org-columns-next-allowed-value)
+ (org-columns-edit-value "TAGS")))
+
+(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
Where possible, use the standard interface for changing this line."
(interactive)
(org-columns-check-computed)
- (let* ((col (current-column))
- (key (get-char-property (point) 'org-columns-key))
+ (let* ((external-key key)
+ (col (current-column))
+ (key (or key (get-char-property (point) 'org-columns-key)))
(value (get-char-property (point) 'org-columns-value))
(bol (point-at-bol)) (eol (point-at-eol))
(pom (or (get-text-property bol 'org-hd-marker)
x))
org-columns-overlays)))
nval eval allowed)
- (when (equal key "ITEM")
- (error "Cannot edit item headline from here"))
-
(cond
+ ((equal key "ITEM")
+ (setq eval '(org-with-point-at pom
+ (org-edit-headline))))
((equal key "TODO")
(setq eval '(org-with-point-at pom
- (let ((current-prefix-arg '(4))) (org-todo '(4))))))
+ (let ((current-prefix-arg
+ (if external-key current-prefix-arg '(4))))
+ (call-interactively 'org-todo)))))
((equal key "PRIORITY")
(setq eval '(org-with-point-at pom
(call-interactively 'org-priority))))
(setq eval '(org-entry-put pom key nval)))))
(when eval
(let ((inhibit-read-only t))
- (remove-text-properties (1- bol) eol '(read-only t))
+ (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))
(unwind-protect
(progn
(setq org-columns-overlays
(if (nth 3 (assoc key org-columns-current-fmt-compiled))
(org-columns-update key))))
+(defun org-edit-headline () ; FIXME: this is not columns specific
+ "Edit the current headline, the part without TODO keyword, TAGS."
+ (org-back-to-heading)
+ (when (looking-at org-todo-line-regexp)
+ (let ((pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+ (txt (match-string 3))
+ (post "")
+ txt2)
+ (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt)
+ (setq post (match-string 0 txt)
+ txt (substring txt 0 (match-beginning 0))))
+ (setq txt2 (read-string "Edit: " txt))
+ (when (not (equal txt txt2))
+ (beginning-of-line 1)
+ (insert pre txt2 post)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil t)))))
+
(defun org-columns-edit-allowed ()
"Edit the list of allowed values for the current property."
(interactive)
- (let* ((col (current-column))
- (key (get-char-property (point) 'org-columns-key))
+ (let* ((key (get-char-property (point) 'org-columns-key))
(key1 (concat key "_ALL"))
- (value (get-char-property (point) 'org-columns-value))
(allowed (org-entry-get (point) key1 t))
nval)
+ ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.????
(setq nval (read-string "Allowed: " allowed))
(org-entry-put
(cond ((marker-position org-entry-property-inherited-from)
org-columns-top-level-marker))
key1 nval)))
+(defmacro org-no-warnings (&rest body)
+ (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+
(defun org-columns-eval (form)
(let (hidep)
(save-excursion
- (forward-line 1)
+ (beginning-of-line 1)
+ ;; `next-line' is needed here, because it skips invisible line.
+ (condition-case nil (org-no-warnings (next-line 1)) (error nil))
(setq hidep (org-on-heading-p 1)))
(eval form)
(and hidep (hide-entry))))
(< emacs-major-version 22))
(error "Emacs 22 is required for the columns feature")))))
+(defun org-columns-open-link (&optional arg)
+ (interactive "P")
+ (let ((key (get-char-property (point) 'org-columns-key))
+ (value (get-char-property (point) 'org-columns-value)))
+ (org-open-link-from-string arg)))
+
+(defun org-open-link-from-string (s &optional arg)
+ "Open a link in the string S, as if it was in Org-mode."
+ (interactive)
+ (with-temp-buffer
+ (let ((org-inhibit-startup t))
+ (org-mode)
+ (insert s)
+ (goto-char (point-min))
+ (org-open-at-point arg))))
+
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
"Store the text version of the current columns format in appropriate place.
This is either in the COLUMNS property of the node starting the current column
display, or in the #+COLUMNS line of the current buffer."
- (let (fmt)
+ (let (fmt (cnt 0))
(setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
+ (org-set-local 'org-columns-current-fmt fmt)
(if (marker-position org-columns-top-level-marker)
(save-excursion
(goto-char org-columns-top-level-marker)
- (if (org-entry-get nil "COLUMNS")
+ (if (and (org-at-heading-p)
+ (org-entry-get nil "COLUMNS"))
(org-entry-put nil "COLUMNS" fmt)
(goto-char (point-min))
+ ;; Overwrite all #+COLUMNS lines....
(while (re-search-forward "^#\\+COLUMNS:.*" nil t)
- (replace-match (concat "#+COLUMNS: " fmt t t)))))
- (setq org-columns-current-fmt fmt))))
+ (setq cnt (1+ cnt))
+ (replace-match (concat "#+COLUMNS: " fmt) t t))
+ (unless (> cnt 0)
+ (goto-char (point-min))
+ (or (org-on-heading-p t) (outline-next-heading))
+ (let ((inhibit-read-only t))
+ (insert-before-markers "#+COLUMNS: " fmt "\n")))
+ (org-set-local 'org-columns-default-format fmt))))))
(defvar org-overriding-columns-format nil
"When set, overrides any other definition.")
(setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled))))
+
+;;; Dynamic block for Column view
+
+(defun org-columns-capture-view ()
+ "Get the column view of the current buffer and return it as a list.
+The list will contains the title row and all other rows. Each row is
+a list of fields."
+ (save-excursion
+ (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
+ (n (length title)) row tbl)
+ (goto-char (point-min))
+ (while (re-search-forward "^\\*+ " nil t)
+ (when (get-char-property (match-beginning 0) 'org-columns-key)
+ (setq row nil)
+ (loop for i from 0 to (1- n) do
+ (push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
+ (get-char-property (+ (match-beginning 0) i) 'org-columns-value)
+ "")
+ row))
+ (setq row (nreverse row))
+ (push row tbl)))
+ (append (list title 'hline) (nreverse tbl)))))
+
+(defun org-dblock-write:columnview (params)
+ "Write the column view table.
+PARAMS is a property list of parameters:
+
+:width enforce same column widths with <N> specifiers.
+:id the :ID: property of the entry where the columns view
+ should be built, as a string. When `local', call locally.
+ When `global' call column view with the cursor at the beginning
+ of the buffer (usually this means that the whole buffer switches
+ to column view).
+:hlines When t, insert a hline before each item. When a number, insert
+ a hline before each level <= that number.
+:vlines When t, make each column a colgroup to enforce vertical lines."
+ (let ((pos (move-marker (make-marker) (point)))
+ (hlines (plist-get params :hlines))
+ (vlines (plist-get params :vlines))
+ tbl id idpos nfields tmp)
+ (save-excursion
+ (save-restriction
+ (when (setq id (plist-get params :id))
+ (cond ((not id) nil)
+ ((eq id 'global) (goto-char (point-min)))
+ ((eq id 'local) nil)
+ ((setq idpos (org-find-entry-with-id id))
+ (goto-char idpos))
+ (t (error "Cannot find entry with :ID: %s" id))))
+ (org-columns)
+ (setq tbl (org-columns-capture-view))
+ (setq nfields (length (car tbl)))
+ (org-columns-quit)))
+ (goto-char pos)
+ (move-marker pos nil)
+ (when tbl
+ (when (plist-get params :hlines)
+ (setq tmp nil)
+ (while tbl
+ (if (eq (car tbl) 'hline)
+ (push (pop tbl) tmp)
+ (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
+ (if (and (not (eq (car tmp) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines) (<= (- (match-end 1) (match-beginning 1)) hlines))))
+ (push 'hline tmp)))
+ (push (pop tbl) tmp)))
+ (setq tbl (nreverse tmp)))
+ (when vlines
+ (setq tbl (mapcar (lambda (x)
+ (if (eq 'hline x) x (cons "" x)))
+ tbl))
+ (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
+ (setq pos (point))
+ (insert (org-listtable-to-string tbl))
+ (when (plist-get params :width)
+ (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
+ org-columns-current-widths "|")))
+ (goto-char pos)
+ (org-table-align))))
+
+(defun org-listtable-to-string (tbl)
+ "Convert a listtable TBL to a string that contains the Org-mode table.
+The table still need to be alligned. The resulting string has no leading
+and tailing newline characters."
+ (mapconcat
+ (lambda (x)
+ (cond
+ ((listp x)
+ (concat "|" (mapconcat 'identity x "|") "|"))
+ ((eq x 'hline) "|-|")
+ (t (error "Garbage in listtable: %s" x))))
+ tbl "\n"))
+
+(defun org-insert-columns-dblock ()
+ "Create a dynamic block capturing a column view table."
+ (interactive)
+ (let ((defaults '(:name "columnview" :hlines 1))
+ (id (completing-read
+ "Capture columns (local, global, entry with :ID: property) [local]: "
+ (append '(("global") ("local"))
+ (mapcar 'list (org-property-values "ID"))))))
+ (if (equal id "") (setq id 'local))
+ (if (equal id "global") (setq id 'global))
+ (setq defaults (append defaults (list :id id)))
+ (org-create-dblock defaults)
+ (org-update-dblock)))
+
;;;; Timestamps
(defvar org-last-changed-timestamp nil)
22 sept 0:34 --> currentyear-09-22 0:34
12 --> currentyear-currentmonth-12
Fri --> nearest Friday (today or later)
- +4 --> four days from today (only if +N is the only thing given)
etc.
+
+Furthermore you can specify a relative date by giving, as the *first* thing
+in the input: a plus/minus sign, a number and a letter [dwmy] to indicate
+change in days weeks, months, years.
+With a single plus or minus, the date is relative to today. With a double
+plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
+ +4d --> four days from today
+ +4 --> same as above
+ +2w --> two weeks from today
+ ++5 --> five days from default date
+
The function understands only English month and weekday abbreviations,
but this can be configured with the variables `parse-time-months' and
`parse-time-weekdays'.
(if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
(ct (org-current-time))
(def (or default-time ct))
+ ; (defdecode (decode-time def))
(calendar-move-hook nil)
(view-diary-entries-initially nil)
(view-calendar-holidays-initially nil)
(if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
(prompt (concat (if prompt (concat prompt " ") "")
(format "Date and/or time (default [%s]): " timestr)))
- ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0)
+ ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef
second minute hour day month year tl wday wday1 pm h2 m2)
(cond
(setq ans (read-string prompt "" nil timestr))))
(org-detach-overlay org-date-ovl)
- (if (string-match "^[ \t]*[-+][0-9]+[ \t]*$" org-ans0)
- (setq deltadays (string-to-number ans) ans ""))
+ (when (setq delta (org-read-date-get-relative ans (current-time) def))
+ (setq ans (replace-match "" t t ans)
+ deltan (car delta)
+ deltaw (nth 1 delta)
+ deltadef (nth 2 delta)))
;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
(when (string-match
(substring ans (match-end 7)))))
(setq tl (parse-time-string ans)
- year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def)))
- month (or (nth 4 tl) (string-to-number (format-time-string "%m" def)))
day (or (nth 3 tl) (string-to-number (format-time-string "%d" def)))
+ month (or (nth 4 tl) (string-to-number (format-time-string "%m" def)))
+ year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def)))
hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def)))
minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def)))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
- (setq day (+ day deltadays))
+ (when deltan
+ (unless deltadef
+ (let ((now (decode-time (current-time))))
+ (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
+ (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
+ ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
+ ((equal deltaw "m") (setq month (+ month deltan)))
+ ((equal deltaw "y") (setq year (+ year deltan)))))
(when (and wday (not (nth 3 tl)))
;; Weekday was given, but no day, so pick that day in the week
;; on or after the derived date.
(format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
(format "%04d-%02d-%02d" year month day)))))
+;(defun org-parse-for-shift (n1 n2 given-dec default-dec)
+; (cond
+; ((not (nth n1 given-dec))
+; (nth n1 default-dec))
+; ((or (> (nth n1 given-dec) (nth n1 (default-dec)))
+; (not org-read-date-prefer-future))
+; (nth n1 given-dec))
+; (t (1+
+; (if (nth 3 given-dec)
+; (nth 3 given-dec)
+; (if (> (nth
+; (setq given
+; (if (and
+
+(defvar parse-time-weekdays)
+
+(defun org-read-date-get-relative (s today default)
+ "Check string S for special relative date string.
+TODAY and DEFAULT are internal times, for today and for a default.
+Return shift list (N what def-flag)
+WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year.
+N is the number if WHATs to shift
+DEF-FLAG is t when a double ++ or -- indicates shift relative to
+ the DEFAULT date rather than TODAY."
+ (when (string-match
+ (concat
+ "\\`[ \t]*\\([-+]\\{1,2\\}\\)"
+ "\\([0-9]+\\)?"
+ "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
+ "\\([ \t]\\|$\\)") s)
+ (let* ((dir (if (match-end 1)
+ (string-to-char (substring (match-string 1 s) -1))
+ ?+))
+ (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
+ (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
+ (what (if (match-end 3) (match-string 3 s) "d"))
+ (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
+ (date (if rel default today))
+ (wday (nth 6 (decode-time date)))
+ delta)
+ (if wday1
+ (progn
+ (setq delta (mod (+ 7 (- wday1 wday)) 7))
+ (if (= dir ?-) (setq delta (- delta 7)))
+ (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
+ (list delta "d" rel))
+ (list (* n (if (= dir ?-) -1 1)) what rel)))))
+
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
Also, store the cursor date in variable org-ans2."
(let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
stamp)
(if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
- (insert (or pre ""))
- (insert (setq stamp (format-time-string fmt time)))
+ (insert-before-markers (or pre ""))
+ (insert-before-markers (setq stamp (format-time-string fmt time)))
(when (listp extra)
(setq extra (car extra))
(if (and (stringp extra)
(setq extra nil)))
(when extra
(backward-char 1)
- (insert extra)
+ (insert-before-markers extra)
(forward-char 1))
- (insert (or post ""))
+ (insert-before-markers (or post ""))
stamp))
(defun org-toggle-time-stamp-overlays ()
(if (> (point) (point-min)) (backward-char 1))
(and (looking-at tsr)
(> (- (match-end 0) pos) -1))))))
- (and (boundp 'org-ts-what)
+ (and ans
+ (boundp 'org-ts-what)
(setq org-ts-what
(cond
+ ((= pos (match-beginning 0)) 'bracket)
+ ((= pos (1- (match-end 0))) 'bracket)
((org-pos-in-match-range pos 2) 'year)
((org-pos-in-match-range pos 3) 'month)
((org-pos-in-match-range pos 7) 'hour)
(t 'day))))
ans))
+(defun org-toggle-timestamp-type ()
+ ""
+ (interactive)
+ (when (org-at-timestamp-p t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (insert (if (equal (char-after) ?<) "[" "<")) (delete-char 1)
+ (goto-char (1- (match-end 0)))
+ (insert (if (equal (char-after) ?>) "]" ">")) (delete-char 1))
+ (message "Timestamp is now %sactive"
+ (if (equal (char-before) ?>) "in" ""))))
+
(defun org-timestamp-change (n &optional what)
"Change the date in the time stamp at point.
The date will be changed by N times WHAT. WHAT can be `day', `month',
ts time time0)
(if (not (org-at-timestamp-p t))
(error "Not at a timestamp"))
- (if (and (not what) (not (eq org-ts-what 'day))
- org-display-custom-times
- (get-text-property (point) 'display)
- (not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
- inactive (= (char-after (match-beginning 0)) ?\[)
- ts (match-string 0))
- (replace-match "")
- (if (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]"
- ts)
- (setq extra (match-string 1 ts)))
- (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
- (setq with-hm t))
- (setq time0 (org-parse-time-string ts))
- (setq time
- (apply 'encode-time
- (append
- (list (or (car time0) 0))
- (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)))
- (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)))
- (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)))
- (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)))
- (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)))
- (nthcdr 6 time0))))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n)))
- (if (eq what 'calendar)
- (let ((cal-date
- (save-excursion
- (save-match-data
- (set-buffer "*Calendar*")
- (calendar-cursor-to-date)))))
- (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
- (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
- (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
- (setcar time0 (or (car time0) 0))
- (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
- (setcar (nthcdr 2 time0) (or (nth 1 time0) 0))
- (setq time (apply 'encode-time time0))))
- (setq org-last-changed-timestamp
- (org-insert-time-stamp time with-hm inactive nil nil extra))
- (org-clock-update-time-maybe)
- (goto-char pos)
- ;; Try to recenter the calendar window, if any
- (if (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
- (org-recenter-calendar (time-to-days time)))))
+ (if (and (not what) (eq org-ts-what 'bracket))
+ (org-toggle-timestamp-type)
+ (if (and (not what) (not (eq org-ts-what 'day))
+ org-display-custom-times
+ (get-text-property (point) 'display)
+ (not (get-text-property (1- (point)) 'display)))
+ (setq org-ts-what 'day))
+ (setq org-ts-what (or what org-ts-what)
+ inactive (= (char-after (match-beginning 0)) ?\[)
+ ts (match-string 0))
+ (replace-match "")
+ (if (string-match
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]"
+ ts)
+ (setq extra (match-string 1 ts)))
+ (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
+ (setq with-hm t))
+ (setq time0 (org-parse-time-string ts))
+ (setq time
+ (encode-time (or (car time0) 0)
+ (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
+ (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
+ (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
+ (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
+ (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0)))
+ (when (integerp org-ts-what)
+ (setq extra (org-modify-ts-extra extra org-ts-what n)))
+ (if (eq what 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
+ (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
+ (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
+ (setcar time0 (or (car time0) 0))
+ (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
+ (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
+ (setq time (apply 'encode-time time0))))
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp time with-hm inactive nil nil extra))
+ (org-clock-update-time-maybe)
+ (goto-char pos)
+ ;; Try to recenter the calendar window, if any
+ (if (and org-calendar-follow-timestamp-change
+ (get-buffer-window "*Calendar*" t)
+ (memq org-ts-what '(day month year)))
+ (org-recenter-calendar (time-to-days time))))))
;; FIXME: does not yet work for lead times
(defun org-modify-ts-extra (s pos n)
(calendar-goto-today)
(if (and diff (not arg)) (calendar-forward-day diff))))
+(defun org-get-date-from-calendar ()
+ "Return a list (month day year) of date at point in calendar."
+ (with-current-buffer "*Calendar*"
+ (save-match-data
+ (calendar-cursor-to-date))))
+
(defun org-date-from-calendar ()
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
If there is already a time stamp at the cursor position, update it."
(interactive)
- (org-timestamp-change 0 'calendar))
+ (if (org-at-timestamp-p t)
+ (org-timestamp-change 0 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (org-insert-time-stamp
+ (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
;; Make appt aware of appointments from the agenda
+;;;###autoload
(defun org-agenda-to-appt (&optional filter)
"Activate appointments found in `org-agenda-files'.
When prefixed, prompt for a regular expression and use it as a
will only add headlines containing IMPORTANT or headlines
belonging to the category \"Work\"."
(interactive "P")
- (require 'org)
+ (require 'calendar)
(if (equal filter '(4))
(setq filter (read-from-minibuffer "Regexp filter: ")))
- (let* ((today (org-date-to-gregorian
+ (let* ((cnt 0) ; count added events
+ (today (org-date-to-gregorian
(time-to-days (current-time))))
- (files org-agenda-files) entries file)
+ (files (org-agenda-files)) entries file)
+ ;; Get all entries which may contain an appt
(while (setq file (pop files))
- (setq entries (append entries (org-agenda-get-day-entries
- file today :timestamp))))
+ (setq entries
+ (append entries
+ (org-agenda-get-day-entries
+ file today
+ :timestamp :scheduled :deadline))))
(setq entries (delq nil entries))
+ ;; Map thru entries and find if they pass thru the filter
(mapc
(lambda(x)
(let* ((evt (org-trim (get-text-property 1 'txt x)))
(cat (get-text-property 1 'org-category x))
(tod (get-text-property 1 'time-of-day x))
- (ok (or (and (stringp filter) (string-match filter evt))
- (and (not (null filter)) (listp filter)
+ (ok (or (null filter)
+ (and (stringp filter) (string-match filter evt))
+ (and (listp filter)
(or (string-match
(cadr (assoc 'category filter)) cat)
(string-match
(cadr (assoc 'headline filter)) evt))))))
- ;; (setq evt (set-text-properties 0 (length event) nil evt))
+ ;; FIXME Shall we remove text-properties for the appt text?
+ ;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)
(setq tod (number-to-string tod)
tod (when (string-match
"\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod)
(concat (match-string 1 tod) ":"
(match-string 2 tod))))
- (appt-add tod evt)))) entries)
- nil))
+ (appt-add tod evt)
+ (setq cnt (1+ cnt))))) entries)
+ (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))
;;; The clock for measuring work time.
(defvar org-agenda-last-dispatch-buffer nil)
;;;###autoload
-(defun org-agenda (arg)
+(defun org-agenda (arg &optional keys restriction)
"Dispatch agenda commands to collect entries to the agenda buffer.
-Prompts for a character to select a command. Any prefix arg will be passed
+Prompts for a command to execute. Any prefix arg will be passed
on to the selected command. The default selections are:
a Call `org-agenda-list' to display the agenda for current day or week.
searches can be pre-defined in this way.
If the current buffer is in Org-mode and visiting a file, you can also
-first press `1' to indicate that the agenda should be temporarily (until the
-next use of \\[org-agenda]) restricted to the current file."
+first press `<' once to indicate that the agenda should be temporarily
+\(until the next use of \\[org-agenda]) restricted to the current file.
+Pressing `<' twice means to restrict to the current subtree or region
+\(if active)."
(interactive "P")
(catch 'exit
- (let* ((buf (current-buffer))
+ (let* ((prefix-descriptions nil)
+ (org-agenda-custom-commands
+ ;; normalize different versions
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond ((stringp (cdr x))
+ (push x prefix-descriptions)
+ nil)
+ ((stringp (nth 1 x)) x)
+ ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
+ (t (cons (car x) (cons "" (cdr x))))))
+ org-agenda-custom-commands)))
+ (buf (current-buffer))
(bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (org-mode-p)))
- (custom org-agenda-custom-commands)
- c entry key type match lprops)
+ entry key type match lprops ans)
;; Turn off restriction
(put 'org-agenda-files 'org-restrict nil)
(setq org-agenda-restrict nil)
(put 'org-agenda-redo-command 'org-lprops nil)
;; Remember where this call originated
(setq org-agenda-last-dispatch-buffer (current-buffer))
- (save-window-excursion
- (delete-other-windows)
- (org-switch-to-buffer-other-window " *Agenda Commands*")
- (erase-buffer)
- (insert (eval-when-compile
- (let ((header
-"Press key for an agenda command:
--------------------------------- C Configure custom agenda commands
-a Agenda for current week or day e Export agenda views
-t List of all TODO entries T Entries with special TODO kwd
-m Match a TAGS query M Like m, but only TODO entries
-L Timeline for current buffer # List stuck projects (!=configure)
-")
- (start 0))
- (while (string-match "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" header start)
- (setq start (match-end 0))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(face bold) header))
- header)))
- (while (setq entry (pop custom))
- (setq key (car entry) type (nth 1 entry) match (nth 2 entry))
- (insert (format "\n%-4s%-14s: %s"
- (org-add-props (copy-sequence key)
- '(face bold))
- (cond
- ((stringp type) type)
- ((eq type 'agenda) "Agenda for current week or day")
- ((eq type 'alltodo) "List of all TODO entries")
- ((eq type 'stuck) "List of stuck projects")
- ((eq type 'todo) "TODO keyword")
- ((eq type 'tags) "Tags query")
- ((eq type 'tags-todo) "Tags (TODO)")
- ((eq type 'tags-tree) "Tags tree")
- ((eq type 'todo-tree) "TODO kwd tree")
- ((eq type 'occur-tree) "Occur tree")
- ((functionp type) (symbol-name type))
- (t "???"))
- (if (stringp match)
- (org-add-props match nil 'face 'org-warning)
- (format "set of %d commands" (length match))))))
- (if restrict-ok
- (insert "\n"
- (org-add-props "1 Restrict call to current buffer 0 Restrict call to region or subtree" nil 'face 'org-table)))
- (goto-char (point-min))
- (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer))
- (message "Press key for agenda command%s"
- (if restrict-ok ", or [1] or [0] to restrict" ""))
- (setq c (read-char-exclusive))
- (message "")
- (when (memq c '(?L ?1 ?0))
- (if restrict-ok
- (put 'org-agenda-files 'org-restrict (list bfn))
- (error "Cannot restrict agenda to current buffer"))
- (with-current-buffer " *Agenda Commands*"
- (goto-char (point-max))
- (delete-region (point-at-bol) (point))
- (goto-char (point-min)))
- (when (eq c ?0)
+ (unless keys
+ (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
+ keys (car ans)
+ restriction (cdr ans)))
+ ;; Estabish the restriction, if any
+ (when restriction
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (cond
+ ((eq restriction 'region)
+ (setq org-agenda-restrict t)
+ (move-marker org-agenda-restrict-begin (region-beginning))
+ (move-marker org-agenda-restrict-end (region-end)))
+ ((eq restriction 'subtree)
+ (save-excursion
(setq org-agenda-restrict t)
- (with-current-buffer buf
- (if (org-region-active-p)
- (progn
- (move-marker org-agenda-restrict-begin (region-beginning))
- (move-marker org-agenda-restrict-end (region-end)))
- (save-excursion
- (org-back-to-heading t)
- (move-marker org-agenda-restrict-begin (point))
- (move-marker org-agenda-restrict-end
- (progn (org-end-of-subtree t)))))))
- (unless (eq c ?L)
- (message "Press key for agenda command%s"
- (if restrict-ok " (restricted to current file)" ""))
- (setq c (read-char-exclusive)))
- (message "")))
+ (org-back-to-heading t)
+ (move-marker org-agenda-restrict-begin (point))
+ (move-marker org-agenda-restrict-end
+ (progn (org-end-of-subtree t)))))))
+
(require 'calendar) ; FIXME: can we avoid this for some commands?
;; For example the todo list should not need it (but does...)
(cond
- ((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
- (if (symbolp (nth 1 entry))
+ ((setq entry (assoc keys org-agenda-custom-commands))
+ (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
(progn
- (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry)
- lprops (nth 3 entry))
+ (setq type (nth 2 entry) match (nth 3 entry) lprops (nth 4 entry))
(put 'org-agenda-redo-command 'org-lprops lprops)
(cond
((eq type 'agenda)
((eq type 'occur-tree)
(org-check-for-org-mode)
(org-let lprops '(org-occur match)))
+ ((functionp type)
+ (org-let lprops '(funcall type match)))
((fboundp type)
(org-let lprops '(funcall type match)))
(t (error "Invalid custom agenda command type %s" type))))
(org-run-agenda-series (nth 1 entry) (cddr entry))))
- ((equal c ?C) (customize-variable 'org-agenda-custom-commands))
- ((equal c ?a) (call-interactively 'org-agenda-list))
- ((equal c ?t) (call-interactively 'org-todo-list))
- ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4))))
- ((equal c ?m) (call-interactively 'org-tags-view))
- ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4))))
- ((equal c ?e) (call-interactively 'org-store-agenda-views))
- ((equal c ?L)
- (unless restrict-ok
+ ((equal keys "C") (customize-variable 'org-agenda-custom-commands))
+ ((equal keys "a") (call-interactively 'org-agenda-list))
+ ((equal keys "t") (call-interactively 'org-todo-list))
+ ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
+ ((equal keys "m") (call-interactively 'org-tags-view))
+ ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
+ ((equal keys "e") (call-interactively 'org-store-agenda-views))
+ ((equal keys "L")
+ (unless (org-mode-p)
(error "This is not an Org-mode file"))
- (org-call-with-arg 'org-timeline arg))
- ((equal c ?#) (call-interactively 'org-agenda-list-stuck-projects))
- ((equal c ?!) (customize-variable 'org-stuck-projects))
- (t (error "Invalid key"))))))
+ (unless restriction
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (org-call-with-arg 'org-timeline arg)))
+ ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects))
+ ((equal keys "/") (call-interactively 'org-occur-in-agenda-files))
+ ((equal keys "!") (customize-variable 'org-stuck-projects))
+ (t (error "Invalid agenda key"))))))
+
+(defun org-agenda-get-restriction-and-command (prefix-descriptions)
+ "The user interface for selecting an agenda command."
+ (catch 'exit
+ (let* ((bfn (buffer-file-name (buffer-base-buffer)))
+ (restrict-ok (and bfn (org-mode-p)))
+ (region-p (org-region-active-p))
+ (custom org-agenda-custom-commands)
+ (selstring "")
+ restriction second-time
+ c entry key type match prefixes rmheader header-end custom1 desc)
+ (save-window-excursion
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window " *Agenda Commands*")
+ (erase-buffer)
+ (insert (eval-when-compile
+ (let ((header
+"Press key for an agenda command: < Buffer,subtree/region restriction
+-------------------------------- C Configure custom agenda commands
+a Agenda for current week or day e Export agenda views
+t List of all TODO entries T Entries with special TODO kwd
+m Match a TAGS query M Like m, but only TODO entries
+L Timeline for current buffer # List stuck projects (!=configure)
+/ Multi-occur
+")
+ (start 0))
+ (while (string-match
+ "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
+ header start)
+ (setq start (match-end 0))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(face bold) header))
+ header)))
+ (setq header-end (move-marker (make-marker) (point)))
+ (while t
+ (setq custom1 custom)
+ (when (eq rmheader t)
+ (goto-line 1)
+ (re-search-forward ":" nil t)
+ (delete-region (match-end 0) (line-end-position))
+ (forward-char 1)
+ (looking-at "-+")
+ (delete-region (match-end 0) (line-end-position))
+ (move-marker header-end (match-end 0)))
+ (goto-char header-end)
+ (delete-region (point) (point-max))
+ (while (setq entry (pop custom1))
+ (setq key (car entry) desc (nth 1 entry)
+ type (nth 2 entry) match (nth 3 entry))
+ (if (> (length key) 1)
+ (add-to-list 'prefixes (string-to-char key))
+ (insert
+ (format
+ "\n%-4s%-14s: %s"
+ (org-add-props (copy-sequence key)
+ '(face bold))
+ (cond
+ ((string-match "\\S-" desc) desc)
+ ((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'alltodo) "List of all TODO entries")
+ ((eq type 'stuck) "List of stuck projects")
+ ((eq type 'todo) "TODO keyword")
+ ((eq type 'tags) "Tags query")
+ ((eq type 'tags-todo) "Tags (TODO)")
+ ((eq type 'tags-tree) "Tags tree")
+ ((eq type 'todo-tree) "TODO kwd tree")
+ ((eq type 'occur-tree) "Occur tree")
+ ((functionp type) (if (symbolp type)
+ (symbol-name type)
+ "Lambda expression"))
+ (t "???"))
+ (cond
+ ((stringp match)
+ (org-add-props match nil 'face 'org-warning))
+ (match
+ (format "set of %d commands" (length match)))
+ (t ""))))))
+ (when prefixes
+ (mapc (lambda (x)
+ (insert
+ (format "\n%s %s"
+ (org-add-props (char-to-string x)
+ nil 'face 'bold)
+ (or (cdr (assoc (concat selstring (char-to-string x))
+ prefix-descriptions))
+ "Prefix key"))))
+ prefixes))
+ (goto-char (point-min))
+ (when (fboundp 'fit-window-to-buffer)
+ (if second-time
+ (if (not (pos-visible-in-window-p (point-max)))
+ (fit-window-to-buffer))
+ (setq second-time t)
+ (fit-window-to-buffer)))
+ (message "Press key for agenda command%s:"
+ (if restrict-ok
+ (if restriction
+ (format " (restricted to %s)" restriction)
+ " (unrestricted)")
+ ""))
+ (setq c (read-char-exclusive))
+ (message "")
+ (cond
+ ((assoc (char-to-string c) custom)
+ (setq selstring (concat selstring (char-to-string c)))
+ (throw 'exit (cons selstring restriction)))
+ ((memq c prefixes)
+ (setq selstring (concat selstring (char-to-string c))
+ prefixes nil
+ rmheader (or rmheader t)
+ custom (delq nil (mapcar
+ (lambda (x)
+ (if (or (= (length (car x)) 1)
+ (/= (string-to-char (car x)) c))
+ nil
+ (cons (substring (car x) 1) (cdr x))))
+ custom))))
+ ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
+ (message "Restriction is only possible in Org-mode buffers")
+ (ding) (sit-for 1))
+ ((eq c ?1)
+ (setq restriction 'buffer))
+ ((eq c ?0)
+ (setq restriction (if region-p 'region 'subtree)))
+ ((eq c ?<)
+ (setq restriction
+ (cond
+ ((eq restriction 'buffer)
+ (if region-p 'region 'subtree))
+ ((memq restriction '(subtree region))
+ nil)
+ (t 'buffer))))
+ ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/)))
+ (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
+ ((equal c ?q) (error "Abort"))
+ (t (error "Invalid key %c" c))))))))
(defun org-run-agenda-series (name series)
(org-prepare-agenda name)
(let (pars)
(while parameters
(push (list (pop parameters) (if parameters (pop parameters))) pars))
- (if (> (length cmd-key) 1)
+ (if (> (length cmd-key) 2)
(eval (list 'let (nreverse pars)
(list 'org-tags-view nil cmd-key)))
- (flet ((read-char-exclusive () (string-to-char cmd-key)))
- (eval (list 'let (nreverse pars) '(org-agenda nil)))))
+ (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(princ (org-encode-for-stdout (buffer-string)))))
(while parameters
(push (list (pop parameters) (if parameters (pop parameters))) pars))
(push (list 'org-agenda-remove-tags t) pars)
- (if (> (length cmd-key) 1)
+ (if (> (length cmd-key) 2)
(eval (list 'let (nreverse pars)
(list 'org-tags-view nil cmd-key)))
- (flet ((read-char-exclusive () (string-to-char cmd-key)))
- (eval (list 'let (nreverse pars) '(org-agenda nil)))))
+ (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(let* ((lines (org-split-string (buffer-string) "\n"))
line)
files (nth 4 cmd))
(if (stringp files) (setq files (list files)))
(when files
- (flet ((read-char-exclusive () (string-to-char thiscmdkey)))
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- '(org-agenda nil))))
+ (eval (list 'let (append org-agenda-exporter-settings opts pars)
+ (list 'org-agenda nil thiscmdkey)))
(set-buffer org-agenda-buffer-name)
(while files
(eval (list 'let (append org-agenda-exporter-settings opts pars)
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
- (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
- (/ (frame-height) 2))))
+ (fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
;;; Agenda file list
((stringp org-agenda-files) (org-read-agenda-file-list))
((listp org-agenda-files) org-agenda-files)
(t (error "Invalid value of `org-agenda-files'")))))
+ (setq files (apply 'append
+ (mapcar (lambda (f)
+ (if (file-directory-p f)
+ (directory-files f t "\\.org\\'")
+ (list f)))
+ files)))
(if org-agenda-skip-unavailable-files
(delq nil
(mapcar (function
(if (and (boundp 'org-agenda-view-columns-initially)
org-agenda-view-columns-initially)
(org-agenda-columns))
+ (when org-agenda-fontify-priorities
+ (org-fontify-priorities))
(run-hooks 'org-finalize-agenda-hook))))
+(defun org-fontify-priorities ()
+ "Make highest priority lines bold, and lowest italic."
+ (interactive)
+ (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
+ (org-delete-overlay o)))
+ (overlays-in (point-min) (point-max)))
+ (save-excursion
+ (let ((ovs (org-overlays-in (point-min) (point-max)))
+ (inhibit-read-only t)
+ b e p ov h l)
+ (goto-char (point-min))
+ (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
+ (setq h (or (get-char-property (point) 'org-highest-priority)
+ org-highest-priority)
+ l (or (get-char-property (point) 'org-lowest-priority)
+ org-lowest-priority)
+ p (string-to-char (match-string 1))
+ b (match-beginning 0) e (line-end-position)
+ ov (org-make-overlay b e))
+ (org-overlay-put
+ ov 'face
+ (cond ((listp org-agenda-fontify-priorities)
+ (cdr (assoc p org-agenda-fontify-priorities)))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold)))
+ (org-overlay-put ov 'org-type 'org-priority)))))
+
(defun org-prepare-agenda-buffers (files)
"Create buffers for all agenda files, protect archived trees and comments."
(interactive)
;;; Agenda timeline
+(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
+
(defun org-timeline (&optional include-all)
"Show a time-sorted view of the entries in the current org file.
Only entries with a time stamp of today or later will be listed. With
(day-numbers (org-get-all-dates beg end 'no-ranges
t doclosed ; always include today
org-timeline-show-empty-dates))
+ (org-deadline-warning-days 0)
+ (org-agenda-only-exact-dates t)
(today (time-to-days (current-time)))
(past t)
args
(file-name-nondirectory buffer-file-name)))
(if doclosed (push :closed args))
(push :timestamp args)
+ (push :deadline args)
+ (push :scheduled args)
(push :sexp args)
(if dotodo (push :todo args))
(while (setq d (pop day-numbers))
;;;###autoload
(defun org-agenda-list (&optional include-all start-day ndays)
- "Produce a weekly view from all files in variable `org-agenda-files'.
-The view will be for the current week, but from the overview buffer you
-will be able to go to other weeks.
-With one \\[universal-argument] prefix argument INCLUDE-ALL, all unfinished TODO items will
-also be shown, under the current date.
-With two \\[universal-argument] prefix argument INCLUDE-ALL, all TODO entries marked DONE
-on the days are also shown. See the variable `org-log-done' for how
-to turn on logging.
+ "Produce a daily/weekly view from all files in variable `org-agenda-files'.
+The view will be for the current day or week, but from the overview buffer
+you will be able to go to other days/weeks.
+
+With one \\[universal-argument] prefix argument INCLUDE-ALL,
+all unfinished TODO items will also be shown, before the agenda.
+This feature is considered obsolete, please use the TODO list or a block
+agenda instead.
+
+With a numeric prefix argument in an interactive call, the agenda will
+span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change
+the number of days. NDAYS defaults to `org-agenda-ndays'.
+
START-DAY defaults to TODAY, or to the most recent match for the weekday
-given in `org-agenda-start-on-weekday'.
-NDAYS defaults to `org-agenda-ndays'."
+given in `org-agenda-start-on-weekday'."
(interactive "P")
+ (if (and (integerp include-all) (> include-all 0))
+ (setq ndays include-all include-all nil))
(setq ndays (or ndays org-agenda-ndays)
start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
+ (day-cnt 0)
(inhibit-redisplay (not debug-on-error))
s e rtn rtnall file date d start-pos end-pos todayp nd)
(setq org-agenda-redo-command
(setq rtnall (append rtnall rtn))))
(if (or rtnall org-agenda-show-all-dates)
(progn
+ (setq day-cnt (1+ day-cnt))
(insert
(if (stringp org-agenda-format-date)
(format-time-string org-agenda-format-date
"\n")
(put-text-property s (1- (point)) 'face 'org-agenda-structure)
(put-text-property s (1- (point)) 'org-date-line t)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(if todayp (put-text-property s (1- (point)) 'org-today t))
(if rtnall (insert
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
"\n"))
- (put-text-property s (1- (point)) 'day d))))
+ (put-text-property s (1- (point)) 'day d)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
(goto-char (point-min))
(org-fit-agenda-window)
(unless (and (pos-visible-in-window-p (point-min))
;; FIXME: this works only if the cursor is *not* at the
;; beginning of the entry
+;(defun org-entry-is-done-p ()
+; "Is the current entry marked DONE?"
+; (save-excursion
+; (and (re-search-backward "[\r\n]\\*+ " nil t)
+; (looking-at org-nl-done-regexp))))
+
+(defun org-entry-is-todo-p ()
+ (member (org-get-todo-state) org-not-done-keywords))
+
(defun org-entry-is-done-p ()
- "Is the current entry marked DONE?"
+ (member (org-get-todo-state) org-done-keywords))
+
+(defun org-get-todo-state ()
(save-excursion
- (and (re-search-backward "[\r\n]\\*+ " nil t)
- (looking-at org-nl-done-regexp))))
+ (org-back-to-heading t)
+ (and (looking-at org-todo-line-regexp)
+ (match-end 2)
+ (match-string 2))))
(defun org-at-date-range-p (&optional inactive-ok)
"Is the cursor inside a date range?"
(save-match-data
(beginning-of-line)
(setq beg (point) end (progn (outline-next-heading) (point)))
- (when (or (and org-agenda-todo-ignore-scheduled (goto-char beg)
+ (when (or (and org-agenda-todo-ignore-with-date (goto-char beg)
+ (re-search-forward org-ts-regexp end t))
+ (and org-agenda-todo-ignore-scheduled (goto-char beg)
(re-search-forward org-scheduled-time-regexp end t))
(and org-agenda-todo-ignore-deadlines (goto-char beg)
(re-search-forward org-deadline-time-regexp end t)
;; When to show a deadline in the calendar:
;; If the expiration is within wdays warning time.
;; Past-due deadlines are only shown on the current date
- (if (or (and (<= diff wdays) todayp)
+ (if (or (and (<= diff wdays)
+ (and todayp (not org-agenda-only-exact-dates)))
(= diff 0))
(save-excursion
(setq category (org-get-category))
(setq txt nil)
(setq txt (org-format-agenda-item
(if (= diff 0)
- "Deadline: "
- (format "In %3d d.: " diff))
+ (car org-agenda-deadline-leaders)
+ (format (nth 1 org-agenda-deadline-leaders)
+ diff))
head category tags timestr))))
(setq txt org-agenda-no-heading-message))
(when txt
(setq pastschedp (and todayp (< diff 0)))
;; When to show a scheduled item in the calendar:
;; If it is on or past the date.
- (if (or (and (< diff 0) todayp)
+ (if (or (and (< diff 0)
+ (and todayp (not org-agenda-only-exact-dates)))
(= diff 0))
(save-excursion
(setq category (org-get-category))
(setq txt nil)
(setq txt (org-format-agenda-item
(if (= diff 0)
- "Scheduled: "
- (format "Sched.%2dx: " (- 1 diff)))
+ (car org-agenda-scheduled-leaders)
+ (format (nth 1 org-agenda-scheduled-leaders)
+ (- 1 diff)))
head category tags timestr))))
(setq txt org-agenda-no-heading-message))
(when txt
;; The user can turn this off with a variable.
(if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
(string-match (concat (regexp-quote s0) " *") txt)
+ (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
(if (eq org-agenda-remove-times-when-in-prefix 'beg)
(= (match-beginning 0) 0)
t))
;; And finally add the text properties
(org-add-props rtn nil
'org-category (downcase category) 'tags tags
+ 'org-highest-priority org-highest-priority
+ 'org-lowest-priority org-lowest-priority
'prefix-length (- (length rtn) (length txt))
'time-of-day time-of-day
'txt txt
HH:MM."
(save-match-data
(when
- (or
- (string-match
- "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match
- "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
+ (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
(let* ((h (string-to-number (match-string 1 s)))
(m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
(ampm (if (match-end 4) (downcase (match-string 4 s))))
(setf (nth 1 org-agenda-overriding-arguments) (car comp))
(setf (nth 2 org-agenda-overriding-arguments) (cdr comp))
(org-agenda-redo)
- (org-agenda-find-today-or-agenda)))
+ (org-agenda-find-same-or-today-or-agenda)))
(t (error "Cannot find today")))))
-(defun org-agenda-find-today-or-agenda ()
+(defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
(goto-char
- (or (text-property-any (point-min) (point-max) 'org-today t)
+ (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
+ (text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(point-min))))
(let* ((span org-agenda-span)
(sd org-starting-day)
(greg (calendar-gregorian-from-absolute sd))
+ (cnt (get-text-property (point) 'org-day-cnt))
greg2 nd)
(cond
((eq span 'day)
(setq nd (- (calendar-absolute-from-gregorian greg2) sd))))
(let ((org-agenda-overriding-arguments
(list (car org-agenda-last-arguments) sd nd t)))
- (org-agenda-redo)
- (org-agenda-find-today-or-agenda))))
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda cnt))))
(defun org-agenda-earlier (arg)
"Go backward in time by the current span.
(list (car org-agenda-last-arguments)
(car computed) (cdr computed) t)))
(org-agenda-redo)
- (org-agenda-find-today-or-agenda))
+ (org-agenda-find-same-or-today-or-agenda))
(org-agenda-set-mode-name)
(message "Switched to %s view" span))
(defun org-agenda-open-link ()
"Follow the link in the current line, if any."
(interactive)
- (let ((eol (point-at-eol)))
- (save-excursion
- (if (or (re-search-forward org-bracket-link-regexp eol t)
- (re-search-forward org-angle-link-re eol t)
- (re-search-forward org-plain-link-re eol t))
- (call-interactively 'org-open-at-point)
- (error "No link in current line")))))
+ (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-at-bol) (point-at-eol))
+ (org-open-at-point))))
+
+(defun org-agenda-copy-local-variable (var)
+ "Get a variable from a referenced buffer and install it here."
+ (let ((m (get-text-property (point) 'org-marker)))
+ (when (and m (buffer-live-p (marker-buffer m)))
+ (org-set-local var (with-current-buffer (marker-buffer m)
+ (symbol-value var))))))
(defun org-agenda-switch-to (&optional delete-other-windows)
"Go to the Org-mode file which contains the item at point."
(:emphasize . org-export-with-emphasize)
(:sub-superscript . org-export-with-sub-superscripts)
(:footnotes . org-export-with-footnotes)
- (:property-drawer . org-export-with-property-drawer)
+ (:drawers . org-export-with-drawers)
+ (:tags . org-export-with-tags)
(:TeX-macros . org-export-with-TeX-macros)
(:LaTeX-fragments . org-export-with-LaTeX-fragments)
(:skip-before-1st-heading . org-export-skip-text-before-1st-heading)
("|" . :tables)
("^" . :sub-superscript)
("f" . :footnotes)
- ("p" . :property-drawer)
+ ("d" . :drawers)
+ ("tags" . :tags)
("*" . :emphasize)
("TeX" . :TeX-macros)
("LaTeX" . :LaTeX-fragments)
b (org-end-of-subtree t))
(if (> b a) (delete-region a b)))))
- ;; Get rid of property drawers
- (unless org-export-with-property-drawer
+ ;; Get rid of drawers
+ (unless (eq t org-export-with-drawers)
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t)
- (replace-match "")))
+ (let ((re (concat "^[ \t]*:\\("
+ (mapconcat 'identity
+ (if (listp org-export-with-drawers)
+ org-export-with-drawers
+ org-drawers)
+ "\\|")
+ "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n")))
+ (while (re-search-forward re nil t)
+ (replace-match ""))))
;; Find targets in comments and move them out of comments,
;; but mark them as targets that should be invisible
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
- (org-search-todo-below
- line lines level))))
+ (org-search-todo-below
+ line lines level))))
(setq txt (org-html-expand-for-ascii txt))
+ (while (string-match org-bracket-link-regexp txt)
+ (setq txt
+ (replace-match
+ (match-string (if (match-end 2) 3 1) txt)
+ t t txt)))
+
(if (and (memq org-export-with-tags '(not-in-toc nil))
(string-match
(org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
(or (looking-at "[ \t]*\n[ \t]*\n")
(insert "\n\n")))
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (make-string (- end beg) ?\ ))))
+
(save-buffer)
;; remove display and invisible chars
(let (beg end)
#+EMAIL: %s
#+LANGUAGE: %s
#+TEXT: Some descriptive text to be emitted. Several lines OK.
-#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s p:%s
+#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s
#+CATEGORY: %s
#+SEQ_TODO: %s
#+TYP_TODO: %s
#+PRIORITIES: %c %c %c
+#+DRAWERS: %s
#+STARTUP: %s %s %s %s %s
#+TAGS: %s
#+ARCHIVE: %s
org-export-with-TeX-macros
org-export-with-LaTeX-fragments
org-export-skip-text-before-1st-heading
- org-export-with-property-drawer
+ org-export-with-drawers
+ org-export-with-tags
(file-name-nondirectory buffer-file-name)
"TODO FEEDBACK VERIFY DONE"
"Me Jason Marie DONE"
org-highest-priority org-lowest-priority org-default-priority
+ (mapconcat 'identity org-drawers " ")
(cdr (assoc org-startup-folded
'((nil . "showall") (t . "overview") (content . "content"))))
(if org-odd-levels-only "odd" "oddeven")
(save-excursion
(org-back-to-heading)
(if (looking-at (concat outline-regexp
- "\\( *\\<" org-quote-string "\\>\\)"))
+ "\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
(replace-match "" t t nil 1)
(if (looking-at outline-regexp)
(progn
(= level umax-toc)
(org-search-todo-below
line lines level))))
- (if (and (memq org-export-with-tags '(not-in-toc nil))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt)))
+ (if (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if org-export-with-section-numbers
(pop local-list-num))
(setq local-list-indent nil
in-local-list nil))
- (org-html-level-start 1 nil umax
+ (org-html-level-start 0 nil umax
(and org-export-with-toc (<= level umax))
head-count)
(unless body-only
(when (plist-get opt-plist :auto-postamble)
+ (insert "<div id=\"postamble\">")
(when (and org-export-author-info author)
(insert "<p class=\"author\"> "
(nth 1 lang-words) ": " author "\n")
(when (and date org-export-time-stamp-file)
(insert "<p class=\"date\"> "
(nth 2 lang-words) ": "
- date "</p>\n")))
+ date "</p>\n"))
+ (insert "</div>"))
(if org-export-html-with-timestamp
(insert org-export-html-html-helper-timestamp))
(when (looking-at "\\s-*</p>")
(goto-char (match-end 0))
(insert "\n")))
- (mapc 'insert thetoc))
+ (insert "<div id=\"table-of-contents\">\n")
+ (mapc 'insert thetoc)
+ (insert "</div>\n"))
;; remove empty paragraphs and lists
(goto-char (point-min))
(while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
(goto-char (point-min))
(while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
(replace-match ""))
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "<span style=\"visibility:hidden;\">%s</span>"
+ (make-string n ?x)))))
+
(or to-buffer (save-buffer))
(goto-char (point-min))
(message "Exporting... done")
(defun org-export-cleanup-toc-line (s)
"Remove tags and time staps from lines going into the toc."
- (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
- (setq s (replace-match "" t t s)))
+ (when (memq org-export-with-tags '(not-in-toc nil))
+ (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s)
+ (setq s (replace-match "" t t s))))
(when org-export-remove-timestamps-from-toc
(while (string-match org-maybe-keyword-time-regexp s)
(setq s (replace-match "" t t s))))
(defun org-html-expand (string)
"Prepare STRING for HTML export. Applies all active conversions.
If there are links in the string, don't modify these."
- (let* (m s l res)
- (while (setq m (string-match org-bracket-link-regexp string))
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
(setq s (substring string 0 m)
l (match-string 0 string)
string (substring string (match-end 0)))
"Insert a new level in HTML export.
When TITLE is nil, just close all open levels."
(org-close-par-maybe)
- (let ((l (1+ (max level umax))))
- (while (<= l org-level-max)
+ (let ((l org-level-max))
+ (while (>= l (1+ level))
(if (aref org-levels-open (1- l))
(progn
- (org-html-level-close l)
+ (org-html-level-close l umax)
(aset org-levels-open (1- l) nil)))
- (setq l (1+ l)))
+ (setq l (1- l)))
(when title
;; If title is nil, this means this function is called to close
;; all levels, so the rest is done only if title is given
(aset org-levels-open (1- level) t)
(org-close-par-maybe)
(insert "<ul>\n<li>" title "<br/>\n")))
+ (aset org-levels-open (1- level) t)
(if (and org-export-with-section-numbers (not body-only))
(setq title (concat (org-section-number level) " " title)))
(setq level (+ level org-export-html-toplevel-hlevel -1))
(if with-toc
- (insert (format "\n<h%d id=\"sec-%d\">%s</h%d>\n"
- level head-count title level))
- (insert (format "\n<h%d>%s</h%d>\n" level title level)))
+ (insert (format "\n<div class=\"outline-%d\">\n<h%d id=\"sec-%d\">%s</h%d>\n"
+ level level head-count title level))
+ (insert (format "\n<div class=\"outline-%d\">\n<h%d>%s</h%d>\n" level level title level)))
(org-open-par)))))
-(defun org-html-level-close (&rest args)
+(defun org-html-level-close (level max-outline-level)
"Terminate one level in HTML export."
- (org-close-li)
- (insert "</ul>\n"))
+ (if (<= level max-outline-level)
+ (insert "</div>\n")
+ (org-close-li)
+ (insert "</ul>\n")))
;;; iCalendar export
(unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
-(define-key org-mode-map (kbd "<backtab>") 'org-shifttab)
+(define-key org-mode-map [backtab] 'org-shifttab)
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines)
-(org-defkey org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved
-(org-defkey org-mode-map "\C-c\C-x/" 'org-occur-in-agenda-files)
+(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
(org-defkey org-mode-map "\C-c^" 'org-sort)
(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
+(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
+(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
+(org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock)
(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
((org-on-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
- (t (org-shiftcursor-error))))
+ (t (transpose-lines 1) (beginning-of-line -1))))
(defun org-metadown (&optional arg)
"Move subtree down or move table row down.
((org-at-table-p) (call-interactively 'org-table-move-row))
((org-on-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
- (t (org-shiftcursor-error))))
+ (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
(defun org-shiftup (&optional arg)
"Increase item in timestamp or increase priority of current headline.
(cond
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
+ ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil))
((org-at-property-p) (call-interactively 'org-property-next-allowed-value))
(t (org-shiftcursor-error))))
(cond
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
+ ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous))
((org-at-property-p)
(call-interactively 'org-property-previous-allowed-value))
(t (org-shiftcursor-error))))
(let ((org-inhibit-startup t)) (org-mode))
(message "Org-mode restarted to refresh keyword and special line setup"))
+(defun org-kill-note-or-show-branches ()
+ "If this is a Note buffer, abort storing the note. Else call `show-branches'."
+ (interactive)
+ (if (not org-finish-function)
+ (call-interactively 'show-branches)
+ (let ((org-note-abort t))
+ (funcall org-finish-function))))
+
(defun org-return ()
"Goto next table row or insert a newline.
Calls `org-table-next-row' or `newline', depending on context.
(call-interactively 'org-table-next-row))
(t (newline))))
+
(defun org-ctrl-c-minus ()
"Insert separator line in table or modify bullet type in list.
Calls `org-table-insert-hline' or `org-cycle-list-bullet',
(cond
((org-at-table-p)
(call-interactively 'org-table-insert-hline))
+ ((org-on-heading-p)
+ ;; Convert to item
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at "\\*+ ")
+ (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- ")))))
((org-in-item-p)
(call-interactively 'org-cycle-list-bullet))
(t (error "`C-c -' does have no function here."))))
("TAGS and Properties"
["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)]
["Change tag in region" 'org-change-tag-in-region (org-region-active-p)]
- ["Column view of properties" org-columns t])
+ "--"
+ ["Set property" 'org-set-property t]
+ ["Column view of properties" org-columns t]
+ ["Insert Column View DBlock" org-insert-columns-dblock t])
("Dates and Scheduling"
["Timestamp" org-time-stamp t]
["Timestamp (inactive)" org-time-stamp-inactive t]
(throw 'exit t)))
nil))))
-(defun org-occur-in-agenda-files (regexp)
+(defun org-occur-in-agenda-files (regexp &optional nlines)
"Call `multi-occur' with buffers for all agenda files."
- (interactive "sList all lines matching: ")
- (multi-occur
- (mapcar
- (lambda (x) (or (get-file-buffer x) (find-file-noselect x)))
- (org-agenda-files))
- regexp))
+ (interactive "sOrg-files matching: \np")
+ (let* ((files (org-agenda-files))
+ (tnames (mapcar 'file-truename files))
+ (extra org-agenda-multi-occur-extra-files)
+ f)
+ (while (setq f (pop extra))
+ (unless (member (file-truename f) tnames)
+ (add-to-list 'files f 'append)
+ (add-to-list 'tnames (file-truename f) 'append)))
+ (multi-occur
+ (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files)
+ regexp)))
(defun org-uniquify (list)
"Remove duplicate elements from LIST."
;;;; Experimental code
-
(defun org-closed-in-range ()
"Sparse tree of items closed in a certain time range.
Still experimental, may disappear in the furture."
(push (cons k c) new))))
(nreverse new)))
-(defun org-parse-local-options (string var)
- "Parse STRING for startup setting relevant for variable VAR."
- (let ((rtn (symbol-value var))
- e opts)
- (save-match-data
- (if (or (not string) (not (string-match "\\S-" string)))
- rtn
- (setq opts (delq nil (mapcar (lambda (x)
- (setq e (assoc x org-startup-options))
- (if (eq (nth 1 e) var) e nil))
- (org-split-string string "[ \t]+"))))
- (if (not opts)
- rtn
- (setq rtn nil)
- (while (setq e (pop opts))
- (if (not (nth 3 e))
- (setq rtn (nth 2 e))
- (if (not (listp rtn)) (setq rtn nil))
- (push (nth 2 e) rtn)))
- rtn)))))
+;(defcustom org-read-date-prefer-future nil
+; "Non-nil means, when reading an incomplete date from the user, assume future.
+;This affects the following situations:
+;1. The user give a day, but no month.
+; In this case, if the day number if after today, the current month will
+; be used, otherwise the next month.
+;2. The user gives a month but not a year.
+; In this case, the the given month is after the current month, the current
+; year will be used. Otherwise the next year will be used.;
+;
+;When nil, always the current month and year will be used."
+; :group 'org-time ;????
+; :type 'boolean)
+
;;;; Finish up
;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
;;; org.el ends here
+
;; Stuff that needs to be there when we use defcustom
(require 'custom)
+(require 'easymenu)
+
(defvar reftex-tables-dirty t
"Flag showing if tables need to be re-computed.")
(defvar reftex-isearch-minor-mode nil)
(make-variable-buffer-local 'reftex-isearch-minor-mode)
-(require 'easymenu)
-
(easy-menu-define reftex-mode-menu reftex-mode-map
"Menu used in RefTeX mode"
`("Ref"
"Read documentation for RefTeX in the info system.
With optional NODE, go directly to that node."
(interactive)
- (require 'info)
+ (eval-and-compile (require 'info))
(Info-goto-node (format "(reftex)%s" (or node ""))))
;;; Install the kill-buffer and kill-emacs hooks ------------------------------
(not (file-symlink-p f)))
(unless (string-match ignored-dirs-re f)
(setq files (nconc
- (directory-files f t tex-input-files-re)
+ (ignore-errors ;Not readable or something.
+ (directory-files f t tex-input-files-re))
files)))
(when (file-newer-than-file-p f file)
(setq uptodate nil)))))
(defmacro tooltip-region-active-p ()
"Value is non-nil if the region is currently active."
- (if (string-match "^GNU" (emacs-version))
+ (if (not (featurep 'xemacs))
`(and transient-mark-mode mark-active)
`(region-active-p)))
(defun vc-mtn-print-log (files &optional buffer)
(vc-mtn-command buffer 0 files "log"))
+(defvar log-view-message-re)
+(defvar log-view-file-re)
+(defvar log-view-font-lock-keywords)
+
(define-derived-mode vc-mtn-log-view-mode log-view-mode "Mtn-Log-View"
;; TODO: Not sure what to do about file markers for now.
(set (make-local-variable 'log-view-file-re) "\\'\\`")
(shrink-window-if-larger-than-buffer)
(error "Running %s...FAILED (%s)" full-command
(if (integerp status) (format "status %d" status) status))))
- ;; We're done
- (if vc-command-messages
+ ;; We're done. But don't emit a status message if running
+ ;; asychronously, it would just mislead.
+ (if (and vc-command-messages (not (eq okstatus 'async)))
(message "Running %s...OK = %d" full-command status)))
(vc-exec-after
`(run-hook-with-args 'vc-post-command-functions
node (lambda (f) (if (vc-backend f) (push f flattened)))))
(nreverse flattened)))
-(defun vc-deduce-fileset (&optional allow-directory-wildcard)
+(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered)
"Deduce a set of files and a backend to which to apply an operation.
If we're in VC-dired mode, the fileset is the list of marked files.
the fileset is a singleton containing this file.
If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
and we're in a dired buffer, select the current directory.
+If none of these conditions is met, but ALLOW_UNREGISTERED is in and the
+visited file is not registered, return a singletin fileset containing it.
Otherwise, throw an error."
(cond (vc-dired-mode
(let ((marked (dired-map-over-marks (dired-get-filename) nil)))
(message "All version-controlled files below %s selected."
default-directory)
(list default-directory)))
+ ((and allow-unregistered (not (vc-registered buffer-file-name)))
+ (list buffer-file-name))
(t (error "No fileset is available here."))))
(defun vc-ensure-vc-buffer ()
If the repository file is changed, you are asked if you want to
merge in the changes into your working copy."
(interactive "P")
- (let* ((files (vc-deduce-fileset))
+ (let* ((files (vc-deduce-fileset nil t))
(state (vc-state (car files)))
(model (vc-checkout-model (car files)))
revision)
(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
;; FIXME: This should probably be moved to vc-rcs.el and replaced in
;; vc-cvs.el by code using cvs2cl.
-(defun vc-update-changelog-rcs2log (backend files)
+(defun vc-update-changelog-rcs2log (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
;; FIXME: We (c|sh)ould add support for cvs2cl
;;; Code:
+(defvar print-region-function)
+
(setq auto-mode-alist (cons '(("\\.com\\'" . dcl-mode)) auto-mode-alist))
;;; Functions that need redefinition
(send-command-to-subprocess 1 current-line)
(if command-prefix-string
(progn (beginning-of-line) (insert command-prefix-string)))
- (next-line 1))))
+ (forward-line 1))))
;; else -- if not at last line in buffer
(goto-char (point-max))
(backward-char)
- (next-line 1)
+ (forward-line 1)
(insert
(if (compare-strings command-prefix-string nil nil
current-line 0 (length command-prefix-string))
(define-key esc-map "$" 'subprocess-command)
+(provide 'vmsproc)
+
;; arch-tag: 600b2512-f903-4887-bcd2-e76b306f5b66
;;; vmsproc.el ends here
;; audio bell initialized.
;;; Code:
+(require 'w32-vars)
(defvar explicit-shell-file-name)
'("cmdproxy" "cmdproxy.exe"))
(w32-system-shell-p (getenv "COMSPEC")))))
+(defvar w32-quote-process-args) ;; defined in w32proc.c
+
(defun w32-check-shell-configuration ()
"Check the configuration of shell variables on Windows NT/9X.
This function is invoked after loading the init files and processing
:type 'boolean
:group 'killing)
+(provide 'w32-vars)
;;; arch-tag: ee2394fb-9db7-4c15-a8f0-66b47f4a2bb1
;;; w32-vars.el ends here
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
- (next-line arg)
+ (forward-line arg)
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
- (previous-line arg)
+ (forward-line (- arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
+2007-10-22 Jason Rumney <jasonr@gnu.org>
+
+ * config.nt (HAVE_STRINGS_H, HAVE_STDLIB_H): Undefine.
+ (strings.h, stdlib.h): Conditionally include.
+ (w32_abort): Declare here.
+ (abort): Redefine to w32_abort (moved from src/s/ms-w32.h).
+
+2007-10-20 Jason Rumney <jasonr@gnu.org>
+
+ * makefile.w32-in (info-nmake): Change into correct directories.
+
+2007-10-20 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.bat (docflags, doldflags): New variables.
+ (genmakefiles): Use them to work around problems with whitespace
+ in arguments of the `if' command.
+
2007-10-18 Jason Rumney <jasonr@gnu.org>
* makefile.w32-in (install): Install COPYING in top-level and bin dirs.
* emacs.rc: Increase version to 23.0.50.
-2007-08-14 Dhuvra Krishnamurthy <dhuvrakm@gmail.com> (tiny change)
+2007-08-14 Dhuvra Krishnamurthy <dhuvrakm@gmail.com> (tiny change)
* makefile.w32-in (bootstrap-nmake): Change directories once more.
#undef HAVE_TERMIOS_H
#undef HAVE_LIMITS_H
#undef HAVE_STRING_H
+#undef HAVE_STRINGS_H
+#undef HAVE_STDLIB_H
#undef HAVE_PWD_H
#undef STDC_HEADERS
#undef TIME_WITH_SYS_TIME
#ifdef HAVE_STRING_H
#include "string.h"
#endif
+#ifdef HAVE_STRINGS_H
+#include "strings.h"
+#endif
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
#endif
#ifndef NO_RETURN
#endif
#endif
+/* Redefine abort. */
+#ifndef NOT_C_CODE
+#ifdef HAVE_NTGUI
+#define abort w32_abort
+void w32_abort (void) NO_RETURN;
+#endif
+#endif
+
/* arch-tag: df720992-aa5a-499a-882d-958dc5eeb5e9
(do not change this comment) */
set nocygwin=N\r
set COMPILER=\r
set usercflags=\r
+set docflags=\r
set userldflags=\r
+set doldflags=\r
set sep1=\r
set sep2=\r
\r
if (%noopt%) == (Y) echo NOOPT=1 >>config.settings\r
if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings\r
if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix%>>config.settings\r
-if not "(%usercflags%)" == "()" echo USER_CFLAGS=%usercflags%>>config.settings\r
-if not "(%userldflags%)" == "()" echo USER_LDFLAGS=%userldflags%>>config.settings\r
+rem We go thru docflags because usercflags could be "-DFOO=bar" -something\r
+rem and the if command cannot cope with this\r
+for %%v in (%usercflags%) do if not (%%v)==() set docflags=Y\r
+if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings\r
+for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y\r
+if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings\r
if (%usefontbackend%) == (Y) echo USE_FONTBACKEND=1 >>config.settings\r
echo # End of settings from configure.bat>>config.settings\r
echo. >>config.settings\r
copy config.nt config.tmp\r
echo. >>config.tmp\r
echo /* Start of settings from configure.bat. */ >>config.tmp\r
-if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>config.tmp\r
-if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>config.tmp\r
+if (%docflags%) == (Y) echo #define USER_CFLAGS " %usercflags%">>config.tmp\r
+if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp\r
if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp\r
if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp\r
if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp\r
set COMPILER=\r
set MAKECMD=\r
set usercflags=\r
+set docflags=\r
set userldflags=\r
+set doldflags=\r
set mingwflag=\r
set mf=\r
\r
info-nmake:\r
cd ..\doc\emacs\r
$(MAKE) $(MFLAGS) info\r
- cd ..\doc\misc\r
+ cd ..\misc\r
$(MAKE) $(MFLAGS) info\r
- cd ..\doc\lispref\r
+ cd ..\lispref\r
$(MAKE) $(MFLAGS) info\r
- cd ..\doc\lispintro\r
+ cd ..\lispintro\r
$(MAKE) $(MFLAGS) info\r
+ cd $(MAKEDIR)\r
\r
info-gmake:\r
$(MAKE) $(MFLAGS) $(XMFLAGS) -C ../doc/emacs info\r
+2007-10-26 Martin Rudalics <rudalics@gmx.at>
+
+ * window.c (window_min_size_2): Don't count header-line.
+
+2007-10-26 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * frame.h (struct frame): Move all bit fields after the first bit
+ field to take advantage of the available space. Group all the
+ chars together to reduce wasted space due to padding.
+
+2007-10-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * minibuf.c (Fread_minibuffer, Feval_minibuffer): Reflow docstrings.
+
+ * alloc.c (spare_memory, stack_copy, stack_copy_size, ignore_warnings)
+ (Vdead, dont_register_blocks, staticvec, staticidx, interval_block)
+ (n_interval_blocks, init_strings, check_string_bytes, check_sblock)
+ (init_float, free_float, n_cons_blocks, init_cons, all_vectors)
+ (n_vectors, symbol_block, symbol_block_index, symbol_free_list)
+ (n_symbol_blocks, init_symbol, marker_block, marker_free_list)
+ (n_marker_blocks, init_marker, valid_pointer_p, make_pure_float)
+ (last_marked, mark_object_loop_halt): Make static.
+
+ * frame.c (syms_of_frame) <delete-frame-functions>:
+ Fix typo in docstring.
+
+2007-10-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32.c (init_environment): Fix tiny memory leak.
+ (w32_get_resource): Remove unused variable `ok'.
+
+2007-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Make `window-system' into a keyboard-local variable (rather than
+ frame-local as done originally by multi-tty).
+
+ * keyboard.h (struct kboard): Add Vwindow_system.
+ * keyboard.c (init_kboard): Set a default for Vwindow_system.
+ (mark_kboards): Mark Vwindow_system.
+
+ * dispnew.c (syms_of_display) <window-system>: Declare terminal-local.
+ (init_display): Don't set the obsolete `window-system' frame-param.
+
+ * xterm.c (x_term_init):
+ * w32term.c (w32_create_terminal):
+ * term.c (init_tty): Set Vwindow_system.
+ * macterm.c (mac_create_terminal): Set a keyboard (missing piece of the
+ multi-tty merge maybe?), copied from w32term.c. Set Vwindow_system.
+
+ * xfns.c (Fx_create_frame, x_create_tip_frame):
+ * w32fns.c (Fx_create_frame, x_create_tip_frame):
+ * macfns.c (Fx_create_frame):
+ Don't set the obsolete `window-system' frame-param.
+
+ * frame.h (Qwindow_system): Remove.
+ * frame.c (Qwindow_system): Remove. In `syms_of_frame' as well.
+ (Fmake_terminal_frame): Don't set obsolete `window-system' frame-param.
+
+2007-10-24 Richard Stallman <rms@gnu.org>
+
+ * frame.c (x_figure_window_size): For fullscreen case,
+ set USPosition | PPosition without clobbering rest of window_prompting.
+
+ * keyboard.c (Fcurrent_idle_time): Doc fix.
+
+ * print.c (Fwith_output_to_temp_buffer): Doc fix.
+
+2007-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * process.c (unwind_request_sigio): Only define if __ultrix__.
+
+ * callproc.c (child_setup): Remove spurious *.
+
+ * lisp.h (Fget_text_property): Declare.
+ (have_menus_p): Declare it here rather than in sys-dep header files.
+ * macterm.h (have_menus_p):
+ * msdos.h (have_menus_p):
+ * xterm.h (have_menus_p): Remove.
+
+ * data.c (Fmake_variable_buffer_local, Fmake_local_variable)
+ (Fmake_variable_frame_local): Just check the variable's const-ness
+ rather than checking nil or t.
+
+2007-10-22 Jason Rumney <jasonr@gnu.org>
+
+ * w32fns.c: Include math.h.
+ (w32_abort): Declaration moved to nt/config.nt.
+
+ * s/ms-w32.h (HAVE_STDLIB_H): Define.
+ (abort): Redefinition moved to nt/config.nt.
+
+ * m/windowsnt.h: Remove.
+
+2007-10-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs.c (Fdump_emacs): Fix typo in message.
+ (syms_of_emacs) <kill-emacs-hook>: Fix typo in docstring.
+ <installation-directory>: Reflow docstring.
+
+2007-10-22 Juri Linkov <juri@jurta.org>
+
+ * minibuf.c: Allow minibuffer default to be a list of default values.
+ With empty input use the first element of this list as returned default.
+ (string_to_object)
+ (read_minibuf_noninteractive): If defalt is cons, set val to its car.
+ (read_minibuf): If defalt is cons, set histstring to its car.
+ (Fread_string): If default_value is cons, set val to its car.
+ (Fread_buffer): If def is cons, use its car.
+ (Fcompleting_read): If defalt is cons, set val to its car.
+
+2007-10-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * fileio.c (Fcopy_file): Call file name handler with preserve_uid_gid.
+
+2007-10-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * doc.c (Fdocumentation): Check for advice in all cases.
+
2007-10-19 Chong Yidong <cyd@stupidchicken.com>
* Makefile.in [HAVE_LIBRESOLV]: Add -lresolv to linker flags.
* term.c (tty_insert_glyphs): Add missing first parameter.
-2007-08-29 Karoly Lorentey <karoly@lorentey.hu>
+2007-08-29 K\e,Aa\e(Broly L\e$,1 q\e(Brentey <karoly@lorentey.hu>
* buffer.c (Fbuffer_list, Fbury_buffer):
Take frame->buried_buffer_list into account.
out of memory. We keep one large block, four cons-blocks, and
two string blocks. */
-char *spare_memory[7];
+static char *spare_memory[7];
/* Amount of spare memory to keep in large reserve block. */
/* Buffer in which we save a copy of the C stack at each GC. */
-char *stack_copy;
-int stack_copy_size;
+static char *stack_copy;
+static int stack_copy_size;
/* Non-zero means ignore malloc warnings. Set during initialization.
Currently not used. */
-int ignore_warnings;
+static int ignore_warnings;
Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
/* A unique object in pure space used to make some Lisp objects
on free lists recognizable in O(1). */
-Lisp_Object Vdead;
+static Lisp_Object Vdead;
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-int dont_register_blocks;
+static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x600
-Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
+#define NSTATICS 1280
+static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
-int staticidx = 0;
+static int staticidx = 0;
static POINTER_TYPE *pure_alloc P_ ((size_t, int));
/* Current interval block. Its `next' pointer points to older
blocks. */
-struct interval_block *interval_block;
+static struct interval_block *interval_block;
/* Index in interval_block above of the next unused interval
structure. */
/* Total number of interval blocks now in use. */
-int n_interval_blocks;
+static int n_interval_blocks;
/* Initialize interval allocation. */
/* Initialize string allocation. Called from init_alloc_once. */
-void
+static void
init_strings ()
{
total_strings = total_free_strings = total_string_size = 0;
static int check_string_bytes_count;
-void check_string_bytes P_ ((int));
-void check_sblock P_ ((struct sblock *));
+static void check_string_bytes P_ ((int));
+static void check_sblock P_ ((struct sblock *));
#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
/* Check validity of Lisp strings' string_bytes member in B. */
-void
+static void
check_sblock (b)
struct sblock *b;
{
non-zero means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
-void
+static void
check_string_bytes (all_p)
int all_p;
{
/* Initialize float allocation. */
-void
+static void
init_float ()
{
float_block = NULL;
/* Explicitly free a float cell by putting it on the free-list. */
-void
+static void
free_float (ptr)
struct Lisp_Float *ptr;
{
/* Total number of cons blocks now in use. */
-int n_cons_blocks;
+static int n_cons_blocks;
/* Initialize cons allocation. */
-void
+static void
init_cons ()
{
cons_block = NULL;
/* Singly-linked list of all vectors. */
-struct Lisp_Vector *all_vectors;
+static struct Lisp_Vector *all_vectors;
/* Total number of vector-like objects now in use. */
-int n_vectors;
+static int n_vectors;
/* Value is a pointer to a newly allocated Lisp_Vector structure
/* Current symbol block and index of first unused Lisp_Symbol
structure in it. */
-struct symbol_block *symbol_block;
-int symbol_block_index;
+static struct symbol_block *symbol_block;
+static int symbol_block_index;
/* List of free symbols. */
-struct Lisp_Symbol *symbol_free_list;
+static struct Lisp_Symbol *symbol_free_list;
/* Total number of symbol blocks now in use. */
-int n_symbol_blocks;
+static int n_symbol_blocks;
/* Initialize symbol allocation. */
-void
+static void
init_symbol ()
{
symbol_block = NULL;
struct marker_block *next;
};
-struct marker_block *marker_block;
-int marker_block_index;
+static struct marker_block *marker_block;
+static int marker_block_index;
-union Lisp_Misc *marker_free_list;
+static union Lisp_Misc *marker_free_list;
/* Total number of marker blocks now in use. */
-int n_marker_blocks;
+static int n_marker_blocks;
-void
+static void
init_marker ()
{
marker_block = NULL;
/* Determine whether it is safe to access memory at address P. */
-int
+static int
valid_pointer_p (p)
void *p;
{
/* Value is a float object with value NUM allocated from pure space. */
-Lisp_Object
+static Lisp_Object
make_pure_float (num)
double num;
{
all the references contained in it. */
#define LAST_MARKED_SIZE 500
-Lisp_Object last_marked[LAST_MARKED_SIZE];
+static Lisp_Object last_marked[LAST_MARKED_SIZE];
int last_marked_index;
/* For debugging--call abort when we cdr down this many
links of a list, in mark_object. In debugging,
the call to abort will hit a breakpoint.
Normally this is zero and the check never goes off. */
-int mark_object_loop_halt;
+static int mark_object_loop_halt;
/* Return non-zero if the object was not yet marked. */
static int
VECTOR_MARK (ptr); /* Else mark it */
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
-
+
/* Note that this size is not the memory-footprint size, but only
the number of Lisp_Object fields that we should trace.
The distinction is used e.g. by Lisp_Process which places extra
}
int suppress_checking;
+
void
die (msg, file, line)
const char *msg;
while (*p != 0)
{
while (*q != 0 && strchr (*q, '=') == NULL)
- *q++;
+ q++;
*p = *q++;
if (*p != 0)
p++;
variable = indirect_variable (variable);
valcontents = SYMBOL_VALUE (variable);
- if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
+ if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents))
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if (BUFFER_OBJFWDP (valcontents))
variable = indirect_variable (variable);
valcontents = SYMBOL_VALUE (variable);
- if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
+ if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents))
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if ((BUFFER_LOCAL_VALUEP (valcontents)
variable = indirect_variable (variable);
valcontents = SYMBOL_VALUE (variable);
- if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
+ if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
(*initial_terminal->delete_terminal_hook) (initial_terminal);
/* Update frame parameters to reflect the new type. */
- Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qwindow_system, Qnil), Qnil));
Fmodify_frame_parameters
(selected_frame, Fcons (Fcons (Qtty_type,
Ftty_type (selected_frame)), Qnil));
The value is a symbol--for instance, `x' for X windows.
The value is nil if Emacs is using a text-only terminal. */);
+ DEFVAR_KBOARD ("window-system", Vwindow_system,
+ doc: /* Name of window system through which the selected frame is displayed.
+The value is a symbol--for instance, `x' for X windows.
+The value is nil if the selected frame is on a text-only-terminal. */);
+
DEFVAR_LISP ("window-system-version", &Vwindow_system_version,
doc: /* The version number of the window system in use.
For X windows, this is 10 or 11. */);
doc = tem;
else
return Qnil;
-
- /* Check for an advised function. Its doc string
- has an `ad-advice-info' text property. */
- if (STRINGP (doc))
- {
- Lisp_Object innerfunc;
- innerfunc = Fget_text_property (make_number (0),
- intern ("ad-advice-info"),
- doc);
- if (! NILP (innerfunc))
- doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
- }
}
else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw);
xsignal1 (Qinvalid_function, fun);
}
+ /* Check for an advised function. Its doc string
+ has an `ad-advice-info' text property. */
+ if (STRINGP (doc))
+ {
+ Lisp_Object innerfunc;
+ innerfunc = Fget_text_property (make_number (0),
+ intern ("ad-advice-info"),
+ doc);
+ if (! NILP (innerfunc))
+ doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+ }
+
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
if (EQ (doc, make_number (0)))
{
fprintf (stderr, "**************************************************\n");
fprintf (stderr, "Warning: Your system has a gap between BSS and the\n");
- fprintf (stderr, "heap (%lu byte). This usually means that exec-shield\n",
+ fprintf (stderr, "heap (%lu bytes). This usually means that exec-shield\n",
heap_bss_diff);
fprintf (stderr, "or something similar is in effect. The dump may\n");
- fprintf (stderr, "fail because of this. See the section about \n");
+ fprintf (stderr, "fail because of this. See the section about\n");
fprintf (stderr, "exec-shield in etc/PROBLEMS for more information.\n");
fprintf (stderr, "**************************************************\n");
}
doc: /* Non-nil means Emacs is running without interactive terminal. */);
DEFVAR_LISP ("kill-emacs-hook", &Vkill_emacs_hook,
- doc: /* Hook to be run when kill-emacs is called.
+ doc: /* Hook to be run when `kill-emacs' is called.
Since `kill-emacs' may be invoked when the terminal is disconnected (or
in other similar situations), functions placed on this hook should not
expect to be able to interact with the user. To ask for confirmation,
DEFVAR_LISP ("installation-directory", &Vinstallation_directory,
doc: /* A directory within which to look for the `lib-src' and `etc' directories.
-This is non-nil when we can't find those directories in their standard
-installed locations, but we can find them
-near where the Emacs executable was found. */);
+This is non-nil when we can't find those directories in their standard installed
+locations, but we can find them near where the Emacs executable was found. */);
Vinstallation_directory = Qnil;
DEFVAR_LISP ("system-messages-locale", &Vsystem_messages_locale,
/* Preserve the match data. */
record_unwind_save_match_data ();
- /* Value saved here is to be restored into Vautoload_queue. */
+ /* If autoloading gets an error (which includes the error of failing
+ to define the function being called), we use Vautoload_queue
+ to undo function definitions and `provide' calls made by
+ the function. We do this in the specific case of autoloading
+ because autoloading is not an explicit request "load this file",
+ but rather a request to "call this function".
+
+ The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
- ok_if_already_exists, keep_time));
+ RETURN_UNGCPRO (call6 (handler, Qcopy_file, file, newname,
+ ok_if_already_exists, keep_time, preserve_uid_gid));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
int opoint_byte = PT_BYTE;
int oinserted = ZV - BEGV;
int ochars_modiff = CHARS_MODIFF;
-
- TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
+
+ TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
Qnil, make_number (oinserted), visit);
CHECK_NUMBER (insval);
int opoint_byte = PT_BYTE;
int oinserted = ZV - BEGV;
int ochars_modiff = CHARS_MODIFF;
-
+
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call1 (XCAR (p), make_number (oinserted));
if (!NILP (insval))
Lisp_Object Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list;
Lisp_Object Qtty_color_mode;
Lisp_Object Qtty, Qtty_type;
-Lisp_Object Qwindow_system;
Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
#ifdef USE_FONT_BACKEND
return Qnil;
else
return type;
-}
+}
struct frame *
make_frame (mini_p)
{
initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
init_kboard (initial_kboard);
+ /* Leave Vwindow_system at its `t' default for now. */
initial_kboard->next_kboard = all_kboards;
all_kboards = initial_kboard;
}
f->terminal = terminal;
f->terminal->reference_count++;
f->output_data.nothing = 0;
-
+
FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
-
+
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
f->terminal = terminal;
f->terminal->reference_count++;
create_tty_output (f);
-
+
FRAME_FOREGROUND_PIXEL (f) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL (f) = FACE_TTY_DEFAULT_BG_COLOR;
-
+
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none;
if (FRAMEP (FRAME_TTY (f)->top_frame)
&& FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame)))
XFRAME (FRAME_TTY (f)->top_frame)->async_visible = 2; /* obscured */
-
+
FRAME_TTY (f)->top_frame = frame;
}
-
+
#ifdef CANNOT_DUMP
FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
#endif
#endif
#endif /* not MSDOS */
-
+
{
Lisp_Object terminal;
t = get_terminal (terminal, 1);
}
}
-
+
if (!t)
- {
+ {
char *name = 0, *type = 0;
Lisp_Object tty, tty_type;
strncpy (name, SDATA (tty), SBYTES (tty));
name[SBYTES (tty)] = 0;
}
-
+
tty_type = get_future_frame_param
(Qtty_type, parms, (FRAME_TERMCAP_P (XFRAME (selected_frame))
? FRAME_TTY (XFRAME (selected_frame))->type
get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
change_frame_size (f, height, width, 0, 0, 0);
}
-
+
adjust_glyphs (f);
calculate_costs (f);
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame, Vdefault_frame_alist);
Fmodify_frame_parameters (frame, parms);
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qnil), Qnil));
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
build_string (t->display_info.tty->type)),
Qnil));
Qnil));
else
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
-
+
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
f->face_alist = Fcopy_alist (sf->face_alist);
{
struct terminal *terminal = FRAME_TERMINAL (f);
- f->output_data.nothing = 0;
+ f->output_data.nothing = 0;
f->terminal = 0; /* Now the frame is dead. */
/* If needed, delete the terminal that this frame was on.
CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
-
+
/* Do like the documentation says. */
Fmake_frame_visible (frame);
Lisp_Object frame;
{
struct frame *f;
-
+
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
-
+
if (FRAME_TERMINAL (f)->frame_raise_lower_hook)
(*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, 0);
Lisp_Object frame, focus_frame;
{
struct frame *f;
-
+
/* Note that we don't check for a live frame here. It's reasonable
to redirect the focus of a frame you're about to delete, if you
know what other frame should receive those keystrokes. */
CHECK_LIVE_FRAME (focus_frame);
f = XFRAME (frame);
-
+
f->focus_frame = focus_frame;
if (FRAME_TERMINAL (f)->frame_rehighlight_hook)
else if (EQ (new_value, Qfullheight))
f->want_fullscreen = FULLSCREEN_HEIGHT;
- if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
+ if (FRAME_TERMINAL (f)->fullscreen_hook != NULL)
FRAME_TERMINAL (f)->fullscreen_hook (f);
}
int width, height;
/* It takes both for some WM:s to place it where we want */
- window_prompting = USPosition | PPosition;
+ window_prompting |= USPosition | PPosition;
x_fullscreen_adjust (f, &width, &height, &top, &left);
FRAME_COLS (f) = width;
FRAME_LINES (f) = height;
staticpro (&Qtty);
Qtty_type = intern ("tty-type");
staticpro (&Qtty_type);
- Qwindow_system = intern ("window-system");
- staticpro (&Qwindow_system);
Qface_set_after_frame_default = intern ("face-set-after-frame-default");
staticpro (&Qface_set_after_frame_default);
staticpro (&Qterminal);
Qterminal_live_p = intern ("terminal-live-p");
staticpro (&Qterminal_live_p);
-
+
{
int i;
frame. In the second invocation, the frame is already deleted, and
the function should do nothing. (You can use `frame-live-p' to check
for this.) This wrinkle happens when an earlier function in
-`delete-frame-functions' (indirectly) calls delete-frame
+`delete-frame-functions' (indirectly) calls `delete-frame'
recursively. */);
Vdelete_frame_functions = Qnil;
#else
focus_follows_mouse = 0;
#endif
-
+
staticpro (&Vframe_list);
defsubr (&Sactive_minibuffer_window);
be used for output. */
unsigned glyphs_initialized_p : 1;
+ /* Set to non-zero in change_frame_size when size of frame changed
+ Clear the frame in clear_garbaged_frames if set. */
+ unsigned resized_p : 1;
+
+ /* Set to non-zero in when we want for force a flush_display in
+ update_frame, usually after resizing the frame. */
+ unsigned force_flush_display_p : 1;
+
+ /* Set to non-zero if the default face for the frame has been
+ realized. Reset to zero whenever the default face changes.
+ Used to see the difference between a font change and face change. */
+ unsigned default_face_done_p : 1;
+
+ /* Set to non-zero if this frame has already been hscrolled during
+ current redisplay. */
+ unsigned already_hscrolled_p : 1;
+
+ /* Set to non-zero when current redisplay has updated frame. */
+ unsigned updated_p : 1;
+
+ /* Set to non-zero to minimize tool-bar height even when
+ auto-resize-tool-bar is set to grow-only. */
+ unsigned minimize_tool_bar_window_p : 1;
+
#if defined (USE_GTK) || defined (MAC_OS)
/* Nonzero means using a tool bar that comes from the toolkit. */
int external_tool_bar;
support scroll bars. */
char can_have_scroll_bars;
- /* If can_have_scroll_bars is non-zero, this is non-zero if we should
- actually display them on this frame. */
- enum vertical_scroll_bar_type vertical_scroll_bar_type;
-
- /* What kind of text cursor should we draw in the future?
- This should always be filled_box_cursor or bar_cursor. */
- enum text_cursor_kinds desired_cursor;
-
- /* Width of bar cursor (if we are using that). */
- int cursor_width;
-
- /* What kind of text cursor should we draw when the cursor blinks off?
- This can be filled_box_cursor or bar_cursor or no_cursor. */
- enum text_cursor_kinds blink_off_cursor;
-
- /* Width of bar cursor (if we are using that) for blink-off state. */
- int blink_off_cursor_width;
-
/* Non-0 means raise this frame to the top of the heap when selected. */
char auto_raise;
/* Nonzero if size of some window on this frame has changed. */
char window_sizes_changed;
+ /* Nonzero if the mouse has moved on this display device
+ since the last time we checked. */
+ char mouse_moved;
+
+ /* If can_have_scroll_bars is non-zero, this is non-zero if we should
+ actually display them on this frame. */
+ enum vertical_scroll_bar_type vertical_scroll_bar_type;
+
+ /* What kind of text cursor should we draw in the future?
+ This should always be filled_box_cursor or bar_cursor. */
+ enum text_cursor_kinds desired_cursor;
+
+ /* Width of bar cursor (if we are using that). */
+ int cursor_width;
+
+ /* What kind of text cursor should we draw when the cursor blinks off?
+ This can be filled_box_cursor or bar_cursor or no_cursor. */
+ enum text_cursor_kinds blink_off_cursor;
+
+ /* Width of bar cursor (if we are using that) for blink-off state. */
+ int blink_off_cursor_width;
+
/* Storage for messages to this frame. */
char *message_buf;
/* The baud rate that was used to calculate costs for this frame. */
int cost_calculation_baud_rate;
- /* Nonzero if the mouse has moved on this display device
- since the last time we checked. */
- char mouse_moved;
-
/* Exponent for gamma correction of colors. 1/(VIEWING_GAMMA *
SCREEN_GAMMA) where viewing_gamma is 0.4545 and SCREEN_GAMMA is a
frame parameter. 0 means don't do gamma correction. */
/* Additional space to put between text lines on this frame. */
int extra_line_spacing;
- /* Set to non-zero in change_frame_size when size of frame changed
- Clear the frame in clear_garbaged_frames if set. */
- unsigned resized_p : 1;
-
- /* Set to non-zero in when we want for force a flush_display in
- update_frame, usually after resizing the frame. */
- unsigned force_flush_display_p : 1;
-
/* All display backends seem to need these two pixel values. */
unsigned long background_pixel;
unsigned long foreground_pixel;
-
- /* Set to non-zero if the default face for the frame has been
- realized. Reset to zero whenever the default face changes.
- Used to see the difference between a font change and face change. */
- unsigned default_face_done_p : 1;
-
- /* Set to non-zero if this frame has already been hscrolled during
- current redisplay. */
- unsigned already_hscrolled_p : 1;
-
- /* Set to non-zero when current redisplay has updated frame. */
- unsigned updated_p : 1;
-
- /* Set to non-zero to minimize tool-bar height even when
- auto-resize-tool-bar is set to grow-only. */
- unsigned minimize_tool_bar_window_p : 1;
};
#ifdef MULTI_KBOARD
extern Lisp_Object Qleft, Qright, Qtop, Qbox;
extern Lisp_Object Qdisplay;
-extern Lisp_Object Qwindow_system;
-
#ifdef HAVE_WINDOW_SYSTEM
/* The class of this X application. */
}
DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
- doc: /* Return the current length of Emacs idleness.
-The value is returned as a list of three integers. The first has the
+ doc: /* Return the current length of Emacs idleness, or nil.
+The value when Emacs is idle is a list of three integers. The first has the
most significant 16 bits of the seconds, while the second has the
least significant 16 bits. The third integer gives the microsecond
count.
+The value when Emacs is not idle is nil.
+
The microsecond count is zero on systems that do not provide
resolution finer than a second. */)
()
from_string = Qnil;
/* The multi-tty merge moved the code below to right after
- `replay_sequence' which caused alll these translation maps to be applied
+ `replay_sequence' which caused all these translation maps to be applied
repeatedly, even tho their doc says very clearly they are not applied to
their own output.
The reason for this move was: "We may switch keyboards between rescans,
kb->reference_count = 0;
kb->Vsystem_key_alist = Qnil;
kb->system_key_syms = Qnil;
+ kb->Vwindow_system = Qt; /* Unset. */
kb->Vinput_decode_map = Fmake_sparse_keymap (Qnil);
kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil);
Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map);
#endif
wipe_kboard (current_kboard);
init_kboard (current_kboard);
+ /* Leave Vwindow_system at its `t' default for now. */
if (!noninteractive)
{
mark_object (kb->Vlast_kbd_macro);
mark_object (kb->Vsystem_key_alist);
mark_object (kb->system_key_syms);
+ mark_object (kb->Vwindow_system);
mark_object (kb->Vinput_decode_map);
mark_object (kb->Vlocal_function_key_map);
mark_object (kb->Vdefault_minibuffer_frame);
commands that set the prefix argument. */
Lisp_Object Vlast_command;
- /* Normally same as last-command, but never modified by
- other commands. */
+ /* Normally same as last-command, but never modified by other commands. */
Lisp_Object Vreal_last_command;
/* User-supplied table to translate input characters through. */
/* Cache for modify_event_symbol. */
Lisp_Object system_key_syms;
+ /* The kind of display: x, w32, ... */
+ Lisp_Object Vwindow_system;
+
/* Keymap mapping keys to alternative preferred forms.
See the DEFVAR for more documentation. */
Lisp_Object Vlocal_function_key_map;
EXFUN (Fprevious_single_property_change, 4);
EXFUN (Fget_text_property, 3);
EXFUN (Fput_text_property, 5);
+EXFUN (Fget_text_property, 3);
EXFUN (Fprevious_char_property_change, 2);
EXFUN (Fnext_char_property_change, 2);
extern void report_interval_modification P_ ((Lisp_Object, Lisp_Object));
extern void init_mac_osx_environment P_ ((void));
#endif /* MAC_OSX */
#endif /* MAC_OS */
+
+#ifdef HAVE_MENUS
+/* Defined in (x|mac|w32)fns.c... */
+extern int have_menus_p P_ ((void));
+#endif
\f
/* Nonzero means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
+++ /dev/null
-/* Machine description file for Windows NT.
-
- Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-/* The following line tells the configuration script what sort of
- operating system this machine is likely to run.
- USUAL-OPSYS="<name of system .h file here, without the s- or .h>" */
-
-/* Define BIG_ENDIAN if lowest-numbered byte in a word
- is the most significant byte. */
-
-/* #define BIG_ENDIAN */
-
-/* Define NO_ARG_ARRAY if you cannot take the address of the first of a
- * group of arguments and treat it as an array of the arguments. */
-
-#define NO_ARG_ARRAY
-
-/* Define WORD_MACHINE if addresses and such have
- * to be corrected before they can be used as byte counts. */
-
-#define WORD_MACHINE
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically:
- Ones defined so far include vax, m68000, ns16000, pyramid,
- orion, tahoe, APOLLO and many others */
-
-/* Use type int rather than a union, to represent Lisp_Object */
-/* This is desirable for most machines. */
-
-#define NO_UNION_TYPE
-
-/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend
- the 24-bit bit field into an int. In other words, if bit fields
- are always unsigned.
-
- If you use NO_UNION_TYPE, this flag does not matter. */
-
-#define EXPLICIT_SIGN_EXTEND
-
-/* Data type of load average, as read out of kmem. */
-
-#define LOAD_AVE_TYPE long
-
-/* Convert that into an integer that is 100 for a load average of 1.0 */
-
-#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE)
-
-/* Define CANNOT_DUMP on machines where unexec does not work.
- Then the function dump-emacs will not be defined
- and temacs will do (load "loadup") automatically unless told otherwise. */
-
-/*
-#define CANNOT_DUMP 1
-#define CANNOT_UNEXEC 1
- */
-
-/* Start and end of text and data. */
-#define DATA_END get_data_end ()
-#define DATA_START get_data_start ()
-
-/* Define VIRT_ADDR_VARIES if the virtual addresses of
- pure and impure space as loaded can vary, and even their
- relative order cannot be relied on.
-
- Otherwise Emacs assumes that text space precedes data space,
- numerically. */
-
-/* Text does precede data space, but this is never a safe assumption. */
-#define VIRT_ADDR_VARIES
-
-/* For alloca. */
-#include <malloc.h>
-
-/* Define NO_REMAP if memory segmentation makes it not work well
- to change the boundary between the text section and data section
- when Emacs is dumped. If you define this, the preloaded Lisp
- code will not be sharable; but that's better than failing completely. */
-
-/* #define NO_REMAP */
-
-/* Some really obscure 4.2-based systems (like Sequent DYNIX)
- * do not support asynchronous I/O (using SIGIO) on sockets,
- * even though it works fine on tty's. If you have one of
- * these systems, define the following, and then use it in
- * config.h (or elsewhere) to decide when (not) to use SIGIO.
- *
- * You'd think this would go in an operating-system description file,
- * but since it only occurs on some, but not all, BSD systems, the
- * reasonable place to select for it is in the machine description
- * file.
- */
-
-/* #define NO_SOCK_SIGIO */
-
-/* After adding support for a new system, modify the large case
- statement in the `configure' script to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
-
-/* arch-tag: ed6dc0c1-5c01-49df-befd-c25dfadfb8cf
- (do not change this comment) */
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
f->param_alist = Fcons (XCAR (tem), f->param_alist);
- store_frame_param (f, Qwindow_system, Qmac);
-
UNGCPRO;
/* Make sure windows on this frame appear in calls to next-window
terminal->memory_below_frame = 0; /* We don't remember what scrolls
off the bottom. */
+#endif
+
+ /* FIXME: This keyboard setup is 100% untested, just copied from
+ w32_create_terminal in order to set window-system now that it's
+ a keyboard object. */
+#ifdef MULTI_KBOARD
+ /* We don't yet support separate terminals on Mac, so don't try to share
+ keyboards between virtual terminals that are on the same physical
+ terminal like X does. */
+ terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
+ init_kboard (terminal->kboard);
+ terminal->kboard->Vwindow_system = intern ("mac");
+ terminal->kboard->next_kboard = all_kboards;
+ all_kboards = terminal->kboard;
+ /* Don't let the initial kboard remain current longer than necessary.
+ That would cause problems if a file loaded on startup tries to
+ prompt in the mini-buffer. */
+ if (current_kboard == initial_kboard)
+ current_kboard = terminal->kboard;
+ terminal->kboard->reference_count++;
#endif
return terminal;
/* Defined in macfns.c */
-extern int have_menus_p P_ ((void));
-
extern void x_real_positions P_ ((struct frame *, int *, int *));
extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern int x_pixel_width P_ ((struct frame *));
GCPRO2 (val, defalt);
- if (STRINGP (val) && SCHARS (val) == 0
- && STRINGP (defalt))
- val = defalt;
+ if (STRINGP (val) && SCHARS (val) == 0)
+ {
+ if (STRINGP (defalt))
+ val = defalt;
+ else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
+ val = XCAR (defalt);
+ }
expr_and_pos = Fread_from_string (val, Qnil, Qnil);
pos = XINT (Fcdr (expr_and_pos));
/* If Lisp form desired instead of string, parse it. */
if (expflag)
- val = string_to_object (val, defalt);
+ val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
return val;
}
histstring = val;
else if (STRINGP (defalt))
histstring = defalt;
+ else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
+ histstring = XCAR (defalt);
else
histstring = Qnil;
doc: /* Return a Lisp object read using the minibuffer, unevaluated.
Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
is a string to insert in the minibuffer before reading.
-\(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
-arguments are used as in `read-from-minibuffer'.) */)
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+Such arguments are used as in `read-from-minibuffer'.) */)
(prompt, initial_contents)
Lisp_Object prompt, initial_contents;
{
doc: /* Return value of Lisp expression read using the minibuffer.
Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
is a string to insert in the minibuffer before reading.
-\(INITIAL-CONTENTS can also be a cons of a string and an integer. Such
-arguments are used as in `read-from-minibuffer'.) */)
+\(INITIAL-CONTENTS can also be a cons of a string and an integer.
+Such arguments are used as in `read-from-minibuffer'.) */)
(prompt, initial_contents)
Lisp_Object prompt, initial_contents;
{
Qnil, history, default_value,
inherit_input_method);
if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
- val = default_value;
+ val = CONSP (default_value) ? XCAR (default_value) : default_value;
return val;
}
args[0] = build_string ("%s (default %s): ");
args[1] = prompt;
- args[2] = def;
+ args[2] = CONSP (def) ? XCAR (def) : def;
prompt = Fformat (3, args);
}
!NILP (inherit_input_method));
if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
- val = def;
+ val = CONSP (def) ? XCAR (def) : def;
RETURN_UNGCPRO (unbind_to (count, val));
}
/* Defined in xfns.c; emulated on msdos.c */
-extern int have_menus_p P_ ((void));
extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern int x_pixel_width P_ ((struct frame *));
extern int x_pixel_height P_ ((struct frame *));
Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
1, UNEVALLED, 0,
doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-The buffer is cleared out initially, and marked as unmodified when done.
-All output done by BODY is inserted in that buffer by default.
-The buffer is displayed in another window, but not selected.
-The value of the last form in BODY is returned.
-If BODY does not finish normally, the buffer BUFNAME is not displayed.
-
-The hook `temp-buffer-setup-hook' is run before BODY,
-with the buffer BUFNAME temporarily current.
-The hook `temp-buffer-show-hook' is run after the buffer is displayed,
-with the buffer temporarily current, and the window that was used
-to display it temporarily selected.
-
-If variable `temp-buffer-show-function' is non-nil, call it at the end
-to get the buffer displayed instead of just displaying the non-selected
-buffer and calling the hook. It gets one argument, the buffer to display.
+
+This construct makes buffer BUFNAME empty before running BODY.
+It does not make the buffer current for BODY.
+Instead it binds `standard-output' to that buffer, so that output
+generated with `prin1' and similar functions in BODY goes into
+the buffer.
+
+At the end of BODY, this marks buffer BUFNAME unmodifed and displays
+it in a window, but does not select it. The normal way to do this is
+by calling `display-buffer', then running `temp-buffer-show-hook'.
+However, if `temp-buffer-show-function' is non-nil, it calls that
+function instead (and does not run `temp-buffer-show-hook'). The
+function gets one argument, the buffer to display.
+
+The return value of `with-output-to-temp-buffer' is the value of the
+last form in BODY. If BODY does not finish normally, the buffer
+BUFNAME is not displayed.
+
+This runs the hook `temp-buffer-setup-hook' before BODY,
+with the buffer BUFNAME temporarily current. It runs the hook
+`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
+buffer temporarily current, and the window that was used to display it
+temporarily selected. But it doesn't run `temp-buffer-show-hook'
+if it uses `temp-buffer-show-function'.
usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
(args)
\f
/* A version of request_sigio suitable for a record_unwind_protect. */
+#ifdef __ultrix__
static Lisp_Object
unwind_request_sigio (dummy)
Lisp_Object dummy;
request_sigio ();
return Qnil;
}
+#endif
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
#undef HAVE_TERMIOS_H
#define HAVE_LIMITS_H 1
#define HAVE_STRING_H 1
+#define HAVE_STDLIB_H 1
#define HAVE_PWD_H 1
#define STDC_HEADERS 1
#define TIME_WITH_SYS_TIME 1
#define utime _utime
#endif
-#ifdef HAVE_NTGUI
-#define abort w32_abort
-#endif
-
/* this is hacky, but is necessary to avoid warnings about macro
redefinitions using the SDK compilers */
#ifndef __STDC__
#ifdef MULTI_KBOARD
terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
init_kboard (terminal->kboard);
+ terminal->kboard->Vwindow_system = Qnil;
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
terminal->kboard->reference_count++;
LPBYTE lpvalue;
HKEY hrootkey = NULL;
DWORD cbData;
- BOOL ok = FALSE;
/* Check both the current user and the local machine to see if
we have any resources. */
/* Also ignore empty environment variables. */
|| *lpval == 0)
{
+ if (lpval) xfree (lpval);
lpval = env_vars[i].def_value;
dwType = REG_EXPAND_SZ;
dont_free = 1;
#include <stdio.h>
#include <limits.h>
#include <errno.h>
+#include <math.h>
#include "lisp.h"
#include "w32term.h"
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
f->param_alist = Fcons (XCAR (tem), f->param_alist);
- store_frame_param (f, Qwindow_system, Qw32);
-
UNGCPRO;
/* Make sure windows on this frame appear in calls to next-window
Qnil));
}
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qw32), Qnil));
-
f->no_split = 1;
UNGCPRO;
#undef abort
-void w32_abort (void) NO_RETURN;
-
void
w32_abort()
{
terminal like X does. */
terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
init_kboard (terminal->kboard);
+ terminal->kboard->Vwindow_system = intern ("w32");
terminal->kboard->next_kboard = all_kboards;
all_kboards = terminal->kboard;
/* Don't let the initial kboard remain current longer than necessary.
}
/* Return the minimum size for leaf window W. WIDTH_P non-zero means
- take into account fringes and the scrollbar of W. WIDTH_P zero
- means take into account mode-line and header-line of W. Return 1
- for the minibuffer. */
+ take into account fringes and the scrollbar of W. WIDTH_P zero means
+ take into account mode-line of W. Return 1 for the minibuffer. */
static int
window_min_size_2 (w, width_p)
else
size = max (window_min_height,
(MIN_SAFE_WINDOW_HEIGHT
- + (WINDOW_WANTS_MODELINE_P (w) ? 1 : 0)
- + (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0 )));
+ /* Don't count the header-line here. It would break
+ splitting a window with a header-line when the new
+ window shall have a height of two (calculator does
+ that). */
+ + (WINDOW_WANTS_MODELINE_P (w) ? 1 : 0)));
return size;
}
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
f->param_alist = Fcons (XCAR (tem), f->param_alist);
- store_frame_param (f, Qwindow_system, Qx);
-
UNGCPRO;
/* Make sure windows on this frame appear in calls to next-window
Qnil));
}
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qwindow_system, Qx), Qnil));
-
f->no_split = 1;
UNGCPRO;
{
terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
init_kboard (terminal->kboard);
+ terminal->kboard->Vwindow_system = intern ("x");
if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound))
{
char *vendor = ServerVendor (dpy);
/* Defined in xfns.c */
extern struct x_display_info * check_x_display_info P_ ((Lisp_Object frame));
-extern int have_menus_p P_ ((void));
#ifdef USE_GTK
extern int xg_set_icon P_ ((struct frame *, Lisp_Object));