1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-23 18:47:57 +00:00

Merge from emacs--devo--0

Patches applied:

 * emacs--devo--0  (patch 846-851)

   - Update from CVS
   - Merge from emacs--rel--22

 * emacs--rel--22  (patch 88-92)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 242-244)

   - Update from CVS

Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-31
This commit is contained in:
Miles Bader 2007-08-13 13:51:08 +00:00
commit aaf34461ff
297 changed files with 3459 additions and 1386 deletions

View File

@ -1,3 +1,7 @@
2007-08-10 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* FOR-RELEASE (http): Add Gtk+ tool bar and GUD focus problem.
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.
@ -19,7 +23,7 @@
* nt/makedist.bat: Change EOL format to DOS. Don't use
redirection characters in REM lines.
2007-01-27 Jan Dj,Ad(Brv <jhd@winter.localdomain>
2007-01-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* FOR-RELEASE: Removed Gtk/Xft issue.

View File

@ -48,19 +48,23 @@ that branch. Do not make manual changes to this file on the trunk.
http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg01113.html
** davby@ida.liu.se, 6 July: Bug in pos-visible-in-window-p
** dak@gnu.org, 30 May: Redraw problem with overlapping frames
** dksw@eircom.net, 3 Jul: Telnet mode (rsh/ssh)
** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in
** sdl.web@gmail.com: problem with transparent PNG image display
** ams@gnu.org, 9 July: eshell and external commands
** timh@insightful.com, 25 June: undigestify-rmail-message in emacs 22.1 doesn't split a digest
** andreas.roehler@online.de, 24 Jul: CVS build on Suse 10.0 failed
** Gtk+ tool bar looses focus when pressing next tool bar button in GUD.
http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-08/msg00008.html
* FIXES FOR EMACS 22.2
Here we list small fixes that arrived too late for Emacs 22.1, but
that should be installed on the release branch after 22.1 is released.
Here we list small fixes that arrived too late for Emacs 22.2, but
that should be installed on the release branch after 22.2 is released.
** Changes to six pbm icons in etc/images.
Sync change from trunk 2007-05-19.

View File

@ -1,7 +1,7 @@
Precompiled Distributions of
Emacs for Windows
Version 22.1
Version 22.2
May 22, 2007
@ -26,9 +26,9 @@
If you want to redistribute any of the precompiled distributions of
Emacs, be careful to check the implications of the GPL. For instance,
if you put the emacs-22.1-bin-i386.tar.gz file from this directory on
if you put the emacs-22.2-bin-i386.tar.gz file from this directory on
an Internet site, you must arrange to distribute the source files of
the SAME version (i.e. ../emacs-22.1.tar.gz).
the SAME version (i.e. ../emacs-22.2.tar.gz).
Making a link to our copy of the source is NOT sufficient, since we
might upgrade to a new version while you are still distributing the
@ -37,8 +37,8 @@
* Files in this directory
+ emacs-22.1-bin-i386.zip
Windows binaries of Emacs-22.1, with all lisp code and documentation
+ emacs-22.2-bin-i386.zip
Windows binaries of Emacs-22.2, with all lisp code and documentation
included.
Download this file if you want a single installation package, and
@ -49,8 +49,8 @@
If you need the C source code at a later date, it will be safe to
unpack the source distribution on top of this installation.
+ emacs-22.1-barebin-i386.zip
Windows binaries of Emacs-22.1, without lisp code or documentation.
+ emacs-22.2-barebin-i386.zip
Windows binaries of Emacs-22.2, without lisp code or documentation.
Download this file if you already have the source distribution, or
if you need to redump the emacs.exe executable.
@ -60,12 +60,22 @@
file, plus temacs.exe and dump.bat, which are required if you want to
redump emacs without recompiling it.
+ libxpm-src.zip
Source code for libXpm-X11R7.2-3.5.6 modified to compile on Windows.
This corresponds to the libXpm.dll in emacs-22.2-bin-i386.zip
and emacs-22.2-barebin-i386.zip.
The following are provided for users who require older versions.
+ emacs-22.1-bin-i386.zip
+ emacs-22-1-barebin-i386.zip
Windows binaries of Emacs 22.1, contents as above.
+ emacs-21.3-bin-i386.tar.gz
Windows binaries of Emacs 21.3, with compiled lisp code and some
documentation included.
This is provided for users who require the older version.
+ emacs-21.3-leim.tar.gz
Compiled lisp input methods. This optional addition to Emacs-21.3
is required if you want to enter languages that are not directly
@ -73,7 +83,7 @@
* Image support
Emacs 22.1 contains support for images, however for most image formats
Emacs 22.2 contains support for images, however for most image formats
supporting libraries are required. This distribution has been tested
with the libraries that are distributed with GTK for Windows, and the
libraries found at http://gnuwin32.sourceforge.net/. The following image
@ -82,10 +92,10 @@
PBM/PGM/PPM: Supported natively by Emacs. This format is used for
the black and white versions of the toolbar icons.
XPM: requires a Windows port of the XPM library 3.4 or later,
which will be named xpm4.dll, libxpm-nox4.dll or
libxpm.dll. This format is used for the color versions of the
toolbar icons, and other images in Emacs.
XPM: a Windows port of the XPM library corresponding to the x.org
release of X11R7.2 is included with the binary distribution, but
can be replaced by other versions with the name xpm4.dll,
libxpm-nox4.dll or libxpm.dll.
PNG: requires the PNG reference library 1.2 or later, which will
be named libpng13d.dll, libpng13.dll, libpng12d.dll, libpng12.dll
@ -217,7 +227,7 @@
about the Windows port and related software packages. Note that as
of writing, most of the information in that FAQ was for Emacs-21.3
and earlier versions, so some information may not be relevant to
Emacs-22.1.
Emacs-22.2.
In addition to the FAQ, there is a mailing list for discussing issues
related to the Windows port of Emacs. For information about the

View File

@ -35,8 +35,8 @@ copy %3\README.W32 emacs-%1\README.W32
rem Info-ZIP zip seems to be broken on Windows.
rem It always writes to zip.zip and treats the zipfile argument as one
rem of the files to go in it.
rem zip -9 -r %2-bin-i386 emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32 emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp emacs-%1/leim -x emacs.mdp *.pdb *.opt *~ CVS
7z a -tZIP -mx=9 -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory %2-bin-i386.zip emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32 emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp emacs-%1/leim emacs-%1/site-lisp
rem zip -9 -r %2-bin-i386 emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32 emacs-%1/INSTALL emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp emacs-%1/leim -x emacs.mdp *.pdb *.opt *~ CVS
7z a -tZIP -mx=9 -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory %2-bin-i386.zip emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32 emacs-%1/INSTALL emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp emacs-%1/leim emacs-%1/site-lisp
del emacs-%1\README.W32
if not (%4) == () goto end

View File

@ -1,3 +1,8 @@
2007-08-08 Glenn Morris <rgm@gnu.org>
* TODO: `iff' item is dealt with.
* GNUS-NEWS, NEWS, NEWS.1-17, NEWS.19, NEWS.21: Replace `iff'.
2007-08-01 Glenn Morris <rgm@gnu.org>
* NEWS: Add fortran-line-length, plus some more sections.

View File

@ -30,7 +30,7 @@ or remove them using `make remove-installed-shadows'.
Use `make.bat' if you want to install Gnus under MS Windows, the first
argument to the batch-program should be the directory where `xemacs.exe'
respectively `emacs.exe' is located, iff you want to install Gnus after
respectively `emacs.exe' is located, if you want to install Gnus after
compiling it, give `make.bat' `/copy' as the second parameter.
`make.bat' has been rewritten from scratch, it now features automatic
@ -308,7 +308,7 @@ as external parts.
** Gnus no longer generate the Sender: header automatically.
Earlier it was generated iff the user configurable email address was
Earlier it was generated when the user configurable email address was
different from the Gnus guessed default user address. As the guessing
algorithm is rarely correct these days, and (more controversially) the
only use of the Sender: header was to check if you are entitled to

View File

@ -77,8 +77,6 @@ history element containing the search string becomes the current.
* New Modes and Packages in Emacs 23.1
** bibtex-style-mode helps you write BibTeX's *.bst files.
** minibuffer-indicate-depth-mode shows the minibuffer depth in the prompt.
@ -99,8 +97,6 @@ considered for update.
*** VC backends can provide extra menu entries to be added to the "Version Control" menu.
This can be used to add menu entries for backend specific functions.
*** VC has some support for Bazaar (bzr).
** sgml-electric-tag-pair-mode lets you simultaneously edit matched tag pairs.
** BibTeX mode:
@ -197,10 +193,6 @@ like this:
** New variable `user-emacs-directory'.
Use this instead of "~/.emacs.d".
+++
** The new function `image-refresh' refreshes all images associated
with a given image specification.
+++
** The new function `start-file-process is similar to `start-process',
but obeys file handlers. The file handler is chosen based on

View File

@ -1208,7 +1208,7 @@ whether and where a line has a comment.
* New function `auto-save-file-name-p'
Should return non-`nil' iff given a string which is the name of an
Should return non-`nil' if given a string which is the name of an
auto-save file (sans directory name). If you redefine
`make-auto-save-file-name', you should redefine this accordingly. By
default, this function returns `t' for filenames beginning with

View File

@ -5133,8 +5133,8 @@ using X).
** It is now simpler to tell Emacs to display accented characters under
X windows. M-x standard-display-european toggles the display of
buffer text according to the ISO Latin-1 standard. With a prefix
argument, this command enables European character display iff the
argument is positive.
argument, this command enables European character display if and only
if the argument is positive.
** The `-i' command-line argument tells Emacs to use a picture of the
GNU gnu as its icon, instead of letting the window manager choose an

View File

@ -2502,7 +2502,7 @@ value is returned. If no window satisfies PREDICATE, DEFAULT is
returned.
Optional second arg MINIBUF t means count the minibuffer window even
if not active. MINIBUF nil or omitted means count the minibuffer iff
if not active. MINIBUF nil or omitted means count the minibuffer if
it is active. MINIBUF neither t nor nil means not to count the
minibuffer even if it is active.

View File

@ -55,6 +55,8 @@ in to make it use the scrollbars from the system theme.
* New Modes and Packages in Emacs 22.2
** bibtex-style-mode helps you write BibTeX's *.bst files.
** The new package css-mode.el provides a major mode for editing CSS files.
** The new package vera-mode.el provides a major mode for editing Vera files.
@ -67,8 +69,21 @@ in to make it use the scrollbars from the system theme.
*** VC has some support for Mercurial (hg).
*** VC has some support for Bazaar (Bzr).
*** VC has some support for Git.
* Lisp Changes in Emacs 22.2.
** New function `window-full-width-p' returns t if a window is as wide
as its frame.
** The new function `image-refresh' refreshes all images associated
with a given image specification.
** The new function `split-string-and-unquote' does (what?)
** The new function `combine-and-quote-strings' does (what?)
* Installation Changes in Emacs 22.1
@ -3550,8 +3565,8 @@ that is, floats are compared by value and other elements with `eq'.
*** New functions `string-or-null-p' and `booleanp'.
`string-or-null-p' returns non-nil iff OBJECT is a string or nil.
`booleanp' returns non-nil iff OBJECT is t or nil.
`string-or-null-p' returns non-nil if OBJECT is a string or nil.
`booleanp' returns non-nil if OBJECT is t or nil.
*** `makehash' is now obsolete. Use `make-hash-table' instead.

View File

@ -19,8 +19,6 @@ I.e. mouse-set-font should use customize-face.
** Compute the list of active keymaps *after* reading the first event.
** Avoid using "iff" in doc strings.
** mouse-autoselect-window should wait to select the window until
the mouse is put to rest or after a delay or both, so that moving over
a window doesn't select it.

View File

@ -2883,7 +2883,7 @@ static void make_C_tag __P((bool));
* function or variable, or corresponds to a typedef, or
* is a struct/union/enum tag, or #define, or an enum constant.
*
* *IS_FUNC gets TRUE iff the token is a function or #define macro
* *IS_FUNC gets TRUE if the token is a function or #define macro
* with args. C_EXTP points to which language we are looking at.
*
* Globals
@ -4803,7 +4803,7 @@ Pascal_functions (inf)
int save_lineno, namelen, taglen;
char c, *name;
bool /* each of these flags is TRUE iff: */
bool /* each of these flags is TRUE if: */
incomment, /* point is inside a comment */
inquote, /* point is inside '..' string */
get_tagname, /* point is after PROCEDURE/FUNCTION

View File

@ -1,3 +1,385 @@
2007-08-13 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-send): Handle CTRL-D more carefully.
2007-08-12 Richard Stallman <rms@gnu.org>
* pcvs.el (cvs-reread-cvsrc, cvs-checkout, cvs-mode-checkout)
(cvs-execute-single-file): Use new name split-string-and-unquote.
(cvs-header-msg): Use new name combine-and-quote-strings.
* emulation/vi.el (vi-next-line): Ignore return value of line-move.
* progmodes/gud.el (gud-common-init): Use new name
split-string-and-unquote.
* progmodes/flymake.el (flymake-err-line-patterns): Fix infloop
in javac regexp.
* pcvs-util.el (cvs-qtypedesc-strings): Use new names
combine-and-quote-strings and split-string-and-unquote.
* subr.el (combine-and-quote-strings): Renamed from strings->string.
(split-string-and-unquote): Renamed from string->strings.
2007-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
* log-view.el (log-view-font-lock-keywords): Use `eval' so as to adapt
to buffer-local settings.
* emacs-lisp/backquote.el (backquote-delay-process): New function.
(backquote-process): Add internal arg `level'. Use the two to
correctly handle nested backquotes.
2007-08-09 Riccardo Murri <riccardo.murri@gmail.com>
* vc-bzr.el (vc-bzr-registered): Use \0 instead of literal NULs.
(vc-bzr-state-words): Add "kind changed" state word.
(vc-bzr-status): New function. Return Bzr idea of file status,
which is different from VC's.
(vc-bzr-state): Use vc-bzr-status.
(vc-workfile-unchanged-p): Use vc-bzr-status.
(vc-bzr-revert): Use synchronous process; expect exitcode 0.
(vc-dired-state): Process "kind changed" state word.
2007-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-hooks.el (vc-default-find-file-not-found-hook): Do nothing.
* vc-rcs.el (vc-rcs-find-file-not-found-hook):
Move from vc-default-find-file-not-found-hook.
2007-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
* man.el: Remove spurious * in docstrings.
Merge defvars and toplevel setq-defaults.
(Man-highlight-references0): Limit=nil rather than point-max.
(Man-mode-map): Move initialization into the declaration.
(Man-strip-page-headers, Man-unindent): Use dolist & inhibit-read-only.
(Man-view-header-file): Use expand-file-name rather than concat.
(Man-notify-when-ready, Man-bgproc-sentinel): Use with-current-buffer.
* man.el (Man-next-section): Make sure we do not move backward.
2007-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (auto-mode-alist): Use the purecopied text (duh!).
2007-08-08 Glenn Morris <rgm@gnu.org>
* Replace `iff' in doc-strings and comments.
2007-08-08 Martin Rudalics <rudalics@gmx.at>
* dired.el (dired-pop-to-buffer):
* mouse-drag.el (mouse-drag-should-do-col-scrolling):
* calendar/calendar.el (generate-calendar-window):
* progmodes/compile.el (compilation-set-window-height):
* textmodes/two-column.el (2C-two-columns, 2C-merge):
Use window-full-width-p instead of comparing frame-width and
window-width.
* progmodes/compile.el (compilation-find-buffer): Remove extra
argument in call to compilation-buffer-internal-p.
2007-08-07 Tom Tromey <tromey@redhat.com>
* progmodes/tcl.el (tcl-indent-level, tcl-continued-indent-level):
Add safe-local-variable property.
2007-08-07 Chong Yidong <cyd@stupidchicken.com>
* image-mode.el (image-toggle-display): Use image-refresh.
2007-08-07 Riccardo Murri <riccardo.murri@gmail.com>
* vc-bzr.el: Remove comments about vc-bzr.el being a modified
unofficial version.
(vc-bzr-command): Remove redundant setting of process-connection-type.
(vc-bzr-admin-checkout-format-file): Add autoload.
(vc-bzr-root-dir): Remove in favor of vc-bzr-root.
(vc-bzr-root): Switch to implementation of vc-bzr-root-dir.
(vc-bzr-registered): Compare dirstate format tag with known good
value, abort parsing if match fails. Warn user in docstring.
(vc-bzr-workfile-version): Case for different Bzr branch formats.
See bzrlib/branch.py in Bzr sources.
(vc-bzr-diff): First argument FILES may be a string rather than a list.
(vc-bzr-shell-command): Remove in favor of
vc-bzr-command-discarding-stderr.
(vc-bzr-command-discarding-stderr): New function.
2007-08-06 Riccardo Murri <riccardo.murri@gmail.com>
* vc-bzr.el (vc-bzr-registered): Gracefully handle missing "bzr"
program, and return nil
(vc-bzr-state): Gracefully handle missing "bzr" program, and return nil.
(vc-bzr-state): Look for path names relative to the repository
root after status keyword.
(vc-bzr-file-name-relative): New function.
(vc-bzr-admin-dirname): Reinstate, as other vc-bzr-admin-... paths
depend on it.
(vc-bzr-admin-dirname, ...-checkout-format-file)
(...-branch-format-file, ...-revhistory): Paths to some Bzr internal
files that we now parse directly for speed.
(vc-bzr-root-dir): Use `vc-bzr-admin-checkout-format-file' as witness.
(vc-bzr-registered): Only parse vc-bzr-admin-dirstate file if it exists.
(vc-bzr-state): "bzr status" successful only if exitcode is 0
(vc-bzr-root): Use `vc-bzr-shell-command'. Stderr may contain
Bzr warnings, so we must discard it.
(vc-bzr-workfile-version): Speedup counting lines from
`vc-bzr-admin-revhistory' file, but fallback to spawning "bzr revno"
if that file doesn't exist.
(vc-bzr-responsible-p): Use `vc-bzr-root' instead of
`vc-bzr-root-dir' for speed. Add `vc-bzr-admin-dirname'
(not ".bzr"!) to `vc-directory-exclusion-list'
(vc-bzr-shell-command): New function.
2007-08-06 Tom Tromey <tromey@redhat.com>
* diff-mode.el (diff-unified->context, diff-reverse-direction)
(diff-fixup-modifs): Typo in docstring.
2007-08-06 Stefan Monnier <monnier@iro.umontreal.ca>
* emulation/tpu-edt.el (tpu-current-line): Use posn-at-point and
count-screen-lines.
(tpu-edt-off): Disable relevant pieces of advice.
* emulation/tpu-extras.el (tpu-before-save-hook): Rename from
tpu-write-file-hook. Activate it with add-hook on buffer-save-hook.
(newline, newline-and-indent, do-auto-fill): Use advice instead of
redefining the function.
(tpu-set-scroll-margins): Activate the pieces of advice.
2007-08-06 Martin Rudalics <rudalics@gmx.at>
* help.el (resize-temp-buffer-window): Use window-full-width-p
instead of comparing frame-width and window-width.
2007-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/autoload.el (autoload-print-form): Use print-quoted.
2007-08-12 Richard Stallman <rms@gnu.org>
* progmodes/sh-script.el (sh): Delete group `unix'.
* progmodes/gud.el (gud): Change to group `processes'.
2007-08-11 Glenn Morris <rgm@gnu.org>
* progmodes/compile.el (compilation-buffer-name): Don't check
compilation-arguments. It is superfluous, and the variable isn't
even set when this function is called.
2007-08-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* term/mac-win.el (mac-ae-reopen-application): New function.
(mac-apple-event-map): Bind "reopen application" Apple event to it.
2007-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/tex-mode.el (tex-font-lock-unfontify-region): Fix to
take tex-font-script-display into account.
(tex-font-script-display, tex-font-lock-suscript): Change from a cons
cell to a list of 2 elements to simplify the unfontify code.
2007-08-09 Edward O'Connor <hober0@gmail.com> (tiny change)
* url/url-auth.el (url-basic-auth): When prompting for username
and password, default to the username and password in the URL.
2007-08-08 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* ps-print.el (ps-default-fg, ps-default-bg): Docstring fix.
(ps-begin-job): Use ps-default-fg and ps-default-bg only when
ps-print-color-p is neither nil nor black-white. Reported by Christian
Schlauer <cs-muelleimer-rubbish.bin@arcor.de>.
2007-08-08 Andreas Schwab <schwab@suse.de>
* mail/mailabbrev.el (sendmail-pre-abbrev-expand-hook): Check for
self-insert-command, not self-insert.
2007-08-08 Glenn Morris <rgm@gnu.org>
* emacs-lisp/eldoc.el (eldoc-get-fnsym-args-string): Make second
argument optional, for backwards compatibility, and only highlight
args when present. Fix symbol name typo (doc/args).
* help-mode.el (help-make-xrefs): Search for symbol constituents,
rather than just `-'.
2007-08-07 Jay Belanger <jay.p.belanger@gmail.com>
* calc/calc-units.el (calc-convert-temperature):
Use `/' to create fractions.
2007-08-07 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-wrong-passwd-regexp): Make the regexp more
global matching.
(tramp-handle-shell-command): Handle OUTPUT-BUFFER and
ERROR-BUFFER more robust. Display output.
(tramp-file-name-handler): Add a connection property when we found
a foreign file name handler. This allows backends like ftp to
profit also from usr/host name completion based on connection
cache.
(tramp-send-command-and-read): Search for trash after the regexp
until eol only. In XEmacs, there is a problem with \n.
* net/tramp-cache.el (top): Read persistent connection history
when cache is empty.
2007-08-07 Nic Ferrier <nferrier@tapsellferrier.co.uk> (tiny change)
* net/tramp.el (tramp-handle-process-file): Fix bug inserting
resulting output.
2007-08-07 Sam Steingold <sds@gnu.org>
* progmodes/compile.el (compilation-start): Pass nil as startfile
to comint-exec.
2007-08-07 Chong Yidong <cyd@stupidchicken.com>
* longlines.el (longlines-decoded): New variable.
(longlines-mode): Avoid encoding or decoding the buffer twice.
2007-08-07 Martin Rudalics <rudalics@gmx.at>
* format.el (format-insert-file): Make sure that at most one undo
entry is recorded for the insertion. Inhibit point-motion and
modification hooks around call to insert-file-contents.
2007-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
* vc.el (vc-annotate): Select temp-buffer before running vc-exec-after.
Select the buffer's window before moving point.
2007-08-07 Richard Stallman <rms@gnu.org>
* term.el (term): Remove parent group `unix'.
* simple.el (default-indent-new-line): New function.
It calls comment-line-break-function if there are comments.
(do-auto-fill): Use that.
2007-08-07 Ivan Kanis <apple@kanis.eu>
* time.el (display-time-world-mode, display-time-world-display)
(display-time-world, display-time-world-list)
(display-time-world-time-format, display-time-world-buffer-name)
(display-time-world-timer-enable)
(display-time-world-timer-second, display-time-world-mode-map):
New.
2007-08-07 Sean O'Rourke <sorourke@cs.ucsd.edu>
* complete.el (PC-lisp-complete-symbol): Complete symbol around point.
(PC-do-completion): Add "acronym completion" for symbols and
filenames, so e.g. "mvbl" expands to "make-variable-buffer-local".
2007-08-06 Sam Steingold <sds@gnu.org>
* mouse.el (mouse-buffer-menu): Pass mode-name through
format-mode-line because it may be a list,
e.g., (sgml-xml-mode "XML" "SGML"), and not a string.
2007-08-06 Vinicius Jose Latorre <viniciusig@ig.com.br>
* printing.el (pr-update-menus): Docstring fix.
2007-08-06 Jason Rumney <jasonr@gnu.org>
* menu-bar.el (menu-bar-vc-filter): Use vc-call-backend.
* vc-hooks.el (vc-call): Add doc string.
2007-08-06 Michael Albinus <michael.albinus@gmx.de>
* net/ange-ftp.el (ange-ftp-hook-function): Catch also errors in
process-filter.
2007-08-06 Kenichi Handa <handa@m17n.org>
* international/quail.el: Wrap (require 'help-mode) by
eval-when-compile.
(quail-help-init): New function.
(quail-help): Call quail-help-init.
(quail-store-decode-map-key): Change it to a function.
2007-08-05 Jason Rumney <jasonr@gnu.org>
* vc.el (vc-rollback): Add norevert argument back.
(vc-revert-buffer): Add back as obsolete alias.
2007-08-05 Peter Povinec <ppovinec@yahoo.com> (tiny change)
* term.el: Honor term-default-fg-color and term-default-bg-color
settings when modifying term-current-face.
(term-default-fg-color, term-default-bg-color): Initialize from
default term-current-face.
(term-mode, term-reset-terminal): Set term-current-face with
term-default-fg-color and term-default-bg-color.
(term-handle-colors-array): term-current-face has term-default-fg-color
and term-default-bg-color after reset escape sequence.
(term-handle-colors-array): Set term-current-color with
term-default-fg/bg-color instead of ansi-term-color-vector when the
index (term-ansi-current-color or term-ansi-current-bg-color) is zero.
2007-08-05 Jay Belanger <belanger@localhost.localdomain>
* calc/calc-nlfit.el (math-nlfit-curve):
Remove unnecessary variables.
(math-nlfit-givens): Let bind free variables.
2007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br>
* printing.el: Require lpr and ps-print when loading printing package.
Reported by Glenn Morris <rgm@gnu.org>.
2007-08-05 Michael Albinus <michael.albinus@gmx.de>
* files.el (set-auto-mode): Handle also remote files wrt
`auto-mode-alist'.
2007-08-04 Jay Belanger <belanger@localhost.localdomain>
* calc/calcalg3.el (calc-curve-fit): Add support for nonlinear
curves and plotting.
* calc/calc-nlfit.el: New file.
2007-08-04 Glenn Morris <rgm@gnu.org>
* autorevert.el (auto-revert-tail-mode): auto-revert-tail-pos is
zero, not nil, when the library is first loaded. Check for a file
that has been modified on disk.
* progmodes/cperl-mode.el (cperl-compilation-error-regexp-alist):
Remove duplicate defvar preventing initialization.
(cperl-mode): Fix compilation-error-regexp-alist-alist setting.
2007-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
* diff-mode.el (diff-font-lock-keywords): Fix up false positives.
(diff-beginning-of-file): Adjust to the fact that diff-file-header-re
may match up to 4 lines.
(diff-beginning-of-file-and-junk): Rewrite.
2007-08-03 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* printing.el: Evaluate require only during compilation.
(pr-version): New version 6.9.1.
(deactivate-mark): Replace (defvar VAR nil) by (defvar VAR).
(pr-global-menubar): Fix code.
2007-08-03 Dan Nicolaescu <dann@ics.uci.edu>
* term.el (term-erase-in-display): Fix case when point is not at
the beginning of the line.
2007-08-03 Jay Belanger <jay.p.belanger@gmail.com>
* calc/calc-ext.el (math-get-value,math-get-sdev)
@ -18,7 +400,7 @@
* vc-bzr.el (vc-bzr-dir-state, vc-bzr-dired-state-info)
(vc-bzr-unload-hook): Use `Bzr' as VC backend name, not `BZR'.
2007-08-02 Richard Stallman <rms@gnu.org>
2007-08-03 Richard Stallman <rms@gnu.org>
* mail/rmailsum.el (rmail-make-summary-line): Find end of msg number
to update deleted flag.
@ -38,13 +420,13 @@
buffer immediately if suitable.
(compile, compilation-buffer-name, compilation-start): Doc fixes.
2007-07-31 Daiki Ueno <ueno@unixuser.org>
2007-08-03 Daiki Ueno <ueno@unixuser.org>
* faces.el (face-normalize-spec): New function.
(frame-set-background-mode): Normalize face-spec before calling
face-spec-match-p.
2007-07-31 Stefan Monnier <monnier@iro.umontreal.ca>
2007-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
* server.el (server-window): Add switch-to-buffer-other-frame option.
@ -98,16 +480,15 @@
(fortran-mode): Use fortran-line-length, and
fortran-font-lock-syntactic-keywords as a function. Add a
hack-local-variables-hook function.
(fortran-line-length, fortran-hack-local-variables): New
functions.
(fortran-window-create, fortran-strip-sequence-nos): Doc fix. Use
fortran-line-length rather than 72.
(fortran-line-length, fortran-hack-local-variables): New functions.
(fortran-window-create, fortran-strip-sequence-nos): Doc fix.
Use fortran-line-length rather than 72.
(fortran-window-create-momentarily): Doc fix.
2007-07-31 Drew Adams <drew.adams@oracle.com> (tiny change)
* cus-edit.el (custom-group-value-create, custom-goto-parent): Fix
parent groups link.
* cus-edit.el (custom-group-value-create, custom-goto-parent):
Fix parent groups link.
2007-07-31 Paul Pogonyshev <pogonyshev@gmx.net>
@ -160,21 +541,21 @@
2007-07-29 Michael Albinus <michael.albinus@gmx.de>
* tramp.el:
* tramp-uu.el:
* trampver.el: Use utf-8 encoding with coding cookie.
* net/tramp.el:
* net/tramp-uu.el:
* net/trampver.el: Use utf-8 encoding with coding cookie.
* tramp-cache.el:
* tramp-fish.el:
* tramp-ftp.el:
* tramp-gw.el:
* tramp-smb.el: Remove coding cookie.
* net/tramp-cache.el:
* net/tramp-fish.el:
* net/tramp-ftp.el:
* net/tramp-gw.el:
* net/tramp-smb.el: Remove coding cookie.
* tramp.el (tramp-handle-verify-visited-file-modtime):
* net/tramp.el (tramp-handle-verify-visited-file-modtime):
Flush buffer file-name's file property.
(tramp-handle-file-remote-p): The first parameter is FILENAME.
* trampver.el: Update release number.
* net/trampver.el: Update release number.
2007-07-29 Juri Linkov <juri@jurta.org>
@ -728,9 +1109,9 @@
Sync with Tramp 2.1.10.
* tramp.el (tramp-get-ls-command): Fyx typo.
* net/tramp.el (tramp-get-ls-command): Fyx typo.
* trampver.el: Update release number.
* net/trampver.el: Update release number.
2007-07-22 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>

View File

@ -39,9 +39,9 @@ define global abbrevs instead."
(defun abbrev-mode (&optional arg)
"Toggle Abbrev mode in the current buffer.
With argument ARG, turn abbrev mode on iff ARG is positive.
In Abbrev mode, inserting an abbreviation causes it to expand
and be replaced by its expansion."
With optional argument ARG, turn abbrev mode on if ARG is
positive, otherwise turn it off. In Abbrev mode, inserting an
abbreviation causes it to expand and be replaced by its expansion."
(interactive "P")
(setq abbrev-mode
(if (null arg) (not abbrev-mode)

View File

@ -1658,8 +1658,9 @@ the following two lines in your Emacs init file:
"Toggle minor mode for controlling exposure and editing of text outlines.
\\<allout-mode-map>
Optional arg forces mode to re-initialize iff arg is positive num or
symbol. Allout outline mode always runs as a minor mode.
Optional prefix argument TOGGLE forces the mode to re-initialize
if it is positive, otherwise it turns the mode off. Allout
outline mode always runs as a minor mode.
Allout outline mode provides extensive outline oriented formatting and
manipulation. It enables structural editing of outlines, as well as

View File

@ -276,9 +276,9 @@ the list of old buffers.")
"Position of last known end of file.")
(add-hook 'find-file-hook
(lambda ()
(set (make-local-variable 'auto-revert-tail-pos)
(nth 7 (file-attributes buffer-file-name)))))
(lambda ()
(set (make-local-variable 'auto-revert-tail-pos)
(nth 7 (file-attributes buffer-file-name)))))
;; Functions:
@ -315,7 +315,7 @@ This function is designed to be added to hooks, for example:
;;;###autoload
(define-minor-mode auto-revert-tail-mode
"Toggle reverting tail of buffer when file on disk grows.
With arg, turn Tail mode on iff arg is positive.
With arg, turn Tail mode on if arg is positive, otherwise turn it off.
When Tail mode is enabled, the tail of the file is constantly
followed, as with the shell command `tail -f'. This means that
@ -334,9 +334,25 @@ Use `auto-revert-mode' for changes other than appends!"
(auto-revert-tail-mode 0)
(error "This buffer is not visiting a file"))
(if (and (buffer-modified-p)
(not auto-revert-tail-pos) ; library was loaded only after finding file
(zerop auto-revert-tail-pos) ; library was loaded only after finding file
(not (y-or-n-p "Buffer is modified, so tail offset may be wrong. Proceed? ")))
(auto-revert-tail-mode 0)
;; a-r-tail-pos stores the size of the file at the time of the
;; last revert. After this package loads, it adds a
;; find-file-hook to set this variable every time a file is
;; loaded. If the package is loaded only _after_ visiting the
;; file to be reverted, then we have no idea what the value of
;; a-r-tail-pos should have been when the file was visited. If
;; the file has changed on disk in the meantime, all we can do
;; is offer to revert the whole thing. If you choose not to
;; revert, then you might miss some output then happened
;; between visiting the file and activating a-r-t-mode.
(and (zerop auto-revert-tail-pos)
(not (verify-visited-file-modtime (current-buffer)))
(y-or-n-p "File changed on disk, content may be missing. \
Perform a full revert? ")
;; Use this (not just revert-buffer) for point-preservation.
(auto-revert-handler))
;; else we might reappend our own end when we save
(add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t)
(or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position

View File

@ -501,7 +501,7 @@ Menu of mode operations in the mode line.")
(defvar minor-mode-alist nil "\
Alist saying how to show minor modes in the mode line.
Each element looks like (VARIABLE STRING);
STRING is included in the mode line iff VARIABLE's value is non-nil.
STRING is included in the mode line if VARIABLE's value is non-nil.
Actually, STRING need not be a string; any possible mode-line element
is okay. See `mode-line-format'.")

817
lisp/calc/calc-nlfit.el Normal file
View File

@ -0,0 +1,817 @@
;;; calc-nlfit.el --- nonlinear curve fitting for Calc
;; Copyright (C) 2007 Free Software Foundation, Inc.
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; 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 code uses the Levenberg-Marquardt method, as described in
;; _Numerical Analysis_ by H. R. Schwarz, to fit data to
;; nonlinear curves. Currently, the only the following curves are
;; supported:
;; The logistic S curve, y=a/(1+exp(b*(t-c)))
;; Here, y is usually interpreted as the population of some
;; quantity at time t. So we will think of the data as consisting
;; of quantities q0, q1, ..., qn and their respective times
;; t0, t1, ..., tn.
;; The logistic bell curve, y=A*exp(B*(t-C))/(1+exp(B*(t-C)))^2
;; Note that this is the derivative of the formula for the S curve.
;; We get A=-a*b, B=b and C=c. Here, y is interpreted as the rate
;; of growth of a population at time t. So we will think of the
;; data as consisting of rates p0, p1, ..., pn and their
;; respective times t0, t1, ..., tn.
;; The Hubbert Linearization, y/x=A*(1-x/B)
;; Here, y is thought of as the rate of growth of a population
;; and x represents the actual population. This is essentially
;; the differential equation describing the actual population.
;; The Levenberg-Marquardt method is an iterative process: it takes
;; an initial guess for the parameters and refines them. To get an
;; initial guess for the parameters, we'll use a method described by
;; Luis de Sousa in "Hubbert's Peak Mathematics". The idea is that
;; given quantities Q and the corresponding rates P, they should
;; satisfy P/Q= mQ+a. We can use the parameter a for an
;; approximation for the parameter a in the S curve, and
;; approximations for b and c are found using least squares on the
;; linearization log((a/y)-1) = log(bb) + cc*t of
;; y=a/(1+bb*exp(cc*t)), which is equivalent to the above s curve
;; formula, and then tranlating it to b and c. From this, we can
;; also get approximations for the bell curve parameters.
;;; Code:
(require 'calc-arith)
(defun math-nlfit-least-squares (xdata ydata &optional sdata sigmas)
"Return the parameters A and B for the best least squares fit y=a+bx."
(let* ((n (length xdata))
(s2data (if sdata
(mapcar 'calcFunc-sqr sdata)
(make-list n 1)))
(S (if sdata 0 n))
(Sx 0)
(Sy 0)
(Sxx 0)
(Sxy 0)
D)
(while xdata
(let ((x (car xdata))
(y (car ydata))
(s (car s2data)))
(setq Sx (math-add Sx (if s (math-div x s) x)))
(setq Sy (math-add Sy (if s (math-div y s) y)))
(setq Sxx (math-add Sxx (if s (math-div (math-mul x x) s)
(math-mul x x))))
(setq Sxy (math-add Sxy (if s (math-div (math-mul x y) s)
(math-mul x y))))
(if sdata
(setq S (math-add S (math-div 1 s)))))
(setq xdata (cdr xdata))
(setq ydata (cdr ydata))
(setq s2data (cdr s2data)))
(setq D (math-sub (math-mul S Sxx) (math-mul Sx Sx)))
(let ((A (math-div (math-sub (math-mul Sxx Sy) (math-mul Sx Sxy)) D))
(B (math-div (math-sub (math-mul S Sxy) (math-mul Sx Sy)) D)))
(if sigmas
(let ((C11 (math-div Sxx D))
(C12 (math-neg (math-div Sx D)))
(C22 (math-div S D)))
(list (list 'sdev A (calcFunc-sqrt C11))
(list 'sdev B (calcFunc-sqrt C22))
(list 'vec
(list 'vec C11 C12)
(list 'vec C12 C22))))
(list A B)))))
;;; The methods described by de Sousa require the cumulative data qdata
;;; and the rates pdata. We will assume that we are given either
;;; qdata and the corresponding times tdata, or pdata and the corresponding
;;; tdata. The following two functions will find pdata or qdata,
;;; given the other..
;;; First, given two lists; one of values q0, q1, ..., qn and one of
;;; corresponding times t0, t1, ..., tn; return a list
;;; p0, p1, ..., pn of the rates of change of the qi with respect to t.
;;; p0 is the right hand derivative (q1 - q0)/(t1 - t0).
;;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)).
;;; The other pis are the averages of the two:
;;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)).
(defun math-nlfit-get-rates-from-cumul (tdata qdata)
(let ((pdata (list
(math-div
(math-sub (nth 1 qdata)
(nth 0 qdata))
(math-sub (nth 1 tdata)
(nth 0 tdata))))))
(while (> (length qdata) 2)
(setq pdata
(cons
(math-mul
'(float 5 -1)
(math-add
(math-div
(math-sub (nth 2 qdata)
(nth 1 qdata))
(math-sub (nth 2 tdata)
(nth 1 tdata)))
(math-div
(math-sub (nth 1 qdata)
(nth 0 qdata))
(math-sub (nth 1 tdata)
(nth 0 tdata)))))
pdata))
(setq qdata (cdr qdata)))
(setq pdata
(cons
(math-div
(math-sub (nth 1 qdata)
(nth 0 qdata))
(math-sub (nth 1 tdata)
(nth 0 tdata)))
pdata))
(reverse pdata)))
;;; Next, given two lists -- one of rates p0, p1, ..., pn and one of
;;; corresponding times t0, t1, ..., tn -- and an initial values q0,
;;; return a list q0, q1, ..., qn of the cumulative values.
;;; q0 is the initial value given.
;;; For i>0, qi is computed using the trapezoid rule:
;;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1))
(defun math-nlfit-get-cumul-from-rates (tdata pdata q0)
(let* ((qdata (list q0)))
(while (cdr pdata)
(setq qdata
(cons
(math-add (car qdata)
(math-mul
(math-mul
'(float 5 -1)
(math-add (nth 1 pdata) (nth 0 pdata)))
(math-sub (nth 1 tdata)
(nth 0 tdata))))
qdata))
(setq pdata (cdr pdata))
(setq tdata (cdr tdata)))
(reverse qdata)))
;;; Given the qdata, pdata and tdata, find the parameters
;;; a, b and c that fit q = a/(1+b*exp(c*t)).
;;; a is found using the method described by de Sousa.
;;; b and c are found using least squares on the linearization
;;; log((a/q)-1) = log(b) + c*t
;;; In some cases (where the logistic curve may well be the wrong
;;; model), the computed a will be less than or equal to the maximum
;;; value of q in qdata; in which case the above linearization won't work.
;;; In this case, a will be replaced by a number slightly above
;;; the maximum value of q.
(defun math-nlfit-find-qmax (qdata pdata tdata)
(let* ((ratios (mapcar* 'math-div pdata qdata))
(lsdata (math-nlfit-least-squares ratios tdata))
(qmax (math-max-list (car qdata) (cdr qdata)))
(a (math-neg (math-div (nth 1 lsdata) (nth 0 lsdata)))))
(if (math-lessp a qmax)
(math-add '(float 5 -1) qmax)
a)))
(defun math-nlfit-find-logistic-parameters (qdata pdata tdata)
(let* ((a (math-nlfit-find-qmax qdata pdata tdata))
(newqdata
(mapcar (lambda (q) (calcFunc-ln (math-sub (math-div a q) 1)))
qdata))
(bandc (math-nlfit-least-squares tdata newqdata)))
(list
a
(calcFunc-exp (nth 0 bandc))
(nth 1 bandc))))
;;; Next, given the pdata and tdata, we can find the qdata if we know q0.
;;; We first try to find q0, using the fact that when p takes on its largest
;;; value, q is half of its maximum value. So we'll find the maximum value
;;; of q given various q0, and use bisection to approximate the correct q0.
;;; First, given pdata and tdata, find what half of qmax would be if q0=0.
(defun math-nlfit-find-qmaxhalf (pdata tdata)
(let ((pmax (math-max-list (car pdata) (cdr pdata)))
(qmh 0))
(while (math-lessp (car pdata) pmax)
(setq qmh
(math-add qmh
(math-mul
(math-mul
'(float 5 -1)
(math-add (nth 1 pdata) (nth 0 pdata)))
(math-sub (nth 1 tdata)
(nth 0 tdata)))))
(setq pdata (cdr pdata))
(setq tdata (cdr tdata)))
qmh))
;;; Next, given pdata and tdata, approximate q0.
(defun math-nlfit-find-q0 (pdata tdata)
(let* ((qhalf (math-nlfit-find-qmaxhalf pdata tdata))
(q0 (math-mul 2 qhalf))
(qdata (math-nlfit-get-cumul-from-rates tdata pdata q0)))
(while (math-lessp (math-nlfit-find-qmax
(mapcar
(lambda (q) (math-add q0 q))
qdata)
pdata tdata)
(math-mul
'(float 5 -1)
(math-add
q0
qhalf)))
(setq q0 (math-add q0 qhalf)))
(let* ((qmin (math-sub q0 qhalf))
(qmax q0)
(qt (math-nlfit-find-qmax
(mapcar
(lambda (q) (math-add q0 q))
qdata)
pdata tdata))
(i 0))
(while (< i 10)
(setq q0 (math-mul '(float 5 -1) (math-add qmin qmax)))
(if (math-lessp
(math-nlfit-find-qmax
(mapcar
(lambda (q) (math-add q0 q))
qdata)
pdata tdata)
(math-mul '(float 5 -1) (math-add qhalf q0)))
(setq qmin q0)
(setq qmax q0))
(setq i (1+ i)))
(math-mul '(float 5 -1) (math-add qmin qmax)))))
;;; To improve the approximations to the parameters, we can use
;;; Marquardt method as described in Schwarz's book.
;;; Small numbers used in the Givens algorithm
(defvar math-nlfit-delta '(float 1 -8))
(defvar math-nlfit-epsilon '(float 1 -5))
;;; Maximum number of iterations
(defvar math-nlfit-max-its 100)
;;; Next, we need some functions for dealing with vectors and
;;; matrices. For convenience, we'll work with Emacs lists
;;; as vectors, rather than Calc's vectors.
(defun math-nlfit-set-elt (vec i x)
(setcar (nthcdr (1- i) vec) x))
(defun math-nlfit-get-elt (vec i)
(nth (1- i) vec))
(defun math-nlfit-make-matrix (i j)
(let ((row (make-list j 0))
(mat nil)
(k 0))
(while (< k i)
(setq mat (cons (copy-list row) mat))
(setq k (1+ k)))
mat))
(defun math-nlfit-set-matx-elt (mat i j x)
(setcar (nthcdr (1- j) (nth (1- i) mat)) x))
(defun math-nlfit-get-matx-elt (mat i j)
(nth (1- j) (nth (1- i) mat)))
;;; For solving the linearized system.
;;; (The Givens method, from Schwarz.)
(defun math-nlfit-givens (C d)
(let* ((C (copy-tree C))
(d (copy-tree d))
(n (length (car C)))
(N (length C))
(j 1)
(r (make-list N 0))
(x (make-list N 0))
w
gamma
sigma
rho)
(while (<= j n)
(let ((i (1+ j)))
(while (<= i N)
(let ((cij (math-nlfit-get-matx-elt C i j))
(cjj (math-nlfit-get-matx-elt C j j)))
(when (not (math-equal 0 cij))
(if (math-lessp (calcFunc-abs cjj)
(math-mul math-nlfit-delta (calcFunc-abs cij)))
(setq w (math-neg cij)
gamma 0
sigma 1
rho 1)
(setq w (math-mul
(calcFunc-sign cjj)
(calcFunc-sqrt
(math-add
(math-mul cjj cjj)
(math-mul cij cij))))
gamma (math-div cjj w)
sigma (math-neg (math-div cij w)))
(if (math-lessp (calcFunc-abs sigma) gamma)
(setq rho sigma)
(setq rho (math-div (calcFunc-sign sigma) gamma))))
(setq cjj w
cij rho)
(math-nlfit-set-matx-elt C j j w)
(math-nlfit-set-matx-elt C i j rho)
(let ((k (1+ j)))
(while (<= k n)
(let* ((cjk (math-nlfit-get-matx-elt C j k))
(cik (math-nlfit-get-matx-elt C i k))
(h (math-sub
(math-mul gamma cjk) (math-mul sigma cik))))
(setq cik (math-add
(math-mul sigma cjk)
(math-mul gamma cik)))
(setq cjk h)
(math-nlfit-set-matx-elt C i k cik)
(math-nlfit-set-matx-elt C j k cjk)
(setq k (1+ k)))))
(let* ((di (math-nlfit-get-elt d i))
(dj (math-nlfit-get-elt d j))
(h (math-sub
(math-mul gamma dj)
(math-mul sigma di))))
(setq di (math-add
(math-mul sigma dj)
(math-mul gamma di)))
(setq dj h)
(math-nlfit-set-elt d i di)
(math-nlfit-set-elt d j dj))))
(setq i (1+ i))))
(setq j (1+ j)))
(let ((i n)
s)
(while (>= i 1)
(math-nlfit-set-elt r i 0)
(setq s (math-nlfit-get-elt d i))
(let ((k (1+ i)))
(while (<= k n)
(setq s (math-add s (math-mul (math-nlfit-get-matx-elt C i k)
(math-nlfit-get-elt x k))))
(setq k (1+ k))))
(math-nlfit-set-elt x i
(math-neg
(math-div s
(math-nlfit-get-matx-elt C i i))))
(setq i (1- i))))
(let ((i (1+ n)))
(while (<= i N)
(math-nlfit-set-elt r i (math-nlfit-get-elt d i))
(setq i (1+ i))))
(let ((j n))
(while (>= j 1)
(let ((i N))
(while (>= i (1+ j))
(setq rho (math-nlfit-get-matx-elt C i j))
(if (math-equal rho 1)
(setq gamma 0
sigma 1)
(if (math-lessp (calcFunc-abs rho) 1)
(setq sigma rho
gamma (calcFunc-sqrt
(math-sub 1 (math-mul sigma sigma))))
(setq gamma (math-div 1 (calcFunc-abs rho))
sigma (math-mul (calcFunc-sign rho)
(calcFunc-sqrt
(math-sub 1 (math-mul gamma gamma)))))))
(let ((ri (math-nlfit-get-elt r i))
(rj (math-nlfit-get-elt r j))
h)
(setq h (math-add (math-mul gamma rj)
(math-mul sigma ri)))
(setq ri (math-sub
(math-mul gamma ri)
(math-mul sigma rj)))
(setq rj h)
(math-nlfit-set-elt r i ri)
(math-nlfit-set-elt r j rj))
(setq i (1- i))))
(setq j (1- j))))
x))
(defun math-nlfit-jacobian (grad xlist parms &optional slist)
(let ((j nil))
(while xlist
(let ((row (apply grad (car xlist) parms)))
(setq j
(cons
(if slist
(mapcar (lambda (x) (math-div x (car slist))) row)
row)
j)))
(setq slist (cdr slist))
(setq xlist (cdr xlist)))
(reverse j)))
(defun math-nlfit-make-ident (l n)
(let ((m (math-nlfit-make-matrix n n))
(i 1))
(while (<= i n)
(math-nlfit-set-matx-elt m i i l)
(setq i (1+ i)))
m))
(defun math-nlfit-chi-sq (xlist ylist parms fn &optional slist)
(let ((cs 0))
(while xlist
(let ((c
(math-sub
(apply fn (car xlist) parms)
(car ylist))))
(if slist
(setq c (math-div c (car slist))))
(setq cs
(math-add cs
(math-mul c c))))
(setq xlist (cdr xlist))
(setq ylist (cdr ylist))
(setq slist (cdr slist)))
cs))
(defun math-nlfit-init-lambda (C)
(let ((l 0)
(n (length (car C)))
(N (length C)))
(while C
(let ((row (car C)))
(while row
(setq l (math-add l (math-mul (car row) (car row))))
(setq row (cdr row))))
(setq C (cdr C)))
(calcFunc-sqrt (math-div l (math-mul n N)))))
(defun math-nlfit-make-Ctilda (C l)
(let* ((n (length (car C)))
(bot (math-nlfit-make-ident l n)))
(append C bot)))
(defun math-nlfit-make-d (fn xdata ydata parms &optional sdata)
(let ((d nil))
(while xdata
(setq d (cons
(let ((dd (math-sub (apply fn (car xdata) parms)
(car ydata))))
(if sdata (math-div dd (car sdata)) dd))
d))
(setq xdata (cdr xdata))
(setq ydata (cdr ydata))
(setq sdata (cdr sdata)))
(reverse d)))
(defun math-nlfit-make-dtilda (d n)
(append d (make-list n 0)))
(defun math-nlfit-fit (xlist ylist parms fn grad &optional slist)
(let*
((C (math-nlfit-jacobian grad xlist parms slist))
(d (math-nlfit-make-d fn xlist ylist parms slist))
(chisq (math-nlfit-chi-sq xlist ylist parms fn slist))
(lambda (math-nlfit-init-lambda C))
(really-done nil)
(iters 0))
(while (and
(not really-done)
(< iters math-nlfit-max-its))
(setq iters (1+ iters))
(let ((done nil))
(while (not done)
(let* ((Ctilda (math-nlfit-make-Ctilda C lambda))
(dtilda (math-nlfit-make-dtilda d (length (car C))))
(zeta (math-nlfit-givens Ctilda dtilda))
(newparms (mapcar* 'math-add (copy-tree parms) zeta))
(newchisq (math-nlfit-chi-sq xlist ylist newparms fn slist)))
(if (math-lessp newchisq chisq)
(progn
(if (math-lessp
(math-div
(math-sub chisq newchisq) newchisq) math-nlfit-epsilon)
(setq really-done t))
(setq lambda (math-div lambda 10))
(setq chisq newchisq)
(setq parms newparms)
(setq done t))
(setq lambda (math-mul lambda 10)))))
(setq C (math-nlfit-jacobian grad xlist parms slist))
(setq d (math-nlfit-make-d fn xlist ylist parms slist))))
(list chisq parms)))
;;; The functions that describe our models, and their gradients.
(defun math-nlfit-s-logistic-fn (x a b c)
(math-div a (math-add 1 (math-mul b (calcFunc-exp (math-mul c x))))))
(defun math-nlfit-s-logistic-grad (x a b c)
(let* ((ep (calcFunc-exp (math-mul c x)))
(d (math-add 1 (math-mul b ep)))
(d2 (math-mul d d)))
(list
(math-div 1 d)
(math-neg (math-div (math-mul a ep) d2))
(math-neg (math-div (math-mul a (math-mul b (math-mul x ep))) d2)))))
(defun math-nlfit-b-logistic-fn (x a c d)
(let ((ex (calcFunc-exp (math-mul c (math-sub x d)))))
(math-div
(math-mul a ex)
(math-sqr
(math-add
1 ex)))))
(defun math-nlfit-b-logistic-grad (x a c d)
(let* ((ex (calcFunc-exp (math-mul c (math-sub x d))))
(ex1 (math-add 1 ex))
(xd (math-sub x d)))
(list
(math-div
ex
(math-sqr ex1))
(math-sub
(math-div
(math-mul a (math-mul xd ex))
(math-sqr ex1))
(math-div
(math-mul 2 (math-mul a (math-mul xd (math-sqr ex))))
(math-pow ex1 3)))
(math-sub
(math-div
(math-mul 2 (math-mul a (math-mul c (math-sqr ex))))
(math-pow ex1 3))
(math-div
(math-mul a (math-mul c ex))
(math-sqr ex1))))))
;;; Functions to get the final covariance matrix and the sdevs
(defun math-nlfit-find-covar (grad xlist pparms)
(let ((j nil))
(while xlist
(setq j (cons (cons 'vec (apply grad (car xlist) pparms)) j))
(setq xlist (cdr xlist)))
(setq j (cons 'vec (reverse j)))
(setq j
(math-mul
(calcFunc-trn j) j))
(calcFunc-inv j)))
(defun math-nlfit-get-sigmas (grad xlist pparms chisq)
(let* ((sgs nil)
(covar (math-nlfit-find-covar grad xlist pparms))
(n (1- (length covar)))
(N (length xlist))
(i 1))
(when (> N n)
(while (<= i n)
(setq sgs (cons (calcFunc-sqrt (nth i (nth i covar))) sgs))
(setq i (1+ i)))
(setq sgs (reverse sgs)))
(list sgs covar)))
;;; Now the Calc functions
(defun math-nlfit-s-logistic-params (xdata ydata)
(let ((pdata (math-nlfit-get-rates-from-cumul xdata ydata)))
(math-nlfit-find-logistic-parameters ydata pdata xdata)))
(defun math-nlfit-b-logistic-params (xdata ydata)
(let* ((q0 (math-nlfit-find-q0 ydata xdata))
(qdata (math-nlfit-get-cumul-from-rates xdata ydata q0))
(abc (math-nlfit-find-logistic-parameters qdata ydata xdata))
(B (nth 1 abc))
(C (nth 2 abc))
(A (math-neg
(math-mul
(nth 0 abc)
(math-mul B C))))
(D (math-neg (math-div (calcFunc-ln B) C)))
(A (math-div A B)))
(list A C D)))
;;; Some functions to turn the parameter lists and variables
;;; into the appropriate functions.
(defun math-nlfit-s-logistic-solnexpr (pms var)
(let ((a (nth 0 pms))
(b (nth 1 pms))
(c (nth 2 pms)))
(list '/ a
(list '+
1
(list '*
b
(calcFunc-exp
(list '*
c
var)))))))
(defun math-nlfit-b-logistic-solnexpr (pms var)
(let ((a (nth 0 pms))
(c (nth 1 pms))
(d (nth 2 pms)))
(list '/
(list '*
a
(calcFunc-exp
(list '*
c
(list '- var d))))
(list '^
(list '+
1
(calcFunc-exp
(list '*
c
(list '- var d))))
2))))
(defun math-nlfit-enter-result (n prefix vals)
(setq calc-aborted-prefix prefix)
(calc-pop-push-record-list n prefix vals)
(calc-handle-whys))
(defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv)
(calc-slow-wrapper
(let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit)))
(calc-display-working-message nil)
(data (calc-top 1))
(xdata (cdr (car (cdr data))))
(ydata (cdr (car (cdr (cdr data)))))
(sdata (if (math-contains-sdev-p ydata)
(mapcar (lambda (x) (math-get-sdev x t)) ydata)
nil))
(ydata (mapcar (lambda (x) (math-get-value x)) ydata))
(calc-curve-varnames nil)
(calc-curve-coefnames nil)
(calc-curve-nvars 1)
(fitvars (calc-get-fit-variables 1 3))
(var (nth 1 calc-curve-varnames))
(parms (cdr calc-curve-coefnames))
(parmguess
(funcall initparms xdata ydata))
(fit (math-nlfit-fit xdata ydata parmguess fn grad sdata))
(finalparms (nth 1 fit))
(sigmacovar
(if sdevv
(math-nlfit-get-sigmas grad xdata finalparms (nth 0 fit))))
(sigmas
(if sdevv
(nth 0 sigmacovar)))
(finalparms
(if sigmas
(mapcar* (lambda (x y) (list 'sdev x y)) finalparms sigmas)
finalparms))
(soln (funcall solnexpr finalparms var)))
(let ((calc-fit-to-trail t)
(traillist nil))
(while parms
(setq traillist (cons (list 'calcFunc-eq (car parms) (car finalparms))
traillist))
(setq finalparms (cdr finalparms))
(setq parms (cdr parms)))
(setq traillist (calc-normalize (cons 'vec (nreverse traillist))))
(cond ((eq sdv 'calcFunc-efit)
(math-nlfit-enter-result 1 "efit" soln))
((eq sdv 'calcFunc-xfit)
(let (sln)
(setq sln
(list 'vec
soln
traillist
(nth 1 sigmacovar)
'(vec)
(nth 0 fit)
(let ((n (length xdata))
(m (length finalparms)))
(if (and sdata (> n m))
(calcFunc-utpc (nth 0 fit)
(- n m))
'(var nan var-nan)))))
(math-nlfit-enter-result 1 "xfit" sln)))
(t
(math-nlfit-enter-result 1 "fit" soln)))
(calc-record traillist "parm")))))
(defun calc-fit-s-shaped-logistic-curve (arg)
(interactive "P")
(math-nlfit-fit-curve 'math-nlfit-s-logistic-fn
'math-nlfit-s-logistic-grad
'math-nlfit-s-logistic-solnexpr
'math-nlfit-s-logistic-params
arg))
(defun calc-fit-bell-shaped-logistic-curve (arg)
(interactive "P")
(math-nlfit-fit-curve 'math-nlfit-b-logistic-fn
'math-nlfit-b-logistic-grad
'math-nlfit-b-logistic-solnexpr
'math-nlfit-b-logistic-params
arg))
(defun calc-fit-hubbert-linear-curve (&optional sdv)
(calc-slow-wrapper
(let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit)))
(calc-display-working-message nil)
(data (calc-top 1))
(qdata (cdr (car (cdr data))))
(pdata (cdr (car (cdr (cdr data)))))
(sdata (if (math-contains-sdev-p pdata)
(mapcar (lambda (x) (math-get-sdev x t)) pdata)
nil))
(pdata (mapcar (lambda (x) (math-get-value x)) pdata))
(poverqdata (mapcar* 'math-div pdata qdata))
(parmvals (math-nlfit-least-squares qdata poverqdata sdata sdevv))
(finalparms (list (nth 0 parmvals)
(math-neg
(math-div (nth 0 parmvals)
(nth 1 parmvals)))))
(calc-curve-varnames nil)
(calc-curve-coefnames nil)
(calc-curve-nvars 1)
(fitvars (calc-get-fit-variables 1 2))
(var (nth 1 calc-curve-varnames))
(parms (cdr calc-curve-coefnames))
(soln (list '* (nth 0 finalparms)
(list '- 1
(list '/ var (nth 1 finalparms))))))
(let ((calc-fit-to-trail t)
(traillist nil))
(setq traillist
(list 'vec
(list 'calcFunc-eq (nth 0 parms) (nth 0 finalparms))
(list 'calcFunc-eq (nth 1 parms) (nth 1 finalparms))))
(cond ((eq sdv 'calcFunc-efit)
(math-nlfit-enter-result 1 "efit" soln))
((eq sdv 'calcFunc-xfit)
(let (sln
(chisq
(math-nlfit-chi-sq
qdata poverqdata
(list (nth 1 (nth 0 finalparms))
(nth 1 (nth 1 finalparms)))
(lambda (x a b)
(math-mul a
(math-sub
1
(math-div x b))))
sdata)))
(setq sln
(list 'vec
soln
traillist
(nth 2 parmvals)
(list
'vec
'(calcFunc-fitdummy 1)
(list 'calcFunc-neg
(list '/
'(calcFunc-fitdummy 1)
'(calcFunc-fitdummy 2))))
chisq
(let ((n (length qdata)))
(if (and sdata (> n 2))
(calcFunc-utpc
chisq
(- n 2))
'(var nan var-nan)))))
(math-nlfit-enter-result 1 "xfit" sln)))
(t
(math-nlfit-enter-result 1 "fit" soln)))
(calc-record traillist "parm")))))
(provide 'calc-nlfit)
;; arch-tag: 6eba3cd6-f48b-4a84-8174-10c15a024928

View File

@ -49,7 +49,7 @@
(defvar math-standard-units
'( ;; Length
( m nil "*Meter" )
( in "2.54 cm" "Inch" )
( in "2.54 cm" "Inch" )
( ft "12 in" "Foot" )
( yd "3 ft" "Yard" )
( mi "5280 ft" "Mile" )
@ -971,17 +971,17 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(symbol-name v)))))))
(or (eq (nth 3 uold) (nth 3 unew))
(cond ((eq (nth 3 uold) 'K)
(setq expr (list '- expr '(float 27315 -2)))
(setq expr (list '- expr '(/ 27315 100)))
(if (eq (nth 3 unew) 'F)
(setq expr (list '+ (list '* expr '(frac 9 5)) 32))))
(setq expr (list '+ (list '* expr '(/ 9 5)) 32))))
((eq (nth 3 uold) 'C)
(if (eq (nth 3 unew) 'F)
(setq expr (list '+ (list '* expr '(frac 9 5)) 32))
(setq expr (list '+ expr '(float 27315 -2)))))
(setq expr (list '+ (list '* expr '(/ 9 5)) 32))
(setq expr (list '+ expr '(/ 27315 100)))))
(t
(setq expr (list '* (list '- expr 32) '(frac 5 9)))
(setq expr (list '* (list '- expr 32) '(/ 5 9)))
(if (eq (nth 3 unew) 'K)
(setq expr (list '+ expr '(float 27315 -2)))))))
(setq expr (list '+ expr '(/ 27315 100)))))))
(if pure
expr
(list '* expr new))))

View File

@ -115,6 +115,8 @@
(if (calc-is-hyperbolic) 'calcFunc-efit
'calcFunc-fit)))
key (which 0)
(nonlinear nil)
(plot nil)
n calc-curve-nvars temp data
(homog nil)
(msgs '( "(Press ? for help)"
@ -125,12 +127,18 @@
"E = a 10^(b x), X = 10^(a + b x), L = a + b log10(x)"
"q = a + b (x-c)^2"
"g = (a/b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2)"
"s = a/(1 + exp(b (x - c)))"
"b = a exp(b (x - c))/(1 + exp(b (x - c)))^2"
"o = (y/x) = a (1 - x/b)"
"h prefix = homogeneous model (no constant term)"
"P prefix = plot result"
"' = alg entry, $ = stack, u = Model1, U = Model2")))
(while (not calc-curve-model)
(message "Fit to model: %s:%s"
(nth which msgs)
(if homog " h" ""))
(message
"Fit to model: %s:%s%s"
(nth which msgs)
(if plot "P" " ")
(if homog "h" ""))
(setq key (read-char))
(cond ((= key ?\C-g)
(keyboard-quit))
@ -138,6 +146,16 @@
(setq which (% (1+ which) (length msgs))))
((memq key '(?h ?H))
(setq homog (not homog)))
((= key ?P)
(if plot
(setq plot nil)
(let ((data (calc-top 1)))
(if (or
(calc-is-hyperbolic)
(calc-is-inverse)
(not (= (length data) 3)))
(setq plot "Can't plot")
(setq plot data)))))
((progn
(if (eq key ?\$)
(setq n 1)
@ -164,8 +182,9 @@
((= key ?1) ; linear or multilinear
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model (math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames))))))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames))))))
((and (>= key ?2) (<= key ?9)) ; polynomial
(calc-get-fit-variables 1 (- key ?0 -1) (and homog 0))
(setq calc-curve-model
@ -180,58 +199,88 @@
((= key ?p) ; power law
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model (math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
calc-curve-varnames
(cons 'vec (cdr (cdr calc-curve-coefnames))))))))
(setq calc-curve-model
(math-mul
(nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
calc-curve-varnames
(cons 'vec (cdr (cdr calc-curve-coefnames))))))))
((= key ?^) ; exponential law
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model (math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames)))))
(setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames)))))
((= key ?s)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(calc-fit-s-shaped-logistic-curve func))
((= key ?b)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(calc-fit-bell-shaped-logistic-curve func))
((= key ?o)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(if (and plot (not (stringp plot)))
(setq plot
(list 'vec
(nth 1 plot)
(cons
'vec
(mapcar* 'calcFunc-div
(cdr (nth 2 plot))
(cdr (nth 1 plot)))))))
(calc-fit-hubbert-linear-curve func))
((memq key '(?e ?E))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model (math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
(if (eq key ?e)
'(var exp var-exp)
'(calcFunc-lambda
(var a var-a)
(^ 10 (var a var-a))))
(calcFunc-map
'(var mul var-mul)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames))))))
(setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
(if (eq key ?e)
'(var exp var-exp)
'(calcFunc-lambda
(var a var-a)
(^ 10 (var a var-a))))
(calcFunc-map
'(var mul var-mul)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames))))))
((memq key '(?x ?X))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model (math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames)))))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames)))))
(setq calc-curve-model (if (eq key ?x)
(list 'calcFunc-exp calc-curve-model)
(list '^ 10 calc-curve-model))))
((memq key '(?l ?L))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model (math-mul calc-curve-coefnames
(cons 'vec
(cons 1 (cdr (calcFunc-map
(if (eq key ?l)
'(var ln var-ln)
'(var log10
var-log10))
calc-curve-varnames)))))))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec
(cons 1 (cdr (calcFunc-map
(if (eq key ?l)
'(var ln var-ln)
'(var log10
var-log10))
calc-curve-varnames)))))))
((= key ?q)
(calc-get-fit-variables calc-curve-nvars
(1+ (* 2 calc-curve-nvars)) (and homog 0))
@ -247,12 +296,14 @@
(list '- (car v) (nth 1 c))
2)))))))
((= key ?g)
(setq calc-curve-model
(math-read-expr "(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)")
calc-curve-varnames '(vec (var XFit var-XFit))
calc-curve-coefnames '(vec (var AFit var-AFit)
(var BFit var-BFit)
(var CFit var-CFit)))
(setq
calc-curve-model
(math-read-expr
"(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)")
calc-curve-varnames '(vec (var XFit var-XFit))
calc-curve-coefnames '(vec (var AFit var-AFit)
(var BFit var-BFit)
(var CFit var-CFit)))
(calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
(and homog 1)))
((memq key '(?\$ ?\' ?u ?U))
@ -262,8 +313,9 @@
(let* ((calc-dollar-values calc-arg-values)
(calc-dollar-used 0)
(calc-hashes-used 0))
(setq calc-curve-model (calc-do-alg-entry "" "Model formula: "
nil 'calc-curve-fit-history))
(setq calc-curve-model
(calc-do-alg-entry "" "Model formula: "
nil 'calc-curve-fit-history))
(if (/= (length calc-curve-model) 1)
(error "Bad format"))
(setq calc-curve-model (car calc-curve-model)
@ -296,11 +348,13 @@
(or (nth 3 calc-curve-model)
(cons 'vec
(math-all-vars-but
calc-curve-model calc-curve-varnames)))
calc-curve-model
calc-curve-varnames)))
calc-curve-model (nth 1 calc-curve-model))
(error "Incorrect model specifier")))))
(or calc-curve-varnames
(let ((with-y (eq (car-safe calc-curve-model) 'calcFunc-eq)))
(let ((with-y
(eq (car-safe calc-curve-model) 'calcFunc-eq)))
(if calc-curve-coefnames
(calc-get-fit-variables
(if with-y (1+ calc-curve-nvars) calc-curve-nvars)
@ -310,7 +364,10 @@
nil with-y)
(let* ((coefs (math-all-vars-but calc-curve-model nil))
(vars nil)
(n (- (length coefs) calc-curve-nvars (if with-y 2 1)))
(n (-
(length coefs)
calc-curve-nvars
(if with-y 2 1)))
p)
(if (< n 0)
(error "Not enough variables in model"))
@ -326,18 +383,43 @@
calc-curve-varnames calc-curve-coefnames)
"modl"))))
(t (beep))))
(let ((calc-fit-to-trail t))
(calc-enter-result n (substring (symbol-name func) 9)
(list func calc-curve-model
(if (= (length calc-curve-varnames) 2)
(nth 1 calc-curve-varnames)
calc-curve-varnames)
(if (= (length calc-curve-coefnames) 2)
(nth 1 calc-curve-coefnames)
calc-curve-coefnames)
data))
(if (consp calc-fit-to-trail)
(calc-record (calc-normalize calc-fit-to-trail) "parm"))))))
(unless nonlinear
(let ((calc-fit-to-trail t))
(calc-enter-result n (substring (symbol-name func) 9)
(list func calc-curve-model
(if (= (length calc-curve-varnames) 2)
(nth 1 calc-curve-varnames)
calc-curve-varnames)
(if (= (length calc-curve-coefnames) 2)
(nth 1 calc-curve-coefnames)
calc-curve-coefnames)
data))
(if (consp calc-fit-to-trail)
(calc-record (calc-normalize calc-fit-to-trail) "parm"))))
(when plot
(if (stringp plot)
(message plot)
(let ((calc-graph-no-auto-view t))
(calc-graph-delete t)
(calc-graph-add-curve
(calc-graph-lookup (nth 1 plot))
(calc-graph-lookup (nth 2 plot)))
(unless (math-contains-sdev-p (nth 2 data))
(calc-graph-set-styles nil nil)
(calc-graph-point-style nil))
(setq plot (cdr (nth 1 plot)))
(setq plot
(list 'intv
3
(math-sub
(math-min-list (car plot) (cdr plot))
'(float 5 -1))
(math-add
'(float 5 -1)
(math-max-list (car plot) (cdr plot)))))
(calc-graph-add-curve (calc-graph-lookup plot)
(calc-graph-lookup (calc-top-n 1)))
(calc-graph-plot nil)))))))
(defun calc-invent-independent-variables (n &optional but)
(calc-invent-variables n but '(x y z t) "x"))

View File

@ -2080,7 +2080,7 @@ Or, for optional MON, YR."
;; Don't do any window-related stuff if we weren't called from a
;; window displaying the calendar
(when in-calendar-window
(if (or (one-window-p t) (/= (frame-width) (window-width)))
(if (or (one-window-p t) (not (window-full-width-p)))
;; Don't mess with the window size, but ensure that the first
;; line is fully visible
(set-window-vscroll nil 0)

View File

@ -450,6 +450,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
env-on
regex
p offset
abbreviated
(poss nil)
helpposs
(case-fold-search completion-ignore-case))
@ -586,17 +587,42 @@ GOTO-END is non-nil, however, it instead replaces up to END."
pred nil))
;; Find an initial list of possible completions
(if (not (setq p (string-match (concat PC-delim-regex
(unless (setq p (string-match (concat PC-delim-regex
(if filename "\\|\\*" ""))
str
(+ (length dirname) offset))))
(+ (length dirname) offset)))
;; Minibuffer contains no hyphens -- simple case!
(setq poss (all-completions (if env-on
basestr str)
(setq poss (all-completions (if env-on basestr str)
table
pred))
(unless poss
;; Try completion as an abbreviation, e.g. "mvb" ->
;; "m-v-b" -> "multiple-value-bind"
(setq origstr str
abbreviated t)
(if filename
(cond
;; "alpha" or "/alpha" -> expand whole path.
((string-match "^/?\\([A-Za-z0-9]+\\)$" str)
(setq
basestr ""
p nil
poss (PC-expand-many-files
(concat "/"
(mapconcat #'list (match-string 1 str) "*/")
"*"))
beg (1- beg)))
;; Alphanumeric trailer -> expand trailing file
((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str)
(setq regex (concat "\\`"
(mapconcat #'list
(match-string 2 str)
"[A-Za-z0-9]*[^A-Za-z0-9]"))
p (1+ (length (match-string 1 str))))))
(setq regex (concat "\\`" (mapconcat #'list str "[^-]*-"))
p 1))))
(when p
;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C!
(let ((compl (all-completions (if env-on
@ -605,12 +631,24 @@ GOTO-END is non-nil, however, it instead replaces up to END."
table
pred)))
(setq p compl)
(when (and compl abbreviated)
(if filename
(progn
(setq p nil)
(dolist (x compl)
(when (string-match regex x)
(push x p)))
(setq basestr (try-completion "" p)))
(setq basestr (mapconcat 'list str "-"))
(delete-region beg end)
(setq end (+ beg (length basestr)))
(insert basestr))))
(while p
(and (string-match regex (car p))
(progn
(set-text-properties 0 (length (car p)) '() (car p))
(setq poss (cons (car p) poss))))
(setq p (cdr p)))))
(setq p (cdr p))))
;; If table had duplicates, they can be here.
(delete-dups poss)
@ -644,6 +682,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(and p (setq poss p))))
;; Now we have a list of possible completions
(cond
;; No valid completions found
@ -653,6 +692,9 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(let ((PC-word-failed-flag t))
(delete-backward-char 1)
(PC-do-completion 'word))
(when abbreviated
(delete-region beg end)
(insert origstr))
(beep)
(PC-temp-minibuffer-message (if ambig
" [Ambiguous dir name]"
@ -789,13 +831,18 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(setq completion-base-size (if dirname
dirlength
(- beg prompt-end))))))
(PC-temp-minibuffer-message " [Next char not unique]"))
nil)))))
(PC-temp-minibuffer-message " [Next char not unique]"))))))
;; Expansion of filenames is not reversible, so just keep
;; the prefix.
(when (and abbreviated filename)
(delete-region (point) end))
nil)
;; Only one possible completion
(t
(if (and (equal basestr (car poss))
(not (and env-on filename)))
(not (and env-on filename))
(not abbreviated))
(if (null mode)
(PC-temp-minibuffer-message " [Sole completion]"))
(delete-region beg end)
@ -853,13 +900,11 @@ only symbols with function definitions are considered.
Otherwise, all symbols with function definitions, values
or properties are considered."
(interactive)
(let* ((end (point))
;; To complete the word under point, rather than just the portion
;; before point, use this:
;;; (save-excursion
;;; (with-syntax-table lisp-mode-syntax-table
;;; (forward-sexp 1)
;;; (point))))
(let* ((end
(save-excursion
(with-syntax-table lisp-mode-syntax-table
(skip-syntax-forward "_w")
(point))))
(beg (save-excursion
(with-syntax-table lisp-mode-syntax-table
(backward-sexp 1)

View File

@ -642,7 +642,7 @@ this sets the local binding in that buffer instead."
(funcall variable (if value 1 0))))
(defun custom-quote (sexp)
"Quote SEXP iff it is not self quoting."
"Quote SEXP if it is not self quoting."
(if (or (memq sexp '(t nil))
(keywordp sexp)
(and (listp sexp)
@ -665,14 +665,14 @@ default value. Otherwise, set it to nil.
To actually save the value, call `custom-save-all'.
Return non-nil iff the `saved-value' property actually changed."
Return non-nil if the `saved-value' property actually changed."
(custom-load-symbol symbol)
(let* ((get (or (get symbol 'custom-get) 'default-value))
(value (funcall get symbol))
(saved (get symbol 'saved-value))
(standard (get symbol 'standard-value))
(comment (get symbol 'customized-variable-comment)))
;; Save default value iff different from standard value.
;; Save default value if different from standard value.
(if (or (null standard)
(not (equal value (condition-case nil
(eval (car standard))
@ -694,13 +694,13 @@ or else if it is different from the standard value, set the
`customized-value' property to a list whose car evaluates to the
default value. Otherwise, set it to nil.
Return non-nil iff the `customized-value' property actually changed."
Return non-nil if the `customized-value' property actually changed."
(custom-load-symbol symbol)
(let* ((get (or (get symbol 'custom-get) 'default-value))
(value (funcall get symbol))
(customized (get symbol 'customized-value))
(old (or (get symbol 'saved-value) (get symbol 'standard-value))))
;; Mark default value as set iff different from old value.
;; Mark default value as set if different from old value.
(if (not (and old
(equal value (condition-case nil
(eval (car old))

View File

@ -349,8 +349,11 @@ when editing big diffs)."
("^--- .+ ----$" . diff-hunk-header-face) ;context
("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal
("^---$" . diff-hunk-header-face) ;normal
("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+\\)\\(.*[^*-]\\)?\n"
(0 diff-header-face) (2 diff-file-header-face prepend))
;; For file headers, accept files with spaces, but be careful to rule
;; out false-positives when matching hunk headers.
("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+?\\)\\(?:\t.*\\| \\(\\*\\*\\*\\*\\|----\\)\\)?\n"
(0 diff-header-face)
(2 (if (not (match-end 3)) diff-file-header-face) prepend))
("^\\([-<]\\)\\(.*\n\\)"
(1 diff-indicator-removed-face) (2 diff-removed-face))
("^\\([+>]\\)\\(.*\n\\)"
@ -425,10 +428,20 @@ but in the file header instead, in which case move forward to the first hunk."
(defun diff-beginning-of-file ()
(beginning-of-line)
(unless (looking-at diff-file-header-re)
(forward-line 2)
(condition-case ()
(re-search-backward diff-file-header-re)
(error (error "Can't find the beginning of the file")))))
(let ((start (point))
res)
;; diff-file-header-re may need to match up to 4 lines, so in case
;; we're inside the header, we need to move up to 3 lines forward.
(forward-line 3)
(if (and (setq res (re-search-backward diff-file-header-re nil t))
;; Maybe the 3 lines forward were too much and we matched
;; a file header after our starting point :-(
(or (<= (point) start)
(setq res (re-search-backward diff-file-header-re nil t))))
res
(goto-char start)
(error "Can't find the beginning of the file")))))
(defun diff-end-of-file ()
(re-search-forward "^[-+#!<>0-9@* \\]" nil t)
@ -481,26 +494,34 @@ If the prefix ARG is given, restrict the view to the current file instead."
"Go to the beginning of file-related diff-info.
This is like `diff-beginning-of-file' except it tries to skip back over leading
data such as \"Index: ...\" and such."
(let ((start (point))
(file (condition-case err (progn (diff-beginning-of-file) (point))
(error err)))
;; prevhunk is one of the limits.
(prevhunk (save-excursion (ignore-errors (diff-hunk-prev) (point))))
err)
(when (consp file)
;; Presumably, we started before the file header, in the leading junk.
(setq err file)
(diff-file-next)
(setq file (point)))
(let ((index (save-excursion
(re-search-backward "^Index: " prevhunk t))))
(when index (setq file index))
(if (<= file start)
(goto-char file)
;; File starts *after* the starting point: we really weren't in
;; a file diff but elsewhere.
(goto-char start)
(signal (car err) (cdr err))))))
(let* ((start (point))
(prevfile (condition-case err
(save-excursion (diff-beginning-of-file) (point))
(error err)))
(err (if (consp prevfile) prevfile))
(nextfile (ignore-errors
(save-excursion
(goto-char start) (diff-file-next) (point))))
;; prevhunk is one of the limits.
(prevhunk (save-excursion
(ignore-errors
(if (numberp prevfile) (goto-char prevfile))
(diff-hunk-prev) (point))))
(previndex (save-excursion
(re-search-backward "^Index: " prevhunk t))))
;; If we're in the junk, we should use nextfile instead of prevfile.
(if (and (numberp nextfile)
(or (not (numberp prevfile))
(and previndex (> previndex prevfile))))
(setq prevfile nextfile))
(if (and previndex (numberp prevfile) (< previndex prevfile))
(setq prevfile previndex))
(if (and (numberp prevfile) (<= prevfile start))
(goto-char prevfile)
;; File starts *after* the starting point: we really weren't in
;; a file diff but elsewhere.
(goto-char start)
(signal (car err) (cdr err)))))
(defun diff-file-kill ()
"Kill current file's hunks."
@ -703,7 +724,7 @@ PREFIX is only used internally: don't use it."
(defun diff-unified->context (start end)
"Convert unified diffs to context diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole bufer."
else cover the whole buffer."
(interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
@ -886,7 +907,7 @@ With a prefix argument, convert unified format to context format."
(defun diff-reverse-direction (start end)
"Reverse the direction of the diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole bufer."
else cover the whole buffer."
(interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
@ -948,7 +969,7 @@ else cover the whole bufer."
(defun diff-fixup-modifs (start end)
"Fixup the hunk headers (in case the buffer was modified).
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole bufer."
else cover the whole buffer."
(interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))

View File

@ -62,7 +62,8 @@
(defun diff-sentinel (code)
"Code run when the diff process exits.
CODE is the exit code of the process. It should be 0 iff no diffs were found."
CODE is the exit code of the process. It should be 0 only if no diffs
were found."
(if diff-old-temp-file (delete-file diff-old-temp-file))
(if diff-new-temp-file (delete-file diff-new-temp-file))
(save-excursion

View File

@ -1993,8 +1993,8 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(defun dired-tree-lessp (dir1 dir2)
;; Lexicographic order on file name components, like `ls -lR':
;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
;; i.e., if DIR1 is a (grand)parent dir of DIR2,
;; or DIR1 and DIR2 are in the same parentdir and their last
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.

View File

@ -2560,12 +2560,12 @@ non-empty directories is allowed."
(cond ;; if split-height-threshold is enabled, use the largest window
((and (> (window-height (setq w2 (get-largest-window)))
split-height-threshold)
(= (frame-width) (window-width w2)))
(window-full-width-p w2))
(setq window w2))
;; if the least-recently-used window is big enough, use it
((and (> (window-height (setq w2 (get-lru-window)))
(* 2 window-min-height))
(= (frame-width) (window-width w2)))
(window-full-width-p w2))
(setq window w2)))
(save-excursion
(set-buffer buf)

View File

@ -187,7 +187,8 @@ use either \\[customize] or the function `double-mode'."
;;;###autoload
(defun double-mode (arg)
"Toggle Double mode.
With prefix arg, turn Double mode on iff arg is positive.
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."

View File

@ -867,7 +867,7 @@ one optional arguments, diff-number to refine.")
(ediff-make-fine-diffs n 'noforce)
(ediff-make-fine-diffs n 'skip)))
;; highlight iff fine diffs already exist
;; highlight if fine diffs already exist
((eq ediff-auto-refine 'off)
(ediff-make-fine-diffs n 'skip))))
@ -1459,7 +1459,7 @@ arguments to `skip-chars-forward'."
(defun ediff-same-contents (d1 d2 &optional filter-re)
"Returns t iff D1 and D2 have the same content.
"Return t if D1 and D2 have the same content.
D1 and D2 can either be both directories or both regular files.
Symlinks and the likes are not handled.
If FILTER-RE is non-nil, recursive checking in directories

View File

@ -209,6 +209,7 @@ put the output in."
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
(print-quoted t)
(print-escape-nonascii t))
(dolist (elt form)
(prin1 elt outbuf)
@ -232,6 +233,7 @@ put the output in."
outbuf))
(terpri outbuf)))
(let ((print-escape-newlines t)
(print-quoted t)
(print-escape-nonascii t))
(print form outbuf)))))))

View File

@ -118,10 +118,28 @@ Vectors work just like lists. Nested backquotes are permitted."
;; constant, 1 => to be unquoted, 2 => to be spliced in.
;; The top-level backquote macro just discards the tag.
(defun backquote-process (s)
(defun backquote-delay-process (s level)
"Process a (un|back|splice)quote inside a backquote.
This simply recurses through the body."
(let ((exp (backquote-listify (list (backquote-process (nth 1 s) level)
(cons 0 (list 'quote (car s))))
'(0))))
(if (eq (car-safe exp) 'quote)
(cons 0 (list 'quote s))
(cons 1 exp))))
(defun backquote-process (s &optional level)
"Process the body of a backquote.
S is the body. Returns a cons cell whose cdr is piece of code which
is the macro-expansion of S, and whose car is a small integer whose value
can either indicate that the code is constant (0), or not (1), or returns
a list which should be spliced into its environment (2).
LEVEL is only used internally and indicates the nesting level:
0 (the default) is for the toplevel nested inside a single backquote."
(unless level (setq level 0))
(cond
((vectorp s)
(let ((n (backquote-process (append s ()))))
(let ((n (backquote-process (append s ()) level)))
(if (= (car n) 0)
(cons 0 s)
(cons 1 (cond
@ -138,11 +156,15 @@ Vectors work just like lists. Nested backquotes are permitted."
s
(list 'quote s))))
((eq (car s) backquote-unquote-symbol)
(cons 1 (nth 1 s)))
(if (<= level 0)
(cons 1 (nth 1 s))
(backquote-delay-process s (1- level))))
((eq (car s) backquote-splice-symbol)
(cons 2 (nth 1 s)))
(if (<= level 0)
(cons 2 (nth 1 s))
(backquote-delay-process s (1- level))))
((eq (car s) backquote-backquote-symbol)
(backquote-process (cdr (backquote-process (nth 1 s)))))
(backquote-delay-process s (1+ level)))
(t
(let ((rest s)
item firstlist list lists expression)
@ -154,11 +176,13 @@ Vectors work just like lists. Nested backquotes are permitted."
;; at the beginning, put them in FIRSTLIST,
;; as a list of tagged values (TAG . FORM).
;; If there are any at the end, they go in LIST, likewise.
(while (consp rest)
;; Turn . (, foo) into (,@ foo).
(if (eq (car rest) backquote-unquote-symbol)
(setq rest (list (list backquote-splice-symbol (nth 1 rest)))))
(setq item (backquote-process (car rest)))
(while (and (consp rest)
;; Stop if the cdr is an expression inside a backquote or
;; unquote since this needs to go recursively through
;; backquote-process.
(not (or (eq (car rest) backquote-unquote-symbol)
(eq (car rest) backquote-backquote-symbol))))
(setq item (backquote-process (car rest) level))
(cond
((= (car item) 2)
;; Put the nonspliced items before the first spliced item
@ -168,8 +192,8 @@ Vectors work just like lists. Nested backquotes are permitted."
list nil))
;; Otherwise, put any preceding nonspliced items into LISTS.
(if list
(setq lists (cons (backquote-listify list '(0 . nil)) lists)))
(setq lists (cons (cdr item) lists))
(push (backquote-listify list '(0 . nil)) lists))
(push (cdr item) lists)
(setq list nil))
(t
(setq list (cons item list))))
@ -177,8 +201,8 @@ Vectors work just like lists. Nested backquotes are permitted."
;; Handle nonsplicing final elements, and the tail of the list
;; (which remains in REST).
(if (or rest list)
(setq lists (cons (backquote-listify list (backquote-process rest))
lists)))
(push (backquote-listify list (backquote-process rest level))
lists))
;; Turn LISTS into a form that produces the combined list.
(setq expression
(if (or (cdr lists)
@ -221,5 +245,5 @@ Vectors work just like lists. Nested backquotes are permitted."
tail))
(t (cons 'list heads)))))
;;; arch-tag: 1a26206a-6b5e-4c56-8e24-2eef0f7e0e7a
;; arch-tag: 1a26206a-6b5e-4c56-8e24-2eef0f7e0e7a
;;; backquote.el ends here

View File

@ -564,7 +564,7 @@
(cons fn args)))))))
(defun byte-optimize-all-constp (list)
"Non-nil iff all elements of LIST satisfy `byte-compile-constp'."
"Non-nil if all elements of LIST satisfy `byte-compile-constp'."
(let ((constant t))
(while (and list constant)
(unless (byte-compile-constp (car list))

View File

@ -1243,7 +1243,8 @@ generating a buffered list of errors."
;;;###autoload
(define-minor-mode checkdoc-minor-mode
"Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
With prefix ARG, turn Checkdoc minor mode on if ARG is positive, otherwise
turn it off.
In Checkdoc minor mode, the usual bindings for `eval-defun' which is
bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include

View File

@ -10,7 +10,7 @@
;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
;;;;;; notevery notany every some mapcon mapcan mapl maplist map
;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "47c92504dda976a632c2c10bedd4b6a4")
;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "53c2b3ede19dac62cff13a37f58cdf9c")
;;; Generated autoloads from cl-extra.el
(autoload (quote coerce) "cl-extra" "\
@ -283,7 +283,7 @@ Not documented
;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function*
;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs"
;;;;;; "cl-macs.el" "7ccc827d272482ca276937ca18a7895a")
;;;;;; "cl-macs.el" "d9759da97810bc01423e77442b459468")
;;; Generated autoloads from cl-macs.el
(autoload (quote cl-compile-time-init) "cl-macs" "\
@ -745,7 +745,7 @@ Not documented
;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
;;;;;; substitute-if substitute delete-duplicates remove-duplicates
;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "8805f76626399794931f5db36ddf855f")
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "c972a97c053d4e001ac1d1012c315b28")
;;; Generated autoloads from cl-seq.el
(autoload (quote reduce) "cl-seq" "\

View File

@ -546,7 +546,7 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'."
(easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
(defun easy-menu-item-present-p (map path name)
"In submenu of MAP with path PATH, return non-nil iff item NAME is present.
"In submenu of MAP with path PATH, return non-nil if item NAME is present.
MAP and PATH are defined as in `easy-menu-add-item'.
NAME should be a string, the name of the element to be looked for."
(easy-menu-return-item (easy-menu-get-map map path) name))

View File

@ -267,13 +267,13 @@ Emacs Lisp mode) that support Eldoc.")
;; Return a string containing the function parameter list, or 1-line
;; docstring if function is a subr and no arglist is obtainable from the
;; docstring or elsewhere.
(defun eldoc-get-fnsym-args-string (sym argument-index)
(defun eldoc-get-fnsym-args-string (sym &optional argument-index)
(let ((args nil)
(doc nil))
(cond ((not (and sym (symbolp sym) (fboundp sym))))
((and (eq sym (aref eldoc-last-data 0))
(eq 'function (aref eldoc-last-data 2)))
(setq args (aref eldoc-last-data 1)))
(setq doc (aref eldoc-last-data 1)))
((setq doc (help-split-fundoc (documentation sym t) sym))
(setq args (car doc))
(string-match "\\`[^ )]* ?" args)
@ -281,8 +281,9 @@ Emacs Lisp mode) that support Eldoc.")
(eldoc-last-data-store sym args 'function))
(t
(setq args (eldoc-function-argstring sym))))
(when args
(setq doc (eldoc-highlight-function-argument sym args argument-index)))
(and args
argument-index
(setq doc (eldoc-highlight-function-argument sym args argument-index)))
doc))
;; Highlight argument INDEX in ARGS list for SYM.

View File

@ -554,7 +554,7 @@ appended to R will apply to all of R. For example, \"a\"
This function may return false negatives, but it will not
return false positives. It is nevertheless useful in
situations where an efficiency shortcut can be taken iff a
situations where an efficiency shortcut can be taken only if a
regexp is atomic. The function can be improved to detect
more cases of atomic regexps. Presently, this function
detects the following categories of atomic regexp;

View File

@ -212,7 +212,7 @@ of symbols with local bindings."
(defun unsafep-function (fun)
"Return nil iff FUN is a safe function.
"Return nil if FUN is a safe function.
\(either a safe lambda or a symbol that names a safe function). Otherwise
result is a reason code."
(cond

View File

@ -792,10 +792,13 @@ Create the key map if necessary."
(use-local-map tpu-buffer-local-map)))
(local-set-key key func))
(defun tpu-current-line nil
(defun tpu-current-line ()
"Return the vertical position of point in the selected window.
Top line is 0. Counts each text line only once, even if it wraps."
(+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1))
(or
(cdr (nth 6 (posn-at-point)))
(if (eq (window-start) (point)) 0
(1- (count-screen-lines (window-start) (point) 'count-final-newline)))))
;;;
@ -2422,6 +2425,7 @@ If FILE is nil, try to load a default file. The default file names are
(if (eq tpu-global-map parent)
(set-keymap-parent map (keymap-parent parent))
(setq map parent)))))
(ad-disable-regexp "\\`tpu-")
(setq tpu-edt-mode nil))
(provide 'tpu-edt)

View File

@ -141,13 +141,11 @@ the previous line when starting from a line beginning."
(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
(defun tpu-write-file-hook nil
(defun tpu-before-save-hook ()
"Eliminate whitespace at ends of lines, if the cursor is free."
(if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends)))
(or (memq 'tpu-write-file-hook write-file-functions)
(setq write-file-functions
(cons 'tpu-write-file-hook write-file-functions)))
(add-hook 'before-save-hook 'tpu-before-save-hook)
;;; Utility routines for implementing scroll margins
@ -246,7 +244,7 @@ Accepts a prefix argument for the number of lines to move."
(end-of-line (- 1 num))))
(tpu-top-check beg num)))
(defun tpu-current-end-of-line nil
(defun tpu-current-end-of-line ()
"Move point to end of current line."
(interactive)
(let ((beg (point)))
@ -392,41 +390,24 @@ A repeat count means scroll that many sections."
;;; Replace the newline, newline-and-indent, and do-auto-fill functions
(or (fboundp 'tpu-old-newline)
(fset 'tpu-old-newline (symbol-function 'newline)))
(or (fboundp 'tpu-old-do-auto-fill)
(fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill)))
(or (fboundp 'tpu-old-newline-and-indent)
(fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent)))
(defun newline (&optional num)
"Insert a newline. With arg, insert that many newlines.
In Auto Fill mode, can break the preceding line if no numeric arg.
This is the TPU-edt version that respects the bottom scroll margin."
(interactive "p")
(let ((beg (tpu-current-line)))
(or num (setq num 1))
(tpu-old-newline num)
;; Advise the newline, newline-and-indent, and do-auto-fill functions.
(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line))
(num (prefix-numeric-value (ad-get-arg 0))))
ad-do-it
(tpu-bottom-check beg num)))
(defun newline-and-indent nil
"Insert a newline, then indent according to major mode.
Indentation is done using the current indent-line-function.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents
to the specified left-margin column. This is the TPU-edt
version that respects the bottom scroll margin."
(interactive)
(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
(tpu-old-newline-and-indent)
ad-do-it
(tpu-bottom-check beg 1)))
(defun do-auto-fill nil
"TPU-edt version that respects the bottom scroll margin."
(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
(tpu-old-do-auto-fill)
ad-do-it
(tpu-bottom-check beg 1)))
@ -440,18 +421,21 @@ version that respects the bottom scroll margin."
\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
;; set top scroll margin
(or (string= top "")
(if (string= "%" (substring top -1))
(setq tpu-top-scroll-margin (string-to-number top))
(setq tpu-top-scroll-margin
(setq tpu-top-scroll-margin
(if (string= "%" (substring top -1))
(string-to-number top)
(/ (1- (+ (* (string-to-number top) 100) (window-height)))
(window-height)))))
;; set bottom scroll margin
(or (string= bottom "")
(if (string= "%" (substring bottom -1))
(setq tpu-bottom-scroll-margin (string-to-number bottom))
(setq tpu-bottom-scroll-margin
(setq tpu-bottom-scroll-margin
(if (string= "%" (substring bottom -1))
(string-to-number bottom)
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
(dolist (f '(newline newline-and-indent do-auto-fill))
(ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
(ad-activate f))
;; report scroll margin settings if running interactively
(and (interactive-p)
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
@ -461,7 +445,7 @@ version that respects the bottom scroll margin."
;;; Functions to set cursor bound or free
;;;###autoload
(defun tpu-set-cursor-free nil
(defun tpu-set-cursor-free ()
"Allow the cursor to move freely about the screen."
(interactive)
(setq tpu-cursor-free t)
@ -471,7 +455,7 @@ version that respects the bottom scroll margin."
(message "The cursor will now move freely about the screen."))
;;;###autoload
(defun tpu-set-cursor-bound nil
(defun tpu-set-cursor-bound ()
"Constrain the cursor to the flow of the text."
(interactive)
(tpu-trim-line-ends)
@ -481,5 +465,5 @@ version that respects the bottom scroll margin."
GOLD-map)
(message "The cursor is now bound to the flow of your text."))
;;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
;;; tpu-extras.el ends here

View File

@ -788,7 +788,7 @@ The given COUNT is remembered for future scrollings."
"Go down count lines, try to keep at the same column."
(interactive "p")
(setq this-command 'next-line) ; this is a needed trick
(if (= (point) (or (line-move count) (point)))
(if (= (point) (progn (line-move count) (point)))
(ding) ; no moving, already at end of buffer
(setq last-command 'next-line)))

View File

@ -1,3 +1,7 @@
2007-08-08 Glenn Morris <rgm@gnu.org>
* erc-log.el, erc.el: Replace `iff' in doc-strings and comments.
2007-07-30 Michael Olson <mwolson@gnu.org>
* erc-nicklist.el: Remove from the Emacs source tree. This file

View File

@ -261,7 +261,7 @@ The current buffer is given by BUFFER."
(defun erc-log-all-but-server-buffers (buffer)
"Returns t if logging should be enabled in BUFFER.
Returns nil iff `erc-server-buffer-p' returns t."
Returns nil if `erc-server-buffer-p' returns t."
(save-excursion
(save-window-excursion
(set-buffer buffer)

View File

@ -3958,7 +3958,7 @@ and always returns t."
(defun erc-echo-notice-in-target-buffer (s parsed buffer sender)
"Echos a private notice in BUFFER, if BUFFER is non-nil. This
function is designed to be added to either `erc-echo-notice-hook'
or `erc-echo-notice-always-hook', and returns non-nil iff BUFFER
or `erc-echo-notice-always-hook', and returns non-nil if BUFFER
is non-nil."
(if buffer
(progn (erc-display-message parsed nil buffer s) t)
@ -3982,7 +3982,7 @@ designed to be added to either `erc-echo-notice-hook' or
"Echos a private notice in the active buffer if the active
buffer is not the server buffer. This function is designed to be
added to either `erc-echo-notice-hook' or
`erc-echo-notice-always-hook', and returns non-nil iff the active
`erc-echo-notice-always-hook', and returns non-nil if the active
buffer is not the server buffer."
(if (not (eq (erc-server-buffer) (erc-active-buffer)))
(progn (erc-display-message parsed nil 'active s) t)
@ -3999,7 +3999,7 @@ designed to be added to either `erc-echo-notice-hook' or
"Echos a private notice in all of the buffers for which SENDER
is a member. This function is designed to be added to either
`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
returns non-nil iff there is at least one buffer for which the
returns non-nil if there is at least one buffer for which the
sender is a member.
See also: `erc-echo-notice-in-first-user-buffer',
@ -4013,7 +4013,7 @@ See also: `erc-echo-notice-in-first-user-buffer',
"Echos a private notice in BUFFER and in all of the buffers for
which SENDER is a member. This function is designed to be added
to either `erc-echo-notice-hook' or
`erc-echo-notice-always-hook', and returns non-nil iff there is
`erc-echo-notice-always-hook', and returns non-nil if there is
at least one buffer for which the sender is a member or the
default target.
@ -4029,7 +4029,7 @@ See also: `erc-echo-notice-in-user-buffers',
"Echos a private notice in one of the buffers for which SENDER
is a member. This function is designed to be added to either
`erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
returns non-nil iff there is at least one buffer for which the
returns non-nil if there is at least one buffer for which the
sender is a member.
See also: `erc-echo-notice-in-user-buffers',
@ -4938,7 +4938,7 @@ Specifically, return the position of `erc-insert-marker'."
(defun erc-send-input (input)
"Treat INPUT as typed in by the user. It is assumed that the input
and the prompt is already deleted.
This returns non-nil only iff we actually send anything."
This returns non-nil only if we actually send anything."
;; Handle different kinds of inputs
(cond
;; Ignore empty input

View File

@ -1937,7 +1937,7 @@ since only a single case-insensitive search through the alist is made."
;; c++-mode, java-mode and more) are added through autoload
;; directives in that file. That way is discouraged since it
;; spreads out the definition of the initial value.
(mapc
(mapcar
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
`(;; do this first, so that .html.pl is Polish html, not Perl
@ -2310,7 +2310,12 @@ we don't actually set it to the same mode the buffer already has."
;; Next compare the filename against the entries in auto-mode-alist.
(unless done
(if buffer-file-name
(let ((name buffer-file-name))
(let ((name buffer-file-name)
(remote-id (file-remote-p buffer-file-name)))
;; Remove remote file name identification.
(when (and (stringp remote-id)
(string-match (regexp-quote remote-id) name))
(setq name (substring name (match-end 0))))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(while name
@ -3989,8 +3994,9 @@ prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(defun toggle-read-only (&optional arg)
"Change whether this buffer is visiting its file read-only.
With arg, set read-only iff arg is positive.
If visiting file read-only and `view-read-only' is non-nil, enter view mode."
With prefix argument ARG, make the buffer read-only if ARG is
positive, otherwise make it writable. If visiting file read-only
and `view-read-only' is non-nil, enter view mode."
(interactive "P")
(if (and arg
(if (> (prefix-numeric-value arg) 0) buffer-read-only
@ -4633,7 +4639,7 @@ FILENAME should lack slashes. You can redefine this for customization."
(defun wildcard-to-regexp (wildcard)
"Given a shell file name pattern WILDCARD, return an equivalent regexp.
The generated regexp will match a filename iff the filename
The generated regexp will match a filename only if the filename
matches that wildcard according to shell rules. Only wildcards known
by `sh' are supported."
(let* ((i (string-match "[[.*+\\^$?]" wildcard))

View File

@ -355,7 +355,7 @@ Each element in a user-level keywords list should have one of these forms:
where MATCHER can be either the regexp to search for, or the function name to
call to make the search (called with one argument, the limit of the search;
it should return non-nil, move point, and set `match-data' appropriately iff
it should return non-nil, move point, and set `match-data' appropriately if
it succeeds; like `re-search-forward' would).
MATCHER regexps can be generated via the function `regexp-opt'.
@ -1068,7 +1068,7 @@ that tries to find such elements and move the boundaries such that they do
not fall in the middle of one.
Each function is called with no argument; it is expected to adjust the
dynamically bound variables `font-lock-beg' and `font-lock-end'; and return
non-nil iff it did make such an adjustment.
non-nil if it did make such an adjustment.
These functions are run in turn repeatedly until they all return nil.
Put first the functions more likely to cause a change and cheaper to compute.")
;; Mark it as a special hook which doesn't use any global setting
@ -1746,7 +1746,7 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to
"Set fontification defaults appropriately for this mode.
Sets various variables using `font-lock-defaults' (or, if nil, using
`font-lock-defaults-alist') and `font-lock-maximum-decoration'."
;; Set fontification defaults iff not previously set for correct major mode.
;; Set fontification defaults if not previously set for correct major mode.
(unless (and font-lock-set-defaults
(eq font-lock-mode-major-mode major-mode))
(setq font-lock-mode-major-mode major-mode)

View File

@ -429,13 +429,34 @@ a list (ABSOLUTE-FILE-NAME SIZE)."
(fmt (format-read (format "Read file `%s' in format: "
(file-name-nondirectory file)))))
(list file fmt)))
(let (value size)
(let ((format-alist nil))
(setq value (insert-file-contents filename nil beg end))
(setq size (nth 1 value)))
(if format
(setq size (format-decode format size)
value (list (car value) size)))
(let (value size old-undo)
;; Record only one undo entry for the insertion. Inhibit point-motion and
;; modification hooks as with `insert-file-contents'.
(let ((inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
;; Don't bind `buffer-undo-list' to t here to assert that
;; `insert-file-contents' may record whether the buffer was unmodified
;; before.
(let ((format-alist nil))
(setq value (insert-file-contents filename nil beg end))
(setq size (nth 1 value)))
(when (consp buffer-undo-list)
(let ((head (car buffer-undo-list)))
(when (and (consp head)
(equal (car head) (point))
(equal (cdr head) (+ (point) size)))
;; Remove first entry from `buffer-undo-list', we shall insert
;; another one below.
(setq old-undo (cdr buffer-undo-list)))))
(when format
(let ((buffer-undo-list t))
(setq size (format-decode format size)
value (list (car value) size)))
(unless (eq buffer-undo-list t)
(setq buffer-undo-list
(cons (cons (point) (+ (point) size)) old-undo)))))
(unless inhibit-modification-hooks
(run-hook-with-args 'after-change-functions (point) (+ (point) size) 0))
value))
(defun format-read (&optional prompt)

View File

@ -1452,9 +1452,9 @@ itself as a pre-command hook."
(define-minor-mode blink-cursor-mode
"Toggle blinking cursor mode.
With a numeric argument, turn blinking cursor mode on iff ARG is positive.
When blinking cursor mode is enabled, the cursor of the selected
window blinks.
With a numeric argument, turn blinking cursor mode on if ARG is positive,
otherwise turn it off. When blinking cursor mode is enabled, the
cursor of the selected window blinks.
Note that this command is effective only when Emacs
displays through a window system, because then Emacs does its own

View File

@ -1,3 +1,23 @@
2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
* nntp.el (nntp-xref-number-is-evil): New server variable.
(nntp-find-group-and-number): If it is non-nil, don't trust article
numbers in the Xref header.
2007-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t.
2007-08-04 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-art.el (article-hide-headers): Bind inhibit-read-only to t.
2007-08-08 Glenn Morris <rgm@gnu.org>
* gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el
* gnus-util.el, imap.el, mailcap.el, nnimap.el: Replace `iff' in
doc-strings and comments.
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.

View File

@ -79,7 +79,7 @@ ARGS are passed to `message'."
;;;###autoload
(defun gmm-widget-p (symbol)
"Non-nil iff SYMBOL is a widget."
"Non-nil if SYMBOL is a widget."
(get symbol 'widget-type))
;; Copy of the `nnmail-lazy' code from `nnmail.el':

View File

@ -1743,7 +1743,7 @@ Initialized from `text-mode-syntax-table.")
(interactive)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
(let ((inhibit-read-only nil)
(let ((inhibit-read-only t)
(case-fold-search t)
(max (1+ (length gnus-sorted-header-list)))
(inhibit-point-motion-hooks t)

View File

@ -320,7 +320,7 @@ It should return non-nil if the article is to be prefetched."
(pop alist))))))
(defun gnus-async-prefetched-article-entry (group article)
"Return the entry for ARTICLE in GROUP iff it has been prefetched."
"Return the entry for ARTICLE in GROUP if it has been prefetched."
(let ((entry (save-excursion
(gnus-async-set-buffer)
(assq (intern (format "%s-%d" group article)

View File

@ -179,7 +179,7 @@
(interactive-p))
"*gnus-x-splash*"
gnus-group-buffer)))
(let ((inhibit-read-only nil)
(let ((inhibit-read-only t)
(file (nnheader-find-etc-directory "images/gnus/x-splash" t))
pixmap fcw fch width height fringes sbars left yoffset top ls)
(erase-buffer)

View File

@ -260,15 +260,15 @@ See also the `mml-default-encrypt-method' variable."
This is done because new users often reply by mistake when reading
news.
This can also be a function receiving the group name as the only
parameter which should return non-nil iff a confirmation is needed, or
a regexp, in which case a confirmation is asked for iff the group name
parameter, which should return non-nil if a confirmation is needed; or
a regexp, in which case a confirmation is asked for if the group name
matches the regexp."
:version "22.1"
:group 'gnus-message
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
(regexp :tag "Iff group matches regexp")
(function :tag "Iff function evaluates to non-nil")))
(regexp :tag "If group matches regexp")
(function :tag "If function evaluates to non-nil")))
(defcustom gnus-confirm-treat-mail-like-news
nil

View File

@ -381,7 +381,7 @@ If nil, the user will be asked for a match type."
(const :tag "ask" nil)))
(defcustom gnus-score-default-fold nil
"Use case folding for new score file entries iff not nil."
"Non-nil means use case folding for new score file entries."
:group 'gnus-score-default
:type 'boolean)

View File

@ -1108,7 +1108,7 @@ Return the modified alist."
`(setq ,alist (delq (,fun ,key ,alist) ,alist))))
(defun gnus-globalify-regexp (re)
"Return a regexp that matches a whole line, iff RE matches a part of it."
"Return a regexp that matches a whole line, if RE matches a part of it."
(concat (unless (string-match "^\\^" re) "^.*")
re
(unless (string-match "\\$$" re) ".*$")))

View File

@ -1581,7 +1581,7 @@ is non-nil return these properties."
(imap-mailbox-get-1 'search imap-current-mailbox)))))
(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
"Return t iff FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
"Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
(with-current-buffer (or buffer (current-buffer))
(or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
(member flag (imap-mailbox-get 'permanentflags mailbox)))))

View File

@ -538,7 +538,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
results)))
(defun mailcap-mailcap-entry-passes-test (info)
"Return non-nil iff mailcap entry INFO passes its test clause.
"Return non-nil if mailcap entry INFO passes its test clause.
Also return non-nil if no test clause is present."
(let ((test (assq 'test info)) ; The test clause
status)
@ -631,7 +631,7 @@ Also return non-nil if no test clause is present."
(defvar mailcap-viewer-test-cache nil)
(defun mailcap-viewer-passes-test (viewer-info type-info)
"Return non-nil iff viewer specified by VIEWER-INFO passes its test clause.
"Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
Also return non-nil if it has no test clause. TYPE-INFO is an argument
to supply to the test."
(let* ((test-info (assq 'test viewer-info))
@ -704,7 +704,7 @@ If TEST is not given, it defaults to t."
;;;
(defun mailcap-viewer-lessp (x y)
"Return t iff viewer X is more desirable than viewer Y."
"Return t if viewer X is more desirable than viewer Y."
(let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
(y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
(x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))

View File

@ -1645,7 +1645,7 @@ be used in a STORE FLAGS command."
result)))
(defun nnimap-mark-permanent-p (mark &optional group)
"Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
"Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
(imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
(when nnimap-debug

View File

@ -183,6 +183,14 @@ by one.")
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")
(defvoo nntp-xref-number-is-evil nil
"*If non-nil, Gnus never trusts article numbers in the Xref header.
Some news servers, e.g., ones running Diablo, run multiple engines
having the same articles but article numbers are not kept synchronized
between them. If you connect to such a server, set this to a non-nil
value, and Gnus never uses article numbers (that appear in the Xref
header and vary by which engine is chosen) to refer to articles.")
(defvoo nntp-prepare-server-hook nil
"*Hook run before a server is opened.
If can be used to set up a server remotely, for instance. Say you
@ -1632,7 +1640,8 @@ password contained in '~/.nntp-authinfo'."
(match-string 1 xref))
(t "")))
(cond
((and (setq xref (mail-fetch-field "xref"))
((and (not nntp-xref-number-is-evil)
(setq xref (mail-fetch-field "xref"))
(string-match
(if group
(concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")

View File

@ -461,9 +461,11 @@ that."
;; An obvious case of a key substitution:
(save-excursion
(while (re-search-forward
;; Assume command name is only word characters
;; and dashes to get things like `use M-x foo.'.
"\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t)
;; Assume command name is only word and symbol
;; characters to get things like `use M-x foo->bar'.
;; Command required to end with word constituent
;; to avoid `.' at end of a sentence.
"\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
(let ((sym (intern-soft (match-string 1))))
(if (fboundp sym)
(help-xref-button 1 'help-function sym)))))
@ -489,7 +491,7 @@ that."
(end-of-line)
(skip-chars-backward "^ \t\n")
(if (and (>= (current-column) col)
(looking-at "\\(\\sw\\|-\\)+$"))
(looking-at "\\(\\sw\\|\\s_\\)+$"))
(let ((sym (intern-soft (match-string 0))))
(if (fboundp sym)
(help-xref-button 0 'help-function sym))))

View File

@ -958,14 +958,14 @@ This applies to `help', `apropos' and `completion' buffers, and some others."
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
(defun resize-temp-buffer-window ()
"Resize the current window to fit its contents.
"Resize the selected window to fit its contents.
Will not make it higher than `temp-buffer-max-height' nor smaller than
`window-min-height'. Do nothing if it is the only window on its frame, if it
is not as wide as the frame or if some of the window's contents are scrolled
out of view."
(unless (or (one-window-p 'nomini)
(not (pos-visible-in-window-p (point-min)))
(/= (frame-width) (window-width)))
(not (window-full-width-p)))
(fit-window-to-buffer
(selected-window)
(if (functionp temp-buffer-max-height)

View File

@ -131,7 +131,7 @@
;; an example, if the value is `buffer-file-name' then all buffers
;; who are visiting files are suitable, but others (like dired
;; buffers) are not;
;; * a list -- then the buffer is suitable iff its mode is in the
;; * a list -- then the buffer is suitable if its mode is in the
;; list, except if the first element is `not', in which case the test
;; is reversed (i.e. it is a list of unsuitable modes).
;; * Otherwise, the buffer is suitable if its name does not begin with

View File

@ -1331,7 +1331,7 @@ If a buffer has no filename, it is ignored.
With no prefix arg, use the filename sans its directory of each marked file.
With a zero prefix arg, use the complete filename of each marked file.
With \\[universal-argument], use the filename of each marked file relative
to `ibuffer-default-directory' iff non-nil, otherwise `default-directory'.
to `ibuffer-default-directory' if non-nil, otherwise `default-directory'.
You can then feed the file name(s) to other commands with \\[yank]."
(interactive "p")

View File

@ -1835,7 +1835,7 @@ If point is on a group name, this function operates on that group."
(defun ibuffer-map-lines (function &optional nomodify group)
"Call FUNCTION for each buffer.
Don't set the ibuffer modification flag iff NOMODIFY is non-nil.
Set the ibuffer modification flag unless NOMODIFY is non-nil.
If optional argument GROUP is non-nil, then only call FUNCTION on
buffers in filtering group GROUP.
@ -2267,7 +2267,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(defun ibuffer-quit ()
"Quit this `ibuffer' session.
Try to restore the previous window configuration iff
Try to restore the previous window configuration if
`ibuffer-restore-window-config-on-quit' is non-nil."
(interactive)
(if ibuffer-restore-window-config-on-quit

View File

@ -99,7 +99,7 @@ completions - see `icomplete-delay-completions-threshold'."
(defcustom icomplete-minibuffer-setup-hook nil
"*Icomplete-specific customization of minibuffer setup.
This hook is run during minibuffer setup iff icomplete will be active.
This hook is run during minibuffer setup if icomplete is active.
It is intended for use in customizing icomplete for interoperation
with other features and packages. For instance:
@ -168,7 +168,8 @@ except those on this list.")
;;;###autoload
(define-minor-mode icomplete-mode
"Toggle incremental minibuffer completion for this Emacs session.
With a numeric argument, turn Icomplete mode on iff ARG is positive."
With a numeric argument, turn Icomplete mode on if ARG is positive,
otherwise turn it off."
:global t :group 'icomplete
(if icomplete-mode
;; The following is not really necessary after first time -

View File

@ -898,7 +898,7 @@ See documentation of `walk-windows' for useful values.")
(defcustom ido-minibuffer-setup-hook nil
"*Ido-specific customization of minibuffer setup.
This hook is run during minibuffer setup iff `ido' will be active.
This hook is run during minibuffer setup if `ido' is active.
It is intended for use in customizing ido for interoperation
with other packages. For instance:

View File

@ -327,7 +327,7 @@ Image types are symbols like `xbm' or `jpeg'."
;;;###autoload
(defun image-type-auto-detected-p ()
"Return t iff the current buffer contains an auto-detectable image.
"Return t if the current buffer contains an auto-detectable image.
This function is intended to be used from `magic-fallback-mode-alist'.
The buffer is considered to contain an auto-detectable image if

View File

@ -727,7 +727,7 @@ definitions, etc. It contains a substring which is the name to
appear in the menu. See the info section on Regexps for more
information. REGEXP may also be a function, called without
arguments. It is expected to search backwards. It shall return
true and set `match-data' iff it finds another element.
true and set `match-data' if it finds another element.
INDEX points to the substring in REGEXP that contains the
name (of the function, variable or type) that is to appear in the

View File

@ -144,7 +144,7 @@ to `symbol', and the help mode defaults to the current major mode."
(apply 'info-lookup-add-help* nil arg))
(defun info-lookup-maybe-add-help (&rest arg)
"Add a help specification iff none is defined.
"Add a help specification if none is defined.
See the documentation of the function `info-lookup-add-help'
for more details."
(apply 'info-lookup-add-help* t arg))

View File

@ -215,8 +215,8 @@
;; Return t if substring of STR (between FROM and TO) can be broken up
;; to chunks all of which can be derived from another entry in SKK
;; dictionary. SKKBUF is the buffer where the original SKK dictionary
;; is visited, KANA is the current entry for STR. FIRST is t iff this
;; is called at top level.
;; is visited, KANA is the current entry for STR. FIRST is t only if
;; this is called at top level.
(defun skkdic-breakup-string (skkbuf kana str from to &optional first)
(let ((len (- to from)))

View File

@ -777,9 +777,9 @@ use either \\[customize] or the function `latin1-display'."
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser.
With argument ARG, turn such display on iff ARG is positive, otherwise
With argument ARG, turn such display on if ARG is positive, otherwise
turn it off and display Unicode characters literally. The display
is't changed if the display can render Unicode characters."
isn't changed if the display can render Unicode characters."
(interactive "p")
(if (> arg 0)
(unless (char-displayable-p

View File

@ -445,11 +445,11 @@ non-nil, it is used to sort CODINGS instead."
(let ((base (coding-system-base x)))
;; We calculate the priority number 0..255 by
;; using the 8 bits PMMLCEII as this:
;; P: 1 iff most preferred.
;; MM: greater than 0 iff mime-charset.
;; L: 1 iff one of the current lang. env.'s codings.
;; C: 1 iff one of codings listed in the category list.
;; E: 1 iff not XXX-with-esc
;; P: 1 if most preferred.
;; MM: greater than 0 if mime-charset.
;; L: 1 if one of the current lang. env.'s codings.
;; C: 1 if one of codings listed in the category list.
;; E: 1 if not XXX-with-esc
;; II: if iso-2022 based, 0..3, else 1.
(logior
(lsh (if (eq base most-preferred) 1 0) 7)

View File

@ -55,7 +55,7 @@
;;; Code:
(require 'help-mode)
(eval-when-compile (require 'help-mode))
(defgroup quail nil
"Quail: multilingual input method."
@ -1942,7 +1942,7 @@ Remaining args are for FUNC."
(overlay-put quail-overlay 'face 'highlight))))
(defun quail-require-guidance-buf ()
"Return t iff the current Quail package requires showing guidance buffer."
"Return t if the current Quail package requires showing guidance buffer."
(and input-method-verbose-flag
(if (eq input-method-verbose-flag 'default)
(not (and (eq (selected-window) (minibuffer-window))
@ -2431,22 +2431,27 @@ should be made by `quail-build-decode-map' (which see)."
(insert ?\n))
(insert ?\n))))
(define-button-type 'quail-keyboard-layout-button
:supertype 'help-xref
'help-function '(lambda (layout)
(help-setup-xref `(quail-keyboard-layout-button ,layout) nil)
(quail-show-keyboard-layout layout))
'help-echo (purecopy "mouse-2, RET: show keyboard layout"))
(defun quail-help-init ()
(unless (featurep 'help-mode)
(require 'help-mode)
(define-button-type 'quail-keyboard-layout-button
:supertype 'help-xref
'help-function '(lambda (layout)
(help-setup-xref `(quail-keyboard-layout-button ,layout)
nil)
(quail-show-keyboard-layout layout))
'help-echo (purecopy "mouse-2, RET: show keyboard layout"))
(define-button-type 'quail-keyboard-customize-button
:supertype 'help-customize-variable
'help-echo (purecopy "mouse-2, RET: customize keyboard layout"))
(define-button-type 'quail-keyboard-customize-button
:supertype 'help-customize-variable
'help-echo (purecopy "mouse-2, RET: customize keyboard layout"))))
(defun quail-help (&optional package)
"Show brief description of the current Quail package.
Optional arg PACKAGE specifies the name of alternative Quail
package to describe."
(interactive)
(quail-help-init)
(let ((help-xref-mule-regexp help-xref-mule-regexp-template)
(default-enable-multibyte-characters enable-multibyte-characters)
(package-def
@ -2629,7 +2634,7 @@ KEY BINDINGS FOR CONVERSION
;; it is not yet stored. As a result, the element is a string or a
;; list of strings.
(defsubst quail-store-decode-map-key (table char key)
(defun quail-store-decode-map-key (table char key)
(let ((elt (aref table char)))
(if elt
(if (consp elt)

View File

@ -825,7 +825,7 @@ NOPUSH is t and EDIT is t."
(run-hooks 'isearch-mode-end-hook))
;; If there was movement, mark the starting position.
;; Maybe should test difference between and set mark iff > threshold.
;; Maybe should test difference between and set mark only if > threshold.
(if (/= (point) isearch-opoint)
(or (and transient-mark-mode mark-active)
(progn
@ -2329,7 +2329,7 @@ since they have special meaning in a regexp."
;; - the direction of the current search is expected to be given by
;; `isearch-forward';
;; - the variable `isearch-error' is expected to be true
;; iff `isearch-string' is an invalid regexp.
;; only if `isearch-string' is an invalid regexp.
(defvar isearch-lazy-highlight-overlays nil)
(defvar isearch-lazy-highlight-wrapped nil)

View File

@ -396,7 +396,7 @@ See documentation of `walk-windows' for useful values.")
(defcustom iswitchb-minibuffer-setup-hook nil
"Iswitchb-specific customization of minibuffer setup.
This hook is run during minibuffer setup iff `iswitchb' will be active.
This hook is run during minibuffer setup if `iswitchb' is active.
For instance:
\(add-hook 'iswitchb-minibuffer-setup-hook
'\(lambda () (set (make-local-variable 'max-mini-window-height) 3)))
@ -1440,7 +1440,7 @@ This is an example function which can be hooked on to
(iswitchb-to-end summaries)))
(defun iswitchb-case ()
"Return non-nil iff we should ignore case when matching.
"Return non-nil if we should ignore case when matching.
See the variable `iswitchb-case' for details."
(if iswitchb-case
(if (featurep 'xemacs)
@ -1450,7 +1450,7 @@ See the variable `iswitchb-case' for details."
;;;###autoload
(define-minor-mode iswitchb-mode
"Toggle Iswitchb global minor mode.
With arg, turn Iswitchb mode on if and only iff ARG is positive.
With arg, turn Iswitchb mode on if ARG is positive, otherwise turn it off.
This mode enables switching between buffers using substrings. See
`iswitchb' for details."
nil nil iswitchb-global-map :global t :group 'iswitchb

View File

@ -568,7 +568,7 @@ for more details."
(defvar user-mail-address)
(defun log-edit-changelog-ours-p ()
"See if ChangeLog entry at point is for the current user, today.
Return non-nil iff it is."
Return non-nil if it is."
;; Code adapted from add-change-log-entry.
(let ((name (or (and (boundp 'add-log-full-name) add-log-full-name)
(and (fboundp 'user-full-name) (user-full-name))

View File

@ -174,6 +174,7 @@ The match group number 1 should match the revision number itself.")
(1 (if (boundp 'cvs-filename-face) cvs-filename-face))
(0 log-view-file-face append)))
(eval . `(,log-view-message-re . log-view-message-face))))
(defconst log-view-font-lock-defaults
'(log-view-font-lock-keywords t nil nil nil))

View File

@ -79,11 +79,13 @@ This is used when `longlines-show-hard-newlines' is on."
(defvar longlines-wrap-end nil)
(defvar longlines-wrap-point nil)
(defvar longlines-showing nil)
(defvar longlines-decoded nil)
(make-variable-buffer-local 'longlines-wrap-beg)
(make-variable-buffer-local 'longlines-wrap-end)
(make-variable-buffer-local 'longlines-wrap-point)
(make-variable-buffer-local 'longlines-showing)
(make-variable-buffer-local 'longlines-decoded)
;; Mode
@ -128,7 +130,9 @@ are indicated with a symbol."
;; longlines-wrap-lines that we'll never encounter from here
(save-restriction
(widen)
(longlines-decode-buffer)
(unless longlines-decoded
(longlines-decode-buffer)
(setq longlines-decoded t))
(longlines-wrap-region (point-min) (point-max)))
(set-buffer-modified-p mod))
(when (and longlines-show-hard-newlines
@ -161,9 +165,11 @@ are indicated with a symbol."
(let ((buffer-undo-list t)
(after-change-functions nil)
(inhibit-read-only t))
(save-restriction
(widen)
(longlines-encode-region (point-min) (point-max))))
(if longlines-decoded
(save-restriction
(widen)
(longlines-encode-region (point-min) (point-max))
(setq longlines-decoded nil))))
(remove-hook 'change-major-mode-hook 'longlines-mode-off t)
(remove-hook 'after-change-functions 'longlines-after-change-function t)
(remove-hook 'post-command-hook 'longlines-post-command-function t)

View File

@ -495,7 +495,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(or (and (integerp last-command-char)
;; Some commands such as M-> may want to expand first.
(equal this-command 'self-insert)
(equal this-command 'self-insert-command)
(or (eq (char-syntax last-command-char) ?_)
;; Don't expand on @.
(memq last-command-char '(?@ ?. ?% ?! ?_ ?-))))

View File

@ -398,7 +398,7 @@ nil."
))
(defun mspools-size-folder (spool)
"Return (SPOOL . SIZE ) iff SIZE of spool file is non-zero."
"Return (SPOOL . SIZE ), if SIZE of spool file is non-zero."
;; 7th file attribute is the size of the file in bytes.
(let ((file (concat mspools-folder-directory spool))
size)

View File

@ -3992,13 +3992,13 @@ specifying headers which should not be copied into the new message."
(mail-position-on-field (if resending "Resent-To" "To") t))))))
(defun rmail-summary-exists ()
"Non-nil iff in an RMAIL buffer and an associated summary buffer exists.
"Non-nil if in an RMAIL buffer and an associated summary buffer exists.
In fact, the non-nil value returned is the summary buffer itself."
(and rmail-summary-buffer (buffer-name rmail-summary-buffer)
rmail-summary-buffer))
(defun rmail-summary-displayed ()
"t iff in RMAIL buffer and an associated summary buffer is displayed."
"t if in RMAIL buffer and an associated summary buffer is displayed."
(and rmail-summary-buffer (get-buffer-window rmail-summary-buffer)))
(defcustom rmail-redisplay-summary nil

View File

@ -37,7 +37,7 @@
;; ========== Credits and History ==========
;; In mid 1991, several people posted some interesting improvements to
;; man.el from the standard emacs 18.57 distribution. I liked many of
;; man.el from the standard Emacs 18.57 distribution. I liked many of
;; these, but wanted everything in one single package, so I decided
;; to incorporate them into a single manual browsing mode. While
;; much of the code here has been rewritten, and some features added,
@ -64,7 +64,7 @@
;; ========== Features ==========
;; + Runs "man" in the background and pipes the results through a
;; series of sed and awk scripts so that all retrieving and cleaning
;; is done in the background. The cleaning commands are configurable.
;; is done in the background. The cleaning commands are configurable.
;; + Syntax is the same as Un*x man
;; + Functionality is the same as Un*x man, including "man -k" and
;; "man <section>", etc.
@ -109,8 +109,6 @@
(defvar Man-notify)
(defvar Man-current-page)
(defvar Man-page-list)
(defcustom Man-filter-list nil
"*Manpage cleaning filter command phrases.
This variable contains a list of the following form:
@ -127,13 +125,8 @@ the manpage buffer."
(string :tag "Phrase String"))))
:group 'man)
(defvar Man-original-frame)
(defvar Man-arguments)
(defvar Man-sections-alist)
(defvar Man-refpages-alist)
(defvar Man-uses-untabify-flag t
"Non-nil means use `untabify' instead of `Man-untabify-command'.")
(defvar Man-page-mode-string)
(defvar Man-sed-script nil
"Script for sed to nuke backspaces and ANSI codes from manpages.")
@ -141,28 +134,28 @@ the manpage buffer."
;; user variables
(defcustom Man-fontify-manpage-flag t
"*Non-nil means make up the manpage with fonts."
"Non-nil means make up the manpage with fonts."
:type 'boolean
:group 'man)
(defcustom Man-overstrike-face 'bold
"*Face to use when fontifying overstrike."
"Face to use when fontifying overstrike."
:type 'face
:group 'man)
(defcustom Man-underline-face 'underline
"*Face to use when fontifying underlining."
"Face to use when fontifying underlining."
:type 'face
:group 'man)
(defcustom Man-reverse-face 'highlight
"*Face to use when fontifying reverse video."
"Face to use when fontifying reverse video."
:type 'face
:group 'man)
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
"*Selects the behavior when manpage is ready.
"Selects the behavior when manpage is ready.
This variable may have one of the following values, where (sf) means
that the frames are switched, so the manpage is displayed in the frame
where the man command was called from:
@ -183,7 +176,7 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
:group 'man)
(defcustom Man-width nil
"*Number of columns for which manual pages should be formatted.
"Number of columns for which manual pages should be formatted.
If nil, the width of the window selected at the moment of man
invocation is used. If non-nil, the width of the frame selected
at the moment of man invocation is used. The value also can be a
@ -194,12 +187,12 @@ positive integer."
:group 'man)
(defcustom Man-frame-parameters nil
"*Frame parameter list for creating a new frame for a manual page."
"Frame parameter list for creating a new frame for a manual page."
:type 'sexp
:group 'man)
(defcustom Man-downcase-section-letters-flag t
"*Non-nil means letters in sections are converted to lower case.
"Non-nil means letters in sections are converted to lower case.
Some Un*x man commands can't handle uppercase letters in sections, for
example \"man 2V chmod\", but they are often displayed in the manpage
with the upper case letter. When this variable is t, the section
@ -209,7 +202,7 @@ being sent to the man background process."
:group 'man)
(defcustom Man-circular-pages-flag t
"*Non-nil means the manpage list is treated as circular for traversal."
"Non-nil means the manpage list is treated as circular for traversal."
:type 'boolean
:group 'man)
@ -220,7 +213,7 @@ being sent to the man background process."
;; '("3X" . "3") ; Xlib man pages
'("3X11" . "3")
'("1-UCB" . ""))
"*Association list of bogus sections to real section numbers.
"Association list of bogus sections to real section numbers.
Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
their references which Un*x `man' does not recognize. This
association list is used to translate those sections, when found, to
@ -250,9 +243,6 @@ the associated section number."
(defvar Man-awk-command "awk"
"Command used for processing awk scripts.")
(defvar Man-mode-map nil
"Keymap for Man mode.")
(defvar Man-mode-hook nil
"Hook run when Man mode is enabled.")
@ -349,20 +339,22 @@ Otherwise, the value is whatever the function
;; end user variables
;; other variables and keymap initializations
(make-variable-buffer-local 'Man-sections-alist)
(make-variable-buffer-local 'Man-refpages-alist)
(make-variable-buffer-local 'Man-page-list)
(make-variable-buffer-local 'Man-current-page)
(make-variable-buffer-local 'Man-page-mode-string)
(defvar Man-original-frame)
(make-variable-buffer-local 'Man-original-frame)
(defvar Man-arguments)
(make-variable-buffer-local 'Man-arguments)
(put 'Man-arguments 'permanent-local t)
(setq-default Man-sections-alist nil)
(setq-default Man-refpages-alist nil)
(setq-default Man-page-list nil)
(setq-default Man-current-page 0)
(setq-default Man-page-mode-string "1 of 1")
(defvar Man-sections-alist nil)
(make-variable-buffer-local 'Man-sections-alist)
(defvar Man-refpages-alist nil)
(make-variable-buffer-local 'Man-refpages-alist)
(defvar Man-page-list nil)
(make-variable-buffer-local 'Man-page-list)
(defvar Man-current-page 0)
(make-variable-buffer-local 'Man-current-page)
(defvar Man-page-mode-string "1 of 1")
(make-variable-buffer-local 'Man-page-mode-string)
(defconst Man-sysv-sed-script "\
/\b/ { s/_\b//g
@ -398,30 +390,32 @@ Otherwise, the value is whatever the function
table)
"Syntax table used in Man mode buffers.")
(unless Man-mode-map
(setq Man-mode-map (make-sparse-keymap))
(suppress-keymap Man-mode-map)
(set-keymap-parent Man-mode-map button-buffer-map)
(defvar Man-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
(define-key Man-mode-map " " 'scroll-up)
(define-key Man-mode-map "\177" 'scroll-down)
(define-key Man-mode-map "n" 'Man-next-section)
(define-key Man-mode-map "p" 'Man-previous-section)
(define-key Man-mode-map "\en" 'Man-next-manpage)
(define-key Man-mode-map "\ep" 'Man-previous-manpage)
(define-key Man-mode-map ">" 'end-of-buffer)
(define-key Man-mode-map "<" 'beginning-of-buffer)
(define-key Man-mode-map "." 'beginning-of-buffer)
(define-key Man-mode-map "r" 'Man-follow-manual-reference)
(define-key Man-mode-map "g" 'Man-goto-section)
(define-key Man-mode-map "s" 'Man-goto-see-also-section)
(define-key Man-mode-map "k" 'Man-kill)
(define-key Man-mode-map "q" 'Man-quit)
(define-key Man-mode-map "m" 'man)
;; Not all the man references get buttons currently. The text in the
;; manual page can contain references to other man pages
(define-key Man-mode-map "\r" 'man-follow)
(define-key Man-mode-map "?" 'describe-mode))
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
(define-key map "n" 'Man-next-section)
(define-key map "p" 'Man-previous-section)
(define-key map "\en" 'Man-next-manpage)
(define-key map "\ep" 'Man-previous-manpage)
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
(define-key map "." 'beginning-of-buffer)
(define-key map "r" 'Man-follow-manual-reference)
(define-key map "g" 'Man-goto-section)
(define-key map "s" 'Man-goto-see-also-section)
(define-key map "k" 'Man-kill)
(define-key map "q" 'Man-quit)
(define-key map "m" 'man)
;; Not all the man references get buttons currently. The text in the
;; manual page can contain references to other man pages
(define-key map "\r" 'man-follow)
(define-key map "?" 'describe-mode)
map)
"Keymap for Man mode.")
;; buttons
(define-button-type 'Man-abstract-xref-man-page
@ -730,8 +724,7 @@ all sections related to a subject, put something appropriate into the
(require 'env)
(message "Invoking %s %s in the background" manual-program man-args)
(setq buffer (generate-new-buffer bufname))
(save-excursion
(set-buffer buffer)
(with-current-buffer buffer
(setq buffer-undo-list t)
(setq Man-original-frame (selected-frame))
(setq Man-arguments man-args))
@ -802,8 +795,7 @@ all sections related to a subject, put something appropriate into the
(defun Man-notify-when-ready (man-buffer)
"Notify the user when MAN-BUFFER is ready.
See the variable `Man-notify-method' for the different notification behaviors."
(let ((saved-frame (save-excursion
(set-buffer man-buffer)
(let ((saved-frame (with-current-buffer man-buffer
Man-original-frame)))
(cond
((eq Man-notify-method 'newframe)
@ -975,7 +967,7 @@ default type, `Man-xref-man-page' is used for the buttons."
(Man-next-section 1)
(point)))
(goto-char (point-min))
(point-max))))
nil)))
(while (re-search-forward regexp end t)
(make-text-button
(match-beginning button-pos)
@ -1031,8 +1023,7 @@ manpage command."
(or (stringp process)
(set-process-buffer process nil))
(save-excursion
(set-buffer Man-buffer)
(with-current-buffer Man-buffer
(let ((case-fold-search nil))
(goto-char (point-min))
(cond ((or (looking-at "No \\(manual \\)*entry for")
@ -1223,13 +1214,10 @@ The following key bindings are currently in effect in the buffer:
(defun Man-strip-page-headers ()
"Strip all the page headers but the first from the manpage."
(let ((buffer-read-only nil)
(let ((inhibit-read-only t)
(case-fold-search nil)
(page-list Man-page-list)
(page ())
(header ""))
(while page-list
(setq page (car page-list))
(dolist (page Man-page-list)
(and (nth 2 page)
(goto-char (car page))
(re-search-forward Man-first-heading-regexp nil t)
@ -1243,17 +1231,14 @@ The following key bindings are currently in effect in the buffer:
;; line.
;; (setq header (concat "\n" header)))
(while (search-forward header (nth 1 page) t)
(replace-match "")))
(setq page-list (cdr page-list)))))
(replace-match ""))))))
(defun Man-unindent ()
"Delete the leading spaces that indent the manpage."
(let ((buffer-read-only nil)
(case-fold-search nil)
(page-list Man-page-list))
(while page-list
(let ((page (car page-list))
(indent "")
(let ((inhibit-read-only t)
(case-fold-search nil))
(dolist (page Man-page-list)
(let ((indent "")
(nindent 0))
(narrow-to-region (car page) (car (cdr page)))
(if Man-uses-untabify-flag
@ -1281,7 +1266,6 @@ The following key bindings are currently in effect in the buffer:
(or (eolp)
(delete-char nindent))
(forward-line 1)))
(setq page-list (cdr page-list))
))))
@ -1291,14 +1275,18 @@ The following key bindings are currently in effect in the buffer:
(defun Man-next-section (n)
"Move point to Nth next section (default 1)."
(interactive "p")
(let ((case-fold-search nil))
(let ((case-fold-search nil)
(start (point)))
(if (looking-at Man-heading-regexp)
(forward-line 1))
(if (re-search-forward Man-heading-regexp (point-max) t n)
(beginning-of-line)
(goto-char (point-max))
;; The last line doesn't belong to any section.
(forward-line -1))))
(forward-line -1))
;; But don't move back from the starting point (can happen if `start'
;; is somewhere on the last line).
(if (< (point) start) (goto-char start))))
(defun Man-previous-section (n)
"Move point to Nth previous section (default 1)."
@ -1462,7 +1450,7 @@ Specify which REFERENCE to use; default is based on word at point."
(let ((path Man-header-file-path)
complete-path)
(while path
(setq complete-path (concat (car path) "/" file)
(setq complete-path (expand-file-name file (car path))
path (cdr path))
(if (file-readable-p complete-path)
(progn (view-file complete-path)

View File

@ -1170,7 +1170,7 @@ mail status in mode line"))
(defun menu-bar-vc-filter (orig-binding)
(let ((ext-binding
(if vc-mode (vc-call 'extra-menu buffer-file-name))))
(if vc-mode (vc-call-backend (vc-backend buffer-file-name) 'extra-menu))))
;; Give the VC backend a chance to add menu entries
;; specific for that backend.
(if (null ext-binding)

View File

@ -1,3 +1,8 @@
2007-08-08 Glenn Morris <rgm@gnu.org>
* mh-folder.el, mh-letter.el, mh-show.el: Replace `iff' in
doc-strings and comments.
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.

View File

@ -1495,7 +1495,7 @@ function doesn't recenter the folder buffer."
(defun mh-update-unseen ()
"Synchronize the unseen sequence with MH.
Return non-nil iff the MH folder was set.
Return non-nil if the MH folder was set.
The hook `mh-unseen-updated-hook' is called after the unseen sequence
is updated."
(if mh-seen-list

View File

@ -844,7 +844,7 @@ body."
(defun mh-position-on-field (field &optional ignored)
"Move to the end of the FIELD in the header.
Move to end of entire header if FIELD not found.
Returns non-nil iff FIELD was found.
Returns non-nil if FIELD was found.
The optional second arg is for pre-version 4 compatibility and is
IGNORED."
(cond ((mh-goto-header-field field)

View File

@ -161,7 +161,7 @@ displayed."
(defun mh-showing-mode (&optional arg)
"Change whether messages should be displayed.
With ARG, display messages iff ARG is positive."
With ARG, display messages if ARG is positive, otherwise don't display them."
(setq mh-showing-mode
(if (null arg)
(not mh-showing-mode)

View File

@ -158,7 +158,7 @@ Keep the cursor on the screen as needed."
Basically, we check for existing horizontal scrolling."
(or truncate-lines
(> (window-hscroll (selected-window)) 0)
(< (window-width) (frame-width))
(not (window-full-width-p))
(and
mouse-drag-electric-col-scrolling
(save-excursion ;; on a long line?

View File

@ -1814,27 +1814,23 @@ and selects that window."
(mouse-minibuffer-check event)
(let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
(let ((tail buffers))
(while tail
;; Divide all buffers into buckets for various major modes.
;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
(with-current-buffer (car tail)
(let* ((adjusted-major-mode major-mode) elt)
(let ((tail mouse-buffer-menu-mode-groups))
(while tail
(if (string-match (car (car tail)) mode-name)
(setq adjusted-major-mode (cdr (car tail))))
(setq tail (cdr tail))))
(setq elt (assoc adjusted-major-mode split-by-major-mode))
(if (null elt)
(setq elt (list adjusted-major-mode
(if (stringp adjusted-major-mode)
adjusted-major-mode
mode-name))
split-by-major-mode (cons elt split-by-major-mode)))
(or (memq (car tail) (cdr (cdr elt)))
(setcdr (cdr elt) (cons (car tail) (cdr (cdr elt)))))))
(setq tail (cdr tail))))
(dolist (buf buffers)
;; Divide all buffers into buckets for various major modes.
;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
(with-current-buffer buf
(let* ((adjusted-major-mode major-mode) elt)
(dolist (group mouse-buffer-menu-mode-groups)
(when (string-match (car group) (format-mode-line mode-name))
(setq adjusted-major-mode (cdr group))))
(setq elt (assoc adjusted-major-mode split-by-major-mode))
(unless elt
(setq elt (list adjusted-major-mode
(if (stringp adjusted-major-mode)
adjusted-major-mode
mode-name))
split-by-major-mode (cons elt split-by-major-mode)))
(or (memq buf (cdr (cdr elt)))
(setcdr (cdr elt) (cons buf (cdr (cdr elt))))))))
;; Compute the sum of squares of sizes of the major-mode buckets.
(let ((tail split-by-major-mode))
(setq sum-of-squares 0)

View File

@ -4285,7 +4285,12 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;;;###autoload
(defun ange-ftp-hook-function (operation &rest args)
(let ((fn (get operation 'ange-ftp)))
(if fn (save-match-data (apply fn args))
(if fn
;; Catch also errors in process-filter.
(condition-case err
(let ((debug-on-error t))
(save-match-data (apply fn args)))
(error (signal (car err) (cdr err))))
(ange-ftp-run-real-handler operation args))))
;; The following code is commented out because Tramp now deals with

View File

@ -248,7 +248,7 @@ There is a variable ``telnet-interrupt-string'' which is the character
sent to try to stop execution of a job on the remote host.
Data is sent to the remote host when RET is typed."
(set (make-local-variable 'comint-prompt-regexp) telnet-prompt-pattern)
(setq comint-use-prompt-regexp t))
(set (make-local-variable 'comint-use-prompt-regexp) t))
;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")

View File

@ -290,9 +290,8 @@ history."
tramp-cache-data)
res))
;; Read persistent connection history. Applied with
;; `load-in-progress', because it shall be evaluated only once.
(when load-in-progress
;; Read persistent connection history.
(when (zerop (hash-table-count tramp-cache-data))
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)

View File

@ -1027,7 +1027,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
"Login incorrect"
"Login Incorrect"
"Connection refused"
"Connection closed by foreign host."
"Connection closed"
"Sorry, try again."
"Name or service not known"
"Host key verification failed."
@ -3581,8 +3581,11 @@ beginning of local filename are not substituted."
(tramp-send-command v command)
;; We should show the output anyway.
(when outbuf
(with-current-buffer outbuf
(insert-buffer-substring (tramp-get-connection-buffer v)))
(let ((output-string
(with-current-buffer (tramp-get-connection-buffer v)
(buffer-substring (point-min) (point-max)))))
(with-current-buffer outbuf
(insert output-string)))
(when display (display-buffer outbuf))))
;; When the user did interrupt, we should do it also.
(error
@ -3614,12 +3617,20 @@ beginning of local filename are not substituted."
(let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
(args (split-string (substring command 0 asynchronous) " "))
(output-buffer
(or output-buffer
(if asynchronous
"*Async Shell Command*"
"*Shell Command Output*")))
(cond
((bufferp output-buffer) output-buffer)
((stringp output-buffer) (get-buffer-create output-buffer))
(output-buffer (current-buffer))
(t (generate-new-buffer
(if asynchronous
"*Async Shell Command*"
"*Shell Command Output*")))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
((stringp error-buffer) (get-buffer-create error-buffer))))
(buffer
(if (and (not asynchronous) (bufferp error-buffer))
(if (and (not asynchronous) error-buffer)
(with-parsed-tramp-file-name default-directory nil
(list output-buffer (tramp-make-tramp-temp-file v)))
output-buffer)))
@ -3637,7 +3648,10 @@ beginning of local filename are not substituted."
(when (listp buffer)
(with-current-buffer error-buffer
(insert-file-contents (cadr buffer)))
(delete-file (cadr buffer))))))
(delete-file (buffer-file-name (cadr buffer))))
;; There's some output, display it.
(when (with-current-buffer output-buffer (> (point-max) (point-min)))
(display-message-or-buffer output-buffer)))))
;; File Editing.
@ -4177,8 +4191,12 @@ Falls back to normal file name handler if no tramp file name handler exists."
((and completion (zerop (length localname))
(memq operation '(file-name-as-directory)))
filename)
;; Call the backend function.
(foreign (apply foreign operation args))
;; Call the backend function. Set a connection property
;; first, it will be reused for user/host name completion.
(foreign
(unless (zerop (length localname))
(tramp-set-connection-property v "started" nil))
(apply foreign operation args))
;; Nothing to do for us.
(t (tramp-run-real-handler operation args)))))))
@ -6116,7 +6134,8 @@ In case there is no valid Lisp expression, it raises an error"
(condition-case nil
(prog1 (read (current-buffer))
;; Error handling.
(when (re-search-forward "\\S-" nil t) (error)))
(when (re-search-forward "\\S-" (tramp-line-end-position) t)
(error)))
(error (tramp-error
vec 'file-error
"`%s' does not return a valid Lisp expression: `%s'"
@ -6125,7 +6144,7 @@ In case there is no valid Lisp expression, it raises an error"
;; It seems that Tru64 Unix does not like it if long strings are sent
;; to it in one go. (This happens when sending the Perl
;; `file-attributes' implementation, for instance.) Therefore, we
;; have this function which waits a bit at each line.
;; have this function which sends the string in chunks.
(defun tramp-send-string (vec string)
"Send the STRING via connection VEC.
@ -6143,7 +6162,7 @@ the remote host use line-endings as defined in the variable
;; Clean up the buffer. We cannot call `erase-buffer' because
;; narrowing might be in effect.
(let (buffer-read-only) (delete-region (point-min) (point-max)))
;; replace "\n" by `tramp-rsh-end-of-line'
;; Replace "\n" by `tramp-rsh-end-of-line'.
(setq string
(mapconcat 'identity
(split-string string "\n")
@ -6151,7 +6170,7 @@ the remote host use line-endings as defined in the variable
(unless (or (string= string "")
(string-equal (substring string -1) tramp-rsh-end-of-line))
(setq string (concat string tramp-rsh-end-of-line)))
;; send the string
;; Send the string.
(if (and chunksize (not (zerop chunksize)))
(let ((pos 0)
(end (length string)))

View File

@ -523,7 +523,7 @@ See `fast-lock-cache-directories'."
;; Just a directory.
directory)
(t
;; A directory iff the file name matches the regexp.
;; A directory if the file name matches the regexp.
(let ((bufile (expand-file-name buffer-file-truename))
(case-fold-search nil))
(when (save-match-data (string-match (car directory) bufile))

View File

@ -211,7 +211,8 @@ arguments. If ARGS is not a list, no argument will be passed."
(defconst cvs-qtypedesc-string1 (cvs-qtypedesc-create 'identity 'identity t))
(defconst cvs-qtypedesc-string (cvs-qtypedesc-create 'identity 'identity))
(defconst cvs-qtypedesc-strings
(cvs-qtypedesc-create 'string->strings 'strings->string nil))
(cvs-qtypedesc-create 'split-string-and-unquote
'combine-and-quote-strings nil))
(defun cvs-query-read (default prompt qtypedesc &optional hist-sym)
(let* ((qtypedesc (or qtypedesc cvs-qtypedesc-strings))

View File

@ -182,7 +182,7 @@
(when (re-search-forward
(concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t)
(let* ((sym (intern (concat "cvs-" cmd "-flags")))
(val (string->strings (or (match-string 2) ""))))
(val (split-string-and-unquote (or (match-string 2) ""))))
(cvs-flags-set sym 0 val))))
;; ensure that cvs doesn't have -q or -Q
(cvs-flags-set 'cvs-cvs-flags 0
@ -612,7 +612,7 @@ If non-nil, NEW means to create a new buffer no matter what."
(t arg)))
args)))
(concat cvs-program " "
(strings->string
(combine-and-quote-strings
(append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
(if cvs-cvsroot (list "-d" cvs-cvsroot))
args
@ -941,7 +941,8 @@ With a prefix argument, prompt for cvs FLAGS to use."
(let ((root (cvs-get-cvsroot)))
(if (or (null root) current-prefix-arg)
(setq root (read-string "CVS Root: ")))
(list (string->strings (read-string "Module(s): " (cvs-get-module)))
(list (split-string-and-unquote
(read-string "Module(s): " (cvs-get-module)))
(read-directory-name "CVS Checkout Directory: "
nil default-directory nil)
(cvs-add-branch-prefix
@ -964,7 +965,7 @@ The files are stored to DIR."
(if branch (format " (branch: %s)" branch)
""))))
(list (read-directory-name prompt nil default-directory nil))))
(let ((modules (string->strings (cvs-get-module)))
(let ((modules (split-string-and-unquote (cvs-get-module)))
(flags (cvs-add-branch-prefix
(cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
(cvs-cvsroot (cvs-get-cvsroot)))
@ -2253,7 +2254,7 @@ With prefix argument, prompt for cvs flags."
(let* ((args (append constant-args arg-list)))
(insert (format "=== %s %s\n\n"
program (strings->string args)))
program (split-string-and-unquote args)))
;; FIXME: return the exit status?
(apply 'call-process program nil t t args)

View File

@ -6,11 +6,11 @@
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
;; Version: 6.9
;; Version: 6.9.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(defconst pr-version "6.9"
"printing.el, v 6.9 <2007/02/11 vinicius>
(defconst pr-version "6.9.1"
"printing.el, v 6.9.1 <2007/08/02 vinicius>
Please send all bug fixes and enhancements to
Vinicius Jose Latorre <viniciusjl@ig.com.br>
@ -1306,7 +1306,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
(defalias 'pr-f-read-string 'read-string)
;; GNU Emacs
(defvar deactivate-mark nil)
(defvar deactivate-mark)
;; GNU Emacs
(defun pr-keep-region-active ()
@ -1326,7 +1326,6 @@ If SUFFIX is non-nil, add that at the end of the file name."
;; GNU Emacs
;; Menu binding
(require 'easymenu)
;; Replace existing "print" item by "Printing" item.
;; If you're changing this file, you'll load it a second,
;; third... time, but "print" item exists only in the first load.
@ -1335,6 +1334,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
;; GNU Emacs 20
((< emacs-major-version 21)
(defun pr-global-menubar (pr-menu-spec)
(require 'easymenu)
(easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item)
(when pr-menu-print-item
(easy-menu-remove-item nil '("tools") pr-menu-print-item)
@ -1345,6 +1345,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
;; GNU Emacs 21 & 22
(t
(defun pr-global-menubar (pr-menu-spec)
(require 'easymenu)
(let ((menu-file (if (= emacs-major-version 21)
'("menu-bar" "files") ; GNU Emacs 21
'("menu-bar" "file")))) ; GNU Emacs 22 or higher
@ -5194,9 +5195,9 @@ See `pr-visible-entry-alist'.")
If FORCE is non-nil, update menus doesn't matter if `pr-ps-printer-alist',
`pr-txt-printer-alist' or `pr-ps-utility-alist' were modified or not;
otherwise, update PostScript printer menu iff `pr-ps-printer-menu-modified' is
non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is
non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is
otherwise, update PostScript printer menu if `pr-ps-printer-menu-modified' is
non-nil, update text printer menu if `pr-txt-printer-menu-modified' is
non-nil, and update PostScript File menus if `pr-ps-utility-menu-modified' is
non-nil.
If menu binding was not done, calls `pr-menu-bind'."
@ -6017,9 +6018,10 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; Printing Interface (inspired on ps-print-interface.el)
(require 'widget)
(require 'wid-edit)
(require 'cus-edit)
(eval-when-compile
(require 'cus-edit)
(require 'wid-edit)
(require 'widget))
(defvar pr-i-window-configuration nil)

View File

@ -568,7 +568,7 @@ The standard value contains the following functions as READ-FN:
general value, or `antlr-read-boolean' with ARGs = \(PROMPT TABLE) which
reads a boolean value or a member of TABLE. PROMPT is the prompt when
asking for a new value. If non-nil, TABLE is a table for completion or
a function evaluating to such a table. The return value is quoted iff
a function evaluating to such a table. The return value is quoted if
AS-STRING is non-nil and is either t or a symbol which is a member of
`antlr-options-style'.")
@ -2203,8 +2203,8 @@ part SUPER in the result of `antlr-file-dependencies'. CLASSES is the
part \(CLASS-SPEC ...) in the result of `antlr-directory-dependencies'.
The result looks like \(OPTION WITH-UNKNOWN GLIB ...). OPTION is the
complete \"-glib\" option. WITH-UNKNOWN has value t iff there is none
or more than one grammar file for at least one super grammar.
complete \"-glib\" option. WITH-UNKNOWN is t if there is none or more
than one grammar file for at least one super grammar.
Each GLIB looks like \(GRAMMAR-FILE \. EVOCAB). GRAMMAR-FILE is a file
in which a super-grammar is defined. EVOCAB is the value of the export

Some files were not shown because too many files have changed in this diff Show More