commit 685ec273ecbb54439ed84474fb96ec847bebb630 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Mon Sep 30 03:18:26 2024 +0200 Delete some libraries obsolete since Emacs 24.4/24.5 * lisp/obsolete/cc-compat.el: * lisp/obsolete/info-edit.el: * lisp/obsolete/meese.el: * lisp/obsolete/otodo-mode.el: * lisp/obsolete/rcompile.el: * lisp/obsolete/sup-mouse.el: * lisp/obsolete/terminal.el: * lisp/obsolete/vi.el: * lisp/obsolete/vip.el: * lisp/obsolete/ws-mode.el: * lisp/obsolete/yow.el: Delete libraries obsolete since Emacs 24.4 and 24.5. (Bug#73257) * doc/misc/vip.texi: * etc/refcards/vipcard.tex: Delete vip.el documentation. * doc/emacs/ack.texi (Acknowledgments): * doc/misc/Makefile.in (INFO_COMMON): * etc/refcards/Makefile (PDF_ENGLISH, survival.dvi): * etc/refcards/README: * lisp/info.el (Info-url-alist): (Info-file-list-for-emacs): Delete references to above libraries. diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 8fd3d61ec64..3fc65476591 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -1044,7 +1044,7 @@ a package for running source-level debuggers like GDB and SDB in Emacs; @file{asm-mode.el}, a mode for editing assembly language code; @file{AT386.el}, terminal support package for IBM's AT keyboards; @file{cookie1.el}, support for fortune-cookie programs like -@file{yow.el} and @file{spook.el}; @file{finder.el}, a package for +@file{spook.el}; @file{finder.el}, a package for finding Emacs Lisp packages by keyword and topic; @file{keyswap.el}, code to swap the @key{BS} and @key{DEL} keys; @file{loadhist.el}, functions for loading and unloading Emacs features; diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 087742f6a9c..4e2cd6448d1 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -74,7 +74,7 @@ INFO_COMMON = auth autotype bovine calc ccmode cl dbus dired-x \ modus-themes newsticker nxml-mode octave-mode org pcl-cvs pgg \ rcirc reftex remember sasl sc semantic ses sieve smtpmail \ speedbar srecode todo-mode tramp transient url use-package \ - vhdl-mode vip viper vtable widget wisent woman + vhdl-mode viper vtable widget wisent woman ## Info files to install on current platform. INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32) diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi deleted file mode 100644 index 6907966f861..00000000000 --- a/doc/misc/vip.texi +++ /dev/null @@ -1,1952 +0,0 @@ -\input texinfo -@setfilename ../../info/vip.info -@settitle VIP -@include docstyle.texi - -@copying -Copyright @copyright{} 1987, 2001--2024 Free Software Foundation, Inc. - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with no -Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'', -and with the Back-Cover Texts as in (a) below. A copy of the license -is included in the section entitled ``GNU Free Documentation License''. - -(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and -modify this GNU manual.'' -@end quotation -@end copying - -@titlepage -@sp 10 -@center @titlefont{VIP} -@sp 1 -@center A Vi Package for GNU Emacs -@center (Version 3.5, September 15, 1987) -@sp 2 -@center Masahiko Sato -@page -@vskip 0pt plus1filll -@insertcopying -@end titlepage - -@finalout -@contents - -@dircategory Emacs misc features -@direntry -* VIP: (vip). An obsolete VI-emulation for Emacs. -@end direntry - -@ifnottex -@node Top -@top VIP - -VIP is a Vi emulating package written in Emacs Lisp. VIP implements most -Vi commands including Ex commands. It is therefore hoped that this package -will enable you to do Vi style editing under the powerful GNU Emacs -environment. This info file describes the usage of VIP assuming that you -are fairly accustomed to Vi but not so much with Emacs. Also we will -concentrate mainly on differences from Vi, especially features unique to -VIP. - -VIP is obsolete since Emacs 24.5---consider using Viper instead. -@xref{Top, Viper,, viper, The Viper VI-emulation mode for Emacs}. - -It is recommended that you read nodes on survey and on customization before -you start using VIP@. Other nodes may be visited as needed. - -Comments and bug reports are welcome. Please send messages to -@code{ms@@Sail.Stanford.Edu} if you are outside of Japan and to -@code{masahiko@@sato.riec.tohoku.junet} if you are in Japan. - -@insertcopying - -@end ifnottex - -@menu -* Survey:: A survey of VIP. -* Vi Commands:: Details of Vi commands. -* Ex Commands:: Details of Ex commands. -* Customization:: How to customize VIP. -* GNU Free Documentation License:: The license for this documentation. - -@end menu -@iftex -@unnumbered Introduction - -VIP is a Vi emulating package written in Emacs Lisp. VIP implements most -Vi commands including Ex commands. It is therefore hoped that this package -will enable you to do Vi style editing under the powerful GNU Emacs -environment. This manual describes the usage of VIP assuming that you are -fairly accustomed to Vi but not so much with Emacs. Also we will -concentrate mainly on differences from Vi, especially features unique to -VIP. - -VIP is obsolete since Emacs 24.5---consider using Viper instead. -@xref{Top, Viper,, viper, The Viper VI-emulation mode for Emacs}. - -It is recommended that you read chapters on survey and on customization -before you start using VIP@. Other chapters may be used as future -references. - -Comments and bug reports are welcome. Please send messages to -@code{ms@@Sail.Stanford.Edu} if you are outside of Japan and to -@code{masahiko@@unsun.riec.tohoku.junet} if you are in Japan. -@end iftex - -@node Survey -@chapter A Survey of VIP - -In this chapter we describe basics of VIP with emphasis on the features not -found in Vi and on how to use VIP under GNU Emacs. - -@menu -* Basic Concepts:: Basic concepts in Emacs. -* Loading VIP:: How to load VIP automatically. -* Modes in VIP:: VIP has three modes, which are orthogonal to modes - in Emacs. -* Differences from Vi:: Differences of VIP from Vi is explained. -@end menu - -@node Basic Concepts -@section Basic Concepts - -We begin by explaining some basic concepts of Emacs. These concepts are -explained in more detail in the GNU Emacs Manual. - -@cindex buffer -@cindex point -@cindex mark -@cindex text -@cindex looking at -@cindex end (of buffer) -@cindex region - -Conceptually, a @dfn{buffer} is just a string of @acronym{ASCII} characters and two -special characters @key{PNT} (@dfn{point}) and @key{MRK} (@dfn{mark}) such -that the character @key{PNT} occurs exactly once and @key{MRK} occurs at -most once. The @dfn{text} of a buffer is obtained by deleting the -occurrences of @key{PNT} and @key{MRK}. If, in a buffer, there is a -character following @key{PNT} then we say that point is @dfn{looking at} -the character; otherwise we say that point is @dfn{at the end of buffer}. -@key{PNT} and @key{MRK} are used -to indicate positions in a buffer and they are not part of the text of the -buffer. If a buffer contains a @key{MRK} then the text between @key{MRK} -and @key{PNT} is called the @dfn{region} of the buffer. - -@cindex window - -Emacs provides (multiple) @dfn{windows} on the screen, and you can see the -content of a buffer through the window associated with the buffer. The -cursor of the screen is always positioned on the character after @key{PNT}. - -@cindex mode -@cindex keymap -@cindex local keymap -@cindex global keymap - -A @dfn{keymap} is a table that records the bindings between characters and -command functions. There is the @dfn{global keymap} common to all the -buffers. Each buffer has its @dfn{local keymap} that determines the -@dfn{mode} of the buffer. Local keymap overrides global keymap, so that if -a function is bound to some key in the local keymap then that function will -be executed when you type the key. If no function is bound to a key in the -local map, however, the function bound to the key in the global map becomes -in effect. - -@node Loading VIP -@section Loading VIP - -The recommended way to load VIP automatically is to include the line: -@example -(load "vip") -@end example -@noindent -in your @file{.emacs} file. The @file{.emacs} file is placed in your home -directory and it will be executed every time you invoke Emacs. If you wish -to be in vi mode whenever Emacs starts up, you can include the following -line in your @file{.emacs} file instead of the above line: -@example -(add-hook 'emacs-startup-hook 'vip-mode) -@end example -@noindent -(@xref{Vi Mode}, for the explanation of vi mode.) - -Even if your @file{.emacs} file does not contain any of the above lines, -you can load VIP and enter vi mode by typing the following from within -Emacs. -@example -M-x vip-mode -@end example -@noindent - -@node Modes in VIP -@section Modes in VIP - -@kindex 032 C-z @r{(}@code{vip-change-mode-to-vi}@r{)} -@kindex 0301 C-x C-z @r{(}@code{suspend-emacs}@r{)} - -Loading VIP has the effect of globally binding @kbd{C-z} (@kbd{Control-z}) -to the function @code{vip-change-mode-to-vi}. The default binding of @kbd{C-z} -in GNU Emacs is @code{suspend-emacs}, but, you can also call -@code{suspend-emacs} by typing @kbd{C-x C-z}. Other than this, all the -key bindings of Emacs remain the same after loading VIP. - -@cindex vi mode - -Now, if you hit @kbd{C-z}, the function @code{vip-change-mode-to-vi} will be -called and you will be in @dfn{vi mode}. (Some major modes may locally bind -@kbd{C-z} to some special functions. In such cases, you can call -@code{vip-change-mode-to-vi} by @code{execute-extended-command} which is -invoked by @kbd{M-x}. Here @kbd{M-x} means @kbd{Meta-x}, and if your -terminal does not have a @key{META} key you can enter it by typing -@kbd{@key{ESC} x}. The same effect can also be achieve by typing -@kbd{M-x vip-mode}.) - -@cindex mode line - -You can observe the change of mode by looking at the @dfn{mode line}. For -instance, if the mode line is: -@example ------Emacs: *scratch* (Lisp Interaction)----All------------ -@end example -@noindent -then it will change to: -@example ------Vi: *scratch* (Lisp Interaction)----All------------ -@end example -@noindent -Thus the word @samp{Emacs} in the mode line will change to @samp{Vi}. - -@cindex insert mode -@cindex emacs mode - -You can go back to the original @dfn{emacs mode} by typing @kbd{C-z} in -vi mode. Thus @kbd{C-z} toggles between these two modes. - -Note that modes in VIP exist orthogonally to modes in Emacs. This means -that you can be in vi mode and at the same time, say, shell mode. - -Vi mode corresponds to Vi's command mode. From vi mode you can enter -@dfn{insert mode} (which corresponds to Vi's insert mode) by usual Vi command -keys like @kbd{i}, @kbd{a}, @kbd{o} @dots{} etc. - -In insert mode, the mode line will look like this: -@example ------Insert *scratch* (Lisp Interaction)----All------------ -@end example -@noindent -You can exit from insert mode by hitting @key{ESC} key as you do in Vi. - -That VIP has three modes may seem very complicated, but in fact it is not -so. VIP is implemented so that you can do most editing remaining only -in the two modes for Vi (that is vi mode and insert mode). - -@ifinfo -The figure below shows the transition of three modes in VIP. -@display - - - === C-z ==> == i,o ... ==> -emacs mode vi mode insert mode - <== X-z === <=== ESC ==== -@end display -@end ifinfo - -@menu -* Emacs Mode:: This is the mode you should know better. -* Vi Mode:: Vi commands are executed in this mode. -* Insert Mode:: You can enter text, and also can do editing if you - know enough Emacs commands. -@end menu - -@node Emacs Mode -@subsection Emacs Mode - -@kindex 032 C-z @r{(}@code{vip-change-mode-to-vi}@r{)} - -You will be in this mode just after you loaded VIP@. You can do all -normal Emacs editing in this mode. Note that the key @kbd{C-z} is globally -bound to @code{vip-change-mode-to-vi}. So, if you type @kbd{C-z} in this mode -then you will be in vi mode. - -@node Vi Mode -@subsection Vi Mode - -This mode corresponds to Vi's command mode. Most Vi commands work as they -do in Vi. You can go back to emacs mode by typing @kbd{C-z}. You can -enter insert mode, just as in Vi, by typing @kbd{i}, @kbd{a} etc. - -@node Insert Mode -@subsection Insert Mode - -The key bindings in this mode is the same as in the emacs mode except for -the following 4 keys. So, you can move around in the buffer and change -its content while you are in insert mode. - -@table @kbd -@item @key{ESC} -@kindex 033 ESC @r{(}@code{vip-change-mode-to-vi}@r{) (insert mode)} -This key will take you back to vi mode. -@item C-h -@kindex 010 C-h @r{(}@code{vip-delete-backward-char}@r{) (insert mode)} -Delete previous character. -@item C-w -@kindex 027 C-w @r{(}@code{vip-delete-backward-word}@r{) (insert mode)} -Delete previous word. -@item C-z -@kindex 032 C-z @r{(}@code{vip-ESC}@r{) (insert mode)} -Typing this key has the same effect as typing @key{ESC} in emacs mode. -Thus typing @kbd{C-z x} in insert mode will have the same effect as typing -@kbd{ESC x} in emacs mode. -@end table - -@node Differences from Vi -@section Differences from Vi - -The major differences from Vi are explained below. - -@menu -* Undoing:: You can undo more in VIP. -* Changing:: Commands for changing the text. -* Searching:: Search commands. -* z Command:: You can now use zH, zM and zL as well as z- etc. -* Counts:: Some Vi commands which do not accept a count now - accept one. -* Marking:: You can now mark the current point, beginning of - the buffer etc. -* Region Commands:: You can now give a region as an argument for delete - commands etc. -* New Commands:: Some new commands not available in Vi are added. -* New Bindings:: Bindings of some keys are changed for the - convenience of editing under Emacs. -* Window Commands:: Commands for moving among windows etc. -* Buffer Commands:: Commands for selecting buffers etc. -* File Commands:: Commands for visiting files etc. -* Misc Commands:: Other useful commands. -@end menu - -@node Undoing -@subsection Undoing - -@kindex 165 u @r{(}@code{vip-undo}@r{)} -@kindex 056 . @r{(}@code{vip-repeat}@r{)} - -You can repeat undoing by the @kbd{.} key. So, @kbd{u} will undo -a single change, while @kbd{u .@: .@: .@:}, for instance, will undo 4 previous -changes. Undo is undoable as in Vi. So the content of the buffer will -be the same before and after @kbd{u u}. - -@node Changing -@subsection Changing - -Some commands which change a small number of characters are executed -slightly differently. Thus, if point is at the beginning of a word -@samp{foo} and you wished to change it to @samp{bar} by typing @w{@kbd{c w}}, -then VIP will prompt you for a new word in the minibuffer by the prompt -@samp{foo => }. You can then enter @samp{bar} followed by @key{RET} or -@key{ESC} to complete the command. Before you enter @key{RET} or -@key{ESC} you can abort the command by typing @kbd{C-g}. In general, -@kindex 007 C-g @r{(}@code{vip-keyboard-quit}) -you can abort a partially formed command by typing @kbd{C-g}. - -@node Searching -@subsection Searching - -@kindex 057 / @r{(}@code{vip-search-forward}@r{)} -@kindex 077 ? @r{(}@code{vip-search-backward}@r{)} - -As in Vi, searching is done by @kbd{/} and @kbd{?}. The string will be -searched literally by default. To invoke a regular expression search, -first execute the search command @kbd{/} (or @kbd{?}) with empty search -string. (I.e., type @kbd{/} followed by @key{RET}.) -A search for empty string will toggle the search mode between vanilla -search and regular expression search. You cannot give an offset to the -search string. (It is a limitation.) By default, search will wrap around -the buffer as in Vi. You can change this by rebinding the variable -@code{vip-search-wrap-around}. @xref{Customization}, for how to do this. - -@node z Command -@subsection z Command - -@kindex 1723 z H @r{(}@code{vip-line-to-top}@r{)} -@kindex 1721 z RET @r{(}@code{vip-line-to-top}@r{)} -@kindex 1723 z M @r{(}@code{vip-line-to-middle}@r{)} -@kindex 1722 z . @r{(}@code{vip-line-to-middle}@r{)} -@kindex 1723 z L @r{(}@code{vip-line-to-bottom}@r{)} -@kindex 1722 z - @r{(}@code{vip-line-to-bottom}@r{)} - -For those of you who cannot remember which of @kbd{z} followed by @key{RET}, -@kbd{.}@: and @kbd{-} do what. You can also use @kbd{z} followed by @kbd{H}, -@kbd{M} and @kbd{L} to place the current line in the Home (Middle, and -Last) line of the window. - -@node Counts -@subsection Counts - -Some Vi commands which do not accept a count now accept one - -@table @kbd -@item p -@itemx P -@kindex 160 p @r{(}@code{vip-put-back}@r{)} -@kindex 120 P @r{(}@code{vip-Put-back}@r{)} -Given counts, text will be yanked (in Vi's sense) that many times. Thus -@kbd{3 p} is the same as @kbd{p p p}. -@item o -@itemx O -@kindex 157 o @r{(}@code{vip-open-line}@r{)} -@kindex 117 O @r{(}@code{vip-Open-line}@r{)} -Given counts, that many copies of text will be inserted. Thus -@kbd{o a b c @key{ESC}} will insert 3 lines of @samp{abc} below the current -line. -@item / -@itemx ? -@kindex 057 / @r{(}@code{vip-search-forward}@r{)} -@kindex 077 ? @r{(}@code{vip-search-backward}@r{)} -Given a count @var{n}, @var{n}-th occurrence will be searched. -@end table - -@node Marking -@subsection Marking - -Typing an @kbd{m} followed by a lower-case character @var{ch} marks the -point to the register named @var{ch} as in Vi. In addition to these, we -have following key bindings for marking. - -@kindex 155 m @r{(}@code{vip-mark-point}@r{)} - -@table @kbd -@item m < -Set mark at the beginning of buffer. -@item m > -Set mark at the end of buffer. -@item m . -Set mark at point (and push old mark on mark ring). -@item m , -Jump to mark (and pop mark off the mark ring). -@end table - -@node Region Commands -@subsection Region Commands - -@cindex region - -Vi operators like @kbd{d}, @kbd{c} etc.@: are usually used in combination -with motion commands. It is now possible to use current region as the -argument to these operators. (A @dfn{region} is a part of buffer -delimited by point and mark.) The key @kbd{r} is used for this purpose. -Thus @kbd{d r} will delete the current region. If @kbd{R} is used instead -of @kbd{r} the region will first be enlarged so that it will become the -smallest region containing the original region and consisting of whole -lines. Thus @kbd{m .@: d R} will have the same effect as @kbd{d d}. - -@node New Commands -@subsection Some New Commands - -Note that the keys below (except for @kbd{R}) are not used in Vi. - -@table @kbd -@item C-a -@kindex 001 C-a @r{(}@code{vip-beginning-of-line}@r{)} -Move point to the beginning of line. -@item C-n -@kindex 016 C-n @r{(}@code{vip-next-window}@r{)} -If you have two or more windows in the screen, this key will move point to -the next window. -@item C-o -@kindex 017 C-o @r{(}@code{vip-open-line-at-point}@r{)} -Insert a newline and leave point before it, and then enter insert mode. -@item C-r -@kindex 022 C-r @r{(}@code{isearch-backward}@r{)} -Backward incremental search. -@item C-s -@kindex 023 C-s @r{(}@code{isearch-forward}@r{)} -Forward incremental search. -@item C-c -@itemx C-x -@itemx @key{ESC} -@kindex 003 C-c @r{(}@code{vip-ctl-c}@r{)} -@kindex 0300 C-x @r{(}@code{vip-ctl-x}@r{)} -@kindex 033 ESC @r{(}@code{vip-ESC}@r{)} -These keys will exit from vi mode and return to emacs mode temporarily. If -you hit one of these keys, Emacs will be in emacs mode and will believe -that you hit that key in emacs mode. For example, if you hit @kbd{C-x} -followed by @kbd{2}, then the current window will be split into 2 and you -will be in vi mode again. -@item \ -@kindex 134 \ @r{(}@code{vip-escape-to-emacs}@r{)} -Escape to emacs mode. Hitting @kbd{\} will take you to emacs mode, and you -can execute a single Emacs command. After executing the Emacs command you -will be in vi mode again. You can give a count before typing @kbd{\}. -Thus @kbd{5 \ *}, as well as @kbd{\ C-u 5 *}, will insert @samp{*****} -before point. Similarly @kbd{1 0 \ C-p} will move the point 10 lines above -the current line. -@item K -@kindex 113 K @r{(}@code{vip-kill-buffer}@r{)} -Kill current buffer if it is not modified. Useful when you selected a -buffer which you did not want. -@item Q -@itemx R -@kindex 121 Q @r{(}@code{vip-query-replace}@r{)} -@kindex 122 R @r{(}@code{vip-replace-string}@r{)} -@kbd{Q} is for query replace and @kbd{R} is for replace. By default, -string to be replaced are treated literally. If you wish to do a regular -expression replace, first do replace with empty string as the string to be -replaced. In this way, you can toggle between vanilla and regular -expression replacement. -@item v -@itemx V -@kindex 166 v @r{(}@code{vip-find-file}@r{)} -@kindex 126 V @r{(}@code{vip-find-file-other-window}@r{)} -These keys are used to Visit files. @kbd{v} will switch to a buffer -visiting file whose name can be entered in the minibuffer. @kbd{V} is -similar, but will use window different from the current window. -@item # -@kindex 0430 # @r{(}@code{vip-command-argument}@r{)} -If followed by a certain character @var{ch}, it becomes an operator whose -argument is the region determined by the motion command that follows. -Currently, @var{ch} can be one of @kbd{c}, @kbd{C}, @kbd{g}, @kbd{q} and -@kbd{s}. -@item # c -@kindex 0432 # c @r{(}@code{downcase-region}@r{)} -Change upper-case characters in the region to lower case -(@code{downcase-region}). -@item # C -@kindex 0431 # C @r{(}@code{upcase-region}@r{)} -Change lower-case characters in the region to upper case. For instance, -@kbd{# C 3 w} will capitalize 3 words from the current point -(@code{upcase-region}). -@item # g -@kindex 0432 # g @r{(}@code{vip-global-execute}@r{)} -Execute last keyboard macro for each line in the region -(@code{vip-global-execute}). -@item # q -@kindex 0432 # q @r{(}@code{vip-quote-region}@r{)} -Insert specified string at the beginning of each line in the region -(@code{vip-quote-region}). -@item # s -@kindex 0432 # s @r{(}@code{spell-region}@r{)} -Check spelling of words in the region (@code{spell-region}). -@item * -@kindex 052 * @r{(}@code{vip-call-last-kbd-macro}@r{)} -Call last keyboard macro. -@end table - -@node New Bindings -@subsection New Key Bindings - -In VIP the meanings of some keys are entirely different from Vi. These key -bindings are done deliberately in the hope that editing under Emacs will -become easier. It is however possible to rebind these keys to functions -which behave similarly as in Vi. @xref{Customizing Key Bindings}, for -details. - -@table @kbd -@item C-g -@itemx g -@kindex 007 C-g @r{(}@code{vip-keyboard-quit}@r{)} -@kindex 147 g @r{(}@code{vip-info-on-file}@r{)} -In Vi, @kbd{C-g} is used to get information about the file associated to -the current buffer. Here, @kbd{g} will do that, and @kbd{C-g} is -used to abort a command (this is for compatibility with emacs mode.) -@item @key{SPC} -@itemx @key{RET} -@kindex 040 SPC @r{(}@code{vip-scroll}@r{)} -@kindex 015 RET @r{(}@code{vip-scroll-back}@r{)} -Now these keys will scroll up and down the text of current window. -Convenient for viewing the text. -@item s -@itemx S -@kindex 163 s @r{(}@code{vip-switch-to-buffer}@r{)} -@kindex 123 S @r{(}@code{vip-switch-to-buffer-other-window}@r{)} -They are used to switch to a specified buffer. Useful for switching to -already existing buffer since buffer name completion is provided. Also -a default buffer will be given as part of the prompt, to which you can -switch by just typing @key{RET} key. @kbd{s} is used to select buffer -in the current window, while @kbd{S} selects buffer in another window. -@item C -@itemx X -@kindex 103 C @r{(}@code{vip-ctl-c-equivalent}@r{)} -@kindex 1300 X @r{(}@code{vip-ctl-x-equivalent}@r{)} -These keys will exit from vi mode and return to emacs mode temporarily. -If you type @kbd{C} (@kbd{X}), Emacs will be in emacs mode and will believe -that you have typed @kbd{C-c} (@kbd{C-x}) in emacs mode. Moreover, -if the following character you type is an upper-case letter, then Emacs -will believe that you have typed the corresponding control character. -You will be in vi mode again after the command is executed. For example, -typing @kbd{X S} in vi mode is the same as typing @kbd{C-x C-s} in emacs -mode. You get the same effect by typing @kbd{C-x C-s} in vi mode, but -the idea here is that you can execute useful Emacs commands without typing -control characters. For example, if you hit @kbd{X} (or @kbd{C-x}) followed -by @kbd{2}, then the current window will be split into 2 and you will be in -vi mode again. -@end table - -In addition to these, @code{ctl-x-map} is slightly modified: - -@kindex 1301 X 3 @r{(}@code{vip-buffer-in-two-windows}@r{)} - -@table @kbd -@item X 3 -@itemx C-x 3 -This is equivalent to @kbd{C-x 1 C-x 2} (1 + 2 = 3). -@end table - -@node Window Commands -@subsection Window Commands - -In this and following subsections, we give a summary of key bindings for -basic functions related to windows, buffers and files. - -@table @kbd -@item C-n -@kindex 016 C-n @r{(}@code{vip-next-window}@r{)} -Switch to next window. -@item X 1 -@itemx C-x 1 -@kindex 1301 X 1 @r{(}@code{delete-other-windows}@r{)} -Delete other windows. -@item X 2 -@itemx C-x 2 -@kindex 1301 X 2 @r{(}@code{split-window-vertically}@r{)} -Split current window into two windows. -@item X 3 -@itemx C-x 3 -@kindex 1301 X 3 @r{(}@code{vip-buffer-in-two-windows}@r{)} -Show current buffer in two windows. -@end table - -@node Buffer Commands -@subsection Buffer Commands - -@table @kbd -@item s -@kindex 163 s @r{(}@code{vip-switch-to-buffer}@r{)} -Switch to the specified buffer in the current window -(@code{vip-switch-to-buffer}). -@item S -@kindex 123 S @r{(}@code{vip-switch-to-buffer-other-window}@r{)} -Switch to the specified buffer in another window -(@code{vip-switch-to-buffer-other-window}). -@item K -@kindex 113 K @r{(}@code{vip-kill-buffer}@r{)} -Kill the current buffer if it is not modified. -@item X S -@itemx C-x C-s -@kindex 1302 X S @r{(}@code{save-buffer}@r{)} -Save the current buffer in the file associated to the buffer. -@end table - -@node File Commands -@subsection File Commands - -@table @kbd -@item v -@kindex 166 v @r{(}@code{vip-find-file}@r{)} -Visit specified file in the current window. -@item V -@kindex 126 V @r{(}@code{vip-find-file-other-window}@r{)} -Visit specified file in another window. -@item X W -@itemx C-x C-w -@kindex 1302 X W @r{(}@code{write-file}@r{)} -Write current buffer into the specified file. -@item X I -@itemx C-x C-i -@kindex 1302 X I @r{(}@code{insert-file}@r{)} - -Insert specified file at point. -@end table - -@node Misc Commands -@subsection Miscellaneous Commands - -@table @kbd -@item X ( -@itemx C-x ( -@kindex 1301 X ( @r{(}@code{start-kbd-macro}@r{)} -Start remembering keyboard macro. -@item X ) -@itemx C-x ) -@kindex 1301 X ) @r{(}@code{end-kbd-macro}@r{)} -Finish remembering keyboard macro. -@item * -@kindex 052 * @r{(}@code{vip-call-last-kbd-macro}@r{)} -Call last remembered keyboard macro. -@item X Z -@itemx C-x C-z -@kindex 1302 X Z @r{(}@code{suspend-emacs}@r{)} -Suspend Emacs. -@item Z Z -Exit Emacs. -@item Q -Query replace. -@item R -Replace. -@end table - -@node Vi Commands -@chapter Vi Commands - -This chapter describes Vi commands other than Ex commands implemented in -VIP@. Except for the last section which discusses insert mode, all the -commands described in this chapter are to be used in vi mode. - -@menu -* Numeric Arguments:: Many commands accept numeric arguments -* Important Keys:: Some very important keys. -* Buffers and Windows:: Commands for handling buffers and windows. -* Files:: Commands for handling files. -* Viewing the Buffer:: How you can view the current buffer. -* Mark Commands:: Marking positions in a buffer. -* Motion Commands:: Commands for moving point. -* Searching and Replacing:: Commands for searching and replacing. -* Modifying Commands:: Commands for modifying the buffer. -* Other Vi Commands:: Miscellaneous Commands. -* Commands in Insert Mode:: Commands for entering insert mode. -@end menu - -@node Numeric Arguments -@section Numeric Arguments - -@cindex numeric arguments -@cindex count -@kindex 061 1 @r{(numeric argument)} -@kindex 062 2 @r{(numeric argument)} -@kindex 063 3 @r{(numeric argument)} -@kindex 064 4 @r{(numeric argument)} -@kindex 065 5 @r{(numeric argument)} -@kindex 066 6 @r{(numeric argument)} -@kindex 067 7 @r{(numeric argument)} -@kindex 068 8 @r{(numeric argument)} -@kindex 069 9 @r{(numeric argument)} - -Most Vi commands accept a @dfn{numeric argument} which can be supplied as -a prefix to the commands. A numeric argument is also called a @dfn{count}. -In many cases, if a count is given, the command is executed that many times. -For instance, @kbd{5 d d} deletes 5 lines while simple @kbd{d d} deletes a -line. In this manual the metavariable @var{n} will denote a count. - -@node Important Keys -@section Important Keys - -The keys @kbd{C-g} and @kbd{C-l} are unique in that their associated -functions are the same in any of emacs, vi and insert mode. - -@table @kbd -@item C-g -@kindex 007 C-g (@code{vip-keyboard-quit}@r{)} -Quit. Cancel running or partially typed command (@code{keyboard-quit}). -@item C-l -@kindex 014 C-l @r{(}@code{recenter}@r{)} -Clear the screen and reprint everything (@code{recenter}). -@end table - -In Emacs many commands are bound to the key strokes that start with -@kbd{C-x}, @kbd{C-c} and @key{ESC}. These commands can be -accessed from vi mode as easily as from emacs mode. - -@table @kbd -@item C-x -@itemx C-c -@itemx @key{ESC} -@kindex 003 C-c @r{(}@code{vip-ctl-c}@r{)} -@kindex 0300 C-x @r{(}@code{vip-ctl-x}@r{)} -@kindex 033 ESC @r{(}@code{vip-ESC}@r{)} -Typing one of these keys have the same effect as typing it in emacs mode. -Appropriate command will be executed according as the keys you type after -it. You will be in vi mode again after the execution of the command. -For instance, if you type @kbd{@key{ESC} <} (in vi mode) then the cursor will -move to the beginning of the buffer and you will still be in vi mode. -@item C -@itemx X -@kindex 103 C @r{(}@code{vip-ctl-c-equivalent}@r{)} -@kindex 1300 X @r{(}@code{vip-ctl-x-equivalent}@r{)} -Typing one of these keys have the effect of typing the corresponding -control character in emacs mode. Moreover, if you type an upper-case -character following it, that character will also be translated to the -corresponding control character. Thus typing @kbd{X W} in vi mode is the -same as typing @kbd{C-x C-w} in emacs mode. You will be in vi mode again -after the execution of a command. -@item \ -@kindex 134 \ @r{(}@code{vip-escape-to-emacs}@r{)} -Escape to emacs mode. Hitting the @kbd{\} key will take you to emacs mode, -and you can execute a single Emacs command. After executing the -Emacs command you will be in vi mode again. You can give a count before -typing @kbd{\}. Thus @kbd{5 \ +}, as well as @kbd{\ C-u 5 +}, will insert -@samp{+++++} before point. -@end table - -@node Buffers and Windows -@section Buffers and Windows - -@cindex buffer -@cindex selected buffer -@cindex current buffer - -In Emacs the text you edit is stored in a @dfn{buffer}. -See GNU Emacs Manual, for details. There is always one @dfn{current} -buffer, also called the @dfn{selected buffer}. - -@cindex window -@cindex modified (buffer) - -You can see the contents of buffers through @dfn{windows} created by Emacs. -When you have multiple windows on the screen only one of them is selected. -Each buffer has a unique name, and each window has a mode line which shows -the name of the buffer associated with the window and other information -about the status of the buffer. You can change the format of the mode -line, but normally if you see @samp{**} at the beginning of a mode line it -means that the buffer is @dfn{modified}. If you write out the content of -the buffer to a file, then the buffer will become not modified. Also if -you see @samp{%%} at the beginning of the mode line, it means that the file -associated with the buffer is write protected. - -We have the following commands related to windows and buffers. - -@table @kbd -@item C-n -@kindex 016 C-n @r{(}@code{vip-next-window}@r{)} -Move cursor to the next-window (@code{vip-next-window}). -@item X 1 -@kindex 1301 X 1 @r{(}@code{delete-other-windows}@r{)} -Delete other windows and make the selected window fill the screen -@*(@code{delete-other-windows}). -@item X 2 -@kindex 1301 X 2 @r{(}@code{split-window-vertically}@r{)} -Split current window into two windows (@code{split-window-vertically}). -@item X 3 -@kindex 1301 X 3 @r{(}@code{vip-buffer-in-two-windows}@r{)} -Show current buffer in two windows. -@item s @var{buffer} @key{RET} -@kindex 163 s @r{(}@code{vip-switch-to-buffer}@r{)} -Select or create a buffer named @var{buffer} (@code{vip-switch-to-buffer}). -@item S @var{buffer} @key{RET} -@kindex 123 S @r{(}@code{vip-switch-to-buffer-other-window}@r{)} -Similar but select a buffer named @var{buffer} in another window -@*(@code{vip-switch-to-buffer-other-window}). -@item K -@kindex 113 K @r{(}@code{vip-kill-buffer}@r{)} -Kill the current buffer if it is not modified or if it is not associated -with a file @*(@code{vip-kill-buffer}). -@item X B -@kindex 1302 X B @r{(}@code{list-buffers}@r{)} -List the existing buffers (@code{list-buffers}). -@end table - -@cindex buffer name completion - -As @dfn{buffer name completion} is provided, you have only to type in -initial substring of the buffer name which is sufficient to identify it -among names of existing buffers. After that, if you hit @key{TAB} the rest -of the buffer name will be supplied by the system, and you can confirm it -by @key{RET}. The default buffer name to switch to will also be prompted, -and you can select it by giving a simple @key{RET}. See GNU Emacs Manual -for details of completion. - -@node Files -@section Files - -We have the following commands related to files. They are used to visit, -save and insert files. - -@table @kbd -@item v @var{file} @key{RET} -@kindex 166 v @r{(}@code{vip-find-file}@r{)} -Visit specified file in the current window (@code{vip-find-file}). -@item V @var{file} @key{RET} -@kindex 126 V @r{(}@code{vip-find-file-other-window}@r{)} -Visit specified file in another window (@code{vip-find-file-other-window}). -@item X S -@kindex 1302 X S @r{(}@code{save-buffer}@r{)} -Save current buffer to the file associated with the buffer. If no file is -associated with the buffer, the name of the file to write out the content -of the buffer will be asked in the minibuffer. -@item X W @var{file} @key{RET} -@kindex 1302 X W @r{(}@code{write-file}@r{)} -Write current buffer into a specified file. -@item X I @var{file} @key{RET} -@kindex 1302 X I @r{(}@code{insert-file}@r{)} -Insert a specified file at point. -@item g -@kindex 147 g @r{(}@code{vip-info-on-file}@r{)} -Give information on the file associated with the current buffer. Tell you -the name of the file associated with the buffer, the line number of the -current point and total line numbers in the buffer. If no file is -associated with the buffer, this fact will be indicated by the null file -name @samp{""}. -@end table - -@cindex visiting (a file) -@cindex default directory - -In Emacs, you can edit a file by @dfn{visiting} it. If you wish to visit a -file in the current window, you can just type @kbd{v}. Emacs maintains the -@dfn{default directory} which is specific to each buffer. Suppose, for -instance, that the default directory of the current buffer is -@file{/usr/masahiko/lisp/}. Then you will get the following prompt in the -minibuffer. -@example -visit file: /usr/masahiko/lisp/ -@end example -@noindent -@cindex file name completion -If you wish to visit, say, @file{vip.el} in this directory, then you can -just type @samp{vip.el} followed by @key{RET}. If the file @file{vip.el} -already exists in the directory, Emacs will visit that file, and if not, -the file will be created. Emacs will use the file name (@file{vip.el}, in -this case) as the name of the buffer visiting the file. In order to make -the buffer name unique, Emacs may add a suffix (@pxref{Uniquify,,, -emacs, The GNU Emacs Manual}). As @dfn{file name completion} is provided here, you -can sometimes save typing. For instance, suppose there is only one file in the -default directory whose name starts with @samp{v}, that is @samp{vip.el}. -Then if you just type @kbd{v @key{TAB}} then it will be completed to -@samp{vip.el}. Thus, in this case, you just have to type @kbd{v v @key{TAB} -@key{RET}} to visit @file{/usr/masahiko/lisp/vip.el}. Continuing the -example, let us now suppose that you wished to visit the file -@file{/usr/masahiko/man/vip.texinfo}. Then to the same prompt which you get -after you typed @kbd{v}, you can enter @samp{/usr/masahiko/man/vip.texinfo} or -@samp{../man/vip.texinfo} followed by @key{RET}. - -Use @kbd{V} instead of @kbd{v}, if you wish to visit a file in another -window. - -You can verify which file you are editing by typing @kbd{g}. (You can also -type @kbd{X B} to get information on other buffers too.) If you type -@kbd{g} you will get an information like below in the echo area: -@example -"/usr/masahiko/man/vip.texinfo" line 921 of 1949 -@end example - -After you edited the buffer (@samp{vip.texinfo}, in our example) for a while, -you may wish to save it in a file. If you wish to save it in the file -associated with the buffer (@file{/usr/masahiko/man/vip.texinfo}, in this -case), you can just say @kbd{X S}. If you wish to save it in another file, -you can type @kbd{X W}. You will then get a similar prompt as you get for -@kbd{v}, to which you can enter the file name. - -@node Viewing the Buffer -@section Viewing the Buffer - -In this and next section we discuss commands for moving around in the -buffer. These command do not change the content of the buffer. The -following commands are useful for viewing the content of the current -buffer. - -@table @kbd -@item @key{SPC} -@itemx C-f -@kindex 040 SPC @r{(}@code{vip-scroll}@r{)} -@kindex 006 C-f @r{(}@code{vip-scroll-back}@r{)} -Scroll text of current window upward almost full screen. You can go -@i{forward} in the buffer by this command (@code{vip-scroll}). -@item @key{RET} -@itemx C-b -@kindex 015 RET @r{(}@code{vip-scroll-back}@r{)} -@kindex 002 C-b @r{(}@code{vip-scroll-back}@r{)} -Scroll text of current window downward almost full screen. You can go -@i{backward} in the buffer by this command (@code{vip-scroll-back}). -@item C-d -@kindex 004 C-d @r{(}@code{vip-scroll-up}@r{)} -Scroll text of current window upward half screen. You can go -@i{down} in the buffer by this command (@code{vip-scroll-down}). -@item C-u -@kindex 025 C-u @r{(}@code{vip-scroll-down}@r{)} -Scroll text of current window downward half screen. You can go -@i{up} in the buffer by this command (@code{vip-scroll-up}). -@item C-y -@kindex 031 C-y @r{(}@code{vip-scroll-down-one}@r{)} -Scroll text of current window upward by one line (@code{vip-scroll-down-one}). -@item C-e -@kindex 005 C-e @r{(}@code{vip-scroll-up-one}@r{)} -Scroll text of current window downward by one line (@code{vip-scroll-up-one}). -@end table -@noindent -You can repeat these commands by giving a count. Thus, @kbd{2 @key{SPC}} -has the same effect as @kbd{@key{SPC} @key{SPC}}. - -The following commands reposition point in the window. - -@table @kbd -@item z H -@itemx z @key{RET} -@kindex 1723 z H @r{(}@code{vip-line-to-top}@r{)} -@kindex 1721 z RET @r{(}@code{vip-line-to-top}@r{)} -Put point on the top (@i{home}) line in the window. So the current line -becomes the top line in the window. Given a count @var{n}, point will be -placed in the @var{n}-th line from top (@code{vip-line-to-top}). -@item z M -@itemx z . -@kindex 1723 z M @r{(}@code{vip-line-to-middle}@r{)} -@kindex 1722 z . @r{(}@code{vip-line-to-middle}@r{)} -Put point on the @i{middle} line in the window. Given a count @var{n}, -point will be placed in the @var{n}-th line from the middle line -(@code{vip-line-to-middle}). -@item z L -@itemx z - -@kindex 1723 z L @r{(}@code{vip-line-to-bottom}@r{)} -@kindex 1722 z - @r{(}@code{vip-line-to-bottom}@r{)} -Put point on the @i{bottom} line in the window. Given a count @var{n}, -point will be placed in the @var{n}-th line from bottom -(@code{vip-line-to-bottom}). -@item C-l -Center point in window and redisplay screen (@code{recenter}). -@end table - -@node Mark Commands -@section Mark Commands - -The following commands are used to mark positions in the buffer. - -@table @kbd -@item m @var{ch} -@kindex 155 m @r{(}@code{vip-mark-point}@r{)} -Store current point in the register @var{ch}. @var{ch} must be a -lower-case @acronym{ASCII} letter. -@item m < -Set mark at the beginning of current buffer. -@item m > -Set mark at the end of current buffer. -@item m . -Set mark at point. -@item m , -Jump to mark (and pop mark off the mark ring). -@end table - -@cindex mark ring - -Emacs uses the @dfn{mark ring} to store marked positions. The commands -@kbd{m <}, @kbd{m >} and @kbd{m .}@: not only set mark but also add it as the -latest element of the mark ring (replacing the oldest one). By repeating -the command @kbd{m ,} you can visit older and older marked positions. You -will eventually be in a loop as the mark ring is a ring. - -@node Motion Commands -@section Motion Commands - -Commands for moving around in the current buffer are collected here. These -commands are used as an ``argument'' for the delete, change and yank commands -to be described in the next section. - -@table @kbd -@item h -@kindex 150 h @r{(}@code{vip-backward-char}@r{)} -Move point backward by one character. Signal error if point is at the -beginning of buffer, but (unlike Vi) do not complain otherwise -(@code{vip-backward-char}). -@item l -@kindex 154 l @r{(}@code{vip-forward-char}@r{)} -Move point backward by one character. Signal error if point is at the -end of buffer, but (unlike Vi) do not complain otherwise -(@code{vip-forward-char}). -@item j -@kindex 152 j @r{(}@code{vip-next-line}@r{)} -Move point to the next line keeping the current column. If point is on the -last line of the buffer, a new line will be created and point will move to -that line (@code{vip-next-line}). -@item k -@kindex 153 k @r{(}@code{vip-previous-line}@r{)} -Move point to the previous line keeping the current column -(@code{vip-next-line}). -@item + -@kindex 053 + @r{(}@code{vip-next-line-at-bol}@r{)} -Move point to the next line at the first non-white character. If point is -on the last line of the buffer, a new line will be created and point will -move to the beginning of that line (@code{vip-next-line-at-bol}). -@item - -@kindex 055 - @r{(}@code{vip-previous-line-at-bol}@r{)} -Move point to the previous line at the first non-white character -(@code{vip-previous-line-at-bol}). -@end table -@noindent -If a count is given to these commands, the commands will be repeated that -many times. - -@table @kbd -@item 0 -@kindex 060 0 @r{(}@code{vip-beginning-of-line}@r{)} -Move point to the beginning of line (@code{vip-beginning-of-line}). -@item ^ -@kindex 136 ^ @r{(}@code{vip-bol-and-skip-white}@r{)} -Move point to the first non-white character on the line -(@code{vip-bol-and-skip-white}). -@item $ -@kindex 044 $ @r{(}@code{vip-goto-eol}@r{)} -Move point to the end of line (@code{vip-goto-eol}). -@item @var{n} | -@kindex 174 | @r{(}@code{vip-goto-col}@r{)} -Move point to the @var{n}-th column on the line (@code{vip-goto-col}). -@end table -@noindent -Except for the @kbd{|} command, these commands neglect a count. - -@cindex word - -@table @kbd -@item w -@kindex 167 w @r{(}@code{vip-forward-word}@r{)} -Move point forward to the beginning of the next word -(@code{vip-forward-word}). -@item W -@kindex 127 W @r{(}@code{vip-forward-Word}@r{)} -Move point forward to the beginning of the next word, where a @dfn{word} is -considered as a sequence of non-white characters (@code{vip-forward-Word}). -@item b -@kindex 142 b @r{(}@code{vip-backward-word}@r{)} -Move point backward to the beginning of a word (@code{vip-backward-word}). -@item B -@kindex 102 B @r{(}@code{vip-backward-Word}@r{)} -Move point backward to the beginning of a word, where a @i{word} is -considered as a sequence of non-white characters (@code{vip-forward-Word}). -@item e -@kindex 145 e @r{(}@code{vip-end-of-word}@r{)} -Move point forward to the end of a word (@code{vip-end-of-word}). -@item E -@kindex 105 E @r{(}@code{vip-end-of-Word}@r{)} -Move point forward to the end of a word, where a @i{word} is -considered as a sequence of non-white characters (@code{vip-end-of-Word}). -@end table -@noindent -@cindex syntax table -Here the meaning of the word ``word'' for the @kbd{w}, @kbd{b} and @kbd{e} -commands is determined by the @dfn{syntax table} effective in the current -buffer. Each major mode has its syntax mode, and therefore the meaning of -a word also changes as the major mode changes. See GNU Emacs Manual for -details of syntax table. - -@table @kbd -@item H -@kindex 110 H @r{(}@code{vip-window-top}@r{)} -Move point to the beginning of the @i{home} (top) line of the window. -Given a count @var{n}, go to the @var{n}-th line from top -(@code{vip-window-top}). -@item M -@kindex 115 M @r{(}@code{vip-window-middle}@r{)} -Move point to the beginning of the @i{middle} line of the window. Given -a count @var{n}, go to the @var{n}-th line from the middle line -(@code{vip-window-middle}). -@item L -@kindex 114 L @r{(}@code{vip-window-bottom}@r{)} -Move point to the beginning of the @i{lowest} (bottom) line of the -window. Given count, go to the @var{n}-th line from bottom -(@code{vip-window-bottom}). -@end table -@noindent -These commands can be used to go to the desired line visible on the screen. - -@table @kbd -@item ( -@kindex 050 ( @r{(}@code{vip-backward-sentence}@r{)} -Move point backward to the beginning of the sentence -(@code{vip-backward-sentence}). -@item ) -@kindex 051 ) @r{(}@code{vip-forward-sentence}@r{)} -Move point forward to the end of the sentence -(@code{vip-forward-sentence}). -@item @{ -@kindex 173 @{ @r{(}@code{vip-backward-paragraph}@r{)} -Move point backward to the beginning of the paragraph -(@code{vip-backward-paragraph}). -@item @} -@kindex 175 @} @r{(}@code{vip-forward-paragraph}@r{)} -Move point forward to the end of the paragraph -(@code{vip-forward-paragraph}). -@end table -@noindent -A count repeats the effect for these commands. - -@table @kbd -@item G -@kindex 107 G @r{(}@code{vip-goto-line}@r{)} -Given a count @var{n}, move point to the @var{n}-th line in the buffer on -the first non-white character. Without a count, go to the end of the buffer -(@code{vip-goto-line}). -@item ` ` -@kindex 140 ` @r{(}@code{vip-goto-mark}@r{)} -Exchange point and mark (@code{vip-goto-mark}). -@item ` @var{ch} -Move point to the position stored in the register @var{ch}. @var{ch} must -be a lower-case letter. -@item ' ' -@kindex 047 ' @r{(}@code{vip-goto-mark-and-skip-white}@r{)} -Exchange point and mark, and then move point to the first non-white -character on the line (@code{vip-goto-mark-and-skip-white}). -@item ' @var{ch} -Move point to the position stored in the register @var{ch} and skip to the -first non-white character on the line. @var{ch} must be a lower-case letter. -@item % -@kindex 045 % @r{(}@code{vip-paren-match}@r{)} -Move point to the matching parenthesis if point is looking at @kbd{(}, -@kbd{)}, @kbd{@{}, @kbd{@}}, @kbd{[} or @kbd{]} -@*(@code{vip-paren-match}). -@end table -@noindent -The command @kbd{G} mark point before move, so that you can return to the -original point by @kbd{` `}. The original point will also be stored in -the mark ring. - -The following commands are useful for moving points on the line. A count -will repeat the effect. - -@table @kbd -@item f @var{ch} -@kindex 146 f @r{(}@code{vip-find-char-forward}@r{)} -Move point forward to the character @var{ch} on the line. Signal error if -@var{ch} could not be found (@code{vip-find-char-forward}). -@item F @var{ch} -@kindex 106 F @r{(}@code{vip-find-char-backward}@r{)} -Move point backward to the character @var{ch} on the line. Signal error if -@var{ch} could not be found (@code{vip-find-char-backward}). -@item t @var{ch} -@kindex 164 t @r{(}@code{vip-goto-char-forward}@r{)} -Move point forward up to the character @var{ch} on the line. Signal error if -@var{ch} could not be found (@code{vip-goto-char-forward}). -@item T @var{ch} -@kindex 124 T @r{(}@code{vip-goto-char-backward}@r{)} -Move point backward up to the character @var{ch} on the line. Signal error if -@var{ch} could not be found (@code{vip-goto-char-backward}). -@item ; -@kindex 073 ; @r{(}@code{vip-repeat-find}@r{)} -Repeat previous @kbd{f}, @kbd{t}, @kbd{F} or @kbd{T} command -(@code{vip-repeat-find}). -@item , -@kindex 054 , @r{(}@code{vip-repeat-find-opposite}@r{)} -Repeat previous @kbd{f}, @kbd{t}, @kbd{F} or @kbd{T} command, in the -opposite direction (@code{vip-repeat-find-opposite}). -@end table - -@node Searching and Replacing -@section Searching and Replacing - -Following commands are available for searching and replacing. - -@cindex regular expression (search) - -@table @kbd -@item / @var{string} @key{RET} -@kindex 057 / @r{(}@code{vip-search-forward}@r{)} -Search the first occurrence of the string @var{string} forward starting -from point. Given a count @var{n}, the @var{n}-th occurrence of -@var{string} will be searched. If the variable @code{vip-re-search} has value -@code{t} then @dfn{regular expression} search is done and the string -matching the regular expression @var{string} is found. If you give an -empty string as @var{string} then the search mode will change from vanilla -search to regular expression search and vice versa -(@code{vip-search-forward}). -@item ? @var{string} @key{RET} -@kindex 077 ? @r{(}@code{vip-search-backward}@r{)} -Same as @kbd{/}, except that search is done backward -(@code{vip-search-backward}). -@item n -@kindex 156 n @r{(}@code{vip-search-next}@r{)} -Search the previous search pattern in the same direction as before -(@code{vip-search-next}). -@item N -@kindex 116 N @r{(}@code{vip-search-Next}@r{)} -Search the previous search pattern in the opposite direction -(@code{vip-search-Next}). -@item C-s -@kindex 023 C-s @r{(}@code{isearch-forward}@r{)} -Search forward incrementally. See GNU Emacs Manual for details -(@code{isearch-forward}). -@item C-r -@kindex 022 C-r @r{(}@code{isearch-backward}@r{)} -Search backward incrementally (@code{isearch-backward}). -@cindex vanilla (replacement) -@cindex regular expression (replacement) -@item R @var{string} @key{RET} @var{newstring} -@kindex 122 R @r{(}@code{vip-replace-string}@r{)} -There are two modes of replacement, @dfn{vanilla} and @dfn{regular expression}. -If the mode is @i{vanilla} you will get a prompt @samp{Replace string:}, -and if the mode is @i{regular expression} you will ge a prompt -@samp{Replace regexp:}. The mode is initially @i{vanilla}, but you can -toggle these modes by giving a null string as @var{string}. If the mode is -vanilla, this command replaces every occurrence of @var{string} with -@var{newstring}. If the mode is regular expression, @var{string} is -treated as a regular expression and every string matching the regular -expression is replaced with @var{newstring} (@code{vip-replace-string}). -@item Q @var{string} @key{RET} @var{newstring} -@kindex 121 Q @r{(}@code{vip-query-replace}@r{)} -Same as @kbd{R} except that you will be asked form confirmation before each -replacement -@*(@code{vip-query-replace}). -@item r @var{ch} -@kindex 162 r @r{(}@code{vip-replace-char}@r{)} -Replace the character point is looking at by the character @var{ch}. Give -count, replace that many characters by @var{ch} (@code{vip-replace-char}). -@end table -@noindent -The commands @kbd{/} and @kbd{?} mark point before move, so that you can -return to the original point by @w{@kbd{` `}}. - -@node Modifying Commands -@section Modifying Commands - -In this section, commands for modifying the content of a buffer are -described. These commands affect the region determined by a motion command -which is given to the commands as their argument. - -@cindex point commands -@cindex line commands - -We classify motion commands into @dfn{point commands} and -@dfn{line commands}. The point commands are as follows: -@example -@kbd{h}, @kbd{l}, @kbd{0}, @kbd{^}, @kbd{$}, @kbd{w}, @kbd{W}, @kbd{b}, @kbd{B}, @kbd{e}, @kbd{E}, @kbd{(}, @kbd{)}, @kbd{/}, @kbd{?}, @kbd{`}, @kbd{f}, @kbd{F}, @kbd{t}, @kbd{T}, @kbd{%}, @kbd{;}, @kbd{,} -@end example -@noindent -The line commands are as follows: -@example -@kbd{j}, @kbd{k}, @kbd{+}, @kbd{-}, @kbd{H}, @kbd{M}, @kbd{L}, @kbd{@{}, @kbd{@}}, @kbd{G}, @kbd{'} -@end example -@noindent -@cindex expanding (region) -If a point command is given as an argument to a modifying command, the -region determined by the point command will be affected by the modifying -command. On the other hand, if a line command is given as an argument to a -modifying command, the region determined by the line command will be -enlarged so that it will become the smallest region properly containing the -region and consisting of whole lines (we call this process @dfn{expanding -the region}), and then the enlarged region will be affected by the modifying -command. - -@menu -* Delete Commands:: Commands for deleting text. -* Yank Commands:: Commands for yanking text in Vi's sense. -* Put Back Commands:: Commands for putting back deleted/yanked text. -* Change Commands:: Commands for changing text. -* Repeating and Undoing Modifications:: -@end menu -@node Delete Commands -@subsection Delete Commands - -@table @kbd -@item d @var{motion-command} -@kindex 1440 d @r{(}@code{vip-command-argument}@r{)} -Delete the region determined by the motion command @var{motion-command}. -@end table -@noindent -For example, @kbd{d $} will delete the region between point and end of -current line since @kbd{$} is a point command that moves point to end of line. -@kbd{d G} will delete the region between the beginning of current line and -end of the buffer, since @kbd{G} is a line command. A count given to the -command above will become the count for the associated motion command. -Thus, @kbd{3 d w} will delete three words. - -@kindex 042 " @r{(}@code{vip-command-argument}@r{)} -It is also possible to save the deleted text into a register you specify. -For example, you can say @kbd{" t 3 d w} to delete three words and save it -to register @kbd{t}. The name of a register is a lower-case letter between -@kbd{a} and @kbd{z}. If you give an upper-case letter as an argument to -a delete command, then the deleted text will be appended to the content of -the register having the corresponding lower-case letter as its name. So, -@kbd{" T d w} will delete a word and append it to register @kbd{t}. Other -modifying commands also accept a register name as their argument, and we -will not repeat similar explanations. - -We have more delete commands as below. - -@table @kbd -@item d d -@kindex 1442 d d -Delete a line. Given a count @var{n}, delete @var{n} lines. -@item d r -@kindex 1442 d r -Delete current region. -@item d R -@kindex 1441 d R -Expand current region and delete it. -@item D -@kindex 104 D @r{(}@code{vip-kill-line}@r{)} -Delete to the end of a line (@code{vip-kill-line}). -@item x -@kindex 170 x @r{(}@code{vip-delete-char}@r{)} -Delete a character after point. Given @var{n}, delete @var{n} characters -(@code{vip-delete-char}). -@item @key{DEL} -@kindex 177 DEL @r{(}@code{vip-delete-backward-char}@r{)} -Delete a character before point. Given @var{n}, delete @var{n} characters -(@code{vip-delete-backward-char}). -@end table - -@node Yank Commands -@subsection Yank Commands - -@cindex yank - -Yank commands @dfn{yank} a text of buffer into a (usually anonymous) register. -Here the word ``yank'' is used in Vi's sense. Thus yank commands do not -alter the content of the buffer, and useful only in combination with -commands that put back the yanked text into the buffer. - -@table @kbd -@item y @var{motion-command} -@kindex 1710 y @r{(}@code{vip-command-argument}@r{)} -Yank the region determined by the motion command @var{motion-command}. -@end table -@noindent -For example, @kbd{y $} will yank the text between point and the end of line -into an anonymous register, while @kbd{"c y $} will yank the same text into -register @kbd{c}. - -Use the following command to yank consecutive lines of text. - -@table @kbd -@item y y -@itemx Y -@kindex 131 Y @r{(}@code{vip-yank-line}@r{)} -@kindex 1712 y y @r{(}@code{vip-yank-line}@r{)} -Yank a line. Given @var{n}, yank @var{n} lines (@code{vip-yank-line}). -@item y r -@kindex 1712 y r -Yank current region. -@item y R -@kindex 1711 y R -Expand current region and yank it. -@end table - -@node Put Back Commands -@subsection Put Back Commands -Deleted or yanked texts can be put back into the buffer by the command -below. - -@table @kbd -@item p -@kindex 160 p @r{(}@code{vip-put-back}@r{)} -Insert, after the character point is looking at, most recently -deleted/yanked text from anonymous register. Given a register name -argument, the content of the named register will be put back. Given a -count, the command will be repeated that many times. This command also -checks if the text to put back ends with a new line character, and if so -the text will be put below the current line (@code{vip-put-back}). -@item P -@kindex 120 P @r{(}@code{vip-Put-back}@r{)} -Insert at point most recently deleted/yanked text from anonymous register. -Given a register name argument, the content of the named register will -be put back. Given a count, the command will be repeated that many times. -This command also checks if the text to put back ends with a new line -character, and if so the text will be put above the current line rather -than at point (@code{vip-Put-back}). -@end table -@noindent -@cindex number register -Thus, @kbd{" c p} will put back the content of the register @kbd{c} into the -buffer. It is also possible to specify @dfn{number register} which is a -numeral between @kbd{1} and @kbd{9}. If the number register @var{n} is -specified, @var{n}-th previously deleted/yanked text will be put back. It -is an error to specify a number register for the delete/yank commands. - -@node Change Commands -@subsection Change Commands - -Most commonly used change command takes the following form. - -@table @kbd -@item c @var{motion-command} -@kindex 1430 c @r{(}@code{vip-command-argument}@r{)} -Replace the content of the region determined by the motion command -@var{motion-command} by the text you type. If the motion command is a -point command then you will type the text into minibuffer, and if the -motion command is a line command then the region will be deleted first and -you can insert the text in @var{insert mode}. -@end table -@noindent -For example, if point is at the beginning of a word @samp{foo} and you -wish to change it to @samp{bar}, you can type @kbd{c w}. Then, as @kbd{w} -is a point command, you will get the prompt @samp{foo =>} in the -minibuffer, for which you can type @kbd{b a r @key{RET}} to complete the change -command. - -@table @kbd -@item c c -@kindex 1432 c c -Change a line. Given a count, that many lines are changed. -@item c r -@kindex 1432 c r -Change current region. -@item c R -@kindex 1431 c R -Expand current region and change it. -@end table - -@node Repeating and Undoing Modifications -@subsection Repeating and Undoing Modifications - -VIP records the previous modifying command, so that it is easy to repeat -it. It is also very easy to undo changes made by modifying commands. - -@table @kbd -@item u -@kindex 165 u @r{(}@code{vip-undo}@r{)} -Undo the last change. You can undo more by repeating undo by the repeat -command @samp{.}. For example, you can undo 5 previous changes by typing -@samp{u....}. If you type @samp{uu}, then the second @samp{u} undoes the -first undo command (@code{vip-undo}). -@item . -@kindex 056 . @r{(}@code{vip-repeat}@r{)} -Repeat the last modifying command. Given count @var{n} it becomes the new -count for the repeated command. Otherwise, the count for the last -modifying command is used again (@code{vip-repeat}). -@end table - -@node Other Vi Commands -@section Other Vi Commands - -Miscellaneous Vi commands are collected here. - -@table @kbd -@item Z Z -@kindex 132 Z Z @r{(}@code{save-buffers-kill-emacs}@r{)} -Exit Emacs. If modified buffers exist, you will be asked whether you wish -to save them or not (@code{save-buffers-kill-emacs}). -@item !@: @var{motion-command} @var{format-command} -@itemx @var{n} !@: !@: @var{format-command} -@kindex 041 ! @r{(}@code{vip-command-argument}@r{)} -The region determined by the motion command @var{motion-command} will be -given to the shell command @var{format-command} and the region will be -replaced by its output. If a count is given, it will be passed to -@var{motion-command}. For example, @samp{3!Gsort} will sort the region -between point and the 3rd line. If @kbd{!} is used instead of -@var{motion-command} then @var{n} lines will be processed by -@var{format-command} (@code{vip-command-argument}). -@item J -@kindex 112 J @r{(}@code{vip-join-lines}@r{)} -Join two lines. Given count, join that many lines. A space will be -inserted at each junction (@code{vip-join-lines}). -@item < @var{motion-command} -@itemx @var{n} < < -@kindex 074 < @r{(}@code{vip-command-argument}@r{)} -Shift region determined by the motion command @var{motion-command} to -left by @var{shift-width} (default is 8). If @kbd{<} is used instead of -@var{motion-command} then shift @var{n} lines -@*(@code{vip-command-argument}). -@item > @var{motion-command} -@itemx @var{n} > > -@kindex 076 > @r{(}@code{vip-command-argument}@r{)} -Shift region determined by the motion command @var{motion-command} to -right by @var{shift-width} (default is 8). If @kbd{<} is used instead of -@var{motion-command} then shift @var{n} lines -@*(@code{vip-command-argument}). -@item = @var{motion-command} -@kindex 075 = @r{(}@code{vip-command-argument}@r{)} -Indent region determined by the motion command @var{motion-command}. If -@kbd{=} is used instead of @var{motion-command} then indent @var{n} lines -(@code{vip-command-argument}). -@item * -@kindex 052 * @r{(}@code{vip-call-last-kbd-macro}@r{)} -Call last remembered keyboard macro. -@item # -A new vi operator. @xref{New Commands}, for more details. -@end table - -The following keys are reserved for future extensions, and currently -assigned to a function that just beeps (@code{vip-nil}). - -@kindex 046 & @r{(}@code{vip-nil}@r{)} -@kindex 100 @@ @r{(}@code{vip-nil}@r{)} -@kindex 125 U @r{(}@code{vip-nil}@r{)} -@kindex 133 [ @r{(}@code{vip-nil}@r{)} -@kindex 135 ] @r{(}@code{vip-nil}@r{)} -@kindex 137 _ @r{(}@code{vip-nil}@r{)} -@kindex 161 q @r{(}@code{vip-nil}@r{)} -@kindex 176 ~ @r{(}@code{vip-nil}@r{)} - -@example -&, @@, U, [, ], _, q, ~ -@end example - -VIP uses a special local keymap to interpret key strokes you enter in vi -mode. The following keys are bound to @code{nil} in the keymap. Therefore, -these keys are interpreted by the global keymap of Emacs. We give below a -short description of the functions bound to these keys in the global -keymap. See GNU Emacs Manual for details. - -@table @kbd -@item C-@@ -@kindex 000 C-@@ @r{(}@code{set-mark-command}@r{)} -Set mark and push previous mark on mark ring (@code{set-mark-command}). -@item @key{TAB} -@kindex 011 TAB @r{(}@code{indent-for-tab-command}@r{)} -Indent line for current major mode (@code{indent-for-tab-command}). -@item C-j -@kindex 012 C-j @r{(}@code{electric-newline-and-maybe-indent}@r{)} -Insert a newline, and maybe indent according to mode. -@item C-k -@kindex 013 C-k @r{(}@code{kill-line}@r{)} -Kill the rest of the current line; before a newline, kill the newline. -With a numeric argument, kill that many lines from point. Negative arguments -kill lines backward (@code{kill-line}). -@item C-l -@kindex 014 C-l @r{(}@code{recenter}@r{)} -Clear the screen and reprint everything (@code{recenter}). -@item @var{n} C-p -@kindex 020 C-p @r{(}@code{previous-line}@r{)} -Move cursor vertically up @var{n} lines (@code{previous-line}). -@item C-q -@kindex 021 C-q @r{(}@code{quoted-insert}@r{)} -Read next input character and insert it. Useful for inserting control -characters -@*(@code{quoted-insert}). -@item C-r -@kindex 022 C-r @r{(}@code{isearch-backward}@r{)} -Search backward incrementally (@code{isearch-backward}). -@item C-s -@kindex 023 C-s @r{(}@code{isearch-forward}@r{)} -Search forward incrementally (@code{isearch-forward}). -@item @var{n} C-t -@kindex 024 C-t @r{(}@code{transpose-chars}@r{)} -Interchange characters around point, moving forward one character. With -count @var{n}, take character before point and drag it forward past @var{n} -other characters. If no argument and at end of line, the previous two -characters are exchanged (@code{transpose-chars}). -@item @var{n} C-v -@kindex 026 C-v @r{(}@code{scroll-up}@r{)} -Scroll text upward @var{n} lines. If @var{n} is not given, scroll near -full screen (@code{scroll-up}). -@item C-w -@kindex 027 C-w @r{(}@code{kill-region}@r{)} -Kill between point and mark. The text is save in the kill ring. The -command @kbd{P} or @kbd{p} can retrieve it from kill ring -(@code{kill-region}). -@end table - -@node Commands in Insert Mode -@section Insert Mode - -You can enter insert mode by one of the following commands. In addition to -these, you will enter insert mode if you give a change command with a line -command as the motion command. Insert commands are also modifying commands -and you can repeat them by the repeat command @kbd{.} (@code{vip-repeat}). - -@table @kbd -@item i -@kindex 151 i @r{(}@code{vip-insert}@r{)} -Enter insert mode at point (@code{vip-insert}). -@item I -@kindex 111 I @r{(}@code{vip-Insert}@r{)} -Enter insert mode at the first non white character on the line -(@code{vip-Insert}). -@item a -@kindex 141 a @r{(}@code{vip-append}@r{)} -Move point forward by one character and then enter insert mode -(@code{vip-append}). -@item A -@kindex 101 A @r{(}@code{vip-Append}@r{)} -Enter insert mode at end of line (@code{vip-Append}). -@item o -@kindex 157 o @r{(}@code{vip-open-line}@r{)} -Open a new line below the current line and enter insert mode -(@code{vip-open-line}). -@item O -@kindex 117 O @r{(}@code{vip-Open-line}@r{)} -Open a new line above the current line and enter insert mode -(@code{vip-Open-line}). -@item C-o -@kindex 017 C-o @r{(}@code{vip-open-line-at-point}@r{)} -Insert a newline and leave point before it, and then enter insert mode -@*(@code{vip-open-line-at-point}). -@end table - -Insert mode is almost like emacs mode. Only the following 4 keys behave -differently from emacs mode. - -@table @kbd -@item @key{ESC} -@kindex 033 ESC @r{(}@code{vip-change-mode-to-vi}@r{) (insert mode)} -This key will take you back to vi mode (@code{vip-change-mode-to-vi}). -@item C-h -@kindex 010 C-h @r{(}@code{delete-backward-char}@r{) (insert mode)} -Delete previous character (@code{delete-backward-char}). -@item C-w -@kindex 027 C-w @r{(}@code{vip-delete-backward-word}@r{) (insert mode)} -Delete previous word (@code{vip-delete-backward-word}). -@item C-z -@kindex 032 C-z @r{(}@code{vip-ESC}@r{) (insert mode)} -This key simulates @key{ESC} key in emacs mode. For instance, typing -@kbd{C-z x} in insert mode is the same as typing @kbd{ESC x} in emacs mode -(@code{vip-ESC}). -@end table -@noindent -You can also bind @kbd{C-h} to @code{help-command} if you like. -(@xref{Customizing Key Bindings}, for details.) Binding @kbd{C-h} to -@code{help-command} has the effect of making the meaning of @kbd{C-h} -uniform among emacs, vi and insert modes. - -When you enter insert mode, VIP records point as the start point of -insertion, and when you leave insert mode the region between point and -start point is saved for later use by repeat command etc. Therefore, repeat -command will not really repeat insertion if you move point by emacs -commands while in insert mode. - -@node Ex Commands -@chapter Ex Commands - -@kindex 072 : @r{(}@code{vip-ex}@r{)} - -In vi mode, you can execute an Ex command @var{ex-command} by typing: -@example -@kbd{:@: @var{ex-command} @key{RET}} -@end example -Every Ex command follows the following pattern: -@example -@var{address command} @kbd{!}@: @var{parameters count flags} -@end example -@noindent -@cindex address -where all parts are optional. For the syntax of @dfn{address}, the reader -is referred to the reference manual of Ex. - -@cindex magic -@cindex regular expression - -In the current version of VIP, searching by Ex commands is always -@dfn{magic}. That is, search patterns are always treated as @dfn{regular -expressions}. For example, a typical forward search would be invoked by -@kbd{:/@var{pat}/}. If you wish to include @samp{/} as part of -@var{pat} you must preceded it by @samp{\}. VIP strips off these @kbd{\}'s -before @kbd{/} and the resulting @var{pat} becomes the actual search -pattern. Emacs provides a different and richer class or regular -expressions than Vi/Ex, and VIP uses Emacs's regular expressions. See GNU -Emacs Manual for details of regular expressions. - -Several Ex commands can be entered in a line by separating them by a pipe -character @samp{|}. - -@menu -* Ex Command Reference:: Explain all the Ex commands available in VIP. -@end menu -@node Ex Command Reference -@section Ex Command Reference -In this section we briefly explain all the Ex commands supported by VIP@. -Most Ex commands expect @var{address} as their argument, and they use -default addresses if they are not explicitly given. In the following, such -default addresses will be shown in parentheses. - -Most command names can and preferably be given in abbreviated forms. In -the following, optional parts of command names will be enclosed in -brackets. For example, @samp{co[py]} will mean that copy command can be -give as @samp{co} or @samp{cop} or @samp{copy}. - -If @var{command} is empty, point will move to the beginning of the line -specified by the @var{address}. If @var{address} is also empty, point will -move to the beginning of the current line. - -@cindex flag - -Some commands accept @dfn{flags} which are one of @kbd{p}, @kbd{l} and -@kbd{#}. If @var{flags} are given, the text affected by the commands will -be displayed on a temporary window, and you will be asked to hit return to -continue. In this way, you can see the text affected by the commands -before the commands will be executed. If you hit @kbd{C-g} instead of -@key{RET} then the commands will be aborted. Note that the meaning of -@var{flags} is different in VIP from that in Vi/Ex. - -@table @kbd -@item (.,.@:) co[py] @var{addr} @var{flags} -@itemx (.,.@:) t @var{addr} @var{flags} -Place a copy of specified lines after @var{addr}. If @var{addr} is -@kbd{0}, it will be placed before the first line. -@item (.,.@:) d[elete] @var{register} @var{count} @var{flags} -Delete specified lines. Text will be saved in a named @var{register} if a -lower-case letter is given, and appended to a register if a capital letter is -given. -@item e[dit] !@: +@var{addr} @var{file} -@itemx e[x] !@: +@var{addr} @var{file} -@itemx vi[sual] !@: +@var{addr} @var{file} -Edit a new file @var{file} in the current window. The command will abort -if current buffer is modified, which you can override by giving @kbd{!}. -If @kbd{+}@var{addr} is given, @var{addr} becomes the current line. -@item file -Give information about the current file. -@item (1,$) g[lobal] !@: /@var{pat}/ @var{cmds} -@itemx (1,$) v /@var{pat}/ @var{cmds} -Among specified lines first mark each line which matches the regular -expression @var{pat}, and then execute @var{cmds} on each marked line. -If @kbd{!}@: is given, @var{cmds} will be executed on each line not matching -@var{pat}. @kbd{v} is same as @kbd{g!}. -@item (.,.+1) j[oin] !@: @var{count} @var{flags} -Join specified lines into a line. Without @kbd{!}, a space character will -be inserted at each junction. -@item (.@:) k @var{ch} -@itemx (.@:) mar[k] @var{ch} -Mark specified line by a lower-case character @var{ch}. Then the -addressing form @kbd{'}@var{ch} will refer to this line. No white space is -required between @kbd{k} and @var{ch}. A white space is necessary between -@kbd{mark} and @var{ch}, however. -@item map @var{ch} @var{rhs} -Define a macro for vi mode. After this command, the character @var{ch} -will be expanded to @var{rhs} in vi mode. -@item (.,.@:) m[ove] @var{addr} -Move specified lines after @var{addr}. -@item (.@:) pu[t] @var{register} -Put back previously deleted or yanked text. If @var{register} is given, -the text saved in the register will be put back; otherwise, last deleted or -yanked text will be put back. -@item q[uit] ! -Quit from Emacs. If modified buffers with associated files exist, you will -be asked whether you wish to save each of them. At this point, you may -choose not to quit, by hitting @kbd{C-g}. If @kbd{!}@: is given, exit from -Emacs without saving modified buffers. -@item (.@:) r[ead] @var{file} -Read in the content of the file @var{file} after the specified line. -@item (.@:) r[ead] !@: @var{command} -Read in the output of the shell command @var{command} after the specified -line. -@item se[t] -Set a variable's value. @xref{Customizing Constants}, for the list of variables -you can set. -@item sh[ell] -Run a subshell in a window. -@item (.,.@:) s[ubstitute] /@var{pat}/@var{repl}/ @var{options} @var{count} @var{flags} -@itemx (.,.@:) & @var{options} @var{count} @var{flags} -On each specified line, the first occurrence of string matching regular -expression @var{pat} is replaced by replacement pattern @var{repl}. Option -characters are @kbd{g} and @kbd{c}. If global option character @kbd{g} -appears as part of @var{options}, all occurrences are substituted. If -confirm option character @kbd{c} appears, you will be asked to give -confirmation before each substitution. If @kbd{/@var{pat}/@var{repl}/} is -missing, the last substitution is repeated. -@item st[op] -Suspend Emacs. -@item ta[g] @var{tag} -@cindex tag -@cindex selected tags table -Find first definition of @var{tag}. If no @var{tag} is given, previously -given @var{tag} is used and next alternate definition is find. By default, -the file @file{TAGS} in the current directory becomes the @dfn{selected tags -table}. You can select another tags table by @kbd{set} command. -@xref{Customizing Constants}, for details. -@item und[o] -Undo the last change. -@item unm[ap] @var{ch} -The macro expansion associated with @var{ch} is removed. -@item ve[rsion] -Tell the version number of VIP. -@item (1,$) w[rite] !@: @var{file} -Write out specified lines into file @var{file}. If no @var{file} is given, -text will be written to the file associated to the current buffer. Unless -@kbd{!}@: is given, if @var{file} is different from the file associated to -the current buffer and if the file @var{file} exists, the command will not -be executed. Unlike Ex, @var{file} becomes the file associated to the -current buffer. -@item (1,$) w[rite]>> @var{file} -Write out specified lines at the end of file @var{file}. @var{file} -becomes the file associated to the current buffer. -@item (1,$) wq !@: @var{file} -Same as @kbd{write} and then @kbd{quit}. If @kbd{!}@: is given, same as -@kbd{write !}@: then @kbd{quit}. -@item (.,.) y[ank] @var{register} @var{count} -Save specified lines into register @var{register}. If no register is -specified, text will be saved in an anonymous register. -@item @var{addr} !@: @var{command} -Execute shell command @var{command}. The output will be shown in a new -window. If @var{addr} is given, specified lines will be used as standard -input to @var{command}. -@item ($) = -Print the line number of the addressed line. -@item (.,.) > @var{count} @var{flags} -Shift specified lines to the right. The variable @code{vip-shift-width} -(default value is 8) determines the amount of shift. -@item (.,.) < @var{count} @var{flags} -Shift specified lines to the left. The variable @code{vip-shift-width} -(default value is 8) determines the amount of shift. -@item (.,.@:) ~ @var{options} @var{count} @var{flags} -Repeat the previous @kbd{substitute} command using previous search pattern -as @var{pat} for matching. -@end table - -The following Ex commands are available in Vi, but not implemented in VIP. -@example -@kbd{abbreviate}, @kbd{list}, @kbd{next}, @kbd{print}, @kbd{preserve}, @kbd{recover}, @kbd{rewind}, @kbd{source}, -@kbd{unabbreviate}, @kbd{xit}, @kbd{z} -@end example - -@node Customization -@chapter Customization - -If you have a file called @file{~/.emacs.d/vip} (or @file{~/.vip}), then it -will also be loaded when VIP is loaded. This file is thus useful for -customizing VIP. - -@menu -* Customizing Constants:: How to change values of constants. -* Customizing Key Bindings:: How to change key bindings. -@end menu - -@node Customizing Constants -@section Customizing Constants -An easy way to customize VIP is to change the values of constants used -in VIP@. Here is the list of the constants used in VIP and their default -values. - -@table @code -@item vip-shift-width 8 -The number of columns shifted by @kbd{>} and @kbd{<} command. -@item vip-re-replace nil -If @code{t} then do regexp replace, if @code{nil} then do string replace. -@item vip-search-wrap-around t -If @code{t}, search wraps around the buffer. -@item vip-re-search nil -If @code{t} then search is reg-exp search, if @code{nil} then vanilla -search. -@item vip-case-fold-search nil -If @code{t} search ignores cases. -@item vip-re-query-replace nil -If @code{t} then do reg-exp replace in query replace. -@item vip-open-with-indent nil -If @code{t} then indent to the previous current line when open a new line -by @kbd{o} or @kbd{O} command. -@item vip-tags-file-name "TAGS" -The name of the file used as the tags table. -@item vip-help-in-insert-mode nil -If @code{t} then @kbd{C-h} is bound to @code{help-command} in insert mode, -if @code{nil} then it sis bound to @code{delete-backward-char}. -@end table -@noindent -You can reset these constants in VIP by the Ex command @kbd{set}. Or you -can include a line like this in your @file{~/.emacs.d/vip} file: -@example -(setq vip-case-fold-search t) -@end example - -@node Customizing Key Bindings -@section Customizing Key Bindings - -@cindex local keymap - -VIP uses @code{vip-command-mode-map} as the @dfn{local keymap} for vi mode. -For example, in vi mode, @key{SPC} is bound to the function -@code{vip-scroll}. But, if you wish to make @key{SPC} and some other keys - behave like Vi, you can include the following lines in your -@file{~/.emacs.d/vip} file. - -@example -(define-key vip-command-mode-map "\C-g" 'vip-info-on-file) -(define-key vip-command-mode-map "\C-h" 'vip-backward-char) -(define-key vip-command-mode-map "\C-m" 'vip-next-line-at-bol) -(define-key vip-command-mode-map " " 'vip-forward-char) -(define-key vip-command-mode-map "g" 'vip-keyboard-quit) -(define-key vip-command-mode-map "s" 'vip-substitute) -(define-key vip-command-mode-map "C" 'vip-change-to-eol) -(define-key vip-command-mode-map "R" 'vip-change-to-eol) -(define-key vip-command-mode-map "S" 'vip-substitute-line) -(define-key vip-command-mode-map "X" 'vip-delete-backward-char) -@end example - -@node GNU Free Documentation License -@appendix GNU Free Documentation License -@include doclicense.texi - - -@unnumbered Key Index - -@printindex ky - -@unnumbered Concept Index -@printindex cp - -@bye diff --git a/etc/NEWS b/etc/NEWS index c8a1e75d68f..37568ffdbea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -478,6 +478,10 @@ All the characters that belong to the 'symbol' script (according to 'char-script-table') now have the 'symbol' category, whose mnemonic is '5'. +** Some libraries obsolete since Emacs 24.4 and 24.5 have been removed: +cc-compat.el, info-edit.el, meese.el, otodo-mode.el, rcompile.el, +sup-mouse.el, terminal.el, vi.el, vip.el, ws-mode.el, and yow.el. + * Lisp Changes in Emacs 31.1 diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index c80c55a60cf..ee85e5f3235 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -29,7 +29,6 @@ PDF_ENGLISH = \ orgcard.pdf \ refcard.pdf \ survival.pdf \ - vipcard.pdf \ viperCard.pdf PDF_CZECH = \ @@ -296,12 +295,6 @@ survival.pdf: $(survival_deps) survival.dvi: $(survival_deps) $(ENVADD) tex survival.tex -vipcard_deps = vipcard.tex emacsver.tex pdflayout.sty -vipcard.pdf: $(vipcard_deps) - $(ENVADD) pdftex vipcard.tex -vipcard.dvi: $(vipcard_deps) - $(ENVADD) tex vipcard.tex - vipercard_deps = viperCard.tex emacsver.tex pdflayout.sty viperCard.pdf: $(vipercard_deps) $(ENVADD) pdftex viperCard.tex diff --git a/etc/refcards/README b/etc/refcards/README index 9521c9e0c2a..835aae4317f 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -32,7 +32,6 @@ List of generated cards: orgcard.pdf Org-Mode Reference Card refcard.pdf Emacs Reference Card survival.pdf Emacs Survival Card - vipcard.pdf VIP Quick Reference Card viperCard.pdf ViperCard: Viper Reference Pal Brazilian Portuguese diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex deleted file mode 100644 index 7e5e0bdcb74..00000000000 --- a/etc/refcards/vipcard.tex +++ /dev/null @@ -1,681 +0,0 @@ -% Quick Reference Card for VIP - -% Copyright (C) 1987, 2001--2024 Free Software Foundation, Inc. - -% Author: Masahiko Sato , - -% This document is free software: you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation, either version 3 of the License, or -% (at your option) any later version. - -% As a special additional permission, you may distribute reference cards -% printed, or formatted for printing, with the notice "Released under -% the terms of the GNU General Public License version 3 or later" -% instead of the usual distributed-under-the-GNU-GPL notice, and without -% a copy of the GPL itself. - -% This document is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. - -% You should have received a copy of the GNU General Public License -% along with GNU Emacs. If not, see . - - -% This file is intended to be processed by plain TeX (TeX82). -% -% The final reference card has six columns, three on each side. -% This file can be used to produce it in any of three ways: -% 1 column per page -% produces six separate pages, each of which needs to be reduced to 80%. -% This gives the best resolution. -% 2 columns per page -% produces three already-reduced pages. -% You will still need to cut and paste. -% 3 columns per page -% produces two pages which must be printed sideways to make a -% ready-to-use 8.5 x 11 inch reference card. -% For this you need a dvi device driver that can print sideways. -% Which mode to use is controlled by setting \columnsperpage. - - -%**start of header -\newcount\columnsperpage - -% This file can be printed with 1, 2, or 3 columns per page. -% Specify how many you want here. -\columnsperpage=1 - -% PDF output layout. 0 for A4, 1 for letter (US), a `l' is added for -% a landscape layout. -\input pdflayout.sty -\pdflayout=(1) - -\input emacsver.tex -\def\versionemacs{18} % version of Emacs this is for -\def\versionvip{3.5} - -% Nothing else needs to be changed. - -\def\shortcopyrightnotice{\vskip 1ex plus 2 fill - \centerline{\small \copyright\ \year\ Free Software Foundation, Inc. - Permissions on back.}} - -\def\copyrightnotice{ -%\vskip 1ex plus 2 fill\begingroup\small -\vskip 1ex \begingroup\small -\centerline{Copyright \copyright\ \year\ Free Software Foundation, Inc.} -\centerline{For VIP \versionvip\ with GNU Emacs version \versionemacs} -\centerline{Written by Masahiko Sato,} -\centerline{using refcard layout designed by Stephen Gildea.} - -Released under the terms of the GNU General Public License version 3 or later. - -For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} -\endgroup} - -% make \bye not \outer so that the \def\bye in the \else clause below -% can be scanned without complaint. -\def\bye{\par\vfill\supereject\end} - -\newdimen\intercolumnskip -\newbox\columna -\newbox\columnb - -\def\ncolumns{\the\columnsperpage} - -\message{[\ncolumns\space - column\if 1\ncolumns\else s\fi\space per page]} - -\def\scaledmag#1{ scaled \magstep #1} - -% This multi-way format was designed by Stephen Gildea -% October 1986. -% Slightly modified by Masahiko Sato, September 1987. -\if 1\ncolumns - \hsize 4in - \vsize 10in - %\voffset -.7in - \voffset -.57in - \font\titlefont=\fontname\tenbf \scaledmag3 - \font\headingfont=\fontname\tenbf \scaledmag2 - \font\miniheadingfont=\fontname\tenbf \scaledmag1 % masahiko - \font\smallfont=\fontname\sevenrm - \font\smallsy=\fontname\sevensy - - \footline{\hss\folio} - \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} -\else - %\hsize 3.2in - %\vsize 7.95in - \hsize 3.41in % masahiko - \vsize 8in % masahiko - \hoffset -.75in - \voffset -.745in - \font\titlefont=cmbx10 \scaledmag2 - \font\headingfont=cmbx10 \scaledmag1 - \font\miniheadingfont=cmbx10 % masahiko - \font\smallfont=cmr6 - \font\smallsy=cmsy6 - \font\eightrm=cmr8 - \font\eightbf=cmbx8 - \font\eightit=cmti8 - \font\eightsl=cmsl8 - \font\eighttt=cmtt8 - \font\eightsy=cmsy8 - \textfont0=\eightrm - \textfont2=\eightsy - \def\rm{\eightrm} - \def\bf{\eightbf} - \def\it{\eightit} - \def\sl{\eightsl} % masahiko - \def\tt{\eighttt} - \normalbaselineskip=.8\normalbaselineskip - \normallineskip=.8\normallineskip - \normallineskiplimit=.8\normallineskiplimit - \normalbaselines\rm %make definitions take effect - - \if 2\ncolumns - \let\maxcolumn=b - \footline{\hss\rm\folio\hss} - \def\makefootline{\vskip 2in \hsize=6.86in\line{\the\footline}} - \else \if 3\ncolumns - \let\maxcolumn=c - \nopagenumbers - \else - \errhelp{You must set \columnsperpage equal to 1, 2, or 3.} - \errmessage{Illegal number of columns per page} - \fi\fi - - %\intercolumnskip=.46in - \intercolumnskip=.19in % masahiko .19x4 + 3.41x3 = 10.99 - \def\abc{a} - \output={% - % This next line is useful when designing the layout. - %\immediate\write16{Column \folio\abc\space starts with \firstmark} - \if \maxcolumn\abc \multicolumnformat \global\def\abc{a} - \else\if a\abc - \global\setbox\columna\columnbox \global\def\abc{b} - %% in case we never use \columnb (two-column mode) - \global\setbox\columnb\hbox to -\intercolumnskip{} - \else - \global\setbox\columnb\columnbox \global\def\abc{c}\fi\fi} - \def\multicolumnformat{\shipout\vbox{\makeheadline - \hbox{\box\columna\hskip\intercolumnskip - \box\columnb\hskip\intercolumnskip\columnbox} - \makefootline}\advancepageno} - \def\columnbox{\leftline{\pagebody}} - - \def\bye{\par\vfill\supereject - \if a\abc \else\null\vfill\eject\fi - \if a\abc \else\null\vfill\eject\fi - \end} -\fi - -% we won't be using math mode much, so redefine some of the characters -% we might want to talk about -\catcode`\^=12 -\catcode`\_=12 - -\chardef\\=`\\ -\chardef\{=`\{ -\chardef\}=`\} - -\hyphenation{mini-buf-fer} - -\parindent 0pt -\parskip 1ex plus .5ex minus .5ex - -\def\small{\smallfont\textfont2=\smallsy\baselineskip=.8\baselineskip} - -\outer\def\newcolumn{\vfill\eject} - -\outer\def\title#1{{\titlefont\centerline{#1}}\vskip 1ex plus .5ex} - -\outer\def\section#1{\par\filbreak - \vskip 3ex plus 2ex minus 2ex {\headingfont #1}\mark{#1}% - \vskip 2ex plus 1ex minus 1.5ex} - -% masahiko -\outer\def\subsection#1{\par\filbreak - \vskip 2ex plus 2ex minus 2ex {\miniheadingfont #1}\mark{#1}% - \vskip 1ex plus 1ex minus 1.5ex} - -\newdimen\keyindent - -\def\beginindentedkeys{\keyindent=1em} -\def\endindentedkeys{\keyindent=0em} -\endindentedkeys - -\def\paralign{\vskip\parskip\halign} - -\def\<#1>{$\langle${\rm #1}$\rangle$} - -\def\kbd#1{{\tt#1}\null} %\null so not an abbrev even if period follows - -\def\beginexample{\par\leavevmode\begingroup - \obeylines\obeyspaces\parskip0pt\tt} -{\obeyspaces\global\let =\ } -\def\endexample{\endgroup} - -\def\key#1#2{\leavevmode\hbox to \hsize{\vtop - {\hsize=.75\hsize\rightskip=1em - \hskip\keyindent\relax#1}\kbd{#2}\hfil}} - -\newbox\metaxbox -\setbox\metaxbox\hbox{\kbd{M-x }} -\newdimen\metaxwidth -\metaxwidth=\wd\metaxbox - -\def\metax#1#2{\leavevmode\hbox to \hsize{\hbox to .75\hsize - {\hskip\keyindent\relax#1\hfil}% - \hskip -\metaxwidth minus 1fil - \kbd{#2}\hfil}} - -\def\fivecol#1#2#3#4#5{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad - &\kbd{#3}\quad&\kbd{#4}\quad&\kbd{#5}\cr} - -\def\fourcol#1#2#3#4{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad - &\kbd{#3}\quad&\kbd{#4}\quad\cr} - -\def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad - &\kbd{#3}\quad\cr} - -\def\twocol#1#2{\hskip\keyindent\relax\kbd{#1}\hfil&\kbd{#2}\quad\cr} - -\def\twocolkey#1#2#3#4{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad&\relax#3\hfil&\kbd{#4}\quad\cr} - -%**end of header - -\beginindentedkeys - -\title{VIP Quick Reference Card} - -\centerline{(Based on VIP \versionvip\ in GNU Emacs \versionemacs)} - -%\copyrightnotice - -\section{Loading VIP} - -Just type \kbd{M-x vip-mode} followed by \kbd{RET} - -\section{VIP Modes} - -VIP has three modes: {\it emacs mode}, {\it vi mode} and {\it insert mode}. -Mode line tells you which mode you are in. -In emacs mode you can do all the normal GNU Emacs editing. -This card explains only vi mode and insert mode. -{\bf GNU Emacs Reference Card} explains emacs mode. -You can switch modes as follows. - -\key{from emacs mode to vi mode}{C-z} -\key{from vi mode to emacs mode}{C-z} -\metax{from vi mode to insert mode}{i, I, a, A, o, O {\rm or} C-o} -\key{from insert mode to vi mode}{ESC} - -If you wish to be in vi mode just after you startup Emacs, -include the line: - -\hskip 5ex -\kbd{(add-hook 'emacs-startup-hook 'vip-mode)} - -in your \kbd{.emacs} file. -Or, you can put the following alias in your \kbd{.cshrc} file. - -\hskip 5ex -\kbd{alias vip 'emacs \\!* -f vip-mode'} - - -\section{Insert Mode} -Insert mode is like emacs mode except for the following. - -\key{go back to vi mode}{ESC} -\key{delete previous character}{C-h} -\key{delete previous word}{C-w} -\key{emulate \kbd{ESC} key in emacs mode}{C-z} - -The rest of this card explains commands in {\bf vi mode}. - -\section{Getting Information on VIP} - -Execute info command by typing \kbd{M-x info} and select menu item -\kbd{vip}. Also: - -\key{describe function attached to the key {\it x}}{C-h k {\it x}} - -\section{Leaving Emacs} - -\key{suspend Emacs}{X Z {\rm or} :st} -\metax{exit Emacs permanently}{Z Z {\rm or} X C {\rm or} :q} - -\section{Error Recovery} - -\key{abort partially typed or executing command}{C-g} -\key{redraw messed up screen}{C-l} -\metax{{\bf recover} a file lost by a system crash}{M-x recover-file} -\metax{restore a buffer to its original contents}{M-x revert-buffer} - -\shortcopyrightnotice - -\section{Counts} - -Most commands in vi mode accept a {\it count} which can be supplied as a -prefix to the commands. In most cases, if a count is given, the -command is executed that many times. E.g., \kbd{5 d d} deletes 5 -lines. - -%\shortcopyrightnotice -\section{Registers} - -There are 26 registers (\kbd{a} to \kbd{z}) that can store texts -and marks. -You can append a text at the end of a register (say \kbd{x}) by -specifying the register name in capital letter (say \kbd{X}). -There are also 9 read only registers (\kbd{1} to \kbd{9}) that store -up to 9 previous changes. -We will use {\it x\/} to denote a register. -\section{Entering Insert Mode} - -\key{{\bf insert} at point}{i} -\key{{\bf append} after cursor}{a} -\key{{\bf insert} before first non-white}{I} -\key{{\bf append} at end of line}{A} -\key{{\bf open} line below}{o} -\key{{\bf open} line above}{O} -\key{{\bf open} line at point}{C-o} - -\section{Buffers and Windows} - -\key{move cursor to {\bf next} window}{C-n} -\key{delete current window}{X 0} -\key{delete other windows}{X 1} -\key{split current window into two windows}{X 2} -\key{show current buffer in two windows}{X 3} -\key{{\bf switch} to a buffer in the current window}{s {\sl buffer}} -\key{{\bf switch} to a buffer in another window}{S {\sl buffer}} -\key{{\bf kill} a buffer}{K} -\key{list existing {\bf buffers}}{X B} - -\section{Files} - -\metax{{\bf visit} file in the current window}{v {\sl file} {\rm or} :e {\sl file}} -\key{{\bf visit} file in another window}{V {\sl file}} -\key{{\bf save} buffer to the associated file}{X S} -\key{{\bf write} buffer to a specified file}{X W} -\key{{\bf insert} a specified file at point}{X I} -\key{{\bf get} information on the current {\bf file}}{g {\rm or} :f} -\key{run the {\bf directory} editor}{X d} - -\section{Viewing the Buffer} - -\key{scroll to next screen}{SPC {\rm or} C-f} -\key{scroll to previous screen}{RET {\rm or} C-b} -\key{scroll {\bf down} half screen}{C-d} -\key{scroll {\bf up} half screen}{C-u} -\key{scroll down one line}{C-e} -\key{scroll up one line}{C-y} - -\key{put current line on the {\bf home} line}{z H {\rm or} z RET} -\key{put current line on the {\bf middle} line}{z M {\rm or} z .} -\key{put current line on the {\bf last} line}{z L {\rm or} z -} - -\section{Marking and Returning} - -\key{{\bf mark} point in register {\it x}}{m {\it x}} -\key{set mark at buffer beginning}{m <} -\key{set mark at buffer end}{m >} -\key{set mark at point}{m .} -\key{jump to mark}{m ,} -\key{exchange point and mark}{` `} -\key{... and skip to first non-white on line}{' '} -\key{go to mark {\it x}}{` {\it x}} -\key{... and skip to first non-white on line}{' {\it x}} - -\section{Macros} - -\key{start remembering keyboard macro}{X (} -\key{finish remembering keyboard macro}{X )} -\key{call last keyboard macro}{*} -\key{execute macro stored in register {\it x}}{@ {\it x}} - -\section{Motion Commands} - -\key{go backward one character}{h} -\key{go forward one character}{l} -\key{next line keeping the column}{j} -\key{previous line keeping the column}{k} -\key{next line at first non-white}{+} -\key{previous line at first non-white}{-} - -\key{beginning of line}{0} -\key{first non-white on line}{^} -\key{end of line}{\$} -\key{go to {\it n}-th column on line}{{\it n} |} - -\key{go to {\it n}-th line}{{\it n} G} -\key{go to last line}{G} -\key{find matching parenthesis for \kbd{()}, \kbd{\{\}} and \kbd{[]}}{\%} - -\key{go to {\bf home} window line}{H} -\key{go to {\bf middle} window line}{M} -\key{go to {\bf last} window line}{L} - -\subsection{Words, Sentences, Paragraphs} - -\key{forward {\bf word}}{w {\rm or} W} -\key{{\bf backward} word}{b {\rm or} B} -\key{{\bf end} of word}{e {\rm or} E} - -In the case of capital letter commands, a word is delimited by a -non-white character. - -\key{forward sentence}{)} -\key{backward sentence}{(} - -\key{forward paragraph}{\}} -\key{backward paragraph}{\{} - -\subsection{Find Characters on the Line} - -\key{{\bf find} {\it c} forward on line}{f {\it c}} -\key{{\bf find} {\it c} backward on line}{F {\it c}} -\key{up {\bf to} {\it c} forward on line}{t {\it c}} -\key{up {\bf to} {\it c} backward on line}{T {\it c}} -\key{repeat previous \kbd{f}, \kbd{F}, \kbd{t} or \kbd{T}}{;} -\key{... in the opposite direction}{,} - -\newcolumn -\title{VIP Quick Reference Card} - -\section{Searching and Replacing} - -\key{search forward for {\sl pat}}{/ {\sl pat}} -\key{search backward for {\sl pat}}{?\ {\sl pat}} -\key{repeat previous search}{n} -\key{... in the opposite direction}{N} - -\key{incremental {\bf search}}{C-s} -\key{{\bf reverse} incremental search}{C-r} - -\key{{\bf replace}}{R} -\key{{\bf query} replace}{Q} -\key{{\bf replace} a character by another character {\it c}}{r {\it c}} - -\section{Modifying Commands} - -The delete (yank, change) commands explained below accept a motion command as -their argument and delete (yank, change) the region determined by the motion -command. Motion commands are classified into {\it point commands} and -{\it line commands}. In the case of line commands, whole lines will -be affected by the command. Motion commands will be represented by -{\it m} below. - -The point commands are as follows: - -\hskip 5ex -\kbd{h l 0 ^ \$ w W b B e E ( ) / ?\ ` f F t T \% ; ,} - -The line commands are as follows: - -\hskip 5ex -\kbd{j k + - H M L \{ \} G '} - -\subsection{Delete/Yank/Change Commands} - -\paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\tabskip=0pt&#\cr -\fourcol{}{{\bf delete}}{{\bf yank}}{{\bf change}} -\fourcol{region determined by {\it m}}{d {\it m}}{y {\it m}}{c {\it m}} -\fourcol{... into register {\it x}}{" {\it x\/} d {\it m}}{" {\it x\/} y {\it m}}{" {\it x\/} c {\it m}} -\fourcol{a line}{d d}{Y {\rm or} y y}{c c} -\fourcol{current {\bf region}}{d r}{y r}{c r} -\fourcol{expanded {\bf region}}{d R}{y R}{c R} -\fourcol{to end of line}{D}{y \$}{c \$} -\fourcol{a character after point}{x}{y l}{c l} -\fourcol{a character before point}{DEL}{y h}{c h} -} - -\subsection{Put Back Commands} - -Deleted/yanked/changed text can be put back by the following commands. - -\key{{\bf Put} back at point/above line}{P} -\key{... from register {\it x}}{" {\it x\/} P} -\key{{\bf put} back after point/below line}{p} -\key{... from register {\it x}}{" {\it x\/} p} - -\subsection{Repeating and Undoing Modifications} - -\key{{\bf undo} last change}{u {\rm or} :und} -\key{repeat last change}{.\ {\rm (dot)}} - -Undo is undoable by \kbd{u} and repeatable by \kbd{.}. -For example, \kbd{u...} will undo 4 previous changes. -A \kbd{.} after \kbd{5dd} is equivalent to \kbd{5dd}, -while \kbd{3.} after \kbd{5dd} is equivalent to \kbd{3dd}. - -\section{Miscellaneous Commands} - -\endindentedkeys - -\paralign to \hsize{#\tabskip=5pt plus 1 fil&#\tabskip=0pt&#\tabskip=0pt&#\tabskip=0pt&#\cr -\fivecol{}{{\bf shift left}}{{\bf shift right}}{{\bf filter shell command}}{{\bf indent}} -\fivecol{region}{< {\it m}}{> {\it m}}{!\ {\it m\/} {\sl shell-com}}{= {\it m}} -\fivecol{line}{< <}{> >}{!\ !\ {\sl shell-com}}{= =} -} - -\key{emulate \kbd{ESC}/\kbd{C-h} in emacs mode}{ESC{\rm /}C-h} -\key{emulate \kbd{C-c}/\kbd{C-x} in emacs mode}{C{\rm /}X} - -\key{{\bf join} lines}{J} - -\key{lowercase region}{\# c {\it m}} -\key{uppercase region}{\# C {\it m}} -\key{execute last keyboard macro on each line in the region}{\# g {\it m}} - -\key{insert specified string for each line in the region}{\# q {\it m}} -\key{check spelling of the words in the region}{\# s {\it m}} - -\section{Differences from Vi} - -\beginindentedkeys - -In VIP some keys behave rather differently from Vi. -The table below lists such keys, and you can get the effect of typing -these keys by typing the corresponding keys in the VIP column. - -\paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr -\threecol{}{{\bf Vi}}{{\bf VIP}} -\threecol{forward character}{SPC}{l} -\threecol{backward character}{C-h}{h} -\threecol{next line at first non-white}{RET}{+} -\threecol{delete previous character}{X}{DEL} -\threecol{get information on file}{C-g}{g} -\threecol{substitute characters}{s}{x i} -\threecol{substitute line}{S}{c c} -\threecol{change to end of line}{C {\rm or} R}{c \$} -} - -(Strictly speaking, \kbd{C} and \kbd{R} behave slightly differently in Vi.) - -\section{Customization} - -By default, search is case sensitive. -You can change this by including the following line in your \kbd{.vip} file. - -\hskip 5ex -\kbd{(setq vip-case-fold-search t)} - -\beginindentedkeys - -\paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr -\twocol{{\bf variable}}{{\bf default value}} -\twocol{vip-search-wrap-around}{t} -\twocol{vip-case-fold-search}{nil} -\twocol{vip-re-search}{nil} -\twocol{vip-re-replace}{nil} -\twocol{vip-re-query-replace}{nil} -\twocol{vip-open-with-indent}{nil} -\twocol{vip-help-in-insert-mode}{nil} -\twocol{vip-shift-width}{8} -\twocol{vip-tags-file-name}{"TAGS"} -} - -%\subsection{Customizing Key Bindings} - -Include (some of) following lines in your \kbd{.vip} file -to restore Vi key bindings. - -\beginexample -(define-key vip-mode-map "\\C-g" 'vip-info-on-file) -(define-key vip-mode-map "\\C-h" 'vip-backward-char) -(define-key vip-mode-map "\\C-m" 'vip-next-line-at-bol) -(define-key vip-mode-map " " 'vip-forward-char) -(define-key vip-mode-map "g" 'vip-keyboard-quit) -(define-key vip-mode-map "s" 'vip-substitute) -(define-key vip-mode-map "C" 'vip-change-to-eol) -(define-key vip-mode-map "R" 'vip-change-to-eol) -(define-key vip-mode-map "S" 'vip-substitute-line) -(define-key vip-mode-map "X" 'vip-delete-backward-char) -\endexample - -\newcolumn - -\title{Ex Commands in VIP} - -In vi mode, an Ex command is entered by typing: - -\hskip 5ex -\kbd{:\ {\sl ex-command} RET} - -\section{Ex Addresses} - -\paralign to \hsize{#\tabskip=5pt plus 1 fil&#\tabskip=2pt&#\tabskip=5pt plus 1 fil&#\cr -\twocolkey{current line}{.}{next line with {\sl pat}}{/ {\sl pat} /} -\twocolkey{line {\it n}}{{\it n}}{previous line with {\sl pat}}{?\ {\sl pat} ?} -\twocolkey{last line}{\$}{{\it n\/} line before {\it a}}{{\it a} - {\it n}} -\twocolkey{next line}{+}{{\it a\/} through {\it b}}{{\it a\/} , {\it b}} -\twocolkey{previous line}{-}{line marked with {\it x}}{' {\it x}} -\twocolkey{entire buffer}{\%}{previous context}{' '} -} - -Addresses can be specified in front of a command. -For example, - -\hskip 5ex -\kbd{:.,.+10m\$} - -moves 11 lines below current line to the end of buffer. - -\section{Ex Commands} - -\endindentedkeys - -\key{mark lines matching {\sl pat} and execute {\sl cmds} on these lines}{:g /{\sl pat}/ {\sl cmds}} - -\key{mark lines {\it not\/} matching {\sl pat} and execute {\sl cmds} on these lines}{:v /{\sl pat}/ {\sl cmds}} - - -\key{{\bf move} specified lines after {\sl addr}}{:m {\sl addr}} -\key{{\bf copy} specified lines after {\sl addr}}{:co\rm\ (or \kbd{:t})\ \sl addr} -\key{{\bf delete} specified lines [into register {\it x\/}]}{:d {\rm [{\it x\/}]}} -\key{{\bf yank} specified lines [into register {\it x\/}]}{:y {\rm [{\it x\/}]}} -\key{{\bf put} back text [from register {\it x\/}]}{:pu {\rm [{\it x\/}]}} - -\key{{\bf substitute} {\sl repl} for first string on line matching {\sl pat}}{:s /{\sl pat}/{\sl repl}/} - -\key{repeat last substitution}{:\&} -\key{repeat previous substitute with previous search pattern as {\sl pat}}{:\~{}} - -\key{{\bf read} in a file}{:r {\sl file}} -\key{{\bf read} in the output of a shell command}{:r!\ {\sl command}} -\key{write out specified lines into {\sl file}}{:w {\sl file}} -\key{write out specified lines at the end of {\sl file}}{:w>> {\sl file}} -\key{write out and then quit}{:wq {\sl file}} - -\key{define a macro {\it x} that expands to {\sl cmd}}{:map {\it x} {\sl cmd}} -\key{remove macro expansion associated with {\it x}}{:unma {\it x}} - -\key{print line number}{:=} -\key{print {\bf version} number of VIP}{:ve} - -\key{shift specified lines to the right}{:>} -\key{shift specified lines to the left}{:<} - -\key{{\bf join} lines}{:j} -\key{mark specified line to register {\it x}}{:k {\it x}} -\key{{\bf set} a variable's value}{:se} -\key{run a sub{\bf shell} in a window}{:sh} -\key{execute shell command {\sl command}}{:!\ {\sl command}} -\key{find first definition of {\bf tag} {\sl tag}}{:ta {\sl tag}} - - -\copyrightnotice - -\bye - -% Local variables: -% compile-command: "pdftex vipcard" -% End: diff --git a/lisp/info.el b/lisp/info.el index e18772436e9..6e386207afe 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -223,7 +223,7 @@ These directories are searched after those in `Info-directory-list'." "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "transient" "url" "use-package" "vhdl-mode" - "vip" "viper" "vtable" "widget" "wisent" "woman") . + "viper" "vtable" "widget" "wisent" "woman") . "https://www.gnu.org/software/emacs/manual/html_node/%m/%e")) "Alist telling `Info-mode' where manuals are accessible online. @@ -4675,7 +4675,7 @@ Advanced commands: (defvar Info-file-list-for-emacs '("ediff" "eudc" "forms" "gnus" "info" ("Info" . "info") ("mh" . "mh-e") - "sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave" + "sc" "message" ("dired" . "dired-x") "viper" "idlwave" ("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode") ("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode") ("skeleton" . "autotype") ("auto-insert" . "autotype") diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el deleted file mode 100644 index b3643f888e4..00000000000 --- a/lisp/obsolete/cc-compat.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion -*- lexical-binding: t; -*- - -;; Copyright (C) 1985, 1987, 1992-2024 Free Software Foundation, Inc. - -;; Authors: 1998- Martin Stjernholm -;; 1994-1999 Barry A. Warsaw -;; Maintainer: bug-cc-mode@gnu.org -;; Created: August 1994, split from cc-mode.el -;; Keywords: c languages -;; Package: cc-mode -;; Obsolete-Since: 24.5 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Boring old c-mode.el (BOCM) is confusion and brain melt. cc-mode.el -;; is clarity of thought and purity of chi. If you are still unwilling -;; to accept enlightenment, this might help, or it may prolong your -;; agony. -;; -;; To use, add the following to your c-mode-hook: -;; -;; (require 'cc-compat) -;; (c-set-style "BOCM") -;; -;; This file is completely unsupported! Although it has been patched -;; superficially to keep pace with the rest of CC Mode, it hasn't been -;; tested for a long time. - -;;; Code: - -(eval-when-compile - (let ((load-path - (if (and (boundp 'byte-compile-dest-file) - (stringp byte-compile-dest-file)) - (cons (file-name-directory byte-compile-dest-file) load-path) - load-path))) - (load "cc-bytecomp" nil t))) - -(cc-require 'cc-defs) -(cc-require 'cc-vars) -(cc-require 'cc-styles) -(cc-require 'cc-engine) - - -;; In case c-mode.el isn't loaded -(defvar c-indent-level 2 - "Indentation of C statements with respect to containing block.") -;;;###autoload(put 'c-indent-level 'safe-local-variable 'integerp) - -(defvar c-brace-imaginary-offset 0 - "Imagined indentation of a C open brace that actually follows a statement.") -(defvar c-brace-offset 0 - "Extra indentation for braces, compared with other text in same context.") -(defvar c-argdecl-indent 5 - "Indentation level of declarations of C function arguments.") -(defvar c-label-offset -2 - "Offset of C label lines and case statements relative to usual indentation.") -(defvar c-continued-statement-offset 2 - "Extra indent for lines not starting new statements.") -(defvar c-continued-brace-offset 0 - "Extra indent for substatements that start with open-braces. -This is in addition to c-continued-statement-offset.") - - - -;; these offsets are taken by brute force testing c-mode.el, since -;; there's no logic to what it does. -(let* ((offsets '((c-offsets-alist . - ((defun-block-intro . cc-block-intro-offset) - (statement-block-intro . cc-block-intro-offset) - (defun-open . 0) - (class-open . 0) - (inline-open . c-brace-offset) - (block-open . c-brace-offset) - (block-close . cc-block-close-offset) - (brace-list-open . c-brace-offset) - (substatement-open . cc-substatement-open-offset) - (substatement . c-continued-statement-offset) - (knr-argdecl-intro . c-argdecl-indent) - (case-label . c-label-offset) - (access-label . c-label-offset) - (label . c-label-offset) - ))))) - (c-add-style "BOCM" offsets)) - - -(defun cc-block-intro-offset (langelem) - ;; taken directly from calculate-c-indent confusion - (save-excursion - (c-backward-syntactic-ws) - (if (eq (char-before) ?{) - (forward-char -1) - (goto-char (cdr langelem))) - (let* ((curcol (save-excursion - (goto-char (cdr langelem)) - (current-column))) - (bocm-lossage - ;; If no previous statement, indent it relative to line - ;; brace is on. For open brace in column zero, don't let - ;; statement start there too. If c-indent-level is zero, - ;; use c-brace-offset + c-continued-statement-offset - ;; instead. For open-braces not the first thing in a line, - ;; add in c-brace-imaginary-offset. - (+ (if (and (bolp) (zerop c-indent-level)) - (+ c-brace-offset c-continued-statement-offset) - c-indent-level) - ;; Move back over whitespace before the openbrace. If - ;; openbrace is not first nonwhite thing on the line, - ;; add the c-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 c-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; possibly a different - ;; line - (progn - (if (eq (char-before) ?\)) - (c-forward-sexp -1)) - ;; Get initial indentation of the line we are on. - (current-indentation))))) - (- bocm-lossage curcol)))) - - -(defun cc-block-close-offset (langelem) - (save-excursion - (let* ((here (point)) - bracep - (curcol (progn - (goto-char (cdr langelem)) - (current-column))) - (bocm-lossage (progn - (goto-char (cdr langelem)) - (if (eq (char-after) ?{) - (setq bracep t) - (goto-char here) - (beginning-of-line) - (backward-up-list 1) - (forward-char 1) - (c-forward-syntactic-ws)) - (current-column)))) - (- bocm-lossage curcol - (if bracep 0 c-indent-level))))) - - -(defun cc-substatement-open-offset (_langelem) - (+ c-continued-statement-offset c-continued-brace-offset)) - - -(cc-provide 'cc-compat) - -;;; cc-compat.el ends here diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el deleted file mode 100644 index fb6de736590..00000000000 --- a/lisp/obsolete/info-edit.el +++ /dev/null @@ -1,89 +0,0 @@ -;;; info-edit.el --- Editing info files -*- lexical-binding:t -*- - -;; Copyright (C) 1985-1986, 1992-2024 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: help -;; Obsolete-since: 24.4 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -(require 'info) - -(defvar Info-edit-mode-hook nil - "Hook run when `Info-edit-mode' is activated.") - -(make-obsolete-variable 'Info-edit-mode-hook - "editing Info nodes by hand is not recommended." "24.4") - -(defvar Info-edit-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map "\C-c\C-c" #'Info-cease-edit) - map) - "Local keymap used within `e' command of Info.") - -(make-obsolete-variable 'Info-edit-mode-map - "editing Info nodes by hand is not recommended." - "24.4") - -;; Info-edit mode is suitable only for specially formatted data. -(put 'Info-edit-mode 'mode-class 'special) - -(define-derived-mode Info-edit-mode text-mode "Info Edit" - "Major mode for editing the contents of an Info node. -Like text mode with the addition of `Info-cease-edit' -which returns to Info mode for browsing." - (setq buffer-read-only nil) - (force-mode-line-update) - (buffer-enable-undo (current-buffer))) - -(defun Info-edit () - "Edit the contents of this Info node." - (interactive) - (Info-edit-mode) - (message "%s" (substitute-command-keys - "Editing: Type \\\\[Info-cease-edit] to return to info"))) - -(put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended. -This feature will be removed in future.") - -(defun Info-cease-edit () - "Finish editing Info node; switch back to Info proper." - (interactive) - ;; Do this first, so nothing has changed if user C-g's at query. - (and (buffer-modified-p) - (y-or-n-p "Save the file? ") - (save-buffer)) - (Info-mode) - (force-mode-line-update) - (and (marker-position Info-tag-table-marker) - (buffer-modified-p) - (message "Tags may have changed. Use Info-tagify if necessary"))) - -(with-eval-after-load 'ibuffer - (defvar ibuffer-help-buffer-modes) - ;; Moved here from definition of ibuffer-help-buffer-modes to make - ;; that variable customizable even though this code is obsolete. See - ;; also Bug#30990. - (add-to-list 'ibuffer-help-buffer-modes 'Info-edit-mode)) - -(provide 'info-edit) - -;;; info-edit.el ends here diff --git a/lisp/obsolete/meese.el b/lisp/obsolete/meese.el deleted file mode 100644 index 7443bacc8b2..00000000000 --- a/lisp/obsolete/meese.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; meese.el --- protect the impressionable young minds of America -*- lexical-binding: t; -*- - -;; This is in the public domain on account of being distributed since -;; 1985 or 1986 without a copyright notice. - -;; This file is part of GNU Emacs. - -;; Maintainer: emacs-devel@gnu.org -;; Keywords: games -;; Obsolete-since: 24.4 - -;;; Commentary: - -;; Adds a hook to protect the impressionable young minds of America -;; from reading certain files in the Emacs distribution using Emacs. - -;; This file is named after Ed Meese, the US Attorney General -;; under President Reagan, because of his support for censorship. - -;;; Code: - -(defun protect-innocence-hook () - (let ((dir (file-name-directory buffer-file-name))) - (if (and (equal buffer-file-name (expand-file-name "sex.6" dir)) - (file-exists-p buffer-file-name) - (not (y-or-n-p "Are you over 18? "))) - (progn - (clear-visited-file-modtime) - (setq buffer-file-name (expand-file-name "celibacy.1" dir)) - (let ((inhibit-read-only t)) ; otherwise (erase-buffer) may bomb. - (erase-buffer) - (insert-file-contents buffer-file-name t)) - (rename-buffer (file-name-nondirectory buffer-file-name)))))) - -;;;(add-hook 'find-file-hook 'protect-innocence-hook) -(provide 'meese) - -;;; meese.el ends here diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el deleted file mode 100644 index deca885b44b..00000000000 --- a/lisp/obsolete/otodo-mode.el +++ /dev/null @@ -1,965 +0,0 @@ -;;; otodo-mode.el --- major mode for editing TODO list files -*- lexical-binding: t; -*- - -;; Copyright (C) 1997, 1999, 2001-2024 Free Software Foundation, Inc. - -;; Author: Oliver Seidel -;; Maintainer: Stephen Berman -;; Created: 2 Aug 1997 -;; Keywords: calendar, todo -;; Obsolete-since: 24.4 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; --------------------------------------------------------------------------- - -;;; Commentary: - -;; Mode Description -;; -;; TODO is a major mode for EMACS which offers functionality to -;; treat most lines in one buffer as a list of items one has to -;; do. There are facilities to add new items, which are -;; categorized, to edit or even delete items from the buffer. -;; The buffer contents are currently compatible with the diary, -;; so that the list of todo-items will show up in the FANCY diary -;; mode. -;; -;; Notice: Besides the major mode, this file also exports the -;; function `todo-show' which will change to the one specific -;; TODO file that has been specified in the todo-file-do -;; variable. If this file does not conform to the TODO mode -;; conventions, the todo-show function will add the appropriate -;; header and footer. I don't anticipate this to cause much -;; grief, but be warned, in case you attempt to read a plain text -;; file. -;; -;; Preface, Quickstart Installation -;; -;; To get this to work, make Emacs execute the line -;; -;; (autoload 'todo-mode "todo-mode" -;; "Major mode for editing TODO lists." t) -;; (autoload 'todo-show "todo-mode" -;; "Show TODO items." t) -;; (autoload 'todo-insert-item "todo-mode" -;; "Add TODO item." t) -;; -;; You may now enter new items by typing "M-x todo-insert-item", -;; or enter your TODO list file by typing "M-x todo-show". -;; -;; The TODO list file has a special format and some auxiliary -;; information, which will be added by the todo-show function if -;; it attempts to visit an un-initialized file. Hence it is -;; recommended to use the todo-show function for the first time, -;; in order to initialize the file, but it is not necessary -;; afterwards. -;; -;; As these commands are quite long to type, I would recommend -;; the addition of two bindings to your to your global keymap. I -;; personally have the following in my initialization file: -;; -;; (global-set-key "\C-ct" 'todo-show) ; switch to TODO buffer -;; (global-set-key "\C-ci" 'todo-insert-item) ; insert new item -;; -;; Note, however, that this recommendation has prompted some -;; criticism, since the keys C-c LETTER are reserved for user -;; functions. I believe my recommendation is acceptable, since -;; the Emacs Lisp Manual *Tips* section also details that the -;; mode itself should not bind any functions to those keys. The -;; express aim of the above two bindings is to work outside the -;; mode, which doesn't need the show function and offers a -;; different binding for the insert function. They serve as -;; shortcuts and are not even needed (since the TODO mode will be -;; entered by visiting the TODO file, and later by switching to -;; its buffer). -;; -;; If you are an advanced user of this package, please consult -;; the whole source code for autoloads, because there are several -;; extensions that are not explicitly listed in the above quick -;; installation. -;; -;; Pre-Requisites -;; -;; This package will require the following packages to be -;; available on the load-path: -;; -;; time-stamp -;; easymenu -;; -;; Operation -;; -;; You will have the following facilities available: -;; -;; M-x todo-show will enter the todo list screen, here type -;; -;; + to go to next category -;; - to go to previous category -;; d to file the current entry, including a -;; comment and timestamp -;; e to edit the current entry -;; E to edit a multi-line entry -;; f to file the current entry, including a -;; comment and timestamp -;; i to insert a new entry, with prefix, omit category -;; I to insert a new entry at current cursor position -;; j jump to category -;; k to kill the current entry -;; l to lower the current entry's priority -;; n for the next entry -;; p for the previous entry -;; P print -;; q to save the list and exit the buffer -;; r to raise the current entry's priority -;; s to save the list -;; S to save the list of top priorities -;; t show top priority items for each category -;; -;; When you add a new entry, you are asked for the text and then -;; for the category. I for example have categories for things -;; that I want to do in the office (like mail my mum), that I -;; want to do in town (like buy cornflakes) and things I want to -;; do at home (move my suitcases). The categories can be -;; selected with the cursor keys and if you type in the name of a -;; category which didn't exist before, an empty category of the -;; desired name will be added and filled with the new entry. -;; -;; Configuration -;; -;; Variable todo-prefix -;; -;; I would like to recommend that you use the prefix "*/*" (by -;; leaving the variable 'todo-prefix' untouched) so that the -;; diary displays each entry every day. -;; -;; To understand what I mean, please read the documentation that -;; goes with the calendar since that will tell you how you can -;; set up the fancy diary display and use the #include command to -;; include your todo list file as part of your diary. -;; -;; If you have the diary package set up to usually display more -;; than one day's entries at once, consider using -;; -;; "&%%(equal (calendar-current-date) date)" -;; -;; as the value of `todo-prefix'. Please note that this may slow -;; down the processing of your diary file some. -;; -;; Carsten Dominik suggested that -;; -;; "&%%(todo-cp)" -;; -;; might be nicer and to that effect a function has been declared -;; further down in the code. You may wish to auto-load this. -;; -;; Carsten also writes that *changing* the prefix after the -;; todo list is already established is not as simple as changing -;; the variable - the todo files have to be changed by hand. -;; -;; Variable todo-file-do -;; -;; This variable is fairly self-explanatory. You have to store -;; your TODO list somewhere. This variable tells the package -;; where to go and find this file. -;; -;; Variable todo-file-done -;; -;; Even when you're done, you may wish to retain the entries. -;; Given that they're timestamped and you are offered to add a -;; comment, this can make a useful diary of past events. It will -;; even blend in with the EMACS diary package. So anyway, this -;; variable holds the name of the file for the filed todo-items. -;; -;; Variable todo-file-top -;; -;; File storing the top priorities of your TODO list when -;; todo-save-top-priorities is non-nil. Nice to include in your -;; diary instead of the complete TODO list. -;; -;; Variable todo-mode-hook -;; -;; Just like other modes, too, this mode offers to call your -;; functions before it goes about its business. This variable -;; will be inspected for any functions you may wish to have -;; called once the other TODO mode preparations have been -;; completed. -;; -;; Variable todo-insert-threshold -;; -;; Another nifty feature is the insertion accuracy. If you have -;; 8 items in your TODO list, then you may get asked 4 questions -;; by the binary insertion algorithm. However, you may not -;; really have a need for such accurate priorities amongst your -;; TODO items. If you now think about the binary insertion -;; halving the size of the window each time, then the threshold -;; is the window size at which it will stop. If you set the -;; threshold to zero, the upper and lower bound will coincide at -;; the end of the loop and you will insert your item just before -;; that point. If you set the threshold to, e.g. 8, it will stop -;; as soon as the window size drops below that amount and will -;; insert the item in the approximate center of that window. I -;; got the idea for this feature after reading a very helpful -;; e-mail reply from Trey Jackson who -;; corrected some of my awful coding and pointed me towards some -;; good reading. Thanks Trey! -;; -;; Things to do -;; -;; These originally were my ideas, but now also include all the -;; suggestions that I included before forgetting them: -;; -;; o Fancy fonts for todo/top-priority buffer -;; o Remove todo-prefix option in todo-top-priorities -;; o Rename category -;; o Move entry from one category to another one -;; o Entries which both have the generic */* prefix and a -;; "deadline" entry which are understood by diary, indicating -;; an event (unless marked by &) -;; o The optional COUNT variable of todo-forward-item should be -;; applied to the other functions performing similar tasks -;; o Modularization could be done for repeated elements of -;; the code, like the completing-read lines of code. -;; o license / version function -;; o export to diary file -;; o todo-report-bug -;; o GNATS support -;; o elide multiline (as in bbdb, or, to a lesser degree, in -;; outline mode) -;; o rewrite complete package to store data as Lisp objects -;; and have display modes for display, for diary export, -;; etc. (Richard Stallman pointed out this is a bad idea) -;; o so base todo-mode.el on generic-mode.el instead -;; -;; History and Gossip -;; -;; Many thanks to all the ones who have contributed to the -;; evolution of this package! I hope I have listed all of you -;; somewhere in the documentation or at least in the RCS history! -;; -;; Enjoy this package and express your gratitude by sending nice -;; things to my parents' address! -;; -;; Oliver Seidel -;; (Lessingstr. 8, 65760 Eschborn, Federal Republic of Germany) - -;;; Code: - -(require 'time-stamp) - - -;; User-configurable variables: - -(defgroup todo nil - "Maintain a list of todo items." - :link '(emacs-commentary-link "todo-mode") - :version "21.1" - :group 'calendar) - -(defcustom todo-prefix "*/*" - "TODO mode prefix for entries. - -This is useful in conjunction with `calendar' and `diary' if you use - -#include \"~/.emacs.d/todo-do\" - -in your diary file to include your todo list file as part of your -diary. With the default value \"*/*\" the diary displays each entry -every day and it may also be marked on every day of the calendar. -Using \"&%%(equal (calendar-current-date) date)\" instead will only -show and mark todo entries for today, but may slow down processing of -the diary file somewhat." - :type 'string) -(defcustom todo-file-do (locate-user-emacs-file "todo-do" ".todo-do") - "TODO mode list file." - :version "24.4" ; added locate-user-emacs-file - :type 'file) -(defcustom todo-file-done (locate-user-emacs-file "todo-done" ".todo-done") - "TODO mode archive file." - :version "24.4" ; added locate-user-emacs-file - :type 'file) -(defcustom todo-mode-hook nil - "TODO mode hooks." - :type 'hook) -(defcustom todo-edit-mode-hook nil - "TODO Edit mode hooks." - :type 'hook) -(defcustom todo-insert-threshold 0 - "TODO mode insertion accuracy. - -If you have 8 items in your TODO list, then you may get asked 4 -questions by the binary insertion algorithm. However, you may not -really have a need for such accurate priorities amongst your TODO -items. If you now think about the binary insertion halving the size -of the window each time, then the threshold is the window size at -which it will stop. If you set the threshold to zero, the upper and -lower bound will coincide at the end of the loop and you will insert -your item just before that point. If you set the threshold to, -e.g. 8, it will stop as soon as the window size drops below that -amount and will insert the item in the approximate center of that -window." - :type 'integer) -(defvar todo-edit-buffer " *TODO Edit*" - "TODO Edit buffer name.") -(defcustom todo-file-top (locate-user-emacs-file "todo-top" ".todo-top") - "TODO mode top priorities file. - -Not in TODO format, but diary compatible. -Automatically generated when `todo-save-top-priorities' is non-nil." - :version "24.4" ; added locate-user-emacs-file - :type 'string) - -(defcustom todo-print-function 'ps-print-buffer-with-faces - "Function to print the current buffer." - :type 'symbol) -(defcustom todo-show-priorities 1 - "Default number of priorities to show by \\[todo-top-priorities]. -0 means show all entries." - :type 'integer) -(defcustom todo-print-priorities 0 - "Default number of priorities to print by \\[todo-print]. -0 means print all entries." - :type 'integer) -(defcustom todo-remove-separator t - "Non-nil to remove category separators in\ -\\[todo-top-priorities] and \\[todo-print]." - :type 'boolean) -(defcustom todo-save-top-priorities-too t - "Non-nil makes `todo-save' automatically save top-priorities in `todo-file-top'." - :type 'boolean) - -;; Thanks for the ISO time stamp format go to Karl Eichwalder -;; My format string for the appt.el package is "%3b %2d, %y, %02I:%02M%p". -;; -(defcustom todo-time-string-format - "%:y-%02m-%02d %02H:%02M" - "TODO mode time string format for done entries. -For details see the variable `time-stamp-format'." - :type 'string) - -(defcustom todo-entry-prefix-function 'todo-entry-timestamp-initials - "Function producing text to insert at start of todo entry." - :type 'symbol) -(defcustom todo-initials (or (getenv "INITIALS") (user-login-name)) - "Initials of todo item author." - :type 'string) - -(defun todo-entry-timestamp-initials () - "Prepend timestamp and your initials to the head of a TODO entry." - (let ((time-stamp-format todo-time-string-format)) - (concat (time-stamp-string) " " todo-initials ": "))) - -;; --------------------------------------------------------------------------- - -;; Set up some helpful context ... - -(defvar todo-categories nil - "TODO categories.") - -(defvar todo-cats nil - "Old variable for holding the TODO categories. -Use `todo-categories' instead.") - -(defvar todo-previous-line 0 - "Previous line asked about.") - -(defvar todo-previous-answer 0 - "Previous answer got.") - -(defvar todo-mode-map - (let ((map (make-keymap))) - (suppress-keymap map t) - (define-key map "+" #'todo-forward-category) - (define-key map "-" #'todo-backward-category) - (define-key map "d" #'todo-file-item) ;done/delete - (define-key map "e" #'todo-edit-item) - (define-key map "E" #'todo-edit-multiline) - (define-key map "f" #'todo-file-item) - (define-key map "i" #'todo-insert-item) - (define-key map "I" #'todo-insert-item-here) - (define-key map "j" #'todo-jump-to-category) - (define-key map "k" #'todo-delete-item) - (define-key map "l" #'todo-lower-item) - (define-key map "n" #'todo-forward-item) - (define-key map "p" #'todo-backward-item) - (define-key map "P" #'todo-print) - (define-key map "q" #'todo-quit) - (define-key map "r" #'todo-raise-item) - (define-key map "s" #'todo-save) - (define-key map "S" #'todo-save-top-priorities) - (define-key map "t" #'todo-top-priorities) - map) - "TODO mode keymap.") - -(defvar todo-category-number 0 "TODO category number.") - -(defvar todo-tmp-buffer-name " *todo tmp*") - -(defvar todo-category-sep (make-string 75 ?-) - "Category separator.") - -(defvar todo-category-beg " --- " - "Category start separator to be prepended onto category name.") - -(defvar todo-category-end "--- End" - "Separator after a category.") - -(defvar todo-header "-*- mode: todo; " - "Header of todo files.") - -;; --------------------------------------------------------------------------- - -(defun todo-category-select () - "Make TODO mode display the current category correctly." - (let ((name (nth todo-category-number todo-categories))) - (setq mode-line-buffer-identification -;; (concat "Category: " name)) - (concat "Category: " (format "%18s" name))) - (widen) - (goto-char (point-min)) - (search-forward-regexp - (concat "^" - (regexp-quote (concat todo-prefix todo-category-beg name)) - "$")) - (let ((begin (1+ (line-end-position)))) - (search-forward-regexp (concat "^" todo-category-end)) - (narrow-to-region begin (line-beginning-position)) - (goto-char (point-min))))) -(defalias 'todo-cat-slct #'todo-category-select) - -(defun todo-forward-category () - "Go forward to TODO list of next category." - (interactive) - (setq todo-category-number - (mod (1+ todo-category-number) (length todo-categories))) - (todo-category-select)) -(defalias 'todo-cmd-forw #'todo-forward-category) - -(defun todo-backward-category () - "Go back to TODO list of previous category." - (interactive) - (setq todo-category-number - (mod (1- todo-category-number) (length todo-categories))) - (todo-category-select)) -(defalias 'todo-cmd-back #'todo-backward-category) - -(defun todo-backward-item () - "Select previous entry of TODO list." - (interactive) - (search-backward-regexp (concat "^" (regexp-quote todo-prefix)) nil t) - (message "")) -(defalias 'todo-cmd-prev #'todo-backward-item) - -(defun todo-forward-item (&optional count) - "Select COUNT-th next entry of TODO list." - (interactive "P") - (if (listp count) (setq count (car count))) - (end-of-line) - (search-forward-regexp (concat "^" (regexp-quote todo-prefix)) - nil 'goto-end count) - (beginning-of-line) - (message "")) -(defalias 'todo-cmd-next #'todo-forward-item) - -(defun todo-save () - "Save the TODO list." - (interactive) - (save-excursion - (save-restriction - (save-buffer))) - (if todo-save-top-priorities-too (todo-save-top-priorities))) -(defalias 'todo-cmd-save #'todo-save) - -(defun todo-quit () - "Done with TODO list for now." - (interactive) - (widen) - (todo-save) - (message "") - (bury-buffer)) -(defalias 'todo-cmd-done #'todo-quit) - -(defun todo-edit-item () - "Edit current TODO list entry." - (interactive) - (if (< (point-min) (point-max)) - (let ((item (todo-item-string))) - (if (todo-string-multiline-p item) - (todo-edit-multiline) - (let ((new (read-from-minibuffer "Edit: " item))) - (todo-remove-item) - (insert new "\n") - (todo-backward-item) - (message "")))) - (error "No TODO list entry to edit"))) -(defalias 'todo-cmd-edit #'todo-edit-item) - -(defun todo-edit-multiline () - "Set up a buffer for editing a multiline TODO list entry." - (interactive) - (let ((buffer-name (generate-new-buffer-name todo-edit-buffer))) - (switch-to-buffer - (make-indirect-buffer - (file-name-nondirectory todo-file-do) buffer-name)) - (message "To exit, simply kill this buffer and return to list.") - (todo-edit-mode) - (narrow-to-region (todo-item-start) (todo-item-end)))) - -;;;###autoload -(defun todo-add-category (&optional cat) - "Add new category CAT to the TODO list." - (interactive) - (let ((buf (find-file-noselect todo-file-do t)) - (prompt "Category: ")) - (unless (zerop (buffer-size buf)) - (and (null todo-categories) - (null todo-cats) - (error "Error in %s: File is non-empty but contains no category" - todo-file-do))) - (unless cat (setq cat (read-from-minibuffer prompt))) - (with-current-buffer buf - ;; reject names that could induce bugs and confusion - (while (and (cond ((string= "" cat) - (setq prompt "Enter a non-empty category name: ")) - ((string-match "\\`\\s-+\\'" cat) - (setq prompt "Enter a category name that is not only white space: ")) - ((member cat todo-categories) - (setq prompt "Enter a non-existing category name: "))) - (setq cat (read-from-minibuffer prompt)))) - ;; initialize a newly created Todo buffer for Todo mode - (unless (file-exists-p todo-file-do) (todo-mode)) - (setq todo-categories (cons cat todo-categories)) - (widen) - (goto-char (point-min)) - (if (search-forward "-*- mode: todo; " (+ (point-min) 16) t) - (kill-line) - (insert "-*- mode: todo; \n") - (forward-char -1)) - (insert (format "todo-categories: %S; -*-" todo-categories)) - (forward-char 1) - (insert (format "%s%s%s\n%s\n%s %s\n" - todo-prefix todo-category-beg cat - todo-category-end - todo-prefix todo-category-sep)) - (if (called-interactively-p 'interactive) - ;; properly display the newly added category - (progn (setq todo-category-number 0) (todo-show)) - 0)))) - -;;;###autoload -(defun todo-add-item-non-interactively (new-item category) - "Insert NEW-ITEM in TODO list as a new entry in CATEGORY." - (save-excursion - (todo-show)) - (save-excursion - (if (string= "" category) - (setq category (nth todo-category-number todo-categories))) - (let ((cat-exists (member category todo-categories))) - (setq todo-category-number - (if cat-exists - (- (length todo-categories) (length cat-exists)) - (todo-add-category category)))) - (todo-show) - (setq todo-previous-line 0) - (let ((top 1) - (bottom (1+ (count-lines (point-min) (point-max))))) - (while (> (- bottom top) todo-insert-threshold) - (let* ((current (/ (+ top bottom) 2)) - (answer (if (< current bottom) - (todo-more-important-p current) nil))) - (if answer - (setq bottom current) - (setq top (1+ current))))) - (setq top (/ (+ top bottom) 2)) - ;; goto-line doesn't have the desired behavior in a narrowed buffer. - (goto-char (point-min)) - (forward-line (1- top))) - (insert new-item "\n") - (todo-backward-item) - (todo-save) - (message ""))) - -;;;###autoload -(defun todo-insert-item (arg) - "Insert new TODO list entry. -With a prefix argument ARG solicit the category, otherwise use the current -category." - (interactive "P") - (save-excursion - (if (not (derived-mode-p 'todo-mode)) (todo-show)) - (let* ((new-item (concat todo-prefix " " - (read-from-minibuffer - "New TODO entry: " - (if todo-entry-prefix-function - (funcall todo-entry-prefix-function))))) - (current-category (nth todo-category-number todo-categories)) - (category (if arg (todo-completing-read) current-category))) - (todo-add-item-non-interactively new-item category)))) - -(defalias 'todo-cmd-inst #'todo-insert-item) - -(defun todo-insert-item-here () - "Insert a new TODO list entry directly above the entry at point. -If point is on an empty line, insert the entry there." - (interactive) - (if (not (derived-mode-p 'todo-mode)) (todo-show)) - (let ((new-item (concat todo-prefix " " - (read-from-minibuffer - "New TODO entry: " - (if todo-entry-prefix-function - (funcall todo-entry-prefix-function)))))) - (unless (and (bolp) (eolp)) (todo-item-start)) - (insert (concat new-item "\n")) - (backward-char) - ;; put point at start of new entry - (todo-item-start))) - -(defun todo-more-important-p (line) - "Ask whether entry is more important than the one at LINE." - (unless (equal todo-previous-line line) - (setq todo-previous-line line) - (goto-char (point-min)) - (forward-line (1- todo-previous-line)) - (let ((item (todo-item-string-start))) - (setq todo-previous-answer - (y-or-n-p (format-message "More important than `%s'? " item))))) - todo-previous-answer) -(defalias 'todo-ask-p #'todo-more-important-p) - -(defun todo-delete-item () - "Delete current TODO list entry." - (interactive) - (if (> (count-lines (point-min) (point-max)) 0) - (let* ((todo-entry (todo-item-string-start)) - (todo-answer (y-or-n-p (concat "Permanently remove '" - todo-entry "'? ")))) - (when todo-answer - (todo-remove-item) - (todo-backward-item)) - (message "")) - (error "No TODO list entry to delete"))) -(defalias 'todo-cmd-kill #'todo-delete-item) - -(defun todo-raise-item () - "Raise priority of current entry." - (interactive) - (if (> (count-lines (point-min) (point)) 0) - (let ((item (todo-item-string))) - (todo-remove-item) - (todo-backward-item) - (save-excursion - (insert item "\n")) - (message "")) - (error "No TODO list entry to raise"))) -(defalias 'todo-cmd-rais #'todo-raise-item) - -(defun todo-lower-item () - "Lower priority of current entry." - (interactive) - (if (> (count-lines (point) (point-max)) 1) - ;; Assume there is a final newline - (let ((item (todo-item-string))) - (todo-remove-item) - (todo-forward-item) - (save-excursion - (insert item "\n")) - (message "")) - (error "No TODO list entry to lower"))) -(defalias 'todo-cmd-lowr #'todo-lower-item) - -(defun todo-file-item (&optional comment) - "File the current TODO list entry away, annotated with an optional COMMENT." - (interactive "sComment: ") - (or (> (count-lines (point-min) (point-max)) 0) - (error "No TODO list entry to file away")) - (let ((time-stamp-format todo-time-string-format)) - (when (and comment (> (length comment) 0)) - (goto-char (todo-item-end)) - (insert - (if (save-excursion (beginning-of-line) - (looking-at (regexp-quote todo-prefix))) - " " - "\n\t") - "(" comment ")")) - (goto-char (todo-item-end)) - (insert " [" (nth todo-category-number todo-categories) "]") - (todo-item-start) - (let ((temp-point (point))) - (if (looking-at (regexp-quote todo-prefix)) - (replace-match (time-stamp-string)) - ;; Standard prefix -> timestamp - ;; Else prefix non-standard item start with timestamp - (insert (time-stamp-string))) - (append-to-file temp-point (todo-item-end 'include-sep) todo-file-done) - (delete-region temp-point (todo-item-end 'include-sep))) - (todo-backward-item) - (message ""))) - -;; --------------------------------------------------------------------------- - -;; Utility functions: - - -;;;###autoload -(defun todo-top-priorities (&optional nof-priorities category-pr-page - interactive) - "List top priorities for each category. - -Number of entries for each category is given by NOF-PRIORITIES which -defaults to `todo-show-priorities'. - -If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted -between each category. -INTERACTIVE should be non-nil if this function is called interactively." - - (interactive "P\ni\nP") - (or nof-priorities (setq nof-priorities todo-show-priorities)) - (if (listp nof-priorities) ;universal argument - (setq nof-priorities (car nof-priorities))) - (let ((todo-print-buffer-name todo-tmp-buffer-name) - ;;(todo-print-category-number 0) - (todo-category-break (if category-pr-page " " "")) - (cat-end - (concat - (if todo-remove-separator - (concat todo-category-end "\n" - (regexp-quote todo-prefix) " " todo-category-sep "\n") - (concat todo-category-end "\n")))) - beg end) - (save-excursion - (todo-show) - (save-restriction - (save-current-buffer - (widen) - (copy-to-buffer todo-print-buffer-name (point-min) (point-max)) - (set-buffer todo-print-buffer-name) - (goto-char (point-min)) - (when (re-search-forward (regexp-quote todo-header) nil t) - (beginning-of-line 1) - (delete-region (point) (line-end-position))) - (while (re-search-forward ;Find category start - (regexp-quote (concat todo-prefix todo-category-beg)) - nil t) - (setq beg (+ (line-end-position) 1)) ;Start of first entry. - (re-search-forward cat-end nil t) - (setq end (match-beginning 0)) - (replace-match todo-category-break) - (narrow-to-region beg end) ;In case we have too few entries. - (goto-char (point-min)) - (if (zerop nof-priorities) ;Traverse entries. - (goto-char end) ;All entries - (todo-forward-item nof-priorities)) - (setq beg (point)) - (delete-region beg end) - (widen)) - (and (looking-at " ") (replace-match "")) ;Remove trailing form-feed. - (goto-char (point-min)) ;Due to display buffer - ))) - (when interactive (display-buffer todo-print-buffer-name)) - (message "Type C-x 1 to remove %s window. M-C-v to scroll the help." - todo-print-buffer-name))) - -(defun todo-save-top-priorities (&optional nof-priorities) - "Save top priorities for each category in `todo-file-top'. - -Number of entries for each category is given by NOF-PRIORITIES which -defaults to `todo-show-priorities'." - (interactive "P") - (save-window-excursion - (save-excursion - (save-restriction - (todo-top-priorities nof-priorities) - (set-buffer todo-tmp-buffer-name) - (write-file todo-file-top) - (kill-this-buffer))))) - -;;;###autoload -(defun todo-print (&optional category-pr-page) - "Print todo summary using `todo-print-function'. -If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted -between each category. - -Number of entries for each category is given by `todo-print-priorities'." - (interactive "P") - (save-window-excursion - (save-excursion - (save-restriction - (todo-top-priorities todo-print-priorities - category-pr-page) - (set-buffer todo-tmp-buffer-name) - (and (funcall todo-print-function) - (kill-this-buffer)) - (message "Todo printing done."))))) - -(defun todo-jump-to-category () - "Jump to a category. Default is previous category." - (interactive) - (let ((category (todo-completing-read))) - (if (string= "" category) - (setq category (nth todo-category-number todo-categories))) - (setq todo-category-number - (if (member category todo-categories) - (- (length todo-categories) - (length (member category todo-categories))) - (todo-add-category category))) - (todo-show))) - -(defun todo-line-string () - "Return current line in buffer as a string." - (buffer-substring (line-beginning-position) (line-end-position))) - -(defun todo-item-string-start () - "Return the start of this TODO list entry as a string." - ;; Suitable for putting in the minibuffer when asking the user - (let ((item (todo-item-string))) - (if (> (length item) 60) - (setq item (concat (substring item 0 56) "..."))) - item)) - -(defun todo-item-start () - "Go to start of current TODO list item and return point." - (beginning-of-line) - (if (not (looking-at (regexp-quote todo-prefix))) - (search-backward-regexp - (concat "^" (regexp-quote todo-prefix)) nil t)) - (point)) - -(defun todo-item-end (&optional include-sep) - "Return point at end of current TODO list item. -If INCLUDE-SEP is non-nil, return point after the separator." - (save-excursion - (end-of-line) - (if (search-forward-regexp - (concat "^" (regexp-quote todo-prefix)) nil 'goto-end) - (goto-char (match-beginning 0))) - (unless include-sep (skip-chars-backward "\n")) - (point))) - -(defun todo-remove-item () - "Delete the current entry from the TODO list." - (delete-region (todo-item-start) (todo-item-end 'include-sep))) - -(defun todo-item-string () - "Return current TODO list entry as a string." - (buffer-substring (todo-item-start) (todo-item-end))) - -(defun todo-string-count-lines (string) - "Return the number of lines STRING spans." - (length (split-string string "\n"))) - -(defun todo-string-multiline-p (string) - "Return non-nil if STRING spans several lines." - (> (todo-string-count-lines string) 1)) - -(defun todo-completing-read () - "Return a category name, with completion, for use in Todo mode." - ;; make a copy of todo-categories in case history-delete-duplicates is - ;; non-nil, which makes completing-read alter todo-categories - (let* ((categories (copy-sequence todo-categories)) - (history (cons 'todo-categories (1+ todo-category-number))) - (default (nth todo-category-number todo-categories)) - (category (completing-read - (concat "Category [" default "]: ") - todo-categories nil nil nil history default))) - ;; restore the original value of todo-categories - (setq todo-categories categories) - category)) - -;; --------------------------------------------------------------------------- - -(easy-menu-define todo-menu todo-mode-map "Todo Menu" - '("Todo" - ["Next category" todo-forward-category t] - ["Previous category" todo-backward-category t] - ["Jump to category" todo-jump-to-category t] - ["Show top priority items" todo-top-priorities t] - ["Print categories" todo-print t] - "---" - ["Edit item" todo-edit-item t] - ["File item" todo-file-item t] - ["Insert new item" todo-insert-item t] - ["Insert item here" todo-insert-item-here t] - ["Kill item" todo-delete-item t] - "---" - ["Lower item priority" todo-lower-item t] - ["Raise item priority" todo-raise-item t] - "---" - ["Next item" todo-forward-item t] - ["Previous item" todo-backward-item t] - "---" - ["Save" todo-save t] - ["Save Top Priorities" todo-save-top-priorities t] - "---" - ["Quit" todo-quit t] - )) - -;; As calendar reads todo-file-do before todo-mode is loaded. -;;;###autoload -(define-derived-mode todo-mode nil "TODO" - "Major mode for editing TODO lists." - nil) - -(with-suppressed-warnings ((lexical date entry)) - (defvar date) - (defvar entry)) - -;; t-c should be used from diary code, which requires calendar. -(declare-function calendar-current-date "calendar" (&optional offset)) - -;; Read about this function in the setup instructions above! -;;;###autoload -(defun todo-cp () - "Make a diary entry appear only in the current date's diary." - (if (equal (calendar-current-date) date) - entry)) - -(define-derived-mode todo-edit-mode text-mode "TODO Edit" - "Major mode for editing items in the TODO list. - -\\{todo-edit-mode-map}") - -;;;###autoload -(defun todo-show () - "Show TODO list." - (interactive) - ;; Call todo-initial-setup only if there is neither a Todo file nor - ;; a corresponding unsaved buffer. - (if (or (file-exists-p todo-file-do) - (let* ((buf (get-buffer (file-name-nondirectory todo-file-do))) - (bufname (buffer-file-name buf))) - (equal (expand-file-name todo-file-do) bufname))) - (find-file todo-file-do) - (todo-initial-setup)) - (if (null todo-categories) - (if (null todo-cats) - (error "Error in %s: No categories in list `todo-categories'" - todo-file-do) - (goto-char (point-min)) - (and (search-forward "todo-cats:" nil t) - (replace-match "todo-categories:")) - (make-local-variable 'todo-categories) - (setq todo-categories todo-cats))) - (beginning-of-line) - (todo-category-select)) - -(defun todo-initial-setup () - "Set up things to work properly in TODO mode." - (find-file todo-file-do) - (erase-buffer) - (todo-mode) - (todo-add-category "Todo")) - -(provide 'todo-mode) - -;;; otodo-mode.el ends here diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el deleted file mode 100644 index 258b2b519d9..00000000000 --- a/lisp/obsolete/rcompile.el +++ /dev/null @@ -1,180 +0,0 @@ -;;; rcompile.el --- run a compilation on a remote machine -*- lexical-binding: t; -*- - -;; Copyright (C) 1993-1994, 2001-2024 Free Software Foundation, Inc. - -;; Author: Alon Albert -;; Maintainer: emacs-devel@gnu.org -;; Created: 1993 Oct 6 -;; Keywords: tools, processes -;; Obsolete-since: 24.4 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This package is for running a remote compilation and using emacs to parse -;; the error messages. It works by rsh'ing the compilation to a remote host -;; and parsing the output. If the file visited at the time remote-compile was -;; called was loaded remotely (ange-ftp), the host and user name are obtained -;; by the calling ange-ftp-ftp-name on the current directory. In this case the -;; next-error command will also ange-ftp the files over. This is achieved -;; automatically because the compilation-parse-errors function uses -;; default-directory to build its file names. If however the file visited was -;; loaded locally, remote-compile prompts for a host and user and assumes the -;; files mounted locally (otherwise, how was the visited file loaded). - -;; See the user defined variables section for more info. - -;; I was contemplating redefining "compile" to "remote-compile" automatically -;; if the file visited was ange-ftp'ed but decided against it for now. If you -;; feel this is a good idea, let me know and I'll consider it again. - -;; Installation: - -;; To use rcompile, you also need to give yourself permission to connect to -;; the remote host. You do this by putting lines like: - -;; monopoly alon -;; vme33 -;; -;; in a file named .rhosts in the home directory (of the remote machine). -;; Be careful what you put in this file. A line like: -;; -;; + -;; -;; Will allow anyone access to your account without a password. I suggest you -;; read the rhosts(5) manual page before you edit this file (if you are not -;; familiar with it already) - -;;; Code: - -(provide 'rcompile) -(require 'compile) -;;; The following should not be needed. -;;; (eval-when-compile (require 'ange-ftp)) - -;;;; user defined variables - -(defgroup remote-compile nil - "Run a compilation on a remote machine." - :group 'processes - :group 'tools) - - -(defcustom remote-compile-host nil - "Host for remote compilations." - :type '(choice string (const nil))) - -(defcustom remote-compile-user nil - "User for remote compilations. -nil means use the value returned by \\[user-login-name]." - :type '(choice string (const nil))) - -(defcustom remote-compile-run-before nil - "Command to run before compilation. -This can be used for setting up environment variables, -since rsh does not invoke the shell as a login shell and files like .login -\(tcsh) and .bash_profile \(bash) are not run. -nil means run no commands." - :type '(choice string (const nil))) - -(defcustom remote-compile-prompt-for-host nil - "Non-nil means prompt for host if not available from filename." - :type 'boolean) - -(defcustom remote-compile-prompt-for-user nil - "Non-nil means prompt for user if not available from filename." - :type 'boolean) - -;;;; internal variables - -;; History of remote compile hosts and users -(defvar remote-compile-host-history nil) -(defvar remote-compile-user-history nil) - - -;;;; entry point - -;; We use the Tramp internal function `tramp-make-tramp-file-name'. -;; It has changed its signature in Emacs 27.1, supporting still the -;; old calling convention. Let's assume rcompile.el has been removed -;; once Tramp does not support it any longer. -;; Better would be, if there are functions to provide user, host and -;; localname of a remote filename, independent of Tramp's implementation. -;; The function calls are wrapped by `funcall' in order to pacify the byte -;; compiler. ange-ftp check removed, because it is handled also by Tramp. -;;;###autoload -(defun remote-compile (host user command) - "Compile the current buffer's directory on HOST. Log in as USER. -See \\[compile]." - (interactive - (let (host user command prompt) ;; l l-host l-user - (setq prompt (if (stringp remote-compile-host) - (format "Compile on host (default %s): " - remote-compile-host) - "Compile on host: ") - host (if (or remote-compile-prompt-for-host - (null remote-compile-host)) - (read-from-minibuffer prompt - "" nil nil - 'remote-compile-host-history) - remote-compile-host) - user (if remote-compile-prompt-for-user - (read-from-minibuffer (format - "Compile by user (default %s): " - (or remote-compile-user - (user-login-name))) - "" nil nil - 'remote-compile-user-history) - remote-compile-user)) - (setq command (read-from-minibuffer "Compile command: " - compile-command nil nil - '(compile-history . 1))) - (list (if (string= host "") remote-compile-host host) - (if (string= user "") remote-compile-user user) - command))) - (setq compile-command command) - (cond (user - (setq remote-compile-user user)) - ((null remote-compile-user) - (setq remote-compile-user (user-login-name)))) - (let* (;; localname ;; Pacify byte-compiler. - (compile-command - (format "%s %s -l %s \"(%scd %s; %s)\"" - remote-shell-program - host - remote-compile-user - (if remote-compile-run-before - (concat remote-compile-run-before "; ") - "") - "" - compile-command))) - (setq remote-compile-host host) - (save-some-buffers nil nil) - (compilation-start compile-command) - ;; Set comint-file-name-prefix in the compilation buffer so - ;; compilation-parse-errors will find referenced files by Tramp. - (with-current-buffer next-error-last-buffer - (when (fboundp 'tramp-make-tramp-file-name) - (setq-local comint-file-name-prefix - (funcall - #'tramp-make-tramp-file-name - nil ;; method. - remote-compile-user - remote-compile-host - "")))))) - -;;; rcompile.el ends here diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el deleted file mode 100644 index e7bb58950a0..00000000000 --- a/lisp/obsolete/sup-mouse.el +++ /dev/null @@ -1,203 +0,0 @@ -;;; sup-mouse.el --- supdup mouse support for lisp machines -*- lexical-binding: t; -*- - -;; Copyright (C) 1985-1986, 2001-2024 Free Software Foundation, Inc. - -;; Author: Wolfgang Rupprecht -;; Maintainer: emacs-devel@gnu.org -;; Created: 21 Nov 1986 -;; Keywords: hardware -;; Obsolete-since: 24.4 - -;; (from code originally written by John Robinson@bbn for the bitgraph) - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -;;; User customization option: - -(defcustom sup-mouse-fast-select-window nil - "Non-nil means mouse hits select new window, then execute. -Otherwise just select." - :type 'boolean - :group 'mouse) - -(defconst mouse-left 0) -(defconst mouse-center 1) -(defconst mouse-right 2) - -(defconst mouse-2left 4) -(defconst mouse-2center 5) -(defconst mouse-2right 6) - -(defconst mouse-3left 8) -(defconst mouse-3center 9) -(defconst mouse-3right 10) - -;;; Defuns: - -(defun sup-mouse-report () - "This function is called directly by the mouse, it parses and -executes the mouse commands. - - L move point * |---- These apply for mouse click in a window. -2L delete word | -3L copy word | If sup-mouse-fast-select-window is nil, - C move point and yank * | just selects that window. -2C yank pop | - R set mark * | -2R delete region | -3R copy region | - -on mode line on \"scroll bar\" in minibuffer - L scroll-up line to top execute-extended-command - C proportional goto-char line to middle mouse-help - R scroll-down line to bottom eval-expression" - - (interactive) - (let* -;; expect a string of :;;c - ((buttons (sup-get-tty-num ?\;)) - (x (sup-get-tty-num ?\;)) - (y (sup-get-tty-num ?c)) - (window (sup-pos-to-window x y)) - (edges (window-edges window)) - (old-window (selected-window)) - (in-minibuf-p (eq y (1- (frame-height)))) - (same-window-p (and (not in-minibuf-p) (eq window old-window))) - (in-mode-line-p (eq y (1- (nth 3 edges)))) - (in-scrollbar-p (>= x (1- (nth 2 edges))))) - (setq x (- x (nth 0 edges))) - (setq y (- y (nth 1 edges))) - -; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug - - (cond (in-mode-line-p - (select-window window) - (cond ((= buttons mouse-left) - (scroll-up)) - ((= buttons mouse-right) - (scroll-down)) - ((= buttons mouse-center) - (goto-char (/ (* x - (- (point-max) (point-min))) - (1- (window-width)))) - (beginning-of-line) - (what-cursor-position))) - (select-window old-window)) - (in-scrollbar-p - (select-window window) - (scroll-up - (cond ((= buttons mouse-left) - y) - ((= buttons mouse-right) - (+ y (- 2 (window-height)))) - ((= buttons mouse-center) - (/ (+ 2 y y (- (window-height))) 2)) - (t - 0))) - (select-window old-window)) - (same-window-p - (cond ((= buttons mouse-left) - (sup-move-point-to-x-y x y)) - ((= buttons mouse-2left) - (sup-move-point-to-x-y x y) - (kill-word 1)) - ((= buttons mouse-3left) - (sup-move-point-to-x-y x y) - (save-excursion - (copy-region-as-kill - (point) (progn (forward-word 1) (point)))) - (setq this-command 'yank) - ) - ((= buttons mouse-right) - (push-mark) - (sup-move-point-to-x-y x y) - (exchange-point-and-mark)) - ((= buttons mouse-2right) - (push-mark) - (sup-move-point-to-x-y x y) - (kill-region (mark) (point))) - ((= buttons mouse-3right) - (push-mark) - (sup-move-point-to-x-y x y) - (copy-region-as-kill (mark) (point)) - (setq this-command 'yank)) - ((= buttons mouse-center) - (sup-move-point-to-x-y x y) - (setq this-command 'yank) - (yank)) - ((= buttons mouse-2center) - (yank-pop 1)) - ) - ) - (in-minibuf-p - (cond ((= buttons mouse-right) - (call-interactively 'eval-expression)) - ((= buttons mouse-left) - (call-interactively 'execute-extended-command)) - ((= buttons mouse-center) - (describe-function 'sup-mouse-report)); silly self help - )) - (t ;in another window - (select-window window) - (cond ((not sup-mouse-fast-select-window)) - ((= buttons mouse-left) - (sup-move-point-to-x-y x y)) - ((= buttons mouse-right) - (push-mark) - (sup-move-point-to-x-y x y) - (exchange-point-and-mark)) - ((= buttons mouse-center) - (sup-move-point-to-x-y x y) - (setq this-command 'yank) - (yank)) - )) - ))) - - -(defun sup-get-tty-num (term-char) - "Read from terminal until TERM-CHAR is read, and return intervening number. -Upon non-numeric not matching TERM-CHAR signal an error." - (let - ((num 0) - (char (read-char))) - (while (and (>= char ?0) - (<= char ?9)) - (setq num (+ (* num 10) (- char ?0))) - (setq char (read-char))) - (or (eq term-char char) - (error "Invalid data format in mouse command")) - num)) - -(defun sup-move-point-to-x-y (x y) - "Position cursor in window coordinates. -X and Y are 0-based character positions in the window." - (move-to-window-line y) - (move-to-column x) - ) - -(defun sup-pos-to-window (x y) - "Find window corresponding to frame coordinates. -X and Y are 0-based character positions on the frame." - (get-window-with-predicate (lambda (w) - (coordinates-in-window-p (cons x y) w)))) - -(provide 'sup-mouse) - -;;; sup-mouse.el ends here diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el deleted file mode 100644 index 13667589c9e..00000000000 --- a/lisp/obsolete/terminal.el +++ /dev/null @@ -1,1333 +0,0 @@ -;;; terminal.el --- terminal emulator for GNU Emacs -*- lexical-binding: t; -*- - -;; Copyright (C) 1986-1989, 1993-1994, 2001-2024 Free Software -;; Foundation, Inc. - -;; Author: Richard Mlynarik -;; Maintainer: emacs-devel@gnu.org -;; Obsolete-since: 24.4 -;; Keywords: comm, terminals - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This file has been censored by the Communications Decency Act. -;; That law was passed under the guise of a ban on pornography, but -;; it bans far more than that. This file did not contain pornography, -;; but it was censored nonetheless. - -;; For information on US government censorship of the Internet, and -;; what you can do to bring back freedom of the press, see the web -;; site https://www.eff.org/ [used to be vtw.org but that link is dead] - -;;; Code: - -;;>>TODO -;;>> ** Nothing can be done about emacs' meta-lossage ** -;;>> (without redoing keymaps `sanely' -- ask Mly for details) - -;;>> One probably wants to do setenv MORE -c when running with -;;>> more-processing enabled. - -(require 'ehelp) -(require 'shell) - -(defgroup terminal nil - "Terminal emulator for Emacs." - :group 'terminals) - - -(defcustom terminal-escape-char ?\C-^ - "All characters except for this are passed verbatim through the -terminal-emulator. This character acts as a prefix for commands -to the emulator program itself. Type this character twice to send -it through the emulator. Type ? after typing it for a list of -possible commands. -This variable is local to each terminal-emulator buffer." - :type 'character) - -(defcustom terminal-scrolling t ;;>> Setting this to t sort-of defeats my whole aim in writing this package... - "If non-nil, the terminal-emulator will losingly `scroll' when output occurs -past the bottom of the screen. If nil, output will win and `wrap' to the top -of the screen. -This variable is local to each terminal-emulator buffer." - :type 'boolean) - -(defcustom terminal-more-processing t - "If non-nil, do more-processing. -This variable is local to each terminal-emulator buffer." - :type 'boolean) - -;; If you are the sort of loser who uses scrolling without more breaks -;; and expects to actually see anything, you should probably set this to -;; around 400 -(defcustom terminal-redisplay-interval 5000 - "Maximum number of characters which will be processed by the -terminal-emulator before a screen redisplay is forced. -Set this to a large value for greater throughput, -set it smaller for more frequent updates but overall slower -performance." - :type 'integer) - -(defvar terminal-more-break-insertion - "*** More break -- Press space to continue ***") - -(defvar terminal-meta-map nil) -(if terminal-meta-map - nil - (let ((map (make-sparse-keymap))) - (define-key map [t] #'te-pass-through) - (setq terminal-meta-map map))) - -(defvar terminal-map nil) -(if terminal-map - nil - (let ((map (make-sparse-keymap))) - ;; Prevent defining [menu-bar] as te-pass-through - ;; so we allow the global menu bar to be visible. - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [t] #'te-pass-through) - (define-key map [switch-frame] #'handle-switch-frame) - (define-key map "\e" terminal-meta-map) - ;;(define-key map "\C-l" - ;; (lambda () (interactive) (te-pass-through) (redraw-display))) - (setq terminal-map map))) - -(defvar terminal-escape-map nil) -(if terminal-escape-map - nil - (let ((map (make-sparse-keymap))) - (define-key map [t] #'undefined) - (dotimes (i 10) - (let ((s (make-string 1 (+ ?0 i)))) - (define-key map s #'digit-argument))) - (define-key map "b" #'switch-to-buffer) - (define-key map "o" #'other-window) - (define-key map "e" #'te-set-escape-char) - (define-key map "\C-l" #'redraw-display) - (define-key map "\C-o" #'te-flush-pending-output) - (define-key map "m" #'te-toggle-more-processing) - (define-key map "x" #'te-escape-extended-command) - ;;>> What use is this? Why is it in the default terminal-emulator map? - (define-key map "w" #'te-edit) - (define-key map "?" #'te-escape-help) - (define-key map (char-to-string help-char) #'te-escape-help) - (setq terminal-escape-map map))) - -(defvar te-escape-command-alist nil) -(if te-escape-command-alist - nil - (setq te-escape-command-alist - '(("Set Escape Character" . te-set-escape-char) - ;;>> What use is this? Why is it in the default terminal-emulator map? - ("Edit" . te-edit) - ("Refresh" . redraw-display) - ("Record Output" . te-set-output-log) - ("Photo" . te-set-output-log) - ("Tofu" . te-tofu) ;; confuse the uninitiated - ("Stuff Input" . te-stuff-string) - ("Flush Pending Output" . te-flush-pending-output) - ("Enable More Processing" . te-enable-more-processing) - ("Disable More Processing" . te-disable-more-processing) - ("Scroll at end of page" . te-do-scrolling) - ("Wrap at end of page" . te-do-wrapping) - ("Switch To Buffer" . switch-to-buffer) - ("Other Window" . other-window) - ("Kill Buffer" . kill-buffer) - ("Help" . te-escape-help) - ("Set Redisplay Interval" . te-set-redisplay-interval) - ))) - -(defvar terminal-more-break-map nil) -(if terminal-more-break-map - nil - (let ((map (make-sparse-keymap))) - (define-key map [t] #'te-more-break-unread) - (define-key map (char-to-string help-char) #'te-more-break-help) - (define-key map " " #'te-more-break-resume) - (define-key map "\C-l" #'redraw-display) - (define-key map "\C-o" #'te-more-break-flush-pending-output) - ;;>>> this isn't right - ;(define-key map "\^?" #'te-more-break-flush-pending-output) ;DEL - (define-key map "\r" #'te-more-break-advance-one-line) - - (setq terminal-more-break-map map))) - - -;;; Pacify the byte compiler -(defvar te-process nil) -(defvar te-log-buffer nil) -(defvar te-height nil) -(defvar te-width nil) -(defvar te-more-count nil) -(defvar te-redisplay-count nil) -(defvar te-pending-output nil) -(defvar te-saved-point) -(defvar te-more-old-point nil) -(defvar te-more-old-local-map nil) -(defvar te-more-old-filter nil) -(defvar te-more-old-mode-line-format nil) -(defvar te-pending-output-info nil) - -;; Required to support terminfo systems -(defconst te-terminal-name-prefix "emacs-em" - "Prefix used for terminal type names for Terminfo.") -(defconst te-terminfo-directory - (file-name-as-directory - (expand-file-name "emacs-terminfo" temporary-file-directory)) - "Directory used for run-time terminal definition files for Terminfo.") -(defvar te-terminal-name nil) - -;;;; escape map - -(defun te-escape () - (interactive) - (let (s - (local (current-local-map)) - (global (current-global-map))) - (unwind-protect - (progn - (use-global-map terminal-escape-map) - (use-local-map terminal-escape-map) - (setq s (read-key-sequence - (if current-prefix-arg - (format "Emacs Terminal escape[%s for help]> %d " - (substitute-command-keys - "\\\\[te-escape-help]") - (prefix-numeric-value current-prefix-arg)) - (format "Emacs Terminal escape[%s for help]> " - (substitute-command-keys - "\\\\[te-escape-help]")))))) - (use-global-map global) - (use-local-map local)) - - (message "") - - (cond - ;; Certain keys give vector notation, like [escape] when - ;; you hit esc key... - ((and (stringp s) - (string= s (make-string 1 terminal-escape-char))) - (setq last-command-event terminal-escape-char) - (let ((terminal-escape-char -259)) - (te-pass-through))) - - ((setq s (lookup-key terminal-escape-map s)) - (call-interactively s))) - - )) - - -(defun te-escape-help () - "Provide help on commands available after terminal-escape-char is typed." - (interactive) - (message "Terminal emulator escape help...") - (let ((char (single-key-description terminal-escape-char))) - (with-electric-help - (function (lambda () - (princ (format "Terminal-emulator escape, invoked by \"%s\" -Type \"%s\" twice to send a single \"%s\" through. - -Other chars following \"%s\" are interpreted as follows:\n" - char char char char)) - - (princ (substitute-command-keys "\\{terminal-escape-map}\n")) - (princ (format "\nSubcommands of \"%s\" (%s)\n" - (where-is-internal 'te-escape-extended-command - terminal-escape-map t) - 'te-escape-extended-command)) - (let ((l (sort (copy-sequence te-escape-command-alist) - (function (lambda (a b) - (string< (car a) (car b))))))) - (while l - (let ((doc (or (documentation (cdr (car l))) - "Not documented"))) - (if (string-match "\n" doc) - ;; just use first line of documentation - (setq doc (substring doc 0 (match-beginning 0)))) - (princ " \"") - (princ (car (car l))) - (princ "\":\n ") - (princ doc) - (write-char ?\n)) - (setq l (cdr l)))) - nil))))) - - - -(defun te-escape-extended-command () - (interactive) - (let ((c (let ((completion-ignore-case t)) - (completing-read "terminal command: " - te-escape-command-alist - nil t)))) - (if c - (catch 'foo - (setq c (downcase c)) - (let ((l te-escape-command-alist)) - (while l - (if (string= c (downcase (car (car l)))) - (throw 'foo (call-interactively (cdr (car l)))) - (setq l (cdr l))))))))) - -;; not used. -(defun te-escape-extended-command-unread () - (interactive) - (setq unread-command-events - (nconc (listify-key-sequence (this-command-keys)) - unread-command-events)) - (te-escape-extended-command)) - -(defun te-set-escape-char (c) - "Change the terminal-emulator escape character." - (interactive "cSet escape character to: ") - (let ((o terminal-escape-char)) - (message (if (= o c) - "\"%s\" is the escape char" - "\"%s\" is now the escape; \"%s\" passes through") - (single-key-description c) - (single-key-description o)) - (setq terminal-escape-char c))) - - -(defun te-stuff-string (string) - "Read a string to send to through the terminal emulator -as though that string had been typed on the keyboard. - -Very poor man's file transfer protocol." - (interactive "sStuff string: ") - (process-send-string te-process string)) - -(defun te-set-output-log (name) - "Record output from the terminal emulator in a buffer." - (interactive (list (if te-log-buffer - nil - (read-buffer "Record output in buffer: " - (format "%s output-log" - (buffer-name (current-buffer))) - nil)))) - (if (or (null name) (equal name "")) - (progn (setq te-log-buffer nil) - (message "Output logging off.")) - (if (get-buffer name) - nil - (with-current-buffer (get-buffer-create name) - (fundamental-mode) - (buffer-disable-undo (current-buffer)) - (erase-buffer))) - (setq te-log-buffer (get-buffer name)) - (message "Recording terminal emulator output into buffer \"%s\"" - (buffer-name te-log-buffer)))) - -(defun te-tofu () - "Discontinue output log." - (interactive) - (te-set-output-log nil)) - - -(defun te-toggle (sym arg) - (set sym (cond ((not (numberp arg)) arg) - ((= arg 1) (not (symbol-value sym))) - ((< arg 0) nil) - (t t)))) - -(defun te-toggle-more-processing (arg) - (interactive "p") - (message (if (te-toggle 'terminal-more-processing arg) - "More processing on" "More processing off")) - (if terminal-more-processing (setq te-more-count -1))) - -(defun te-toggle-scrolling (arg) - (interactive "p") - (message (if (te-toggle 'terminal-scrolling arg) - "Scroll at end of page" "Wrap at end of page"))) - -(defun te-enable-more-processing () - "Enable ** MORE ** processing" - (interactive) - (te-toggle-more-processing t)) - -(defun te-disable-more-processing () - "Disable ** MORE ** processing" - (interactive) - (te-toggle-more-processing nil)) - -(defun te-do-scrolling () - "Scroll at end of page (yuck)" - (interactive) - (te-toggle-scrolling t)) - -(defun te-do-wrapping () - "Wrap to top of window at end of page" - (interactive) - (te-toggle-scrolling nil)) - - -(defun te-set-redisplay-interval (arg) - "Set the maximum interval (in output characters) between screen updates. -Set this number to large value for greater throughput, -set it smaller for more frequent updates (but overall slower performance." - (interactive "NMax number of output chars between redisplay updates: ") - (setq arg (max arg 1)) - (setq terminal-redisplay-interval arg - te-redisplay-count 0)) - -;;;; more map - -;; every command -must- call te-more-break-unwind -;; or grave lossage will result - -(put 'te-more-break-unread 'suppress-keymap t) -(defun te-more-break-unread () - (interactive) - (if (eq last-input-event terminal-escape-char) - (call-interactively 'te-escape) - (message "Continuing from more break (\"%s\" typed, %d chars output pending...)" - (single-key-description last-input-event) - (te-pending-output-length)) - (setq te-more-count 259259) - (te-more-break-unwind) - (let ((terminal-more-processing nil)) - (te-pass-through)))) - -(defun te-more-break-resume () - "Proceed past the **MORE** break, -allowing the next page of output to appear" - (interactive) - (message "Continuing from more break") - (te-more-break-unwind)) - -(defun te-more-break-help () - "Provide help on commands available in a terminal-emulator **MORE** break" - (interactive) - (message "Terminal-emulator more break help...") - (sit-for 0) - (with-electric-help - (function (lambda () - (princ "Terminal-emulator more break.\n\n") - (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n" - (where-is-internal 'te-more-break-resume - terminal-more-break-map t) - (documentation 'te-more-break-resume))) - (princ (substitute-command-keys "\\{terminal-more-break-map}\n")) - (princ "Any other key is passed through to the program -running under the terminal emulator and disables more processing until -all pending output has been dealt with.") - nil)))) - - -(defun te-more-break-advance-one-line () - "Allow one more line of text to be output before doing another more break." - (interactive) - (setq te-more-count 1) - (te-more-break-unwind)) - -(defun te-more-break-flush-pending-output () - "Discard any output which has been received by the terminal emulator but -not yet processed and then proceed from the more break." - (interactive) - (te-more-break-unwind) - (te-flush-pending-output)) - -(defun te-flush-pending-output () - "Discard any as-yet-unprocessed output which has been received by -the terminal emulator." - (interactive) - ;; this could conceivably be confusing in the presence of - ;; escape-sequences spanning process-output chunks - (if (null (cdr te-pending-output)) - (message "(There is no output pending)") - (let ((length (te-pending-output-length))) - (message "Flushing %d chars of pending output" length) - (setq te-pending-output - (list 0 (format "\n*** %d chars of pending output flushed ***\n" - length))) - (te-update-pending-output-display) - (te-process-output nil) - (sit-for 0)))) - - -(defun te-pass-through () - "Character is passed to the program running under the terminal emulator. -One characters is treated specially: -the terminal escape character (normally C-^) -lets you type a terminal emulator command." - (interactive) - (cond ((eq last-input-event terminal-escape-char) - (call-interactively 'te-escape)) - (t - ;; Convert `return' to C-m, etc. - (if (and (symbolp last-input-event) - (get last-input-event 'ascii-character)) - (setq last-input-event (get last-input-event 'ascii-character))) - ;; Convert meta characters to 8-bit form for transmission. - (if (and (integerp last-input-event) - (not (zerop (logand last-input-event ?\M-\^@)))) - (setq last-input-event (+ 128 (logand last-input-event 127)))) - ;; Now ignore all but actual characters. - ;; (It ought to be possible to send through function - ;; keys as character sequences if we add a description - ;; to our termcap entry of what they should look like.) - (if (integerp last-input-event) - (progn - (and terminal-more-processing (null (cdr te-pending-output)) - (te-set-more-count nil)) - (process-send-string te-process (make-string 1 last-input-event)) - (te-process-output t)) - (message "Function key `%s' ignored" - (single-key-description last-input-event)))))) - - -(defun te-set-window-start () - (let* ((w (get-buffer-window (current-buffer))) - (h (if w (window-height w)))) - (cond ((not w)) ; buffer not displayed - ((>= h (/ (- (point) (point-min)) (1+ te-width))) - ;; this is the normal case - (set-window-start w (point-min))) - ;; this happens if some vandal shrinks our window. - ((>= h (/ (- (point-max) (point)) (1+ te-width))) - (set-window-start w (- (point-max) (* h (1+ te-width)) -1))) - ;; I give up. - (t nil)))) - -(defun te-pending-output-length () - (let ((length (car te-pending-output)) - (tem (cdr te-pending-output))) - (while tem - (setq length (+ length (length (car tem))) tem (cdr tem))) - length)) - -;;>> What use is this terminal-edit stuff anyway? -;;>> If nothing else, it was written by somebody who didn't -;;>> competently understand the terminal-emulator... - -(defvar terminal-edit-map nil) -(if terminal-edit-map - nil - (setq terminal-edit-map (make-sparse-keymap)) - (define-key terminal-edit-map "\C-c\C-c" #'terminal-cease-edit)) - -;; Terminal Edit mode is suitable only for specially formatted data. -(put 'terminal-edit-mode 'mode-class 'special) - -(defun terminal-edit-mode () - "Major mode for editing the contents of a terminal-emulator buffer. -The editing commands are the same as in Fundamental mode, -together with a command \\to return to terminal emulation: \\[terminal-cease-edit]." - (use-local-map terminal-edit-map) - (setq major-mode 'terminal-edit-mode) - (setq mode-name "Terminal Edit") - (setq mode-line-modified (default-value 'mode-line-modified)) - (setq mode-line-process nil) - (run-mode-hooks 'terminal-edit-mode-hook)) - -(defun te-edit () - "Start editing the terminal emulator buffer with ordinary Emacs commands." - (interactive) - (terminal-edit-mode) - (force-mode-line-update) - ;; Make mode line update. - (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit) - (message "Editing: Type C-c C-c to return to Terminal") - (message "%s" - (substitute-command-keys - "Editing: Type \\[terminal-cease-edit] to return to Terminal")))) - -(defun terminal-cease-edit () - "Finish editing message; switch back to Terminal proper." - (interactive) - - ;;>> emulator will blow out if buffer isn't exactly te-width x te-height - (let ((buffer-read-only nil)) - (widen) - (let ((opoint (point-marker)) - (width te-width) - (h (1- te-height))) - (goto-char (point-min)) - (while (>= h 0) - (let ((p (point))) - (cond ((search-forward "\n" (+ p width) 'move) - (forward-char -1) - (insert-char ?\s (- width (- (point) p))) - (forward-char 1)) - ((eobp) - (insert-char ?\s (- width (- (point) p)))) - ((= (following-char) ?\n) - (forward-char 1)) - (t - (setq p (point)) - (if (search-forward "\n" nil t) - (delete-region p (1- (point))) - (delete-region p (point-max)))))) - (if (= h 0) - (if (not (eobp)) (delete-region (point) (point-max))) - (if (eobp) (insert ?\n))) - (setq h (1- h))) - (goto-char opoint) - (set-marker opoint nil nil) - (setq te-saved-point (point)) - (setq te-redisplay-count 0) - (setq te-more-count -1))) - - (setq mode-line-modified (default-value 'mode-line-modified)) - (use-local-map terminal-map) - (setq major-mode 'terminal-mode) - (setq mode-name "terminal") - (setq mode-line-process '(":%s"))) - -;;;; more break hair - -(defun te-more-break () - (te-set-more-count t) - (make-local-variable 'te-more-old-point) - (setq te-more-old-point (point)) - (make-local-variable 'te-more-old-local-map) - (setq te-more-old-local-map (current-local-map)) - (use-local-map terminal-more-break-map) - (make-local-variable 'te-more-old-filter) - (setq te-more-old-filter (process-filter te-process)) - (make-local-variable 'te-more-old-mode-line-format) - (setq te-more-old-mode-line-format mode-line-format - mode-line-format (list "-- **MORE** " - mode-line-buffer-identification - "%-")) - (set-process-filter te-process - (function (lambda (process string) - (with-current-buffer (process-buffer process) - (setq te-pending-output (nconc te-pending-output - (list string)))) - (te-update-pending-output-display)))) - (te-update-pending-output-display) - (if (eq (window-buffer (selected-window)) (current-buffer)) - (message "More break ")) - (or (eobp) - (null terminal-more-break-insertion) - (save-excursion - (forward-char 1) - (delete-region (point) (+ (point) te-width)) - (insert terminal-more-break-insertion))) - (run-hooks 'terminal-more-break-hook) - (sit-for 0) ;get display to update - (throw 'te-process-output t)) - -(defun te-more-break-unwind () - (use-local-map te-more-old-local-map) - (set-process-filter te-process te-more-old-filter) - (goto-char te-more-old-point) - (setq mode-line-format te-more-old-mode-line-format) - (force-mode-line-update) - (let ((buffer-read-only nil)) - (cond ((eobp)) - (terminal-more-break-insertion - (forward-char 1) - (delete-region (point) - (+ (point) (length terminal-more-break-insertion))) - (insert-char ?\s te-width) - (goto-char te-more-old-point))) - (setq te-more-old-point nil) - (let ((te-more-count 259259)) - (te-newline))) - ;(sit-for 0) - (te-process-output t)) - -(defun te-set-more-count (newline) - (let ((line (/ (- (point) (point-min)) (1+ te-width)))) - (if newline (setq line (1+ line))) - (cond ((= line te-height) - (setq te-more-count te-height)) - ;>>>> something is strange. Investigate this! - ((= line (1- te-height)) - (setq te-more-count te-height)) - ((or (< line (/ te-height 2)) - (> (- te-height line) 10)) - ;; break at end of this page - (setq te-more-count (- te-height line))) - (t - ;; migrate back towards top (ie bottom) of screen. - (setq te-more-count (- te-height - (if (> te-height 10) 2 1))))))) - - -;;;; More or less straight-forward terminal escapes - -;; ^j, meaning `newline' to non-display programs. -;; (Who would think of ever writing a system which doesn't understand -;; display terminals natively? Un*x: The Operating System of the Future.) -(defun te-newline () - "Move down a line, optionally do more processing, perhaps wrap/scroll, -move to start of new line, clear to end of line." - (end-of-line) - (cond ((not terminal-more-processing)) - ((< (setq te-more-count (1- te-more-count)) 0) - (te-set-more-count t)) - ((eq te-more-count 0) - ;; this doesn't return - (te-more-break))) - (if (eobp) - (progn - (delete-region (point-min) (+ (point-min) te-width)) - (goto-char (point-min)) - (if terminal-scrolling - (progn (delete-char 1) - (goto-char (point-max)) - (insert ?\n)))) - (forward-char 1) - (delete-region (point) (+ (point) te-width))) - (insert-char ?\s te-width) - (beginning-of-line) - (te-set-window-start)) - -; ^p = x+32 y+32 -(defun te-move-to-position () - ;; must offset by #o40 since cretinous unix won't send a 004 char through - (let ((y (- (te-get-char) 32)) - (x (- (te-get-char) 32))) - (if (or (> x te-width) - (> y te-height)) - () - (goto-char (+ (point-min) x (* y (1+ te-width)))) - ;(te-set-window-start?) - )) - (setq te-more-count -1)) - - - -;; ^p c -(defun te-clear-rest-of-line () - (save-excursion - (let ((n (- (point) (progn (end-of-line) (point))))) - (delete-region (point) (+ (point) n)) - (insert-char ?\s (- n))))) - - -;; ^p C -(defun te-clear-rest-of-screen () - (save-excursion - (te-clear-rest-of-line) - (while (progn (end-of-line) (not (eobp))) - (forward-char 1) (end-of-line) - (delete-region (- (point) te-width) (point)) - (insert-char ?\s te-width)))) - - -;; ^p ^l -(defun te-clear-screen () - ;; regenerate buffer to compensate for (nonexistent!!) bugs. - (erase-buffer) - (let ((i 0)) - (while (< i te-height) - (setq i (1+ i)) - (insert-char ?\s te-width) - (insert ?\n))) - (delete-region (1- (point-max)) (point-max)) - (goto-char (point-min)) - (setq te-more-count -1)) - - -;; ^p ^o count+32 -(defun te-insert-lines () - (if (not (bolp)) - ();(error "fooI") - (save-excursion - (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) - (n (min (- (te-get-char) ?\s) line)) - (i 0)) - (delete-region (- (point-max) (* n (1+ te-width))) (point-max)) - (if (eq (point) (point-max)) (insert ?\n)) - (while (< i n) - (setq i (1+ i)) - (insert-char ?\s te-width) - (or (eq i line) (insert ?\n)))))) - (setq te-more-count -1)) - - -;; ^p ^k count+32 -(defun te-delete-lines () - (if (not (bolp)) - ();(error "fooD") - (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1)) - (n (min (- (te-get-char) ?\s) line)) - (i 0)) - (delete-region (point) - (min (+ (point) (* n (1+ te-width))) (point-max))) - (save-excursion - (goto-char (point-max)) - (while (< i n) - (setq i (1+ i)) - (insert-char ?\s te-width) - (or (eq i line) (insert ?\n)))))) - (setq te-more-count -1)) - -;; ^p ^a -(defun te-beginning-of-line () - (beginning-of-line)) - -;; ^p ^b -(defun te-backward-char () - (if (not (bolp)) - (backward-char 1))) - -;; ^p ^f -(defun te-forward-char () - (if (not (eolp)) - (forward-char 1))) - - -;; 0177 -(defun te-delete () - (if (bolp) - () - (delete-region (1- (point)) (point)) - (insert ?\s) - (forward-char -1))) - -;; ^p ^g -(defun te-beep () - (beep)) - - -;; ^p _ count+32 -(defun te-insert-spaces () - (let* ((p (point)) - (n (min (- (te-get-char) 32) - (- (progn (end-of-line) (point)) p)))) - (if (<= n 0) - nil - (delete-char (- n)) - (goto-char p) - (insert-char ?\s n)) - (goto-char p))) - -;; ^p d count+32 (should be ^p ^d but cretinous un*x won't send ^d chars!!!) -(defun te-delete-char () - (let* ((p (point)) - (n (min (- (te-get-char) 32) - (- (progn (end-of-line) (point)) p)))) - (if (<= n 0) - nil - (insert-char ?\s n) - (goto-char p) - (delete-char n)) - (goto-char p))) - - - -;; disgusting unix-required excrement -;; Are we living twenty years in the past yet? - -(defun te-losing-unix () - nil) - -;; ^i -(defun te-output-tab () - (let* ((p (point)) - (x (- p (progn (beginning-of-line) (point)))) - (l (min (- 8 (logand x 7)) - (progn (end-of-line) (- (point) p))))) - (goto-char (+ p l)))) - -;; ^p ^j -;; Handle the `do' or `nl' termcap capability. -;;>> I am not sure why this broken, obsolete, capability is here. -;;>> Perhaps it is for VIle. No comment was made about why it -;;>> was added (in "Sun Dec 6 01:22:27 1987 Richard Stallman") -(defun te-down-vertically-or-scroll () - "Move down a line vertically, or scroll at bottom." - (let ((column (current-column))) - (end-of-line) - (if (eobp) - (progn - (delete-region (point-min) (+ (point-min) te-width)) - (goto-char (point-min)) - (delete-char 1) - (goto-char (point-max)) - (insert ?\n) - (insert-char ?\s te-width) - (beginning-of-line)) - (forward-line 1)) - (move-to-column column)) - (te-set-window-start)) - -;; Also: -;; ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!) -;; ^g => te-beep (for which it should use ^p ^g) -;; ^h => te-backward-char (for which it should use ^p ^b) - - - -(defun te-filter (process string) - (with-current-buffer (process-buffer process) - (goto-char te-saved-point) - (and (bufferp te-log-buffer) - (if (null (buffer-name te-log-buffer)) - ;; killed - (setq te-log-buffer nil) - (set-buffer te-log-buffer) - (goto-char (point-max)) - (insert-before-markers string) - (set-buffer (process-buffer process)))) - (setq te-pending-output (nconc te-pending-output (list string))) - (te-update-pending-output-display) - (te-process-output (eq (current-buffer) - (window-buffer (selected-window)))) - (set-buffer (process-buffer process)) - (setq te-saved-point (point)))) - -;; (A version of the following comment which might be distractingly offensive -;; to some readers has been moved to term-nasty.el.) -;; unix lacks ITS-style tty control... -(defun te-process-output (preemptible) - ;;>> There seems no good reason to ever disallow preemption - (setq preemptible t) - (catch 'te-process-output - (let ((buffer-read-only nil) - (string nil) ostring start char (matchpos nil)) - (while (cdr te-pending-output) - (setq ostring string - start (car te-pending-output) - string (car (cdr te-pending-output)) - char (aref string start)) - (if (eq (setq start (1+ start)) (length string)) - (progn (setq te-pending-output - (cons 0 (cdr (cdr te-pending-output))) - start 0 - string (car (cdr te-pending-output))) - (te-update-pending-output-display)) - (setcar te-pending-output start)) - (if (and (> char ?\037) (< char ?\377)) - (cond ((eolp) - ;; unread char - (if (eq start 0) - (setq te-pending-output - (cons 0 (cons (make-string 1 char) - (cdr te-pending-output)))) - (setcar te-pending-output (1- start))) - (te-newline)) - ((null string) - (delete-char 1) (insert char) - (te-redisplay-if-necessary 1)) - (t - (let ((end (or (and (eq ostring string) matchpos) - (setq matchpos (string-match - "[\000-\037\177-\377]" - string start)) - (length string)))) - (delete-char 1) (insert char) - (setq char (point)) (end-of-line) - (setq end (min end (+ start (- (point) char)))) - (goto-char char) - (if (eq end matchpos) (setq matchpos nil)) - (delete-region (point) (+ (point) (- end start))) - (insert (if (and (eq start 0) - (eq end (length string))) - string - (substring string start end))) - (if (eq end (length string)) - (setq te-pending-output - (cons 0 (cdr (cdr te-pending-output)))) - (setcar te-pending-output end)) - (te-redisplay-if-necessary (1+ (- end start)))))) - ;; I suppose if I split the guts of this out into a separate - ;; function we could trivially emulate different terminals - ;; Who cares in any case? (Apart from stupid losers using rlogin) - (funcall - (if (eq char ?\^p) - (or (cdr (assq (te-get-char) - '((?= . te-move-to-position) - (?c . te-clear-rest-of-line) - (?C . te-clear-rest-of-screen) - (?\C-o . te-insert-lines) - (?\C-k . te-delete-lines) - ;; not necessary, but help sometimes. - (?\C-a . te-beginning-of-line) - (?\C-b . te-backward-char) - ;; should be C-d, but un*x - ;; pty's won't send \004 through! - ;; Can you believe this? - (?d . te-delete-char) - (?_ . te-insert-spaces) - ;; random - (?\C-f . te-forward-char) - (?\C-g . te-beep) - (?\C-j . te-down-vertically-or-scroll) - (?\C-l . te-clear-screen) - ))) - 'te-losing-unix) - (or (cdr (assq char - '((?\C-j . te-newline) - (?\177 . te-delete) - ;; Did I ask to be sent these characters? - ;; I don't remember doing so, either. - ;; (Perhaps some operating system or - ;; other is completely incompetent...) - (?\C-m . te-beginning-of-line) - (?\C-g . te-beep) - (?\C-h . te-backward-char) - (?\C-i . te-output-tab)))) - 'te-losing-unix))) - (te-redisplay-if-necessary 1)) - (and preemptible - (input-pending-p) - ;; preemptible output! Oh my!! - (throw 'te-process-output t))))) - ;; We must update window-point in every window displaying our buffer - (walk-windows (lambda (w) - (when (and (not (eq w (selected-window))) - (eq (window-buffer w) (current-buffer))) - (set-window-point w (point)))))) - -(defun te-get-char () - (if (cdr te-pending-output) - (let ((start (car te-pending-output)) - (string (car (cdr te-pending-output)))) - (prog1 (aref string start) - (if (eq (setq start (1+ start)) (length string)) - (setq te-pending-output (cons 0 (cdr (cdr te-pending-output)))) - (setcar te-pending-output start)))) - (catch 'char - (let ((filter (process-filter te-process))) - (unwind-protect - (progn - (set-process-filter te-process - (function (lambda (_p s) - (or (eq (length s) 1) - (setq te-pending-output (list 1 s))) - (throw 'char (aref s 0))))) - (accept-process-output te-process)) - (set-process-filter te-process filter)))))) - - -(defun te-redisplay-if-necessary (length) - (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0) - (eq (current-buffer) (window-buffer (selected-window))) - (waiting-for-user-input-p) - (progn (te-update-pending-output-display) - (sit-for 0) - (setq te-redisplay-count terminal-redisplay-interval)))) - -(defun te-update-pending-output-display () - (if (null (cdr te-pending-output)) - (setq te-pending-output-info "") - (let ((length (te-pending-output-length))) - (if (< length 1500) - (setq te-pending-output-info "") - (setq te-pending-output-info (format "(%dK chars output pending) " - (/ (+ length 512) 1024)))))) - (force-mode-line-update)) - - -(defun te-sentinel (process message) - (cond ((eq (process-status process) 'run)) - ((null (buffer-name (process-buffer process)))) ;deleted - (t (let ((b (current-buffer))) - (with-current-buffer (process-buffer process) - (setq buffer-read-only nil) - (fundamental-mode) - (goto-char (point-max)) - (delete-blank-lines) - (delete-horizontal-space) - (insert "\n*******\n" message "*******\n")) - (if (and (eq b (process-buffer process)) - (waiting-for-user-input-p)) - (progn (goto-char (point-max)) - (recenter -1))))))) - -(defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" - "Shell command to set terminal modes for terminal emulator.") -;; This used to have `new' in it, but that loses outside BSD -;; and it's apparently not needed in BSD. - -;;;###autoload -(defun terminal-emulator (buffer program args &optional width height) - "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. -ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. -BUFFER's contents are made an image of the display generated by that program, -and any input typed when BUFFER is the current Emacs buffer is sent to that -program as keyboard input. - -Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS -are parsed from an input-string using your usual shell. -WIDTH and HEIGHT are determined from the size of the current window --- WIDTH will be one less than the window's width, HEIGHT will be its height. - -To switch buffers and leave the emulator, or to give commands -to the emulator itself (as opposed to the program running under it), -type Control-^. The following character is an emulator command. -Type Control-^ twice to send it to the subprogram. -This escape character may be changed using the variable `terminal-escape-char'. - -`Meta' characters may not currently be sent through the terminal emulator. - -Here is a list of some of the variables which control the behavior -of the emulator -- see their documentation for more information: -terminal-escape-char, terminal-scrolling, terminal-more-processing, -terminal-redisplay-interval. - -This function calls the value of terminal-mode-hook if that exists -and is non-nil after the terminal buffer has been set up and the -subprocess started." - (interactive - (cons (with-current-buffer (get-buffer-create "*terminal*") - (buffer-name (if (or (not (boundp 'te-process)) - (null te-process) - (not (eq (process-status te-process) - 'run))) - (current-buffer) - (generate-new-buffer "*terminal*")))) - (append - (let* ((default-s - ;; Default shell is same thing M-x shell uses. - (or explicit-shell-file-name - (getenv "ESHELL") - (getenv "SHELL") - (if (eq system-type 'android) - "/system/bin/sh" - "/bin/sh"))) - (s (read-string - (format "Run program in emulator (default %s): " - default-s)))) - (if (equal s "") - (list default-s '()) - (te-parse-program-and-args s)))))) - (switch-to-buffer buffer) - (if (null width) (setq width (- (window-width (selected-window)) 1))) - (if (null height) (setq height (- (window-height (selected-window)) 1))) - (terminal-mode) - (setq te-width width te-height height) - (setq te-terminal-name (concat te-terminal-name-prefix - (number-to-string te-width) - (number-to-string te-height))) - (setq mode-line-buffer-identification - (list (format "Emacs terminal %dx%d: %%b " te-width te-height) - 'te-pending-output-info)) - (let ((buffer-read-only nil)) - (te-clear-screen)) - (let (process) - (while (setq process (get-buffer-process (current-buffer))) - (if (y-or-n-p (format "Kill process %s? " (process-name process))) - (delete-process process) - (error "Process %s not killed" (process-name process))))) - (condition-case err - (let ((process-environment - (cons (concat "TERM=" te-terminal-name) - (cons (concat "TERMCAP=" (te-create-termcap)) - (cons (concat "TERMINFO=" (te-create-terminfo)) - process-environment))))) - (setq te-process - (start-process "terminal-emulator" (current-buffer) - "/bin/sh" "-c" - ;; Yuck!!! Start a shell to set some terminal - ;; control characteristics. Then start the - ;; "env" program to setup the terminal type - ;; Then finally start the program we wanted. - (format "%s; exec %s" - te-stty-string - (mapconcat #'te-quote-arg-for-sh - (cons program args) " ")))) - (set-process-filter te-process #'te-filter) - (set-process-sentinel te-process #'te-sentinel)) - (error (fundamental-mode) - (signal (car err) (cdr err)))) - (setq inhibit-quit t) ;sport death - (use-local-map terminal-map) - (run-hooks 'terminal-mode-hook) - (message "Entering Emacs terminal-emulator... Type %s %s for help" - (single-key-description terminal-escape-char) - (mapconcat #'single-key-description - (where-is-internal #'te-escape-help terminal-escape-map t) - " "))) - - -(defun te-parse-program-and-args (s) - (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:][-a-zA-Z0-9+=_.@/: \t]*\\'" s) - (let ((l ()) (p 0)) - (while p - (setq l (cons (if (string-match - "\\([-a-zA-Z0-9+=_.@/:]+\\)[ \t]*" - s p) - (prog1 (substring s p (match-end 1)) - (setq p (match-end 0)) - (if (eq p (length s)) (setq p nil))) - (prog1 (substring s p) - (setq p nil))) - l))) - (setq l (nreverse l)) - (list (car l) (cdr l)))) - ((and (string-match "[ \t]" s) (not (file-exists-p s))) - (list shell-file-name (list "-c" (concat "exec " s)))) - (t (list s ())))) - -(put 'terminal-mode 'mode-class 'special) -;; This is only separated out from function terminal-emulator -;; to keep the latter a little more manageable. -(defun terminal-mode () - "Set up variables for use with the terminal-emulator. -One should not call this -- it is an internal function -of the terminal-emulator" - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'terminal-mode) - (setq mode-name "terminal") -; (make-local-variable 'Helper-return-blurb) -; (setq Helper-return-blurb "return to terminal simulator") - (setq mode-line-process '(":%s")) - (setq buffer-read-only t) - (setq truncate-lines t) - (make-local-variable 'terminal-escape-char) - (setq terminal-escape-char (default-value 'terminal-escape-char)) - (make-local-variable 'terminal-scrolling) - (setq terminal-scrolling (default-value 'terminal-scrolling)) - (make-local-variable 'terminal-more-processing) - (setq terminal-more-processing (default-value 'terminal-more-processing)) - (make-local-variable 'terminal-redisplay-interval) - (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval)) - (make-local-variable 'te-width) - (make-local-variable 'te-height) - (make-local-variable 'te-process) - (make-local-variable 'te-pending-output) - (setq te-pending-output (list 0)) - (make-local-variable 'te-saved-point) - (setq te-saved-point (point-min)) - (make-local-variable 'te-pending-output-info) ;for the mode line - (setq te-pending-output-info "") - (make-local-variable 'inhibit-quit) - ;(setq inhibit-quit t) - (make-local-variable 'te-log-buffer) - (setq te-log-buffer nil) - (make-local-variable 'te-more-count) - (setq te-more-count -1) - (make-local-variable 'te-redisplay-count) - (setq te-redisplay-count terminal-redisplay-interval) - ;(use-local-map terminal-mode-map) - ;; terminal-mode-hook is called above in function terminal-emulator - ) - -;;;; what a complete loss - -(defun te-quote-arg-for-sh (string) - (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'" - string) - string) - ((not (string-search "$" string)) - ;; "[\"\\]" are special to sh and the lisp reader in the same way - (prin1-to-string string)) - (t - (let ((harder "") - (start 0) - (end 0)) - (while (cond ((>= start (length string)) - nil) - ;; this is the set of chars magic with "..." in `sh' - ((setq end (string-match "[\"\\$]" - string start)) - t) - (t (setq harder (concat harder - (substring string start))) - nil)) - (setq harder (concat harder (substring string start end) - ;; Can't use ?\\ since `concat' - ;; unfortunately does prin1-to-string - ;; on fixna. Amazing. - "\\" - (substring string - end - (1+ end))) - start (1+ end))) - (concat "\"" harder "\""))))) - -(defun te-create-terminfo () - "Create and compile a terminfo entry for the virtual terminal. This is kept -in the directory specified by `te-terminfo-directory'." - (when (and system-uses-terminfo - (not (file-exists-p (concat te-terminfo-directory - (substring te-terminal-name-prefix 0 1) - "/" te-terminal-name)))) - (let ( (terminfo - (concat - ;; The first newline avoids trouble with ncurses. - (format "%s,\n\tmir, xon,cols#%d, lines#%d," - te-terminal-name te-width te-height) - "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n," - "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c," - "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c," - "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s," - "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c," - ;; The last newline avoids trouble with ncurses. - "il1=^P^O!, ind=^P\\n, nel=\\n,\n")) - ;; This is the desired name for the source file. - (file-name (concat te-terminfo-directory te-terminal-name ".tif")) ) - (make-directory te-terminfo-directory t) - (let ((temp-file - (make-temp-file (expand-file-name "tif" te-terminfo-directory)))) - ;; Store the source file under a random temp name. - (with-temp-file temp-file - (insert terminfo)) - ;; Rename it to the desired name. - ;; We use this roundabout approach - ;; to avoid any risk of writing a name that - ;; was mischievously set up as a symlink. - (rename-file temp-file file-name)) - ;; Now compile that source to make the binary that the - ;; programs actually use. - (let ((process-environment - (cons (concat "TERMINFO=" - (directory-file-name te-terminfo-directory)) - process-environment))) - (set-process-sentinel (start-process "tic" nil "tic" file-name) - #'te-tic-sentinel)))) - (directory-file-name te-terminfo-directory)) - -(defun te-create-termcap () - "Create a termcap entry for the virtual terminal" - ;; Because of Unix Brain Death(tm), we can't change - ;; the terminal type of a running process, and so - ;; terminal size and scrollability are wired-down - ;; at this point. ("Detach? What's that?") - (concat (format "%s:co#%d:li#%d:%s" - ;; Sigh. These can't be dynamically changed. - te-terminal-name te-width te-height (if terminal-scrolling - "" "ns:")) - ;;-- Basic things - ;; cursor-motion, bol, forward/backward char - "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:" - ;; newline, clear eof/eof, audible bell - "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:" - ;; insert/delete char/line - "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :" - ;;-- Not-widely-known (ie nonstandard) flags, which mean - ;; o writing in the last column of the last line - ;; doesn't cause idiotic scrolling, and - ;; o don't use idiotische c-s/c-q sogenannte - ;; ``flow control'' auf keinen Fall. - "LP:NF:" - ;;-- For stupid or obsolete programs - "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p= :" - ;;-- For disgusting programs. - ;; (VI? What losers need these, I wonder?) - "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:") -) - -(defun te-tic-sentinel (_proc state-change) - "If tic has finished, delete the .tif file" - (if (equal state-change "finished -") - (delete-file (concat te-terminfo-directory te-terminal-name ".tif")))) - -(provide 'terminal) - -;;; terminal.el ends here diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el deleted file mode 100644 index afc6284b348..00000000000 --- a/lisp/obsolete/vi.el +++ /dev/null @@ -1,1495 +0,0 @@ -;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs -*- lexical-binding: t; -*- - -;; This file is in the public domain because the authors distributed it -;; without a copyright notice before the US signed the Bern Convention. - -;; This file is part of GNU Emacs. - -;; Author: Neal Ziring -;; Felix S. T. Wu -;; Keywords: emulations -;; Obsolete-since: 24.5 - -;;; Commentary: - -;; This file is obsolete. Consider using viper instead. - -;; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring) -;; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu) -;; Last revision: 01/07/87 Wed (for GNU Emacs 18.33) - -;; INSTALLATION PROCEDURE: -;; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of -;; the single ESC used in real "vi", so I can access other ESC prefixed emacs -;; commands while I'm in "vi"), say, by putting the following line in your -;; ".emacs" file: -;; (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode -;; 2) If you wish you can define "find-file-hook" to enter "vi" automatically -;; after a file is loaded into the buffer. For example, I defined it as: -;; (setq find-file-hook (list -;; (function (lambda () -;; (if (not (or (eq major-mode 'Info-mode) -;; (eq major-mode 'vi-mode))) -;; (vi-mode)))))) -;; 3) In your init file you can define the command "vi-mode" to be "autoload" -;; or you can execute the "load" command to load "vi" directly. -;; 4) Read the comments for command "vi-mode" before you start using it. - -;; COULD DO -;; 1). A general 'define-operator' function to replace current hack -;; 2). In operator handling, should allow other point moving Emacs commands -;; (such as ESC <, ESC >) to be used as arguments. - -;;; Code: - -(defvar vi-mode-old-major-mode) -(defvar vi-mode-old-mode-name) -(defvar vi-mode-old-local-map) -(defvar vi-mode-old-case-fold) - -(if (null (where-is-internal 'vi-switch-mode (current-local-map))) - (define-key ctl-x-map "~" #'vi-switch-mode)) - -(defvar vi-tilde-map nil - "Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") - -(if vi-tilde-map - nil - (setq vi-tilde-map (make-keymap)) - (define-key vi-tilde-map "a" #'abbrev-mode) - (define-key vi-tilde-map "c" #'c-mode) - (define-key vi-tilde-map "d" #'vi-debugging) - (define-key vi-tilde-map "e" #'emacs-lisp-mode) - (define-key vi-tilde-map "f" #'auto-fill-mode) - (define-key vi-tilde-map "g" #'prolog-mode) - (define-key vi-tilde-map "h" #'hanoi) - ;; (define-key vi-tilde-map "i" #'info-mode) - (define-key vi-tilde-map "l" #'lisp-mode) - (define-key vi-tilde-map "n" #'nroff-mode) - (define-key vi-tilde-map "o" #'overwrite-mode) - (define-key vi-tilde-map "O" #'outline-mode) - (define-key vi-tilde-map "P" #'picture-mode) - (define-key vi-tilde-map "r" #'vi-readonly-mode) - (define-key vi-tilde-map "t" #'text-mode) - (define-key vi-tilde-map "v" #'vi-mode) - (define-key vi-tilde-map "x" #'tex-mode) - (define-key vi-tilde-map "~" #'vi-back-to-old-mode)) - -(defun vi-switch-mode (arg mode-char) - "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" - (interactive "P\nc") - (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char)))) - (if (null mode-cmd) - (with-output-to-temp-buffer "*Help*" - (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}")) - (with-current-buffer standard-output - (help-mode))) - (setq prefix-arg arg) ; prefix arg will be passed down - (command-execute mode-cmd nil) ; may need to save mode-line-format etc - (force-mode-line-update)))) ; just in case - - -(defun vi-debugging (arg) - "Toggle debug-on-error flag. If prefix arg is given, set t." - (interactive "P") - (if arg - (setq debug-on-error t) - (setq debug-on-error (not debug-on-error))) - (if debug-on-error - (message "Debug-on-error ...") - (message "NO more debug-on-error"))) - -(defun vi-back-to-old-mode () - "Go back to the previous mode without setting up for insertion." - (interactive) - (if vi-mode-old-major-mode - (progn - (setq mode-name vi-mode-old-mode-name) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (setq case-fold-search vi-mode-old-case-fold) - (force-mode-line-update)))) - -(defun vi-readonly-mode () - "Toggle current buffer's readonly flag." - (interactive) - (setq buffer-read-only (not buffer-read-only))) - -(defvar vi-com-map nil - "Keymap used in Evi's command state -Command state includes most of the vi editing commands, with some Emacs -command extensions.") - -(put 'vi-undefined 'suppress-keymap t) -(if vi-com-map nil - (setq vi-com-map (make-keymap)) -;;(fillarray vi-com-map #'vi-undefined) - (define-key vi-com-map "\C-@" #'vi-mark-region) ; extension - (define-key vi-com-map "\C-a" #'vi-ask-for-info) ; extension - (define-key vi-com-map "\C-b" #'vi-backward-windowful) - (define-key vi-com-map "\C-c" #'vi-do-old-mode-C-c-command) ; extension - (define-key vi-com-map "\C-d" #'vi-scroll-down-window) - (define-key vi-com-map "\C-e" #'vi-expose-line-below) - (define-key vi-com-map "\C-f" #'vi-forward-windowful) - (define-key vi-com-map "\C-g" #'keyboard-quit) - (define-key vi-com-map "\C-i" #'indent-relative-first-indent-point) ; TAB - (define-key vi-com-map "\C-j" #'vi-next-line) ; LFD - (define-key vi-com-map "\C-k" #'vi-kill-line) ; extension - (define-key vi-com-map "\C-l" #'recenter) - (define-key vi-com-map "\C-m" #'vi-next-line-first-nonwhite) ; RET - (define-key vi-com-map "\C-n" #'vi-next-line) - (define-key vi-com-map "\C-o" #'vi-split-open-line) - (define-key vi-com-map "\C-p" #'previous-line) - (define-key vi-com-map "\C-q" #'vi-query-replace) ; extension - (define-key vi-com-map "\C-r" #'vi-isearch-backward) ; modification - (define-key vi-com-map "\C-s" #'vi-isearch-forward) ; extension - (define-key vi-com-map "\C-t" #'vi-transpose-objects) ; extension - (define-key vi-com-map "\C-u" #'vi-scroll-up-window) - (define-key vi-com-map "\C-v" #'scroll-up-command) ; extension - (define-key vi-com-map "\C-w" #'vi-kill-region) ; extension - (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension - (define-key vi-com-map "\C-y" #'vi-expose-line-above) - (define-key vi-com-map "\C-z" #'suspend-emacs) - - (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) - (define-key vi-com-map "\C-\\" #'vi-unimplemented) - (define-key vi-com-map "\C-]" #'xref-find-definitions) - (define-key vi-com-map "\C-^" #'vi-locate-def) ; extension - (define-key vi-com-map "\C-_" #'vi-undefined) - - (define-key vi-com-map " " #'forward-char) - (define-key vi-com-map "!" #'vi-operator) - (define-key vi-com-map "\"" #'vi-char-argument) - (define-key vi-com-map "#" #'universal-argument) ; extension - (define-key vi-com-map "$" #'end-of-line) - (define-key vi-com-map "%" #'vi-find-matching-paren) - (define-key vi-com-map "&" #'vi-unimplemented) - (define-key vi-com-map "'" #'vi-goto-line-mark) - (define-key vi-com-map "(" #'backward-sexp) - (define-key vi-com-map ")" #'forward-sexp) - (define-key vi-com-map "*" #'vi-name-last-change-or-macro) ; extension - (define-key vi-com-map "+" #'vi-next-line-first-nonwhite) - (define-key vi-com-map "," #'vi-reverse-last-find-char) - (define-key vi-com-map "-" #'vi-previous-line-first-nonwhite) - (define-key vi-com-map "." #'vi-redo-last-change-command) - (define-key vi-com-map "/" #'vi-search-forward) - (define-key vi-com-map "0" #'beginning-of-line) - - (define-key vi-com-map "1" #'vi-digit-argument) - (define-key vi-com-map "2" #'vi-digit-argument) - (define-key vi-com-map "3" #'vi-digit-argument) - (define-key vi-com-map "4" #'vi-digit-argument) - (define-key vi-com-map "5" #'vi-digit-argument) - (define-key vi-com-map "6" #'vi-digit-argument) - (define-key vi-com-map "7" #'vi-digit-argument) - (define-key vi-com-map "8" #'vi-digit-argument) - (define-key vi-com-map "9" #'vi-digit-argument) - - (define-key vi-com-map ":" #'vi-ex-cmd) - (define-key vi-com-map ";" #'vi-repeat-last-find-char) - (define-key vi-com-map "<" #'vi-operator) - (define-key vi-com-map "=" #'vi-operator) - (define-key vi-com-map ">" #'vi-operator) - (define-key vi-com-map "?" #'vi-search-backward) - (define-key vi-com-map "@" #'vi-call-named-change-or-macro) ; extension - - (define-key vi-com-map "A" #'vi-append-at-end-of-line) - (define-key vi-com-map "B" #'vi-backward-blank-delimited-word) - (define-key vi-com-map "C" #'vi-change-rest-of-line) - (define-key vi-com-map "D" #'vi-kill-line) - (define-key vi-com-map "E" #'vi-end-of-blank-delimited-word) - (define-key vi-com-map "F" #'vi-backward-find-char) - (define-key vi-com-map "G" #'vi-goto-line) - (define-key vi-com-map "H" #'vi-home-window-line) - (define-key vi-com-map "I" #'vi-insert-before-first-nonwhite) - (define-key vi-com-map "J" #'vi-join-lines) - (define-key vi-com-map "K" #'vi-undefined) - (define-key vi-com-map "L" #'vi-last-window-line) - (define-key vi-com-map "M" #'vi-middle-window-line) - (define-key vi-com-map "N" #'vi-reverse-last-search) - (define-key vi-com-map "O" #'vi-open-above) - (define-key vi-com-map "P" #'vi-put-before) - (define-key vi-com-map "Q" #'vi-quote-words) ; extension - (define-key vi-com-map "R" #'vi-replace-chars) - (define-key vi-com-map "S" #'vi-substitute-lines) - (define-key vi-com-map "T" #'vi-backward-upto-char) - (define-key vi-com-map "U" #'vi-unimplemented) - (define-key vi-com-map "V" #'vi-undefined) - (define-key vi-com-map "W" #'vi-forward-blank-delimited-word) - (define-key vi-com-map "X" #'call-last-kbd-macro) ; modification/extension - (define-key vi-com-map "Y" #'vi-yank-line) - (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command - (define-key vi-com-map "ZZ" #'vi-save-all-and-exit) - - (define-key vi-com-map "[" #'vi-unimplemented) - (define-key vi-com-map "\\" #'vi-operator) ; extension for vi-narrow-op - (define-key vi-com-map "]" #'vi-unimplemented) - (define-key vi-com-map "^" #'back-to-indentation) - (define-key vi-com-map "_" #'vi-undefined) - (define-key vi-com-map "`" #'vi-goto-char-mark) - - (define-key vi-com-map "a" #'vi-insert-after) - (define-key vi-com-map "b" #'backward-word) - (define-key vi-com-map "c" #'vi-operator) - (define-key vi-com-map "d" #'vi-operator) - (define-key vi-com-map "e" #'vi-end-of-word) - (define-key vi-com-map "f" #'vi-forward-find-char) - (define-key vi-com-map "g" #'vi-beginning-of-buffer) ; extension - (define-key vi-com-map "h" #'backward-char) - (define-key vi-com-map "i" #'vi-insert-before) - (define-key vi-com-map "j" #'vi-next-line) - (define-key vi-com-map "k" #'previous-line) - (define-key vi-com-map "l" #'forward-char) - (define-key vi-com-map "m" #'vi-set-mark) - (define-key vi-com-map "n" #'vi-repeat-last-search) - (define-key vi-com-map "o" #'vi-open-below) - (define-key vi-com-map "p" #'vi-put-after) - (define-key vi-com-map "q" #'vi-replace) - (define-key vi-com-map "r" #'vi-replace-1-char) - (define-key vi-com-map "s" #'vi-substitute-chars) - (define-key vi-com-map "t" #'vi-forward-upto-char) - (define-key vi-com-map "u" #'undo) - (define-key vi-com-map "v" #'vi-verify-spelling) - (define-key vi-com-map "w" #'vi-forward-word) - (define-key vi-com-map "x" #'vi-kill-char) - (define-key vi-com-map "y" #'vi-operator) - (define-key vi-com-map "z" #'vi-adjust-window) - - (define-key vi-com-map "{" #'backward-paragraph) - (define-key vi-com-map "|" #'vi-goto-column) - (define-key vi-com-map "}" #'forward-paragraph) - (define-key vi-com-map "~" #'vi-change-case) - (define-key vi-com-map "\177" #'delete-backward-char)) - -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-next-line 'point-moving-unit 'line) -(put 'next-line 'point-moving-unit 'line) -(put 'forward-line 'point-moving-unit 'line) -(put 'previous-line 'point-moving-unit 'line) -(put 'vi-isearch-backward 'point-moving-unit 'search) -(put 'vi-search-backward 'point-moving-unit 'search) -(put 'vi-isearch-forward 'point-moving-unit 'search) -(put 'vi-search-forward 'point-moving-unit 'search) -(put 'forward-char 'point-moving-unit 'char) -(put 'end-of-line 'point-moving-unit 'char) -(put 'vi-find-matching-paren 'point-moving-unit 'match) -(put 'vi-goto-line-mark 'point-moving-unit 'line) -(put 'backward-sexp 'point-moving-unit 'sexp) -(put 'forward-sexp 'point-moving-unit 'sexp) -(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find) -(put 'vi-re-search-forward 'point-moving-unit 'search) -(put 'beginning-of-line 'point-moving-unit 'char) -(put 'vi-beginning-of-buffer 'point-moving-unit 'char) -(put 'vi-repeat-last-find-char 'point-moving-unit 'find) -(put 'vi-re-search-backward 'point-moving-unit 'search) -(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match) -(put 'vi-backward-find-char 'point-moving-unit 'find) -(put 'vi-goto-line 'point-moving-unit 'line) -(put 'vi-home-window-line 'point-moving-unit 'line) -(put 'vi-last-window-line 'point-moving-unit 'line) -(put 'vi-middle-window-line 'point-moving-unit 'line) -(put 'vi-reverse-last-search 'point-moving-unit 'rev-search) -(put 'vi-backward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'back-to-indentation 'point-moving-unit 'char) -(put 'vi-goto-char-mark 'point-moving-unit 'char) -(put 'backward-word 'point-moving-unit 'word) -(put 'vi-end-of-word 'point-moving-unit 'match) -(put 'vi-forward-find-char 'point-moving-unit 'find) -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-forward-char 'point-moving-unit 'char) -(put 'vi-repeat-last-search 'point-moving-unit 'search) -(put 'vi-forward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-word 'point-moving-unit 'word) -(put 'vi-goto-column 'point-moving-unit 'match) -(put 'forward-paragraph 'point-moving-unit 'paragraph) -(put 'backward-paragraph 'point-moving-unit 'paragraph) - -;;; region mark commands -(put 'mark-page 'point-moving-unit 'region) -(put 'mark-paragraph 'point-moving-unit 'region) -(put 'mark-word 'point-moving-unit 'region) -(put 'mark-sexp 'point-moving-unit 'region) -(put 'mark-defun 'point-moving-unit 'region) -(put 'mark-whole-buffer 'point-moving-unit 'region) -(put 'mark-end-of-sentence 'point-moving-unit 'region) -(put 'c-mark-function 'point-moving-unit 'region) -;;; - -(defvar vi-mark-alist nil - "Alist of (NAME . MARK), marks are local to each buffer.") - -(defvar vi-scroll-amount (/ (window-height) 2) - "Default amount of lines for scrolling (used by \"^D\"/\"^U\").") - -(defvar vi-shift-width 4 - "Shift amount for \"<\"/\">\" operators.") - -(defvar vi-ins-point nil ; integer - "Last insertion point. Should use `mark' instead.") - -(defvar vi-ins-length nil ; integer - "Length of last insertion.") - -(defvar vi-ins-repetition nil ; integer - "The repetition required for last insertion.") - -(defvar vi-ins-overwrt-p nil ; boolean - "T if last insertion was a replace actually.") - -(defvar vi-ins-prefix-code nil ; ready-to-eval sexp - "Code to be eval'ed before (redo-)insertion begins.") - -(defvar vi-last-find-char nil ; cons cell - "Save last direction, char and upto-flag used for char finding.") - -(defvar vi-last-change-command nil ; cons cell - "Save commands for redoing last changes. Each command is in (FUNC . ARGS) -form that is ready to be `apply'ed.") - -(defvar vi-last-shell-command nil ; last shell op command line - "Save last shell command given for \"!\" operator.") - -(defvar vi-insert-state nil ; boolean - "Non-nil if it is in insert state.") - -; in "loaddefs.el" -;(defvar search-last-string "" -; "Last string search for by a search command.") - -(defvar vi-search-last-command nil ; (re-)search-forward(backward) - "Save last search command for possible redo.") - -(defvar vi-mode-old-local-map nil - "Save the local-map used before entering vi-mode.") - -(defvar vi-mode-old-mode-name nil - "Save the mode-name before entering vi-mode.") - -(defvar vi-mode-old-major-mode nil - "Save the major-mode before entering vi-mode.") - -(defvar vi-mode-old-case-fold nil) - -;(defconst vi-add-to-mode-line-1 -; '(overwrite-mode nil " Insert")) - -;; Value is same as vi-add-to-mode-line-1 when in vi mode, -;; but nil in other buffers. -;(defvar vi-add-to-mode-line nil) - -(defun vi-mode-setup () - "Setup a buffer for vi-mode by creating necessary buffer-local variables." -; (make-local-variable 'vi-add-to-mode-line) -; (setq vi-add-to-mode-line vi-add-to-mode-line-1) -; (or (memq vi-add-to-mode-line minor-mode-alist) -; (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist))) - (make-local-variable 'vi-scroll-amount) - (setq vi-scroll-amount (/ (window-height) 2)) - (make-local-variable 'vi-shift-width) - (setq vi-shift-width 4) - (make-local-variable 'vi-ins-point) - (make-local-variable 'vi-ins-length) - (make-local-variable 'vi-ins-repetition) - (make-local-variable 'vi-ins-overwrt-p) - (make-local-variable 'vi-ins-prefix-code) - (make-local-variable 'vi-last-change-command) - (make-local-variable 'vi-last-shell-command) - (make-local-variable 'vi-last-find-char) - (make-local-variable 'vi-mark-alist) - (make-local-variable 'vi-insert-state) - (make-local-variable 'vi-mode-old-local-map) - (make-local-variable 'vi-mode-old-mode-name) - (make-local-variable 'vi-mode-old-major-mode) - (make-local-variable 'vi-mode-old-case-fold) - (run-mode-hooks 'vi-mode-hook)) - -;;;###autoload -(defun vi-mode () - "Major mode that acts like the `vi' editor. -The purpose of this mode is to provide you the combined power of vi (namely, -the \"cross product\" effect of commands and repeat last changes) and Emacs. - -This command redefines nearly all keys to look like vi commands. -It records the previous major mode, and any vi command for input -\(`i', `a', `s', etc.) switches back to that mode. -Thus, ordinary Emacs (in whatever major mode you had been using) -is \"input\" mode as far as vi is concerned. - -To get back into vi from \"input\" mode, you must issue this command again. -Therefore, it is recommended that you assign it to a key. - -Major differences between this mode and real vi : - -* Limitations and unsupported features - - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are - not supported. - - Ex commands are not implemented; try ':' to get some hints. - - No line undo (i.e. the `U' command), but multi-undo is a standard feature. - -* Modifications - - The stopping positions for some point motion commands (word boundary, - pattern search) are slightly different from standard `vi'. - Also, no automatic wrap around at end of buffer for pattern searching. - - Since changes are done in two steps (deletion then insertion), you need - to undo twice to completely undo a change command. But this is not needed - for undoing a repeated change command. - - No need to set/unset `magic', to search for a string with regular expr - in it just put a prefix arg for the search commands. Replace cmds too. - - ^R is bound to incremental backward search, so use ^L to redraw screen. - -* Extensions - - Some standard (or modified) Emacs commands were integrated, such as - incremental search, query replace, transpose objects, and keyboard macros. - - In command state, ^X links to the `ctl-x-map', and ESC can be linked to - esc-map or set undefined. These can give you the full power of Emacs. - - See vi-com-map for those keys that are extensions to standard vi, e.g. - `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', - `vi-mark-region', and `vi-quote-words'. Some of them are quite handy. - - Use \\[vi-switch-mode] to switch among different modes quickly. - -Syntax table and abbrevs while in vi mode remain as they were in Emacs." - (interactive) - (if (null vi-mode-old-major-mode) ; very first call for current buffer - (vi-mode-setup)) - - (if (eq major-mode 'vi-mode) - (progn (ding) (message "Already in vi-mode.")) - (setq vi-mode-old-local-map (current-local-map)) - (setq vi-mode-old-mode-name mode-name) - (setq vi-mode-old-major-mode major-mode) - (setq vi-mode-old-case-fold case-fold-search) ; this is needed !! - (setq case-fold-search nil) ; exact case match in searching - (use-local-map vi-com-map) - (setq major-mode 'vi-mode) - (setq mode-name "VI") - (force-mode-line-update) ; force mode line update - (if vi-insert-state ; this is a return from insertion - (vi-end-of-insert-state)))) - -(defun vi-ding() - "Ding !" - (interactive) - (ding)) - -(defun vi-save-all-and-exit () - "Save all modified buffers without asking, then exits emacs." - (interactive) - (save-some-buffers t) - (kill-emacs)) - -;; to be used by "ex" commands -(defvar vi-replaced-string nil) -(defvar vi-replacing-string nil) - -(defun vi-ex-cmd () - "Ex commands are not implemented in Evi mode. For some commonly used ex -commands, you can use the following alternatives for similar effect : -w C-x C-s (save-buffer) -wq C-x C-c (save-buffers-kill-emacs) -w fname C-x C-w (write-file) -e fname C-x C-f (find-file) -r fname C-x i (insert-file) -s/old/new use q (vi-replace) to do unconditional replace - use C-q (vi-query-replace) to do query replace -set sw=n M-x set-variable vi-shift-width n " - (interactive) -;; (let ((cmd (read-string ":")) (lines 1)) -;; (cond ((string-match "s")))) - (with-output-to-temp-buffer "*Help*" - (princ (documentation 'vi-ex-cmd)) - (with-current-buffer standard-output - (help-mode)))) - -(defun vi-undefined () - (interactive) - (message "Command key \"%s\" is undefined in Evi." - (single-key-description last-command-event)) - (ding)) - -(defun vi-unimplemented () - (interactive) - (message "Command key \"%s\" is not implemented in Evi." - (single-key-description last-command-event)) - (ding)) - -;;;;; -(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p) - "Go into insert state, the text entered will be repeated if REPETITION > 1. -If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. -In any case, the prefix-code will be done before each `redo-insert'. -This function expects `overwrite-mode' being set properly beforehand." - (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) - (setq vi-ins-point (point)) - (setq vi-ins-repetition repetition) - (setq vi-ins-prefix-code prefix-code) - (setq mode-name vi-mode-old-mode-name) - (setq case-fold-search vi-mode-old-case-fold) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (force-mode-line-update) - (setq vi-insert-state t)) - -(defun vi-end-of-insert-state () - "Terminate insertion and set up last change command." - (if (or (< (point) vi-ins-point) ;Check if there is any effective change - (and (= (point) vi-ins-point) (null vi-ins-prefix-code)) - (<= vi-ins-repetition 0)) - (vi-goto-command-state t) - (if (> vi-ins-repetition 1) - (progn - (let ((str (buffer-substring vi-ins-point (point)))) - (while (> vi-ins-repetition 1) - (insert str) - (setq vi-ins-repetition (1- vi-ins-repetition)))))) - (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point) - overwrite-mode vi-ins-prefix-code) - (vi-goto-command-state t))) - -(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code) - "Redo last insertion the first time. Extract the string and save it for -future redoes. Do prefix-code if it's given, use overwrite mode if asked." - (let ((str (buffer-substring begin end))) - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str) - (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) - -(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code) - "Redo more insertion : copy string from STR to point, use overwrite mode -if overwrite-p is T; apply prefix-code first if it's non-nil." - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str)) - -(defun vi-goto-command-state (&optional from-insert-state-p) - "Go to vi-mode command state. If optional arg exists, means return from -insert state." - (use-local-map vi-com-map) - (setq vi-insert-state nil) - (if from-insert-state-p - (if overwrite-mode - (overwrite-mode 0) -; (set-minor-mode 'ins "Insert" nil) - ))) - -(defun vi-kill-line (arg) - "kill specified number of lines (=d$), text saved in the kill ring." - (interactive "*P") - (kill-line arg) - (vi-set-last-change-command 'kill-line arg)) - -(defun vi-kill-region (start end) - (interactive "*r") - (kill-region start end) - (vi-set-last-change-command 'kill-region)) - -(defun vi-append-at-end-of-line (arg) - "go to end of line and then go into vi insert state." - (interactive "*p") - (vi-goto-insert-state arg '(end-of-line) t)) - -(defun vi-change-rest-of-line (arg) - "Change the rest of (ARG) lines (= c$ in vi)." - (interactive "*P") - (vi-goto-insert-state 1 (list 'kill-line arg) t)) - -(defun vi-insert-before-first-nonwhite (arg) - "(= ^i in vi)" - (interactive "*p") - (vi-goto-insert-state arg '(back-to-indentation) t)) - -(defun vi-open-above (arg) - "open new line(s) above current line and enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (beginning-of-line) - (open-line x)))) arg) - t)) - -(defun vi-open-below (arg) - "open new line(s) and go into insert mode on the last line." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (end-of-line) - (open-line x) - (forward-line x)))) arg) - t)) - -(defun vi-insert-after (arg) - "start vi insert state after cursor." - (interactive "*p") - (vi-goto-insert-state arg - (list (function (lambda () - (if (not (eolp)) (forward-char))))) - t)) - -(defun vi-insert-before (arg) - "enter insert state before the cursor." - (interactive "*p") - (vi-goto-insert-state arg)) - -(defun vi-goto-line (arg) - "Go to ARGth line." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (with-no-warnings - (end-of-buffer)) - (with-no-warnings (goto-line (vi-prefix-numeric-value arg))))) - -(defun vi-beginning-of-buffer () - "Move point to the beginning of current buffer." - (interactive) - (goto-char (point-min))) - -;;;;; not used now -;;(defvar regexp-search t ; string -;; "*T if search string can contain regular expressions. (= set magic in vi)") -;;;;; - -(defun vi-isearch-forward (arg) - "Incremental search forward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-forward 'search-forward))))) - -(defun vi-isearch-backward (arg) - "Incremental search backward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-backward 'search-backward))))) - -(defun vi-search-forward (arg string) - "Nonincremental search forward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp/" nil)) - (list nil (read-string "/" nil)))) - (setq vi-search-last-command (if arg 're-search-forward 'search-forward)) - (if (> (length string) 0) - (isearch-update-ring string arg)) - (funcall vi-search-last-command string nil nil 1)) - -(defun vi-search-backward (arg string) - "Nonincremental search backward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp?" nil)) - (list nil (read-string "?" nil)))) - (setq vi-search-last-command (if arg 're-search-backward 'search-backward)) - (if (> (length string) 0) - (isearch-update-ring string arg)) - (funcall vi-search-last-command string nil nil 1)) - -(defun vi-repeat-last-search (arg &optional search-command search-string) - "Repeat last search command. -If optional search-command/string are given, -use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) - (setq search-string - (car (if (memq search-command - '(re-search-forward re-search-backward)) - regexp-search-ring - search-ring)))) - (if (null search-command) - (progn (ding) (message "No last search command to repeat.")) - (funcall search-command search-string nil nil arg))) - -(defun vi-reverse-last-search (arg &optional search-command search-string) - "Redo last search command in reverse direction. -If the optional search args are given, use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) - (setq search-string - (car (if (memq search-command - '(re-search-forward re-search-backward)) - regexp-search-ring - search-ring)))) - (if (null search-command) - (progn (ding) (message "No last search command to repeat.")) - (funcall (cond ((eq search-command 're-search-forward) 're-search-backward) - ((eq search-command 're-search-backward) 're-search-forward) - ((eq search-command 'search-forward) 'search-backward) - ((eq search-command 'search-backward) 'search-forward)) - search-string nil nil arg))) - -(defun vi-join-lines (arg) - "join ARG lines from current line (default 2), cleaning up white space." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (delete-indentation t) - (let ((count (vi-prefix-numeric-value arg))) - (while (>= count 2) - (delete-indentation t) - (setq count (1- count))))) - (vi-set-last-change-command 'vi-join-lines arg)) - -(defun vi-backward-kill-line () - "kill the current line. Only works in insert state." - (interactive) - (if (not vi-insert-state) - nil - (beginning-of-line 1) - (kill-line nil))) - -(defun vi-abort-ins () - "abort insert state, kill inserted text and go back to command state." - (interactive) - (if (not vi-insert-state) - nil - (if (> (point) vi-ins-point) - (kill-region vi-ins-point (point))) - (vi-goto-command-state t))) - -(defun vi-backward-windowful (count) - "Backward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-down nil) - (setq count (1- count)))) - -(defun vi-scroll-down-window (count) - "Scrolls down window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-up vi-scroll-amount)) - -(defun vi-expose-line-below (count) - "Expose COUNT more lines below the current window. Default COUNT is 1." - (interactive "p") - (scroll-up count)) - -(defun vi-forward-windowful (count) - "Forward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-up nil) - (setq count (1- count)))) - -(defun vi-next-line (count) - "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) (progn (line-move count) (point))) - (ding) ; no moving, already at end of buffer - (setq last-command 'next-line))) - -(defun vi-next-line-first-nonwhite (count) - "Go down COUNT lines. Stop at first non-white." - (interactive "p") - (if (= (point) (progn (forward-line count) (back-to-indentation) (point))) - (ding))) ; no moving, already at end of buffer - -(defun vi-previous-line-first-nonwhite (count) - "Go up COUNT lines. Stop at first non-white." - (interactive "p") - (forward-line (- count)) - (back-to-indentation)) - -(defun vi-scroll-up-window (count) - "Scrolls up window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-down vi-scroll-amount)) - -(defun vi-expose-line-above (count) - "Expose COUNT more lines above the current window. Default COUNT is 1." - (interactive "p") - (scroll-down count)) - -(defun vi-char-argument (arg) - "Get following character (could be any CHAR) as part of the prefix argument. -Possible prefix-arg cases are nil, INTEGER, (nil . CHAR) or (INTEGER . CHAR)." - (interactive "P") - (let ((char (read-char))) - (cond ((null arg) (setq prefix-arg (cons nil char))) - ((integerp arg) (setq prefix-arg (cons arg char))) - ; This can happen only if the user changed his/her mind for CHAR, - ; Or there are some leading "universal-argument"s - (t (setq prefix-arg (cons (car arg) char)))))) - -(defun vi-goto-mark (mark-char &optional line-flag) - "Go to marked position or line (if line-flag is given). -Goto mark `@' means jump into and pop the top mark on the mark ring." - (cond ((char-equal mark-char last-command-event) ; `` or '' - (exchange-point-and-mark) (if line-flag (back-to-indentation))) - ((char-equal mark-char ?@) ; jump and pop mark - (set-mark-command t) (if line-flag (back-to-indentation))) - (t - (let ((mark (vi-get-mark mark-char))) - (if (null mark) - (progn (vi-ding) (message "Mark register undefined.")) - (set-mark-command nil) - (goto-char mark) - (if line-flag (back-to-indentation))))))) - -(defun vi-goto-line-mark (char) - "Go to the line (at first non-white) marked by next char." - (interactive "c") - (vi-goto-mark char t)) - -(defun vi-goto-char-mark (char) - "Go to the char position marked by next mark-char." - (interactive "c") - (vi-goto-mark char)) - -(defun vi-digit-argument (arg) - "Set numeric prefix argument." - (interactive "P") - (cond ((null arg) (digit-argument arg)) - ((integerp arg) (digit-argument nil) - (setq prefix-arg (* prefix-arg arg))) - (t (digit-argument nil) ; in (NIL . CHAR) or (NUM . CHAR) form - (setq prefix-arg (cons (* prefix-arg - (if (null (car arg)) 1 (car arg))) - (cdr arg)))))) - -(defun vi-raw-numeric-prefix (arg) - "Return the raw value of numeric part prefix argument." - (if (consp arg) (car arg) arg)) - -(defun vi-prefix-numeric-value (arg) - "Return numeric meaning of the raw prefix argument. This is a modification -to the standard one provided in `callint.c' to handle (_ . CHAR) cases." - (cond ((null arg) 1) - ((integerp arg) arg) - ((consp arg) (if (car arg) (car arg) 1)))) - -(defun vi-reverse-last-find-char (count &optional find-arg) - "Reverse last f F t T operation COUNT times. If the optional FIND-ARG -is given, it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (progn (ding) (message "No last find char to repeat.")) - (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86 - -(defun vi-find-char (arg count) - "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. -If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG." - (let* ((direction (car arg)) (char (car (cdr arg))) - (upto-flag (cdr (cdr arg))) (pos (+ (point) direction))) - (if (catch 'exit-find-char - (while t - (cond ((null (char-after pos)) (throw 'exit-find-char nil)) - ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil)) - ((char-equal char (char-after pos)) (setq count (1- count)) - (if (= count 0) - (throw 'exit-find-char - (if upto-flag - (setq pos (- pos direction)) - pos))))) - (setq pos (+ pos direction)))) - (goto-char pos) - (ding)))) - -(defun vi-repeat-last-find-char (count &optional find-arg) - "Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, -it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (progn (ding) (message "No last find char to repeat.")) - (vi-find-char find-arg count))) - -(defun vi-backward-find-char (count char) - "Find the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-find-char (count char) - "Find the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-backward-upto-char (count char) - "Find up to the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-upto-char (count char) - "Find up to the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-end-of-word (count) - "Move forward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (if (not (eobp)) (forward-char)) - (if (re-search-forward "\\W*\\w+\\>" nil t count) - (backward-char))) - -(defun vi-replace-1-char (count char) - "Replace char after point by CHAR. Repeat COUNT times." - (interactive "p\nc") - (delete-char count nil) ; don't save in kill ring - (setq last-command-event char) - (self-insert-command count) - (vi-set-last-change-command 'vi-replace-1-char count char)) - -(defun vi-replace-chars (arg) - "Replace chars over old ones." - (interactive "*p") - (overwrite-mode 1) - (vi-goto-insert-state arg)) - -(defun vi-substitute-chars (count) - "Substitute COUNT chars by the input chars, enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky - (delete-region (point) - (+ (point) c)))) - count) t)) - -(defun vi-substitute-lines (count) - "Substitute COUNT lines by the input chars. (=cc in vi)" - (interactive "*p") - (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t)) - -(defun vi-prefix-char-value (arg) - "Get the char part of the current prefix argument." - (cond ((null arg) nil) - ((integerp arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vi-operator (arg) - "Handling vi operators (d/c//!/=/y). Current implementation requires -the key bindings of the operators being fixed." - (interactive "P") - (catch 'vi-exit-op - (let ((this-op-char last-command-event)) - (setq last-command-event (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-event))) - (if (not (eq this-command 'vi-digit-argument)) - (setq prefix-arg arg) - (vi-digit-argument arg) - (setq last-command-event (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-event)))) - (cond ((char-equal this-op-char last-command-event) ; line op - (vi-execute-op this-op-char 'next-line - (cons (1- (vi-prefix-numeric-value prefix-arg)) - (vi-prefix-char-value prefix-arg)))) - ;; We assume any command that has no property 'point-moving-unit' - ;; as having that property with the value 'CHAR'. 3/12/86 - (t ;; (get this-command 'point-moving-unit) - (vi-execute-op this-op-char this-command prefix-arg)))))) - ;; (t (throw 'vi-exit-op (ding))))))) - -(defun vi-execute-op (op-char motion-command arg) - "Execute vi edit operator as specified by OP-CHAR, the operand is the region -determined by the MOTION-COMMAND with ARG." - (cond ((= op-char ?d) - (if (vi-delete-op motion-command arg) - (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?c) - (if (vi-delete-op motion-command arg) - (vi-goto-insert-state 1 (list 'vi-delete-op - (vi-repeat-command-of motion-command) arg) nil))) - ((= op-char ?y) - (if (vi-yank-op motion-command arg) - (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?!) - (if (vi-shell-op motion-command arg) - (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command))) - ((= op-char ?<) - (if (vi-shift-op motion-command arg (- vi-shift-width)) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width)))) - ((= op-char ?>) - (if (vi-shift-op motion-command arg vi-shift-width) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width))) - ((= op-char ?=) - (if (vi-indent-op motion-command arg) - (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?\\) - (vi-narrow-op motion-command arg)))) - -(defun vi-repeat-command-of (command) - "Return the command for redo the given command." - (let ((cmd-type (get command 'point-moving-unit))) - (cond ((eq cmd-type 'search) 'vi-repeat-last-search) - ((eq cmd-type 'find) 'vi-repeat-last-find-char) - (t command)))) - -(defun vi-effective-range (motion-command arg) - "Return (begin . end) of the range spanned by executing the given -MOTION-COMMAND with ARG. - MOTION-COMMAND in ready-to-eval list form is not yet supported." - (save-excursion - (let ((begin (point)) end opoint - (moving-unit (get motion-command 'point-moving-unit))) - (setq prefix-arg arg) - (setq opoint (point)) - (command-execute motion-command nil) -;; Check if there is any effective motion. Note that for single line operation -;; the motion-command causes no effective point movement (since it moves up or -;; down zero lines), but it should be counted as effectively moved. - (if (and (= (point) opoint) (not (eq moving-unit 'line))) - (cons opoint opoint) ; no effective motion - (if (eq moving-unit 'region) - (setq begin (or (mark) (point)))) - (if (<= begin (point)) - (setq end (point)) - (setq end begin) - (setq begin (point))) - (cond ((or (eq moving-unit 'match) (eq moving-unit 'find)) - (setq end (1+ end))) - ((eq moving-unit 'line) - (goto-char begin) (beginning-of-line) (setq begin (point)) - (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point)))) - (if (> end (point-max)) (setq end (point-max))) ; force in buffer region - (cons begin end))))) - -(defun vi-delete-op (motion-command arg) - "Delete range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (kill-region begin end) ; kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end t) - (copy-to-register reg begin end t))) - t))) - -(defun vi-yank-op (motion-command arg) - "Yank (in vi sense) range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (copy-region-as-kill begin end); kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end nil) - (copy-to-register reg begin end nil))) - t))) - -(defun vi-yank-line (arg) - "Yank (in vi sense) lines (= `yy' command)." - (interactive "*P") - (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg))) - (if (vi-yank-op 'next-line arg) - (vi-set-last-change-command 'vi-yank-op 'next-line arg))) - -(defun vi-string-end-with-nl-p (string) - "See if STRING ends with a newline char. -Used in checking whether the yanked text should be put back as lines or not." - (= (aref string (1- (length string))) ?\n)) - -(defun vi-put-before (arg &optional after-p) - "Put yanked (in vi sense) text back before/above cursor. -If a numeric prefix value (currently it should be >1) is given, put back -text as lines. If the optional after-p is given, put after/below the cursor." - (interactive "P") - (let ((reg (vi-prefix-char-value arg)) put-text) - (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg))) - (error "Nothing in register %c" reg) - (if (null reg) (setq reg ?1)) ; the default is the last text killed - (setq put-text - (cond - ((and (>= reg ?1) (<= reg ?9)) - (setq this-command 'yank) ; So we may yank-pop !! - (current-kill (- reg ?0 1) 'do-not-rotate)) - ((stringp (get-register reg)) (get-register reg)) - (t (error "Register %c is not containing text string" reg)))) - (if (vi-string-end-with-nl-p put-text) ; put back text as lines - (if after-p - (progn (forward-line 1) (beginning-of-line)) - (beginning-of-line)) - (if after-p (forward-char 1))) - (push-mark) - (insert put-text) - (exchange-point-and-mark) -;; (back-to-indentation) ; this is not allowed if we allow yank-pop - (vi-set-last-change-command 'vi-put-before arg after-p)))) - -(defun vi-put-after (arg) - "Put yanked (in vi sense) text back after/below cursor." - (interactive "P") - (vi-put-before arg t)) - -(defun vi-shell-op (motion-command arg &optional shell-command) - "Perform shell command (as filter). -Performs command on range specified by MOTION-COMMAND -with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. -If char argument is given, it directs the output to a *temp* buffer." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (cond ((null shell-command) - (setq shell-command (read-string "!" nil)) - (setq vi-last-shell-command shell-command))) - (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg)) - (not (vi-prefix-char-value arg))) - t))) - -(defun vi-shift-op (motion-command arg amount) - "Perform shift command on range specified by MOTION-COMMAND with ARG for -AMOUNT on each line. Negative amount means shift left. -SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (if (vi-prefix-char-value arg) - (setq amount (if (> amount 0) - (- (vi-prefix-char-value arg) ?0) - (- ?0 (vi-prefix-char-value arg))))) - (indent-rigidly begin end amount) - t))) - -(defun vi-indent-op (motion-command arg) - "Perform indent command on range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (indent-region begin end nil) ; insert TAB as indent command - t))) - -(defun vi-narrow-op (motion-command arg) - "Narrow to region specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (narrow-to-region begin end)))) - -(defun vi-get-mark (char) - "Return contents of vi mark register named CHAR, or nil if undefined." - (cdr (assq char vi-mark-alist))) - -(defun vi-set-mark (char) - "Set contents of vi mark register named CHAR to current point. -'@' is the special anonymous mark register." - (interactive "c") - (if (char-equal char ?@) - (set-mark-command nil) - (let ((aelt (assq char vi-mark-alist))) - (if aelt - (move-marker (cdr aelt) (point)) ; fixed 6/12/86 - (setq aelt (cons char (point-marker))) - (setq vi-mark-alist (cons aelt vi-mark-alist)))))) - -(defun vi-find-matching-paren () - "Locate the matching paren. It's a hack right now." - (interactive) - (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1)) - ((looking-at "[])}]") (forward-char 1) (backward-sexp 1)) - (t (ding)))) - -(defun vi-backward-blank-delimited-word (count) - "Backward COUNT blank-delimited words." - (interactive "p") - (if (re-search-backward "[ \t\n`][^ \t\n`]+" nil t count) - (if (not (bobp)) (forward-char 1)))) - -(defun vi-forward-blank-delimited-word (count) - "Forward COUNT blank-delimited words." - (interactive "p") - (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count) - (if (not (eobp)) (backward-char 1)))) - -(defun vi-end-of-blank-delimited-word (count) - "Forward to the end of the COUNT'th blank-delimited word." - (interactive "p") - (if (re-search-forward "[^ \t\n']+[ \t\n']" nil t count) - (if (not (eobp)) (backward-char 2)))) - -(defun vi-home-window-line (arg) - "To window home or arg'th line from the top of the window." - (interactive "p") - (move-to-window-line (1- arg)) - (back-to-indentation)) - -(defun vi-last-window-line (arg) - "To window last line or arg'th line from the bottom of the window." - (interactive "p") - (move-to-window-line (- arg)) - (back-to-indentation)) - -(defun vi-middle-window-line () - "To the middle line of the window." - (interactive) - (move-to-window-line nil) - (back-to-indentation)) - -(defun vi-forward-word (count) - "Stop at the beginning of the COUNT'th words from point." - (interactive "p") - (if (re-search-forward "\\w*\\W+\\<" nil t count) - t - (vi-ding))) - -(defun vi-set-last-change-command (fun &rest args) - "Set (FUN . ARGS) as the `last-change-command'." - (setq vi-last-change-command (cons fun args))) - -(defun vi-redo-last-change-command (count &optional command) - "Redo last change command COUNT times. If the optional COMMAND is given, -it is used instead of the current `last-change-command'." - (interactive "p") - (if (null command) - (setq command vi-last-change-command)) - (if (null command) - (message "No last change command available.") - (while (> count 0) - (apply (car command) (cdr command)) - (setq count (1- count))))) - -(defun vi-kill-char (count) - "Kill COUNT chars from current point." - (interactive "*p") - (delete-char count t) ; save in kill ring - (vi-set-last-change-command 'delete-char count t)) - -(defun vi-transpose-objects (arg unit) - "Transpose objects. -The following char specifies unit of objects to be -transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for - sexp, \"p\" for paragraph. -For the use of the prefix-arg, refer to individual functions called." - (interactive "*P\nc") - (if (char-equal unit ??) - (progn - (message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),") - (setq unit (read-char)))) - (vi-set-last-change-command 'vi-transpose-objects arg unit) - (cond ((char-equal unit ?c) (transpose-chars arg)) - ((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg))) - ((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg))) - ((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg))) - ((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg))) - (t (vi-transpose-objects arg ??)))) - -(defun vi-query-replace (arg) - "Query replace, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'query-replace-regexp 'query-replace))) - (call-interactively rcmd nil))) - -(defun vi-replace (arg) - "Replace strings, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'replace-regexp 'replace-string))) - (call-interactively rcmd nil))) - -(defun vi-adjust-window (arg position) - "Move current line to the top/center/bottom of the window." - (interactive "p\nc") - (cond ((char-equal position ?\r) (recenter 0)) - ((char-equal position ?-) (recenter -1)) - ((char-equal position ?.) (recenter (/ (window-height) 2))) - (t (message "Move current line to: \\r(top) -(bottom) .(middle)") - (setq position (read-char)) - (vi-adjust-window arg position)))) - -(defun vi-goto-column (col) - "Go to given column of the current line." - (interactive "p") - (let ((opoint (point))) - (beginning-of-line) - (while (> col 1) - (if (eolp) - (setq col 0) - (forward-char 1) - (setq col (1- col)))) - (if (= col 1) - t - (goto-char opoint) - (ding)))) - -(defun vi-name-last-change-or-macro (arg char) - "Give name to the last change command or just defined kbd macro. -If prefix ARG is given, name last macro, otherwise name last change command. -The following CHAR will be the name for the command or macro." - (interactive "P\nc") - (if arg - (name-last-kbd-macro (intern (char-to-string char))) - (if (eq (car vi-last-change-command) 'vi-first-redo-insertion) - (let* ((args (cdr vi-last-change-command)) ; save the insertion text - (str (buffer-substring (nth 0 args) (nth 1 args))) - (overwrite-p (nth 2 args)) - (prefix-code (nth 3 args))) - (vi-set-last-change-command 'vi-more-redo-insertion str - overwrite-p prefix-code))) - (fset (intern (char-to-string char)) vi-last-change-command))) - -(defun vi-call-named-change-or-macro (count char) - "Execute COUNT times the keyboard macro definition named by the following CHAR." - (interactive "p\nc") - (if (stringp (symbol-function (intern (char-to-string char)))) - (execute-kbd-macro (intern (char-to-string char)) count) - (vi-redo-last-change-command count (symbol-function (intern (char-to-string char)))))) - -(defun vi-change-case (arg) ; could be made as an operator ? - "Change the case of the char after point." - (interactive "*p") - (catch 'exit - (if (looking-at "[a-z]") - (upcase-region (point) (+ (point) arg)) - (if (looking-at "[A-Z]") - (downcase-region (point) (+ (point) arg)) - (ding) - (throw 'exit nil))) - (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save - (forward-char arg))) - -(defun vi-ask-for-info (char) - "Inquire status info. The next CHAR will specify the particular info requested." - (interactive "c") - (cond ((char-equal char ?l) (what-line)) - ((char-equal char ?c) (what-cursor-position)) - ((char-equal char ?p) (what-page)) - (t (message "Ask for: l(ine number), c(ursor position), p(age number)") - (setq char (read-char)) - (vi-ask-for-info char)))) - -(declare-function c-mark-function "cc-cmds" ()) - -(defun vi-mark-region (arg region) - "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), -p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), -l(ines)." - (interactive "p\nc") - (cond ((char-equal region ?d) (mark-defun)) - ((char-equal region ?s) (mark-sexp arg)) - ((char-equal region ?b) (with-no-warnings (mark-whole-buffer))) - ((char-equal region ?p) (mark-paragraph)) - ((char-equal region ?P) (mark-page arg)) - ((char-equal region ?f) (c-mark-function)) - ((char-equal region ?w) (mark-word arg)) - ((char-equal region ?e) (mark-end-of-sentence arg)) - ((char-equal region ?l) (vi-mark-lines arg)) - (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") - (setq region (read-char)) - (vi-mark-region arg region)))) - -(defun vi-mark-lines (num) - "Mark NUM of lines from current line as current region." - (beginning-of-line 1) - (push-mark) - (end-of-line num)) - -(defun vi-verify-spelling (arg unit) - "Verify spelling for the objects specified by char UNIT : [b(uffer), -r(egion), s(tring), w(ord) ]." - (interactive "P\nc") - (setq prefix-arg arg) ; seems not needed - (cond ((char-equal unit ?b) (call-interactively 'spell-buffer)) - ((char-equal unit ?r) (call-interactively 'spell-region)) - ((char-equal unit ?s) (call-interactively 'spell-string)) - ((char-equal unit ?w) (call-interactively 'spell-word)) - (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") - (setq unit (read-char)) - (vi-verify-spelling arg unit)))) - -(defun vi-do-old-mode-C-c-command (arg) - "This is a hack for accessing mode specific C-c commands in vi-mode." - (interactive "P") - (let ((cmd (lookup-key vi-mode-old-local-map - (concat "\C-c" (char-to-string (read-char)))))) - (if (catch 'exit-vi-mode ; kludge hack due to dynamic binding - ; of case-fold-search - (if (null cmd) - (progn (ding) nil) - (let ((case-fold-search vi-mode-old-case-fold)) ; a hack - (setq prefix-arg arg) - (command-execute cmd nil) - nil))) - (progn - (vi-back-to-old-mode) - (setq prefix-arg arg) - (command-execute cmd nil))))) - -(defun vi-quote-words (arg char) - "Quote ARG words from the word point is on with pattern specified by CHAR. -Currently, CHAR could be [,{,(,\",',`,<,*, etc." - (interactive "*p\nc") - (while (not (string-match "[[({<\"'`*]" (char-to-string char))) - (message "Enter any of [,{,(,<,\",',`,* as quoting character.") - (setq char (read-char))) - (vi-set-last-change-command 'vi-quote-words arg char) - (if (not (looking-at "\\<")) (forward-word -1)) - (insert char) - (cond ((char-equal char ?\[) (setq char ?\])) - ((char-equal char ?{) (setq char ?})) - ((char-equal char ?<) (setq char ?>)) - ((char-equal char ?\() (setq char ?\))) - ((char-equal char ?`) (setq char ?'))) - (vi-end-of-word arg) - (forward-char 1) - (insert char)) - -(defun vi-locate-def () - "Locate definition in current file for the name before the point. -It assumes a `(def..' always starts at the beginning of a line." - (interactive) - (let (name) - (save-excursion - (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1) - (skip-chars-forward "^a-zA-Z") - (point)) - (progn (vi-end-of-blank-delimited-word 1) - (forward-char) - (skip-chars-backward "^a-zA-Z") - (point))))) - (set-mark-command nil) - (goto-char (point-min)) - (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t) - nil - (ding) - (message "No definition for \"%s\" in current file." name) - (set-mark-command t)))) - -(defun vi-split-open-line (arg) - "Insert a newline and leave point before it. -With ARG, inserts that many newlines." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (arg) - (let ((flag (and (bolp) (not (bobp))))) - (if flag (forward-char -1)) - (while (> arg 0) - (save-excursion - (insert ?\n) - (if fill-prefix (insert fill-prefix))) - (setq arg (1- arg))) - (if flag (forward-char 1))))) arg) - t)) - -(provide 'vi) - -;;; vi.el ends here diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el deleted file mode 100644 index eecedbd5e74..00000000000 --- a/lisp/obsolete/vip.el +++ /dev/null @@ -1,3050 +0,0 @@ -;;; vip.el --- a VI Package for GNU Emacs -*- lexical-binding: t; -*- - -;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2024 Free Software -;; Foundation, Inc. - -;; Author: Masahiko Sato -;; Keywords: emulations -;; Obsolete-since: 24.5 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This file is obsolete. Consider using viper instead. - -;; A full-featured vi(1) emulator. -;; -;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet -;; -;; Send suggestions and bug reports to one of the above addresses. -;; When you report a bug, be sure to include the version number of VIP and -;; Emacs you are using. - -;; Execute info command by typing "M-x info" to get information on VIP. - -;;; Code: - -(defgroup vip nil - "A VI Package for GNU Emacs." - :prefix "vip-" - :group 'emulations) - -;; external variables - -(defvar vip-emacs-local-map nil - "Local map used in Emacs mode. (Buffer-specific.)") - -(defvar vip-insert-local-map nil - "Local map used in insert command mode. (Buffer-specific.)") - -(make-variable-buffer-local 'vip-emacs-local-map) -(make-variable-buffer-local 'vip-insert-local-map) - -(defvar vip-insert-point nil - "Remember insert point as a marker. (Buffer-specific.)") - -(set-default 'vip-insert-point (make-marker)) -(make-variable-buffer-local 'vip-insert-point) - -(defvar vip-com-point nil - "Remember com point as a marker. (Buffer-specific.)") - -(set-default 'vip-com-point (make-marker)) -(make-variable-buffer-local 'vip-com-point) - -(defvar vip-current-mode nil - "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.") - -(make-variable-buffer-local 'vip-current-mode) -(setq-default vip-current-mode 'emacs-mode) - -(defvar vip-emacs-mode-line-buffer-identification nil - "Value of mode-line-buffer-identification in Emacs mode within vip.") -(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) -(setq-default vip-emacs-mode-line-buffer-identification - '("Emacs: %17b")) - -(defvar vip-current-major-mode nil - "vip-current-major-mode is the major-mode vi considers it is now. -\(buffer specific)") - -(make-variable-buffer-local 'vip-current-major-mode) - -(defvar vip-last-shell-com nil - "Last shell command executed by ! command.") - -(defvar vip-use-register nil - "Name of register to store deleted or yanked strings.") - -(defvar vip-d-com nil - "How to reexecute last destructive command. Value is list (M-COM VAL COM).") - -(defcustom vip-shift-width 8 - "The number of columns shifted by > and < command." - :type 'integer) - -(defcustom vip-re-replace nil - "If t then do regexp replace, if nil then do string replace." - :type 'boolean) - -(defvar vip-d-char nil - "The character remembered by the vi \"r\" command.") - -(defvar vip-f-char nil - "For use by \";\" command.") - -(defvar vip-F-char nil - "For use by \".\" command.") - -(defvar vip-f-forward nil - "For use by \";\" command.") - -(defvar vip-f-offset nil - "For use by \";\" command.") - -(defcustom vip-search-wrap-around t - "If t, search wraps around." - :type 'boolean) - -(defcustom vip-re-search nil - "If t, search is reg-exp search, otherwise vanilla search." - :type 'boolean) - -(defvar vip-s-string nil - "Last vip search string.") - -(defvar vip-s-forward nil - "If t, search is forward.") - -(defcustom vip-case-fold-search nil - "If t, search ignores cases." - :type 'boolean) - -(defcustom vip-re-query-replace nil - "If t then do regexp replace, if nil then do string replace." - :type 'boolean) - -(defcustom vip-open-with-indent nil - "If t, indent when open a new line." - :type 'boolean) - -(defcustom vip-help-in-insert-mode nil - "If t then C-h is bound to help-command in insert mode. -If nil then it is bound to `delete-backward-char'." - :type 'boolean) - -(defvar vip-quote-string "> " - "String inserted at the beginning of region.") - -(defvar vip-tags-file-name "TAGS") - -(defvar vip-inhibit-startup-message nil) - -(defvar vip-startup-file (locate-user-emacs-file "vip" ".vip") - "Filename used as startup file for vip.") - -;; key bindings - -(defvar vip-mode-map - (let ((map (make-keymap))) - (define-key map "\C-a" #'beginning-of-line) - (define-key map "\C-b" #'vip-scroll-back) - (define-key map "\C-c" #'vip-ctl-c) - (define-key map "\C-d" #'vip-scroll-up) - (define-key map "\C-e" #'vip-scroll-up-one) - (define-key map "\C-f" #'vip-scroll) - (define-key map "\C-g" #'vip-keyboard-quit) - (define-key map "\C-h" #'help-command) - (define-key map "\C-m" #'vip-scroll-back) - (define-key map "\C-n" #'vip-other-window) - (define-key map "\C-o" #'vip-open-line-at-point) - (define-key map "\C-u" #'vip-scroll-down) - (define-key map "\C-x" #'vip-ctl-x) - (define-key map "\C-y" #'vip-scroll-down-one) - (define-key map "\C-z" #'vip-change-mode-to-emacs) - (define-key map "\e" #'vip-ESC) - - (define-key map [?\S-\ ] #'vip-scroll-back) - (define-key map " " #'vip-scroll) - (define-key map "!" #'vip-command-argument) - (define-key map "\"" #'vip-command-argument) - (define-key map "#" #'vip-command-argument) - (define-key map "$" #'vip-goto-eol) - (define-key map "%" #'vip-paren-match) - (define-key map "&" #'vip-nil) - (define-key map "'" #'vip-goto-mark-and-skip-white) - (define-key map "(" #'vip-backward-sentence) - (define-key map ")" #'vip-forward-sentence) - (define-key map "*" #'call-last-kbd-macro) - (define-key map "+" #'vip-next-line-at-bol) - (define-key map "," #'vip-repeat-find-opposite) - (define-key map "-" #'vip-previous-line-at-bol) - (define-key map "." #'vip-repeat) - (define-key map "/" #'vip-search-forward) - - (define-key map "0" #'vip-beginning-of-line) - (define-key map "1" #'vip-digit-argument) - (define-key map "2" #'vip-digit-argument) - (define-key map "3" #'vip-digit-argument) - (define-key map "4" #'vip-digit-argument) - (define-key map "5" #'vip-digit-argument) - (define-key map "6" #'vip-digit-argument) - (define-key map "7" #'vip-digit-argument) - (define-key map "8" #'vip-digit-argument) - (define-key map "9" #'vip-digit-argument) - - (define-key map ":" #'vip-ex) - (define-key map ";" #'vip-repeat-find) - (define-key map "<" #'vip-command-argument) - (define-key map "=" #'vip-command-argument) - (define-key map ">" #'vip-command-argument) - (define-key map "?" #'vip-search-backward) - (define-key map "@" #'vip-nil) - - (define-key map "A" #'vip-Append) - (define-key map "B" #'vip-backward-Word) - (define-key map "C" #'vip-ctl-c-equivalent) - (define-key map "D" #'vip-kill-line) - (define-key map "E" #'vip-end-of-Word) - (define-key map "F" #'vip-find-char-backward) - (define-key map "G" #'vip-goto-line) - (define-key map "H" #'vip-window-top) - (define-key map "I" #'vip-Insert) - (define-key map "J" #'vip-join-lines) - (define-key map "K" #'vip-kill-buffer) - (define-key map "L" #'vip-window-bottom) - (define-key map "M" #'vip-window-middle) - (define-key map "N" #'vip-search-Next) - (define-key map "O" #'vip-Open-line) - (define-key map "P" #'vip-Put-back) - (define-key map "Q" #'vip-query-replace) - (define-key map "R" #'vip-replace-string) - (define-key map "S" #'vip-switch-to-buffer-other-window) - (define-key map "T" #'vip-goto-char-backward) - (define-key map "U" #'vip-nil) - (define-key map "V" #'vip-find-file-other-window) - (define-key map "W" #'vip-forward-Word) - (define-key map "X" #'vip-ctl-x-equivalent) - (define-key map "Y" #'vip-yank-line) - (define-key map "ZZ" #'save-buffers-kill-emacs) - - (define-key map "[" #'vip-nil) - (define-key map "\\" #'vip-escape-to-emacs) - (define-key map "]" #'vip-nil) - (define-key map "^" #'vip-bol-and-skip-white) - (define-key map "_" #'vip-nil) - (define-key map "`" #'vip-goto-mark) - - (define-key map "a" #'vip-append) - (define-key map "b" #'vip-backward-word) - (define-key map "c" #'vip-command-argument) - (define-key map "d" #'vip-command-argument) - (define-key map "e" #'vip-end-of-word) - (define-key map "f" #'vip-find-char-forward) - (define-key map "g" #'vip-info-on-file) - (define-key map "h" #'vip-backward-char) - (define-key map "i" #'vip-insert) - (define-key map "j" #'vip-next-line) - (define-key map "k" #'vip-previous-line) - (define-key map "l" #'vip-forward-char) - (define-key map "m" #'vip-mark-point) - (define-key map "n" #'vip-search-next) - (define-key map "o" #'vip-open-line) - (define-key map "p" #'vip-put-back) - (define-key map "q" #'vip-nil) - (define-key map "r" #'vip-replace-char) - (define-key map "s" #'vip-switch-to-buffer) - (define-key map "t" #'vip-goto-char-forward) - (define-key map "u" #'vip-undo) - (define-key map "v" #'vip-find-file) - (define-key map "w" #'vip-forward-word) - (define-key map "x" #'vip-delete-char) - (define-key map "y" #'vip-command-argument) - (define-key map "zH" #'vip-line-to-top) - (define-key map "zM" #'vip-line-to-middle) - (define-key map "zL" #'vip-line-to-bottom) - (define-key map "z\C-m" #'vip-line-to-top) - (define-key map "z." #'vip-line-to-middle) - (define-key map "z-" #'vip-line-to-bottom) - - (define-key map "{" #'vip-backward-paragraph) - (define-key map "|" #'vip-goto-col) - (define-key map "}" #'vip-forward-paragraph) - (define-key map "~" #'vip-nil) - (define-key map "\177" #'vip-delete-backward-char) - map)) - -(defun vip-version () - (interactive) - (message "VIP version 3.5 of September 15, 1987")) - - -;; basic set up - -;;;###autoload -(defun vip-setup () - "Set up bindings for C-x 7 and C-z that are useful for VIP users." - (define-key ctl-x-map "7" #'vip-buffer-in-two-windows) - (global-set-key "\C-z" #'vip-change-mode-to-vi)) - -(defmacro vip-loop (count body) - "(COUNT BODY) Execute BODY COUNT times." - `(let ((count ,count)) - (while (> count 0) - ,body - (setq count (1- count))))) - -(defun vip-push-mark-silent (&optional location) - "Set mark at LOCATION (point, by default) and push old mark on mark ring. -No message." - (if (null (mark t)) - nil - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (if (> (length mark-ring) mark-ring-max) - (progn - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) - (set-mark (or location (point)))) - -(defun vip-goto-col (arg) - "Go to ARG's column." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (save-excursion - (end-of-line) - (if (> val (1+ (current-column))) (error ""))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line) - (forward-char (1- val)) - (if com (vip-execute-com 'vip-goto-col val com)))) - -(defun vip-copy-keymap (map) - (if (null map) (make-sparse-keymap) (copy-keymap map))) - - -;; changing mode - -(defun vip-change-mode (new-mode) - "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." - (or (eq new-mode vip-current-mode) - (progn - (cond ((eq new-mode 'vi-mode) - (if (eq vip-current-mode 'insert-mode) - (progn - (vip-copy-region-as-kill (point) vip-insert-point) - (vip-repeat-insert-command)) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map)))) - (vip-change-mode-line "Vi: ") - (use-local-map vip-mode-map)) - ((eq new-mode 'insert-mode) - (move-marker vip-insert-point (point)) - (if (eq vip-current-mode 'emacs-mode) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map))) - (setq vip-insert-local-map (vip-copy-keymap - vip-emacs-local-map))) - (vip-change-mode-line "Insert") - (use-local-map vip-insert-local-map) - (define-key vip-insert-local-map "\e" #'vip-change-mode-to-vi) - (define-key vip-insert-local-map "\C-z" #'vip-ESC) - (define-key vip-insert-local-map "\C-h" - (if vip-help-in-insert-mode #'help-command - #'delete-backward-char)) - (define-key vip-insert-local-map "\C-w" - #'vip-delete-backward-word)) - ((eq new-mode 'emacs-mode) - (vip-change-mode-line "Emacs:") - (use-local-map vip-emacs-local-map))) - (setq vip-current-mode new-mode) - (force-mode-line-update)))) - -(defun vip-copy-region-as-kill (beg end) - "If BEG and END do not belong to the same buffer, it copies empty region." - (condition-case nil - (copy-region-as-kill beg end) - (error (copy-region-as-kill beg beg)))) - -(defun vip-change-mode-line (string) - "Assuming that the mode line format contains the string \"Emacs:\", this -function replaces the string by \"Vi: \" etc." - (setq mode-line-buffer-identification - (if (string= string "Emacs:") - vip-emacs-mode-line-buffer-identification - (list (concat string " %17b"))))) - -;;;###autoload -(defun vip-mode () - "Turn on VIP emulation of VI." - (interactive) - (if (not vip-inhibit-startup-message) - (progn - (switch-to-buffer "VIP Startup Message") - (erase-buffer) - (insert - "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands -including Ex commands. VIP is however different from Vi in several points. -You can get more information on VIP by: - 1. Typing `M-x info' and selecting menu item \"vip\". - 2. Typing `C-h k' followed by a key whose description you want. - 3. Printing VIP manual which can be found as GNU/man/vip.texinfo - 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex - -This startup message appears whenever you load VIP unless you type `y' now. -Type `n' to quit this window for now.\n") - (goto-char (point-min)) - (if (y-or-n-p "Inhibit VIP startup message? ") - (progn - (with-current-buffer - (find-file-noselect - (substitute-in-file-name vip-startup-file)) - (goto-char (point-max)) - (insert "\n(setq vip-inhibit-startup-message t)\n") - (save-buffer) - (kill-buffer (current-buffer))) - (message "VIP startup message inhibited.") - (sit-for 2))) - (kill-buffer (current-buffer)) - (message "") - (setq vip-inhibit-startup-message t))) - (vip-change-mode-to-vi)) - -(defun vip-change-mode-to-vi () - "Change mode to vi mode." - (interactive) - (vip-change-mode 'vi-mode)) - -(defun vip-change-mode-to-insert () - "Change mode to insert mode." - (interactive) - (vip-change-mode 'insert-mode)) - -(defun vip-change-mode-to-emacs () - "Change mode to Emacs mode." - (interactive) - (vip-change-mode 'emacs-mode)) - - -;; escape to emacs mode temporarily - -(defun vip-escape-to-emacs (arg &optional events) - "Escape to Emacs mode for one Emacs command. -ARG is used as the prefix value for the executed command. If -EVENTS is a list of events, which become the beginning of the command." - (interactive "P") - (let (com (old-map (current-local-map))) - (if events (setq unread-command-events - (append events unread-command-events))) - (setq prefix-arg arg) - (use-local-map vip-emacs-local-map) - (unwind-protect - (setq com (key-binding (read-key-sequence nil))) - (use-local-map old-map)) - (command-execute com prefix-arg) - (setq prefix-arg nil) ;; reset prefix arg - )) - -(defun vip-message-conditions (conditions) - "Print CONDITIONS as a message." - (let ((case (car conditions)) (msg (cdr conditions))) - (if (null msg) - (message "%s" case) - (message "%s %s" case (prin1-to-string msg))) - (ding))) - -(defun vip-ESC (arg) - "Emulate ESC key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\e))) - -(defun vip-ctl-c (arg) - "Emulate C-c key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-c))) - -(defun vip-ctl-x (arg) - "Emulate C-x key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-x))) - -(defun vip-ctl-h (arg) - "Emulate C-h key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-h))) - - -;; prefix argument for vi mode - -;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM -;; represents the numeric value of the prefix argument and COM represents -;; command prefix such as "c", "d", "m" and "y". - -(defun vip-prefix-arg-value (char value com) - "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value -obtained so far, and COM is the command part obtained so far." - (while (and (>= char ?0) (<= char ?9)) - (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) - (setq char (read-char))) - (setq prefix-arg value) - (if com (setq prefix-arg (cons prefix-arg com))) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (push char unread-command-events)) - -(defun vip-prefix-arg-com (char value com) - "Vi operator as prefix argument." - (let ((cont t)) - (while (and cont - (or (= char ?c) (= char ?d) (= char ?y) - (= char ?!) (= char ?<) (= char ?>) (= char ?=) - (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) - (if com - ;; this means that we already have a command character, so we - ;; construct a com list and exit while. however, if char is " - ;; it is an error. - (progn - ;; new com is (CHAR . OLDCOM) - (if (or (= char ?#) (= char ?\")) (error "")) - (setq com (cons char com)) - (setq cont nil)) - ;; if com is nil we set com as char, and read more. again, if char - ;; is ", we read the name of register and store it in vip-use-register. - ;; if char is !, =, or #, a complete com is formed so we exit while. - (cond ((or (= char ?!) (= char ?=)) - (setq com char) - (setq char (read-char)) - (setq cont nil)) - ((= char ?#) - ;; read a char and encode it as com - (setq com (+ 128 (read-char))) - (setq char (read-char)) - (setq cont nil)) - ((or (= char ?<) (= char ?>)) - (setq com char) - (setq char (read-char)) - (if (= com char) (setq com (cons char com))) - (setq cont nil)) - ((= char ?\") - (let ((reg (read-char))) - (if (or (and (<= ?A reg) (<= reg ?z)) - (and (<= ?1 reg) (<= reg ?9))) - (setq vip-use-register reg) - (error "")) - (setq char (read-char)))) - (t - (setq com char) - (setq char (read-char))))))) - (if (atom com) - ;; com is a single char, so we construct prefix-arg - ;; and if char is ?, describe prefix arg, otherwise exit by - ;; pushing the char back - (progn - (setq prefix-arg (cons value com)) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (push char unread-command-events)) - ;; as com is non-nil, this means that we have a command to execute - (if (or (= (car com) ?r) (= (car com) ?R)) - ;; execute appropriate region command. - (let ((char (car com)) (com (cdr com))) - (setq prefix-arg (cons value com)) - (if (= char ?r) (vip-region prefix-arg) - (vip-Region prefix-arg)) - ;; reset prefix-arg - (setq prefix-arg nil)) - ;; otherwise, reset prefix arg and call appropriate command - (setq value (if (null value) 1 value)) - (setq prefix-arg nil) - (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) - ((equal com '(?d . ?d)) (vip-line (cons value ?D))) - ((equal com '(?d . ?y)) (vip-yank-defun)) - ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) - ((equal com '(?< . ?<)) (vip-line (cons value ?<))) - ((equal com '(?> . ?>)) (vip-line (cons value ?>))) - ((equal com '(?! . ?!)) (vip-line (cons value ?!))) - ((equal com '(?= . ?=)) (vip-line (cons value ?=))) - (t (error "")))))) - -(defun vip-describe-arg (arg) - (let (val com) - (setq val (vip-P-val arg) - com (vip-getcom arg)) - (if (null val) - (if (null com) - (message "Value is nil, and command is nil.") - (message "Value is nil, and command is %c." com)) - (if (null com) - (message "Value is %d, and command is nil." val) - (message "Value is %d, and command is %c." val com))))) - -(defun vip-digit-argument (arg) - "Begin numeric argument for the next command." - (interactive "P") - (vip-prefix-arg-value last-command-event nil - (if (consp arg) (cdr arg) nil))) - -(defun vip-command-argument (arg) - "Accept a motion command as an argument." - (interactive "P") - (condition-case nil - (vip-prefix-arg-com - last-command-event - (cond ((null arg) nil) - ((consp arg) (car arg)) - ((numberp arg) arg) - (t (error "Strange arg"))) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - ((numberp arg) nil) - (t (error "Strange arg")))) - (quit - (setq vip-use-register nil) - (signal 'quit nil)))) - -(defun vip-p-val (arg) - "Get value part of prefix-argument ARG." - (cond ((null arg) 1) - ((consp arg) (if (null (car arg)) 1 (car arg))) - (t arg))) - -(defun vip-P-val (arg) - "Get value part of prefix-argument ARG." - (cond ((consp arg) (car arg)) - (t arg))) - -(defun vip-getcom (arg) - "Get com part of prefix-argument ARG." - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vip-getCom (arg) - "Get com part of prefix-argument ARG and modify it." - (let ((com (vip-getcom arg))) - (cond ((equal com ?c) ?C) - ((equal com ?d) ?D) - ((equal com ?y) ?Y) - (t com)))) - - -;; repeat last destructive command - -(defun vip-append-to-register (reg start end) - "Append region to text in register REG. -START and END are buffer positions indicating what to append." - (set-register reg (concat (or (get-register reg) "") - (buffer-substring start end)))) - -(defun vip-execute-com (m-com val com) - "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set -to vip-d-com for later use by vip-repeat" - (let ((reg vip-use-register)) - (if com - (cond ((= com ?c) (vip-change vip-com-point (point))) - ((= com (- ?c)) (vip-change-subr vip-com-point (point))) - ((or (= com ?C) (= com (- ?C))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (delete-region (mark) (point))) - (open-line 1) - (if (= com ?C) (vip-change-mode-to-insert) (yank))) - ((= com ?d) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'd-command) 'kill-region nil)) - (kill-region vip-com-point (point)) - (setq this-command 'd-command)) - ((= com ?D) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'D-command) 'kill-region nil)) - (kill-region (mark) (point)) - (if (eq m-com 'vip-line) (setq this-command 'D-command))) - (back-to-indentation)) - ((= com ?y) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill vip-com-point (point)) - (goto-char vip-com-point)) - ((= com ?Y) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill (mark) (point))) - (goto-char vip-com-point)) - ((or (= com ?!) (= com (- ?!))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (shell-command-on-region - (mark) (point) - (if (= com ?!) - (setq vip-last-shell-com (vip-read-string "!")) - vip-last-shell-com) - t t))) - ((= com ?=) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if (> (mark) (point)) (exchange-point-and-mark)) - (indent-region (mark) (point) nil))) - ((= com ?<) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) (- vip-shift-width))) - (goto-char vip-com-point)) - ((= com ?>) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) vip-shift-width)) - (goto-char vip-com-point)) - ((>= com 128) - ;; this is special command # - (vip-special-prefix-com (- com 128))))) - (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) - (- com) com) - reg)))) - -(defun vip-repeat (arg) - "(ARG) Re-execute last destructive command. vip-d-com has the form -\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the -argument for COM, CH is a flag for repeat, and REG is optional and if exists -is the name of the register for COM." - (interactive "P") - (if (eq last-command 'vip-undo) - ;; if the last command was vip-undo, then undo-more - (vip-undo-more) - ;; otherwise execute the command stored in vip-d-com. if arg is non-nil - ;; its prefix value is used as new prefix value for the command. - (let ((m-com (car vip-d-com)) - (val (vip-P-val arg)) - (com (car (cdr (cdr vip-d-com)))) - (reg (nth 3 vip-d-com))) - (if (null val) (setq val (car (cdr vip-d-com)))) - (if (null m-com) (error "No previous command to repeat")) - (setq vip-use-register reg) - (funcall m-com (cons val com))))) - -(defun vip-special-prefix-com (char) - "This command is invoked interactively by the key sequence #" - (cond ((= char ?c) - (downcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?C) - (upcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?g) - (set-mark vip-com-point) - (vip-global-execute)) - ((= char ?q) - (set-mark vip-com-point) - (vip-quote-region)) - ((= char ?s) (ispell-region vip-com-point (point))))) - - -;; undoing - -(defun vip-undo () - "Undo previous change." - (interactive) - (message "undo!") - (undo-start) - (undo-more 2) - (setq this-command 'vip-undo)) - -(defun vip-undo-more () - "Continue undoing previous changes." - (message "undo more!") - (undo-more 1) - (setq this-command 'vip-undo)) - - -;; utilities - -(defun vip-string-tail (str) - (if (or (null str) (string= str "")) nil - (substring str 1))) - -(defun vip-yank-defun () - (mark-defun) - (copy-region-as-kill (point) (mark))) - -(defun vip-enlarge-region (beg end) - "Enlarge region between BEG and END." - (if (< beg end) - (progn (goto-char beg) (set-mark end)) - (goto-char end) - (set-mark beg)) - (beginning-of-line) - (exchange-point-and-mark) - (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1))) - (beginning-of-line) - (if (> beg end) (exchange-point-and-mark))) - -(defun vip-global-execute () - "Call last keyboard macro for each line in the region." - (if (> (point) (mark)) (exchange-point-and-mark)) - (beginning-of-line) - (call-last-kbd-macro) - (while (< (point) (mark)) - (forward-line 1) - (beginning-of-line) - (call-last-kbd-macro))) - -(defun vip-quote-region () - "Quote region by inserting the user supplied string at the beginning of -each line in the region." - (setq vip-quote-string - (let ((str - (vip-read-string (format "quote string (default %s): " - vip-quote-string)))) - (if (string= str "") vip-quote-string str))) - (vip-enlarge-region (point) (mark)) - (if (> (point) (mark)) (exchange-point-and-mark)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1) - (while (and (< (point) (mark)) (bolp)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1))) - -(defun vip-end-with-a-newline-p (string) - "Check if the string ends with a newline." - (or (string= string "") - (= (aref string (1- (length string))) ?\n))) - -(defvar vip-save-minibuffer-local-map) - -(defun vip-read-string (prompt &optional init) - (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map)) - (define-key minibuffer-local-map "\C-h" #'backward-char) - (define-key minibuffer-local-map "\C-w" #'backward-word) - (define-key minibuffer-local-map "\e" #'exit-minibuffer) - (let (str) - (condition-case nil - (setq str (read-string prompt init)) - (quit - (setq minibuffer-local-map vip-save-minibuffer-local-map) - (signal 'quit nil))) - (setq minibuffer-local-map vip-save-minibuffer-local-map) - str)) - - -;; insertion commands - -(defun vip-repeat-insert-command () - "This function is called when mode changes from insertion mode to -vi command mode. It will repeat the insertion command if original insertion -command was invoked with argument > 1." - (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) - (if (and val (> val 1)) ;; first check that val is non-nil - (progn - (setq vip-d-com (list i-com (1- val) ?r)) - (vip-repeat nil) - (setq vip-d-com (list i-com val ?r)))))) - -(defun vip-insert (arg) "" - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-insert val ?r)) - (if com (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-append (arg) - "Append after point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-append val ?r)) - (if (not (eolp)) (forward-char)) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Append (arg) - "Append at end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Append val ?r)) - (end-of-line) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Insert (arg) - "Insert before first non-white." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Insert val ?r)) - (back-to-indentation) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-open-line (arg) - "Open line below." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-Open-line (arg) - "Open line above." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-open-line-at-point (arg) - "Open line at point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line-at-point val ?r)) - (if (equal com ?r) - (vip-loop val - (progn - (open-line 1) - (yank))) - (open-line 1) - (vip-change-mode-to-insert)))) - -(defun vip-substitute (arg) - "Substitute characters." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (save-excursion - (set-mark (point)) - (forward-char val) - (if (equal com ?r) - (vip-change-subr (mark) (point)) - (vip-change (mark) (point)))) - (setq vip-d-com (list 'vip-substitute val ?r)))) - -(defun vip-substitute-line (arg) - "Substitute lines." - (interactive "p") - (vip-line (cons arg ?C))) - - -;; line command - -(defun vip-line (arg) - (let ((val (car arg)) (com (cdr arg))) - (move-marker vip-com-point (point)) - (with-no-warnings (next-line (1- val))) - (vip-execute-com 'vip-line val com))) - -(defun vip-yank-line (arg) - "Yank ARG lines (in vi's sense)" - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-line (cons val ?Y)))) - - -;; region command - -(defun vip-region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-region val com))) - -(defun vip-Region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-Region val com))) - -(defun vip-replace-char (arg) - "Replace the following ARG chars by the character read." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-replace-char val ?r)) - (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) - -(defun vip-replace-char-subr (char arg) - (delete-char arg t) - (setq vip-d-char char) - (vip-loop (if (> arg 0) arg (- arg)) (insert char)) - (backward-char arg)) - -(defun vip-replace-string () - "Replace string. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-replace "Replace regexp: " "Replace string: "))) - (if (string= str "") - (progn - (setq vip-re-replace (not vip-re-replace)) - (message "Replace mode changed to %s." - (if vip-re-replace "regexp replace" - "string replace"))) - (if vip-re-replace - ;; (replace-regexp - ;; str - ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) - (while (re-search-forward str nil t) - (replace-match (vip-read-string - (format "Replace regexp \"%s\" with: " str)) - nil nil)) - (with-no-warnings - (replace-string - str - (vip-read-string (format "Replace \"%s\" with: " str)))))))) - - -;; basic cursor movement. j, k, l, m commands. - -(defun vip-forward-char (arg) - "Move point right ARG characters (left if ARG negative).On reaching end -of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char val) - (if com (vip-execute-com 'vip-forward-char val com)))) - -(defun vip-backward-char (arg) - "Move point left ARG characters (right if ARG negative). On reaching -beginning of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-char val) - (if com (vip-execute-com 'vip-backward-char val com)))) - - -;; word command - -(defun vip-forward-word (arg) - "Forward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-word val) - (skip-chars-forward " \t\n") - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-word val com))))) - -(defun vip-end-of-word (arg) - "Move point to end of current word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (forward-word val) - (backward-char) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-word val com))))) - -(defun vip-backward-word (arg) - "Backward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-word val) - (if com (vip-execute-com 'vip-backward-word val com)))) - -(defun vip-forward-Word (arg) - "Forward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-Word val com))))) - -(defun vip-end-of-Word (arg) - "Move forward to end of word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-Word val com))))) - -(defun vip-backward-Word (arg) - "Backward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) - (forward-char) - (goto-char (point-min))) - (if com (vip-execute-com 'vip-backward-Word val com)))) - -(defun vip-beginning-of-line (arg) - "Go to beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line val) - (if com (vip-execute-com 'vip-beginning-of-line val com)))) - -(defun vip-bol-and-skip-white (arg) - "Beginning of line at first non-white character." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (back-to-indentation) - (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) - -(defun vip-goto-eol (arg) - "Go to end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (end-of-line val) - (if com (vip-execute-com 'vip-goto-eol val com)))) - -(defun vip-next-line (arg) - "Go to next line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (line-move val) - (setq this-command 'next-line) - (if com (vip-execute-com 'vip-next-line val com)))) - -(defun vip-next-line-at-bol (arg) - "Next line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line val)) - (back-to-indentation) - (if com (vip-execute-com 'vip-next-line-at-bol val com)))) - -(defun vip-previous-line (arg) - "Go to previous line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line (- val))) - (setq this-command 'previous-line) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-previous-line-at-bol (arg) - "Previous line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line (- val))) - (back-to-indentation) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-change-to-eol (arg) - "Change to end of line." - (interactive "P") - (vip-goto-eol (cons arg ?c))) - -(defun vip-kill-line (arg) - "Delete line." - (interactive "P") - (vip-goto-eol (cons arg ?d))) - - -;; moving around - -(defun vip-goto-line (arg) - "Go to ARG's line. Without ARG go to end of buffer." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (set-mark (point)) - (if (null val) - (goto-char (point-max)) - (goto-char (point-min)) - (forward-line (1- val))) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-line val com)))) - -(defun vip-find-char (arg char forward offset) - "Find ARG's occurrence of CHAR on the current line. If FORWARD then -search is forward, otherwise backward. OFFSET is used to adjust point -after search." - (let ((arg (if forward arg (- arg))) point) - (save-excursion - (save-restriction - (if (> arg 0) - (narrow-to-region - ;; forward search begins here - (if (eolp) (error "") (point)) - ;; forward search ends here - (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point))) - (narrow-to-region - ;; backward search begins from here - (if (bolp) (error "") (point)) - ;; backward search ends here - (progn (beginning-of-line) (point)))) - ;; if arg > 0, point is forwarded before search. - (if (> arg 0) (goto-char (1+ (point-min))) - (goto-char (point-max))) - (let ((case-fold-search nil)) - (search-forward (char-to-string char) nil 0 arg)) - (setq point (point)) - (if (or (and (> arg 0) (= point (point-max))) - (and (< arg 0) (= point (point-min)))) - (error "")))) - (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) - -(defun vip-find-char-forward (arg) - "Find char on the line. If called interactively read the char to find -from the terminal, and if called from vip-repeat, the char last used is -used. This behavior is controlled by the sign of prefix numeric value." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-find-char-forward val com))))) - -(defun vip-goto-char-forward (arg) - "Go up to char ARG forward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-goto-char-forward val com))))) - -(defun vip-find-char-backward (arg) - "Find char ARG on line backward." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char - val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-find-char-backward val com))))) - -(defun vip-goto-char-backward (arg) - "Go up to char ARG backward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-goto-char-backward val com))))) - -(defun vip-repeat-find (arg) - "Repeat previous find command." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char vip-f-forward vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find val com))))) - -(defun vip-repeat-find-opposite (arg) - "Repeat previous find command in the opposite direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find-opposite val com))))) - - -;; window scrolling etc. - -(defun vip-other-window (arg) - "Switch to other window." - (interactive "p") - (other-window arg) - (or (not (eq vip-current-mode 'emacs-mode)) - (string= (buffer-name (current-buffer)) " *Minibuf-1*") - (vip-change-mode-to-vi))) - -(defun vip-window-top (arg) - "Go to home window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (1- val)) - (if com (vip-execute-com 'vip-window-top val com)))) - -(defun vip-window-middle (arg) - "Go to middle window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) - (if com (vip-execute-com 'vip-window-middle val com)))) - -(defun vip-window-bottom (arg) - "Go to last window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (- val)) - (if com (vip-execute-com 'vip-window-bottom val com)))) - -(defun vip-line-to-top (arg) - "Put current line on the home line." - (interactive "p") - (recenter (1- arg))) - -(defun vip-line-to-middle (arg) - "Put current line on the middle line." - (interactive "p") - (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) - -(defun vip-line-to-bottom (arg) - "Put current line on the last line." - (interactive "p") - (recenter (- (window-height) (1+ arg)))) - - -;; paren match - -(defun vip-paren-match (arg) - "Go to the matching parenthesis." - (interactive "P") - (let ((com (vip-getcom arg))) - (if (numberp arg) - (if (or (> arg 99) (< arg 1)) - (error "Prefix must be between 1 and 99") - (goto-char - (if (> (point-max) 80000) - (* (/ (point-max) 100) arg) - (/ (* (point-max) arg) 100))) - (back-to-indentation)) - (cond ((looking-at "[([{]") - (if com (move-marker vip-com-point (point))) - (forward-sexp 1) - (if com - (vip-execute-com 'vip-paren-match nil com) - (backward-char))) - ((looking-at "[])}]") - (forward-char) - (if com (move-marker vip-com-point (point))) - (backward-sexp 1) - (if com (vip-execute-com 'vip-paren-match nil com))) - (t (error "")))))) - - -;; sentence and paragraph - -(defun vip-forward-sentence (arg) - "Forward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-sentence val) - (if com (vip-execute-com 'vip-forward-sentence nil com)))) - -(defun vip-backward-sentence (arg) - "Backward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-sentence val) - (if com (vip-execute-com 'vip-backward-sentence nil com)))) - -(defun vip-forward-paragraph (arg) - "Forward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (forward-paragraph val) - (if com (vip-execute-com 'vip-forward-paragraph nil com)))) - -(defun vip-backward-paragraph (arg) - "Backward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (backward-paragraph val) - (if com (vip-execute-com 'vip-backward-paragraph nil com)))) - - -;; scrolling - -(defun vip-scroll (arg) - "Scroll to next screen." - (interactive "p") - (if (> arg 0) - (while (> arg 0) - (scroll-up) - (setq arg (1- arg))) - (while (> 0 arg) - (scroll-down) - (setq arg (1+ arg))))) - -(defun vip-scroll-back (arg) - "Scroll to previous screen." - (interactive "p") - (vip-scroll (- arg))) - -(defun vip-scroll-down (arg) - "Scroll up half screen." - (interactive "P") - (if (null arg) (scroll-down (/ (window-height) 2)) - (scroll-down arg))) - -(defun vip-scroll-down-one (arg) - "Scroll up one line." - (interactive "p") - (scroll-down arg)) - -(defun vip-scroll-up (arg) - "Scroll down half screen." - (interactive "P") - (if (null arg) (scroll-up (/ (window-height) 2)) - (scroll-up arg))) - -(defun vip-scroll-up-one (arg) - "Scroll down one line." - (interactive "p") - (scroll-up arg)) - - -;; splitting window - -(defun vip-buffer-in-two-windows () - "Show current buffer in two windows." - (interactive) - (delete-other-windows) - (split-window-below)) - - -;; searching - -(defun vip-search-forward (arg) - "Search a string forward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward t - vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string t val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search-backward (arg) - "Search a string backward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward nil - vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string nil val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search (string forward arg &optional no-offset init-point) - "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of -STRING. Search will be forward if FORWARD, otherwise backward." - (let ((val (vip-p-val arg)) (com (vip-getcom arg)) - (null-arg (null (vip-P-val arg))) (offset (not no-offset)) - (case-fold-search vip-case-fold-search) - (start-point (or init-point (point)))) - (if forward - (condition-case conditions - (progn - (if (and offset (not (eobp))) (forward-char)) - (if vip-re-search - (progn - (re-search-forward string nil nil val) - (re-search-backward string)) - (search-forward string nil nil val) - (search-backward string)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-min)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions))))) - (condition-case conditions - (progn - (if vip-re-search - (re-search-backward string nil nil val) - (search-backward string nil nil val)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-max)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions)))))))) - -(defun vip-search-next (arg) - "Repeat previous search." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string")) - (vip-search vip-s-string vip-s-forward arg) - (if com (vip-execute-com 'vip-search-next val com)))) - -(defun vip-search-Next (arg) - "Repeat previous search in the reverse direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string")) - (vip-search vip-s-string (not vip-s-forward) arg) - (if com (vip-execute-com 'vip-search-Next val com)))) - - -;; visiting and killing files, buffers - -(defun vip-switch-to-buffer () - "Switch to buffer in the current window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "switch to buffer (%s): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer buffer) - (vip-change-mode-to-vi))) - -(defun vip-switch-to-buffer-other-window () - "Switch to buffer in another window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "Switch to buffer (%s): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer-other-window buffer) - (vip-change-mode-to-vi))) - -(defun vip-kill-buffer () - "Kill a buffer." - (interactive) - (let (buffer buffer-name) - (setq buffer-name - (read-buffer - (format "Kill buffer (%s): " - (buffer-name (current-buffer))))) - (setq buffer - (if (null buffer-name) - (current-buffer) - (get-buffer buffer-name))) - (if (null buffer) (error "Buffer %s nonexistent" buffer-name)) - (if (or (not (buffer-modified-p buffer)) - (y-or-n-p "Buffer is modified, are you sure? ")) - (kill-buffer buffer) - (error "Buffer not killed")))) - -(defun vip-find-file () - "Visit file in the current window." - (interactive) - (let (file) - (setq file (read-file-name "visit file: ")) - (switch-to-buffer (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-find-file-other-window () - "Visit file in another window." - (interactive) - (let (file) - (setq file (read-file-name "Visit file: ")) - (switch-to-buffer-other-window (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-info-on-file () - "Give information of the file associated to the current buffer." - (interactive) - (message "\"%s\" line %d of %d" - (if (buffer-file-name) (buffer-file-name) "") - (1+ (count-lines (point-min) (point))) - (1+ (count-lines (point-min) (point-max))))) - - -;; yank and pop - -(defun vip-yank (text) - "yank TEXT silently." - (save-excursion - (vip-push-mark-silent (point)) - (insert text) - (exchange-point-and-mark)) - (skip-chars-forward " \t")) - -(defun vip-put-back (arg) - "Put back after point/below line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) - (progn - (with-no-warnings (next-line 1)) - (beginning-of-line)) - (if (and (not (eolp)) (not (eobp))) (forward-char))) - (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-Put-back (arg) - "Put back at point/above line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) (beginning-of-line)) - (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-delete-char (arg) - "Delete character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (- (point) val)) - (copy-to-register vip-use-register (point) (- (point) val) nil)) - (setq vip-use-register nil))) - (delete-char val t))) - -(defun vip-delete-backward-char (arg) - "Delete previous character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-backward-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (+ (point) val)) - (copy-to-register vip-use-register (point) (+ (point) val) nil)) - (setq vip-use-register nil))) - (with-no-warnings (delete-backward-char val t)))) - - -;; join lines. - -(defun vip-join-lines (arg) - "Join this line to next, if ARG is nil. Otherwise, join ARG lines" - (interactive "*P") - (let ((val (vip-P-val arg))) - (setq vip-d-com (list 'vip-join-lines val nil)) - (vip-loop (if (null val) 1 (1- val)) - (progn - (end-of-line) - (if (not (eobp)) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (fixup-whitespace))))))) - - -;; making small changes - -(defvar vip-c-string) - -(defun vip-change (beg end) - (setq vip-c-string - (vip-read-string (format "%s => " (buffer-substring beg end)))) - (vip-change-subr beg end)) - -(defun vip-change-subr (beg end) - (if vip-use-register - (progn - (copy-to-register vip-use-register beg end nil) - (setq vip-use-register nil))) - (kill-region beg end) - (setq this-command 'vip-change) - (insert vip-c-string)) - - -;; query replace - -(defun vip-query-replace () - "Query replace. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-query-replace "Query replace regexp: " - "Query replace: "))) - (if (string= str "") - (progn - (setq vip-re-query-replace (not vip-re-query-replace)) - (message "Query replace mode changed to %s." - (if vip-re-query-replace "regexp replace" - "string replace"))) - (if vip-re-query-replace - (query-replace-regexp - str - (vip-read-string (format "Query replace regexp \"%s\" with: " str))) - (query-replace - str - (vip-read-string (format "Query replace \"%s\" with: " str))))))) - - -;; marking - -(defun vip-mark-beginning-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-min)) - (exchange-point-and-mark) - (message "mark set at the beginning of buffer")) - -(defun vip-mark-end-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-max)) - (exchange-point-and-mark) - (message "mark set at the end of buffer")) - -(defun vip-mark-point (char) - (interactive "c") - (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (- char (- ?a ?\C-a)) nil)) - ((= char ?<) (vip-mark-beginning-of-buffer)) - ((= char ?>) (vip-mark-end-of-buffer)) - ((= char ?.) (push-mark)) - ((= char ?,) (set-mark-command 1)) - ((= char ?D) (mark-defun)) - (t (error "")))) - -(defun vip-goto-mark (arg) - "Go to mark." - (interactive "P") - (let ((char (read-char)) (com (vip-getcom arg))) - (vip-goto-mark-subr char com nil))) - -(defun vip-goto-mark-and-skip-white (arg) - "Go to mark and skip to first non-white on line." - (interactive "P") - (let ((char (read-char)) (com (vip-getCom arg))) - (vip-goto-mark-subr char com t))) - -(defun vip-goto-mark-subr (char com skip-white) - (cond ((and (<= ?a char) (<= char ?z)) - (let ((buff (current-buffer))) - (if com (move-marker vip-com-point (point))) - (goto-char (register-to-point (- char (- ?a ?\C-a)))) - (if skip-white (back-to-indentation)) - (vip-change-mode-to-vi) - (if com - (if (equal buff (current-buffer)) - (vip-execute-com (if skip-white - 'vip-goto-mark-and-skip-white - 'vip-goto-mark) - nil com) - (switch-to-buffer buff) - (goto-char vip-com-point) - (vip-change-mode-to-vi) - (error ""))))) - ((and (not skip-white) (= char ?`)) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (if com (vip-execute-com 'vip-goto-mark nil com))) - ((and skip-white (= char ?')) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) - (t (error "")))) - -(defun vip-exchange-point-and-mark () - (interactive) - (exchange-point-and-mark) - (back-to-indentation)) - -(defun vip-keyboard-quit () - "Abort partially formed or running command." - (interactive) - (setq vip-use-register nil) - (keyboard-quit)) - -(defun vip-ctl-c-equivalent (arg) - "Emulate C-c in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-c" arg)) - -(defun vip-ctl-x-equivalent (arg) - "Emulate C-x in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-x" arg)) - -(defun vip-ctl-key-equivalent (key arg) - (let ((char (read-char))) - (if (and (<= ?A char) (<= char ?Z)) - (setq char (- char (- ?A ?\C-a)))) - (vip-escape-to-emacs arg (list (aref key 0) char)))) - -;; commands in insertion mode - -(defun vip-delete-backward-word (arg) - "Delete previous word." - (interactive "p") - (save-excursion - (set-mark (point)) - (backward-word arg) - (delete-region (point) (mark)))) - - -;; implement ex commands - -(defvar ex-token-type nil - "type of token. if non-nil, gives type of address. if nil, it -is a command.") - -(defvar ex-token nil - "value of token.") - -(defvar ex-addresses nil - "list of ex addresses") - -(defvar ex-flag nil - "flag for ex flag") - -(defvar ex-buffer nil - "name of ex buffer") - -(defvar ex-count nil - "value of ex count") - -(defvar ex-g-flag nil - "flag for global command") - -(defvar ex-g-variant nil - "if t global command is executed on lines not matching ex-g-pat") - -(defvar ex-reg-exp nil - "save reg-exp used in substitute") - -(defvar ex-repl nil - "replace pattern for substitute") - -(defvar ex-g-pat nil - "pattern for global command") - -(defvar ex-map (make-sparse-keymap) - "save commands for mapped keys") - -(defvar ex-tag nil - "save ex tag") - -(defvar ex-file nil) - -(defvar ex-variant nil) - -(defvar ex-offset nil) - -(defvar ex-append nil) - -(defun vip-nil () - (interactive) - (error "")) - -(defun vip-looking-back (str) - "returns t if looking back reg-exp STR before point." - (and (save-excursion (re-search-backward str nil t)) - (= (point) (match-end 0)))) - -(defun vip-check-sub (str) - "check if ex-token is an initial segment of STR" - (let ((length (length ex-token))) - (if (and (<= length (length str)) - (string= ex-token (substring str 0 length))) - (setq ex-token str) - (setq ex-token-type "non-command")))) - -(defun vip-get-ex-com-subr () - "get a complete ex command" - (set-mark (point)) - (re-search-forward "[a-z][a-z]*") - (setq ex-token-type "command") - (setq ex-token (buffer-substring (point) (mark))) - (exchange-point-and-mark) - (cond ((looking-at "a") - (cond ((looking-at "ab") (vip-check-sub "abbreviate")) - ((looking-at "ar") (vip-check-sub "args")) - (t (vip-check-sub "append")))) - ((looking-at "[bh]") (setq ex-token-type "non-command")) - ((looking-at "c") - (if (looking-at "co") (vip-check-sub "copy") - (vip-check-sub "change"))) - ((looking-at "d") (vip-check-sub "delete")) - ((looking-at "e") - (if (looking-at "ex") (vip-check-sub "ex") - (vip-check-sub "edit"))) - ((looking-at "f") (vip-check-sub "file")) - ((looking-at "g") (vip-check-sub "global")) - ((looking-at "i") (vip-check-sub "insert")) - ((looking-at "j") (vip-check-sub "join")) - ((looking-at "l") (vip-check-sub "list")) - ((looking-at "m") - (cond ((looking-at "map") (vip-check-sub "map")) - ((looking-at "mar") (vip-check-sub "mark")) - (t (vip-check-sub "move")))) - ((looking-at "n") - (if (looking-at "nu") (vip-check-sub "number") - (vip-check-sub "next"))) - ((looking-at "o") (vip-check-sub "open")) - ((looking-at "p") - (cond ((looking-at "pre") (vip-check-sub "preserve")) - ((looking-at "pu") (vip-check-sub "put")) - (t (vip-check-sub "print")))) - ((looking-at "q") (vip-check-sub "quit")) - ((looking-at "r") - (cond ((looking-at "rec") (vip-check-sub "recover")) - ((looking-at "rew") (vip-check-sub "rewind")) - (t (vip-check-sub "read")))) - ((looking-at "s") - (cond ((looking-at "se") (vip-check-sub "set")) - ((looking-at "sh") (vip-check-sub "shell")) - ((looking-at "so") (vip-check-sub "source")) - ((looking-at "st") (vip-check-sub "stop")) - (t (vip-check-sub "substitute")))) - ((looking-at "t") - (if (looking-at "ta") (vip-check-sub "tag") - (vip-check-sub "t"))) - ((looking-at "u") - (cond ((looking-at "una") (vip-check-sub "unabbreviate")) - ((looking-at "unm") (vip-check-sub "unmap")) - (t (vip-check-sub "undo")))) - ((looking-at "v") - (cond ((looking-at "ve") (vip-check-sub "version")) - ((looking-at "vi") (vip-check-sub "visual")) - (t (vip-check-sub "v")))) - ((looking-at "w") - (if (looking-at "wq") (vip-check-sub "wq") - (vip-check-sub "write"))) - ((looking-at "x") (vip-check-sub "xit")) - ((looking-at "y") (vip-check-sub "yank")) - ((looking-at "z") (vip-check-sub "z"))) - (exchange-point-and-mark)) - -(defun vip-get-ex-token () - "get an ex-token which is either an address or a command. -a token has type \(command, address, end-mark) and value." - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (cond ((looking-at "[k#]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "[a-z]") (vip-get-ex-com-subr)) - ((looking-at "\\.") - (forward-char 1) - (setq ex-token-type "dot")) - ((looking-at "[0-9]") - (set-mark (point)) - (re-search-forward "[0-9]*") - (setq ex-token-type - (cond ((string= ex-token-type "plus") "add-number") - ((string= ex-token-type "minus") "sub-number") - (t "abs-number"))) - (setq ex-token (string-to-number (buffer-substring (point) (mark))))) - ((looking-at "\\$") - (forward-char 1) - (setq ex-token-type "end")) - ((looking-at "%") - (forward-char 1) - (setq ex-token-type "whole")) - ((looking-at "\\+") - (cond ((looking-at "\\+[-+\n|]") - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "plus")) - ((looking-at "\\+[0-9]") - (forward-char 1) - (setq ex-token-type "plus")) - (t - (error "Badly formed address")))) - ((looking-at "-") - (cond ((looking-at "-[-+\n|]") - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "minus")) - ((looking-at "-[0-9]") - (forward-char 1) - (setq ex-token-type "minus")) - (t - (error "Badly formed address")))) - ((looking-at "/") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^/]*/") - (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (vip-looking-back "[^\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (backward-char 1) - (setq ex-token (buffer-substring (point) (mark))) - (if (looking-at "/") (forward-char 1)) - (setq ex-token-type "search-forward")) - ((looking-at "\\?") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^\\?]*\\?") - (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (vip-looking-back "[^\\]\\(\\\\\\\\\\)*\\\\\\?")) - (setq cont nil)) - (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) - (setq ex-token-type "search-backward") - (setq ex-token (buffer-substring (1- (point)) (mark)))) - ((looking-at ",") - (forward-char 1) - (setq ex-token-type "comma")) - ((looking-at ";") - (forward-char 1) - (setq ex-token-type "semi-colon")) - ((looking-at "[!=><&~]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "'") - (setq ex-token-type "goto-mark") - (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) - ((looking-at "[a-z]") (setq ex-token (following-char))) - (t (error "%s" "Marks are ' and a-z"))) - (forward-char 1)) - ((looking-at "\n") - (setq ex-token-type "end-mark") - (setq ex-token "goto")) - (t - (error "Invalid token"))))) - -(defun vip-ex (&optional string) - "ex commands within VIP." - (interactive) - (or string - (setq ex-g-flag nil - ex-g-variant nil)) - (let ((com-str (or string (vip-read-string ":"))) - (address nil) (cont t) (dot (point))) - (with-current-buffer (get-buffer-create " *ex-working-space*") - (delete-region (point-min) (point-max)) - (insert com-str "\n") - (goto-char (point-min))) - (setq ex-token-type "") - (setq ex-addresses nil) - (while cont - (vip-get-ex-token) - (cond ((or (string= ex-token-type "command") - (string= ex-token-type "end-mark")) - (if address (setq ex-addresses (cons address ex-addresses))) - (cond ((string= ex-token "global") - (ex-global nil) - (setq cont nil)) - ((string= ex-token "v") - (ex-global t) - (setq cont nil)) - (t - (vip-execute-ex-command) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (cond ((looking-at "|") - (forward-char 1)) - ((looking-at "\n") - (setq cont nil)) - (t (error "Extra character at end of a command"))))))) - ((string= ex-token-type "non-command") - (error "%s: Not an editor command" ex-token)) - ((string= ex-token-type "whole") - (setq ex-addresses - (cons (point-max) (cons (point-min) ex-addresses)))) - ((string= ex-token-type "comma") - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - ((string= ex-token-type "semi-colon") - (if address (setq dot address)) - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - (t (let ((ans (vip-get-ex-address-subr address dot))) - (if ans (setq address ans)))))))) - -(defun vip-get-ex-pat () - "get a regular expression and set ex-variant if found" - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-g-variant (not ex-g-variant) - ex-g-flag (not ex-g-flag)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "/") - (progn - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - (re-search-forward "[^/]*\\(/\\|\n\\)") - ;;(re-search-forward "[^/]*/") - (if (not (vip-looking-back "[^\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (setq ex-token - (if (= (mark) (point)) "" - (buffer-substring (1- (point)) (mark)))) - (backward-char 1)) - (setq ex-token nil)))) - -(defun vip-get-ex-command () - "get an ex command" - (with-current-buffer " *ex-working-space*" - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "[a-z]") - (vip-get-ex-com-subr) - (if (string= ex-token-type "non-command") - (error "%s: Not an editor command" ex-token))) - ((looking-at "[!=><&~]") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - (t (error "Could not find an ex command"))))) - -(defun vip-get-ex-opt-gc () - "get an ex option g or c" - (with-current-buffer " *ex-working-space*" - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "g") - (setq ex-token "g") - (forward-char 1) - t) - ((looking-at "c") - (setq ex-token "c") - (forward-char 1) - t) - (t nil)))) - -(defun vip-default-ex-addresses (&optional whole-flag) - "compute default addresses. whole-flag means whole buffer." - (cond ((null ex-addresses) - (setq ex-addresses - (if whole-flag - (cons (point-max) (cons (point-min) nil)) - (cons (point) (cons (point) nil))))) - ((null (cdr ex-addresses)) - (setq ex-addresses - (cons (car ex-addresses) ex-addresses))))) - -(defun vip-get-ex-address () - "get an ex-address as a marker and set ex-flag if a flag is found" - (let ((address (point-marker)) (cont t)) - (setq ex-token "") - (setq ex-flag nil) - (while cont - (vip-get-ex-token) - (cond ((string= ex-token-type "command") - (if (or (string= ex-token "print") (string= ex-token "list") - (string= ex-token "#")) - (progn - (setq ex-flag t) - (setq cont nil)) - (error "Address expected"))) - ((string= ex-token-type "end-mark") - (setq cont nil)) - ((string= ex-token-type "whole") - (error "a trailing address is expected")) - ((string= ex-token-type "comma") - (error "Extra characters after an address")) - (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) - (if ans (setq address ans)))))) - address)) - -(defun vip-get-ex-address-subr (old-address dot) - "returns an address as a point" - (let ((address nil)) - (if (null old-address) (setq old-address dot)) - (cond ((string= ex-token-type "dot") - (setq address dot)) - ((string= ex-token-type "add-number") - (save-excursion - (goto-char old-address) - (forward-line (if (= old-address 0) (1- ex-token) ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "sub-number") - (save-excursion - (goto-char old-address) - (forward-line (- ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "abs-number") - (save-excursion - (goto-char (point-min)) - (if (= ex-token 0) (setq address 0) - (forward-line (1- ex-token)) - (setq address (point-marker))))) - ((string= ex-token-type "end") - (setq address (point-max-marker))) - ((string= ex-token-type "plus") t);; do nothing - ((string= ex-token-type "minus") t);; do nothing - ((string= ex-token-type "search-forward") - (save-excursion - (ex-search-address t) - (setq address (point-marker)))) - ((string= ex-token-type "search-backward") - (save-excursion - (ex-search-address nil) - (setq address (point-marker)))) - ((string= ex-token-type "goto-mark") - (save-excursion - (if (null ex-token) - (exchange-point-and-mark) - (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) - (setq address (point-marker))))) - address)) - -(defun ex-search-address (forward) - "search pattern and set address" - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-token vip-s-string)) - (setq vip-s-string ex-token)) - (if forward - (progn - (forward-line 1) - (re-search-forward ex-token)) - (forward-line -1) - (re-search-backward ex-token))) - -(defun vip-get-ex-buffer () - "get a buffer name and set ex-count and ex-flag if found" - (setq ex-buffer nil) - (setq ex-count nil) - (setq ex-flag nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "[a-zA-Z]") - (progn - (setq ex-buffer (following-char)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-number (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Invalid extra characters")))) - -(defun vip-get-ex-count () - (setq ex-variant nil - ex-count nil - ex-flag nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1))) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-number (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Invalid extra characters")))) - -(defun vip-get-ex-file () - "get a file name and set ex-variant, ex-append and ex-offset if found" - (setq ex-file nil - ex-variant nil - ex-append nil - ex-offset nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at ">>") - (progn - (setq ex-append t - ex-variant t) - (forward-char 2) - (skip-chars-forward " \t"))) - (if (looking-at "\\+") - (progn - (forward-char 1) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-offset (buffer-substring (point) (mark))) - (forward-char 1) - (skip-chars-forward " \t"))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-file (buffer-substring (point) (mark))))) - -(defun vip-execute-ex-command () - "execute ex command using the value of addresses." - (cond ((string= ex-token "goto") (ex-goto)) - ((string= ex-token "copy") (ex-copy nil)) - ((string= ex-token "delete") (ex-delete)) - ((string= ex-token "edit") (ex-edit)) - ((string= ex-token "file") (vip-info-on-file)) - ;((string= ex-token "global") (ex-global nil)) - ((string= ex-token "join") (ex-line "join")) - ((string= ex-token "k") (ex-mark)) - ((string= ex-token "mark") (ex-mark)) - ((string= ex-token "map") (ex-map)) - ((string= ex-token "move") (ex-copy t)) - ((string= ex-token "put") (ex-put)) - ((string= ex-token "quit") (ex-quit)) - ((string= ex-token "read") (ex-read)) - ((string= ex-token "set") (ex-set)) - ((string= ex-token "shell") (ex-shell)) - ((string= ex-token "substitute") (ex-substitute)) - ((string= ex-token "stop") (suspend-emacs)) - ((string= ex-token "t") (ex-copy nil)) - ((string= ex-token "tag") (ex-tag)) - ((string= ex-token "undo") (vip-undo)) - ((string= ex-token "unmap") (ex-unmap)) - ;((string= ex-token "v") (ex-global t)) - ((string= ex-token "version") (vip-version)) - ((string= ex-token "visual") (ex-edit)) - ((string= ex-token "write") (ex-write nil)) - ((string= ex-token "wq") (ex-write t)) - ((string= ex-token "yank") (ex-yank)) - ((string= ex-token "!") (ex-command)) - ((string= ex-token "=") (ex-line-no)) - ((string= ex-token ">") (ex-line "right")) - ((string= ex-token "<") (ex-line "left")) - ((string= ex-token "&") (ex-substitute t)) - ((string= ex-token "~") (ex-substitute t t)) - ((or (string= ex-token "append") - (string= ex-token "args") - (string= ex-token "change") - (string= ex-token "insert") - (string= ex-token "open") - ) - (error "%s: No such command from VIP" ex-token)) - ((or (string= ex-token "abbreviate") - (string= ex-token "list") - (string= ex-token "next") - (string= ex-token "print") - (string= ex-token "preserve") - (string= ex-token "recover") - (string= ex-token "rewind") - (string= ex-token "source") - (string= ex-token "unabbreviate") - (string= ex-token "xit") - (string= ex-token "z") - ) - (error "%s: Not implemented in VIP" ex-token)) - (t (error "%s: Not an editor command" ex-token)))) - -(defun ex-goto () - "ex goto command" - (if (null ex-addresses) - (setq ex-addresses (cons (point) nil))) - (push-mark) - (goto-char (car ex-addresses)) - (beginning-of-line)) - -(defun ex-copy (del-flag) - "ex copy and move command. DEL-FLAG means delete." - (vip-default-ex-addresses) - (let ((address (vip-get-ex-address)) - (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (goto-char end) - (save-excursion - (set-mark beg) - (vip-enlarge-region (mark) (point)) - (if del-flag (kill-region (point) (mark)) - (copy-region-as-kill (point) (mark))) - (if ex-flag - (progn - (with-output-to-temp-buffer "*copy text*" - (princ - (if (or del-flag ex-g-flag ex-g-variant) - (current-kill 0) - (buffer-substring (point) (mark))))) - (condition-case nil - (progn - (vip-read-string "[Hit return to continue] ") - (save-excursion (kill-buffer "*copy text*"))) - (quit - (save-excursion (kill-buffer "*copy text*")) - (signal 'quit nil)))))) - (if (= address 0) - (goto-char (point-min)) - (goto-char address) - (forward-line 1)) - (insert (current-kill 0)))) - -(defun ex-delete () - "ex delete" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag - ;; show text to be deleted and ask for confirmation - (progn - (with-output-to-temp-buffer " *delete text*" - (princ (buffer-substring (point) (mark)))) - (condition-case nil - (vip-read-string "[Hit return to continue] ") - (quit - (save-excursion (kill-buffer " *delete text*")) - (error ""))) - (save-excursion (kill-buffer " *delete text*"))) - (if ex-buffer - (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) - (vip-append-to-register - (+ ex-buffer 32) (point) (mark)) - (copy-to-register ex-buffer (point) (mark) nil))) - (delete-region (point) (mark)))))) - -(defun ex-edit () - "ex-edit" - (vip-get-ex-file) - (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) - (error "No write since last change (:e! overrides)")) - (vip-change-mode-to-emacs) - (set-buffer - (find-file-noselect (concat default-directory ex-file))) - (vip-change-mode-to-vi) - (goto-char (point-min)) - (if ex-offset - (progn - (with-current-buffer " *ex-working-space*" - (delete-region (point-min) (point-max)) - (insert ex-offset "\n") - (goto-char (point-min))) - (goto-char (vip-get-ex-address)) - (beginning-of-line)))) - -(defun ex-global (variant) - "ex global command" - (if (or ex-g-flag ex-g-variant) - (error "Global within global not allowed") - (if variant - (setq ex-g-flag nil - ex-g-variant t) - (setq ex-g-flag t - ex-g-variant nil))) - (vip-get-ex-pat) - (if (null ex-token) - (error "Missing regular expression for global command")) - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-g-pat vip-s-string)) - (setq ex-g-pat ex-token - vip-s-string ex-token)) - (if (null ex-addresses) - (setq ex-addresses (list (point-max) (point-min)))) - (let ((marks nil) (mark-count 0) - com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (let ((cont t) (limit (point-marker))) - (exchange-point-and-mark) - ;; skip the last line if empty - (beginning-of-line) - (if (and (eobp) (not (bobp))) (backward-char 1)) - (while (and cont (not (bobp)) (>= (point) limit)) - (beginning-of-line) - (set-mark (point)) - (end-of-line) - (let ((found (re-search-backward ex-g-pat (mark) t))) - (if (or (and ex-g-flag found) - (and ex-g-variant (not found))) - (progn - (end-of-line) - (setq mark-count (1+ mark-count)) - (setq marks (cons (point-marker) marks))))) - (beginning-of-line) - (if (bobp) (setq cont nil) - (forward-line -1) - (end-of-line))))) - (with-current-buffer " *ex-working-space*" - (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) - (while marks - (goto-char (car marks)) - ;; report progress of execution on a slow machine. - ;;(message "Executing global command...") - ;;(if (zerop (% mark-count 10)) - ;; (message "Executing global command...%d" mark-count)) - (vip-ex com-str) - (setq mark-count (1- mark-count)) - (setq marks (cdr marks))))) -;;(message "Executing global command...done"))) - -(defun ex-line (com) - "ex line commands. COM is join, shift-right or shift-left." - (vip-default-ex-addresses) - (vip-get-ex-count) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line ex-count))) - (if ex-flag - ;; show text to be joined and ask for confirmation - (progn - (with-output-to-temp-buffer " *text*" - (princ (buffer-substring (point) (mark)))) - (condition-case nil - (progn - (vip-read-string "[Hit return to continue] ") - (ex-line-subr com (point) (mark))) - (quit - (ding))) - (save-excursion (kill-buffer " *text*"))) - (ex-line-subr com (point) (mark))) - (setq point (point))) - (goto-char (1- point)) - (beginning-of-line))) - -(defun ex-line-subr (com beg end) - (cond ((string= com "join") - (goto-char (min beg end)) - (while (and (not (eobp)) (< (point) (max beg end))) - (end-of-line) - (if (and (<= (point) (max beg end)) (not (eobp))) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (if (not ex-variant) (fixup-whitespace)))))) - ((or (string= com "right") (string= com "left")) - (indent-rigidly - (min beg end) (max beg end) - (if (string= com "right") vip-shift-width (- vip-shift-width))) - (goto-char (max beg end)) - (end-of-line) - (forward-char 1)))) - -(defun ex-mark () - "ex mark" - (let (char) - (if (null ex-addresses) - (setq ex-addresses - (cons (point) nil))) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "[a-z]") - (progn - (setq char (following-char)) - (forward-char 1) - (skip-chars-forward " \t") - (if (not (looking-at "[\n|]")) - (error "Extra characters at end of \"k\" command"))) - (if (looking-at "[\n|]") - (error "\"k\" requires a following letter") - (error "Mark must specify a letter")))) - (save-excursion - (goto-char (car ex-addresses)) - (point-to-register (- char (- ?a ?\C-a)) nil)))) - -(defun ex-map () - "ex map" - (let (char string) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (looking-at "[\n|]") (error "Missing rhs")) - (set-mark (point)) - (with-no-warnings - (end-of-buffer)) - (backward-char 1) - (setq string (buffer-substring (mark) (point)))) - (if (not (lookup-key ex-map char)) - (define-key ex-map char - (or (lookup-key vip-mode-map char) 'vip-nil))) - (define-key vip-mode-map char - (lambda (count) - (interactive "p") - (execute-kbd-macro string count))))) - -(defun ex-unmap () - "ex unmap" - (let (char) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) - (if (not (lookup-key ex-map char)) - (error "That macro wasn't mapped")) - (define-key vip-mode-map char (lookup-key ex-map char)) - (define-key ex-map char nil))) - -(defun ex-put () - "ex put" - (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) - (vip-get-ex-buffer) - (setq vip-use-register ex-buffer) - (goto-char point) - (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) - -(defun ex-quit () - "ex quit" - (let (char) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (following-char))) - (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) - -(defun ex-read () - "ex read" - (let ((point (if (null ex-addresses) (point) (car ex-addresses))) - (variant nil) command file) - (goto-char point) - (if (not (= point 0)) (with-no-warnings (next-line 1))) - (beginning-of-line) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq variant t) - (forward-char 1) - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq file (buffer-substring (point) (mark))))) - (if variant - (shell-command command t) - (with-no-warnings - (insert-file file))))) - -(defalias 'ex-set #'set-variable) - -(defun ex-shell () - "ex shell" - (vip-change-mode-to-emacs) - (shell)) - -(defun ex-substitute (&optional repeat r-flag) - "ex substitute. -If REPEAT use previous reg-exp which is ex-reg-exp or -vip-s-string" - (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) - (if repeat (setq ex-token nil) (vip-get-ex-pat)) - (if (null ex-token) - (setq pat (if r-flag vip-s-string ex-reg-exp) - repl ex-repl) - (setq pat (if (string= ex-token "") vip-s-string ex-token)) - (setq vip-s-string pat - ex-reg-exp pat) - (vip-get-ex-pat) - (if (null ex-token) - (setq ex-token "" - ex-repl "") - (setq repl ex-token - ex-repl ex-token))) - (while (vip-get-ex-opt-gc) - (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) - (vip-get-ex-count) - (if ex-count - (save-excursion - (if ex-addresses (goto-char (car ex-addresses))) - (set-mark (point)) - (forward-line (1- ex-count)) - (setq ex-addresses (cons (point) (cons (mark) nil)))) - (if (null ex-addresses) - (setq ex-addresses (cons (point) (cons (point) nil))) - (if (null (cdr ex-addresses)) - (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) - ;(setq G opt-g) - (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) - eol-mark) ;;(cont t) - (save-excursion - (vip-enlarge-region beg end) - (let ((limit (save-excursion - (goto-char (max (point) (mark))) - (point-marker)))) - (goto-char (min (point) (mark))) - (while (< (point) limit) - (end-of-line) - (setq eol-mark (point-marker)) - (beginning-of-line) - (if opt-g - (progn - (while (and (not (eolp)) - (re-search-forward pat eol-mark t)) - (if (or (not opt-c) (y-or-n-p "Replace? ")) - (progn - (setq matched-pos (point)) - (replace-match repl)))) - (end-of-line) - (forward-char)) - (if (and (re-search-forward pat eol-mark t) - (or (not opt-c) (y-or-n-p "Replace? "))) - (progn - (setq matched-pos (point)) - (replace-match repl))) - (end-of-line) - (forward-char)))))) - (if matched-pos (goto-char matched-pos)) - (beginning-of-line) - (if opt-c (message "done")))) - -(defun ex-tag () - "ex tag" - (let (tag) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (set-mark (point)) - (skip-chars-forward "^ |\t\n") - (setq tag (buffer-substring (mark) (point)))) - (if (not (string= tag "")) (setq ex-tag tag)) - (vip-change-mode-to-emacs) - (condition-case conditions - (progn - (with-suppressed-warnings ((obsolete find-tag find-tag-other-window)) - (if (string= tag "") - (find-tag ex-tag t) - (find-tag-other-window ex-tag))) - (vip-change-mode-to-vi)) - (error - (vip-change-mode-to-vi) - (vip-message-conditions conditions))))) - -(defun ex-write (q-flag) - "ex write" - (vip-default-ex-addresses t) - (vip-get-ex-file) - (if (string= ex-file "") - (progn - (if (null buffer-file-name) - (error "No file associated with this buffer")) - (setq ex-file buffer-file-name)) - (setq ex-file (expand-file-name ex-file))) - (if (and (not (string= ex-file (buffer-file-name))) - (file-exists-p ex-file) - (not ex-variant)) - (error "\"%s\" File exists - use w! to override" ex-file)) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (write-region (point) (mark) ex-file ex-append t))) - (if (null buffer-file-name) (setq buffer-file-name ex-file)) - (if q-flag (save-buffers-kill-emacs))) - -(defun ex-yank () - "ex yank" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag (error "Extra characters at end of command")) - (if ex-buffer - (copy-to-register ex-buffer (point) (mark) nil)) - (copy-region-as-kill (point) (mark))))) - -(defun ex-command () - "execute shell command" - (let (command) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (if (null ex-addresses) - (shell-command command) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (null beg) (setq beg end)) - (save-excursion - (goto-char beg) - (set-mark end) - (vip-enlarge-region (point) (mark)) - (shell-command-on-region (point) (mark) command t t)) - (goto-char beg))))) - -(defun ex-line-no () - "print line number" - (message "%d" - (1+ (count-lines - (point-min) - (if (null ex-addresses) (point-max) (car ex-addresses)))))) - -(if (file-exists-p vip-startup-file) (load vip-startup-file)) - -(provide 'vip) - -;;; vip.el ends here diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el deleted file mode 100644 index d8ee63c8a01..00000000000 --- a/lisp/obsolete/ws-mode.el +++ /dev/null @@ -1,539 +0,0 @@ -;;; ws-mode.el --- WordStar emulation mode for GNU Emacs -*- lexical-binding: t -*- - -;; Copyright (C) 1991, 2001-2024 Free Software Foundation, Inc. - -;; Author: Juergen Nickelsen -;; Version: 0.7 -;; Keywords: emulations -;; Obsolete-since: 24.5 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This provides emulation of WordStar with a minor mode. - -;;; Code: - -(defgroup wordstar nil - "WordStar emulation within Emacs." - :prefix "wordstar-" - :prefix "ws-" - :group 'emulations) - -(defcustom wordstar-mode-lighter " WordStar" - "Lighter shown in the modeline for `wordstar' mode." - :type 'string) - -(defvar wordstar-C-k-map - (let ((map (make-keymap))) - (define-key map " " ()) - (define-key map "0" #'ws-set-marker-0) - (define-key map "1" #'ws-set-marker-1) - (define-key map "2" #'ws-set-marker-2) - (define-key map "3" #'ws-set-marker-3) - (define-key map "4" #'ws-set-marker-4) - (define-key map "5" #'ws-set-marker-5) - (define-key map "6" #'ws-set-marker-6) - (define-key map "7" #'ws-set-marker-7) - (define-key map "8" #'ws-set-marker-8) - (define-key map "9" #'ws-set-marker-9) - (define-key map "b" #'ws-begin-block) - (define-key map "\C-b" #'ws-begin-block) - (define-key map "c" #'ws-copy-block) - (define-key map "\C-c" #'ws-copy-block) - (define-key map "d" #'save-buffers-kill-emacs) - (define-key map "\C-d" #'save-buffers-kill-emacs) - (define-key map "f" #'find-file) - (define-key map "\C-f" #'find-file) - (define-key map "h" #'ws-show-markers) - (define-key map "\C-h" #'ws-show-markers) - (define-key map "i" #'ws-indent-block) - (define-key map "\C-i" #'ws-indent-block) - (define-key map "k" #'ws-end-block) - (define-key map "\C-k" #'ws-end-block) - (define-key map "p" #'ws-print-block) - (define-key map "\C-p" #'ws-print-block) - (define-key map "q" #'kill-emacs) - (define-key map "\C-q" #'kill-emacs) - (define-key map "r" #'insert-file) - (define-key map "\C-r" #'insert-file) - (define-key map "s" #'save-some-buffers) - (define-key map "\C-s" #'save-some-buffers) - (define-key map "t" #'ws-mark-word) - (define-key map "\C-t" #'ws-mark-word) - (define-key map "u" #'ws-exdent-block) - (define-key map "\C-u" #'keyboard-quit) - (define-key map "v" #'ws-move-block) - (define-key map "\C-v" #'ws-move-block) - (define-key map "w" #'ws-write-block) - (define-key map "\C-w" #'ws-write-block) - (define-key map "x" #'save-buffers-kill-emacs) - (define-key map "\C-x" #'save-buffers-kill-emacs) - (define-key map "y" #'ws-delete-block) - (define-key map "\C-y" #'ws-delete-block) - map)) - -(defvar wordstar-C-o-map - (let ((map (make-keymap))) - (define-key map " " ()) - (define-key map "c" #'wordstar-center-line) - (define-key map "\C-c" #'wordstar-center-line) - (define-key map "b" #'switch-to-buffer) - (define-key map "\C-b" #'switch-to-buffer) - (define-key map "j" #'justify-current-line) - (define-key map "\C-j" #'justify-current-line) - (define-key map "k" #'kill-buffer) - (define-key map "\C-k" #'kill-buffer) - (define-key map "l" #'list-buffers) - (define-key map "\C-l" #'list-buffers) - (define-key map "m" #'auto-fill-mode) - (define-key map "\C-m" #'auto-fill-mode) - (define-key map "r" #'set-fill-column) - (define-key map "\C-r" #'set-fill-column) - (define-key map "\C-u" #'keyboard-quit) - (define-key map "wd" #'delete-other-windows) - (define-key map "wh" #'split-window-right) - (define-key map "wo" #'other-window) - (define-key map "wv" #'split-window-below) - map)) - -(defvar wordstar-C-q-map - (let ((map (make-keymap))) - (define-key map " " ()) - (define-key map "0" #'ws-find-marker-0) - (define-key map "1" #'ws-find-marker-1) - (define-key map "2" #'ws-find-marker-2) - (define-key map "3" #'ws-find-marker-3) - (define-key map "4" #'ws-find-marker-4) - (define-key map "5" #'ws-find-marker-5) - (define-key map "6" #'ws-find-marker-6) - (define-key map "7" #'ws-find-marker-7) - (define-key map "8" #'ws-find-marker-8) - (define-key map "9" #'ws-find-marker-9) - (define-key map "a" #'ws-query-replace) - (define-key map "\C-a" #'ws-query-replace) - (define-key map "b" #'ws-goto-block-begin) - (define-key map "\C-b" #'ws-goto-block-begin) - (define-key map "c" #'end-of-buffer) - (define-key map "\C-c" #'end-of-buffer) - (define-key map "d" #'end-of-line) - (define-key map "\C-d" #'end-of-line) - (define-key map "f" #'ws-search) - (define-key map "\C-f" #'ws-search) - (define-key map "k" #'ws-goto-block-end) - (define-key map "\C-k" #'ws-goto-block-end) - (define-key map "l" #'ws-undo) - (define-key map "\C-l" #'ws-undo) - ;; (define-key map "p" #'ws-last-cursorp) - ;; (define-key map "\C-p" #'ws-last-cursorp) - (define-key map "r" #'beginning-of-buffer) - (define-key map "\C-r" #'beginning-of-buffer) - (define-key map "s" #'beginning-of-line) - (define-key map "\C-s" #'beginning-of-line) - (define-key map "\C-u" #'keyboard-quit) - (define-key map "w" #'ws-last-error) - (define-key map "\C-w" #'ws-last-error) - (define-key map "y" #'ws-kill-eol) - (define-key map "\C-y" #'ws-kill-eol) - (define-key map "\177" #'ws-kill-bol) - map)) - -(defvar wordstar-mode-map - (let ((map (make-keymap))) - (define-key map "\C-a" #'backward-word) - (define-key map "\C-b" #'fill-paragraph) - (define-key map "\C-c" #'scroll-up-command) - (define-key map "\C-d" #'forward-char) - (define-key map "\C-e" #'previous-line) - (define-key map "\C-f" #'forward-word) - (define-key map "\C-g" #'delete-char) - (define-key map "\C-h" #'backward-char) - (define-key map "\C-i" #'indent-for-tab-command) - (define-key map "\C-j" #'help-for-help) - (define-key map "\C-k" wordstar-C-k-map) - (define-key map "\C-l" #'ws-repeat-search) - (define-key map "\C-n" #'open-line) - (define-key map "\C-o" wordstar-C-o-map) - (define-key map "\C-p" #'quoted-insert) - (define-key map "\C-q" wordstar-C-q-map) - (define-key map "\C-r" #'scroll-down-command) - (define-key map "\C-s" #'backward-char) - (define-key map "\C-t" #'kill-word) - (define-key map "\C-u" #'keyboard-quit) - (define-key map "\C-v" #'overwrite-mode) - (define-key map "\C-w" #'scroll-down-line) - (define-key map "\C-x" #'next-line) - (define-key map "\C-y" #'kill-complete-line) - (define-key map "\C-z" #'scroll-up-line) - map)) - -;; wordstar-C-j-map not yet implemented -(defvar wordstar-C-j-map nil) - -;;;###autoload -(define-minor-mode wordstar-mode - "Minor mode with WordStar-like key bindings. - -BUGS: - - Help menus with WordStar commands (C-j just calls help-for-help) - are not implemented - - Options for search and replace - - Show markers (C-k h) is somewhat strange - - Search and replace (C-q a) is only available in forward direction - -No key bindings beginning with ESC are installed, they will work -Emacs-like." - :group 'wordstar - :lighter wordstar-mode-lighter - :keymap wordstar-mode-map) - -(defun turn-on-wordstar-mode () - (when (and (not (minibufferp)) - (not wordstar-mode)) - (wordstar-mode 1))) - -(define-globalized-minor-mode global-wordstar-mode wordstar-mode - turn-on-wordstar-mode) - -(defun wordstar-center-paragraph () - "Center each line in the paragraph at or after point. -See `wordstar-center-line' for more info." - (interactive) - (save-excursion - (forward-paragraph) - (or (bolp) (newline 1)) - (let ((end (point))) - (backward-paragraph) - (wordstar-center-region (point) end)))) - -(defun wordstar-center-region (from to) - "Center each line starting in the region. -See `wordstar-center-line' for more info." - (interactive "r") - (if (> from to) - (let ((tem to)) - (setq to from from tem))) - (save-excursion - (save-restriction - (narrow-to-region from to) - (goto-char from) - (while (not (eobp)) - (wordstar-center-line) - (forward-line 1))))) - -(defun wordstar-center-line () - "Center the line point is on, within the width specified by `fill-column'. -This means adjusting the indentation to match -the distance between the end of the text and `fill-column'." - (interactive) - (save-excursion - (let (line-length) - (beginning-of-line) - (delete-horizontal-space) - (end-of-line) - (delete-horizontal-space) - (setq line-length (current-column)) - (beginning-of-line) - (indent-to - (+ left-margin - (/ (- fill-column left-margin line-length) 2)))))) - -;;;;;;;;;;; -;; wordstar special variables: - -(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.") -(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.") -(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.") -(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.") -(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.") -(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.") -(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.") -(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.") -(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.") -(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.") - -(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.") -(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.") - -(defvar ws-search-string nil "String of last search in WordStar mode.") -(defvar ws-search-direction t - "Direction of last search in WordStar mode. t if forward, nil if backward.") - -(defvar ws-last-cursorposition nil - "Position before last search etc. in WordStar mode.") - -(defvar ws-last-errormessage nil - "Last error message issued by a WordStar mode function.") - -;;;;;;;;;;; -;; wordstar special functions: - -(defun ws-error (string) - "Report error of a WordStar special function. -Error message is saved in `ws-last-errormessage' for recovery -with C-q w." - (setq ws-last-errormessage string) - (error string)) - -(defun ws-begin-block () - "In WordStar mode: Set block begin marker to current cursor position." - (interactive) - (setq ws-block-begin-marker (point-marker)) - (message "Block begin marker set")) - -(defun ws-show-markers () - "In WordStar mode: Show block markers." - (interactive) - (if (or ws-block-begin-marker ws-block-end-marker) - (save-excursion - (if ws-block-begin-marker - (progn - (goto-char ws-block-begin-marker) - (message "Block begin marker") - (sit-for 2)) - (message "Block begin marker not set") - (sit-for 2)) - (if ws-block-end-marker - (progn - (goto-char ws-block-end-marker) - (message "Block end marker") - (sit-for 2)) - (message "Block end marker not set")) - (message "")) - (message "Block markers not set"))) - -(defun ws-indent-block () - "In WordStar mode: Indent block (not yet implemented)." - (interactive) - (ws-error "Indent block not yet implemented")) - -(defun ws-end-block () - "In WordStar mode: Set block end marker to current cursor position." - (interactive) - (setq ws-block-end-marker (point-marker)) - (message "Block end marker set")) - -(defun ws-print-block () - "In WordStar mode: Print block." - (interactive) - (message "Don't do this. Write block to a file (C-k w) and print this file")) - -(defun ws-mark-word () - "In WordStar mode: Mark current word as block." - (interactive) - (save-excursion - (forward-word 1) - (sit-for 1) - (ws-end-block) - (forward-word -1) - (sit-for 1) - (ws-begin-block))) - -(defun ws-exdent-block () - "I don't know what this (C-k u) should do." - (interactive) - (ws-error "This won't be done -- not yet implemented")) - -(defun ws-move-block () - "In WordStar mode: Move block to current cursor position." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (progn - (kill-region ws-block-begin-marker ws-block-end-marker) - (yank) - (save-excursion - (goto-char (region-beginning)) - (setq ws-block-begin-marker (point-marker)) - (goto-char (region-end)) - (setq ws-block-end-marker (point-marker)))) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -(defun ws-write-block () - "In WordStar mode: Write block to file." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (let ((filename (read-file-name "Write block to file: "))) - (write-region ws-block-begin-marker ws-block-end-marker filename)) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - - -(defun ws-delete-block () - "In WordStar mode: Delete block." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (progn - (kill-region ws-block-begin-marker ws-block-end-marker) - (setq ws-block-end-marker nil) - (setq ws-block-begin-marker nil)) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -(defun ws-goto-block-begin () - "In WordStar mode: Go to block begin marker." - (interactive) - (if ws-block-begin-marker - (progn - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-block-begin-marker)) - (ws-error "Block begin marker not set"))) - -(defun ws-search (string) - "In WordStar mode: Search string, remember string for repetition." - (interactive "sSearch for: ") - (message "Forward (f) or backward (b)") - (let ((direction - (read-char))) - (cond ((equal (upcase direction) ?F) - (setq ws-search-string string) - (setq ws-search-direction t) - (setq ws-last-cursorposition (point-marker)) - (search-forward string)) - ((equal (upcase direction) ?B) - (setq ws-search-string string) - (setq ws-search-direction nil) - (setq ws-last-cursorposition (point-marker)) - (search-backward string)) - (t (keyboard-quit))))) - -(defun ws-goto-block-end () - "In WordStar mode: Go to block end marker." - (interactive) - (if ws-block-end-marker - (progn - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-block-end-marker)) - (ws-error "Block end marker not set"))) - -(defun ws-undo () - "In WordStar mode: Undo and give message about undoing more changes." - (interactive) - (undo) - (message "Repeat C-q l to undo more changes")) - -(defun ws-goto-last-cursorposition () - "In WordStar mode: Go to position before last search." - (interactive) - (if ws-last-cursorposition - (progn - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-last-cursorposition)) - (ws-error "No last cursor position available"))) - -(defun ws-last-error () - "In WordStar mode: repeat last error message. -This will only work for errors raised by WordStar mode functions." - (interactive) - (if ws-last-errormessage - (message "%s" ws-last-errormessage) - (message "No WordStar error yet"))) - -(defun ws-kill-eol () - "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)." - (interactive) - (let ((p (point))) - (end-of-line) - (kill-region p (point)))) - -(defun ws-kill-bol () - "In WordStar mode: Kill to beginning of line (like WordStar, not like Emacs)." - (interactive) - (let ((p (point))) - (beginning-of-line) - (kill-region (point) p))) - -(defun kill-complete-line () - "Kill the complete line." - (interactive) - (beginning-of-line) - (if (eobp) (error "End of buffer")) - (let ((beg (point))) - (forward-line 1) - (kill-region beg (point)))) - -(defun ws-repeat-search () - "In WordStar mode: Repeat last search." - (interactive) - (setq ws-last-cursorposition (point-marker)) - (if ws-search-string - (if ws-search-direction - (search-forward ws-search-string) - (search-backward ws-search-string)) - (ws-error "No search to repeat"))) - -(defun ws-query-replace (from to) - "In WordStar mode: Search string, remember string for repetition." - (interactive "sReplace: \n\ -sWith: " ) - (setq ws-search-string from) - (setq ws-search-direction t) - (setq ws-last-cursorposition (point-marker)) - (query-replace from to)) - -(defun ws-copy-block () - "In WordStar mode: Copy block to current cursor position." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (progn - (copy-region-as-kill ws-block-begin-marker ws-block-end-marker) - (yank) - (save-excursion - (goto-char (region-beginning)) - (setq ws-block-begin-marker (point-marker)) - (goto-char (region-end)) - (setq ws-block-end-marker (point-marker)))) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -(defmacro ws-set-marker (&rest indices) - (let (n forms) - (while indices - (setq n (pop indices)) - (push `(defun ,(intern (format "ws-set-marker-%d" n)) () - ,(format "In WordStar mode: Set marker %d to current cursor position" n) - (interactive) - (setq ,(intern (format "ws-marker-%d" n)) (point-marker)) - (message ,(format "Marker %d set" n))) - forms)) - `(progn ,@(nreverse forms)))) - -(ws-set-marker 0 1 2 3 4 5 6 7 8 9) - -(defmacro ws-find-marker (&rest indices) - (let (n forms) - (while indices - (setq n (pop indices)) - (push `(defun ,(intern (format "ws-find-marker-%d" n)) () - ,(format "In WordStar mode: Go to marker %d." n) - (interactive) - (if ,(intern (format "ws-marker-%d" n)) - (progn (setq ws-last-cursorposition (point-marker)) - (goto-char ,(intern (format "ws-marker-%d" n)))) - (ws-error ,(format "Marker %d not set" n)))) - forms)) - `(progn ,@(nreverse forms)))) - -(ws-find-marker 0 1 2 3 4 5 6 7 8 9) - -(provide 'ws-mode) - -;;; ws-mode.el ends here diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el deleted file mode 100644 index eb4c65c4084..00000000000 --- a/lisp/obsolete/yow.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; yow.el --- quote random zippyisms -*- lexical-binding: t; -*- - -;; Copyright (C) 1993-1995, 2000-2024 Free Software Foundation, Inc. - -;; Author: Richard Mlynarik -;; Maintainer: emacs-devel@gnu.org -;; Keywords: games -;; Obsolete-since: 24.4 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Important pinheadery for GNU Emacs. -;; This file is obsolete. For similar functionality, see -;; fortune.el and cookie1.el. - -;;; Code: - -(require 'cookie1) - -(defgroup yow nil - "Quote random zippyisms." - :prefix "yow-" - :group 'games) - -(defcustom yow-file (expand-file-name "yow.lines" data-directory) - "File containing pertinent pinhead phrases." - :type 'file) - -(defconst yow-load-message "Am I CONSING yet?...") -(defconst yow-after-load-message "I have SEEN the CONSING!!") - -;;;###autoload -(defun yow (&optional insert display) - "Return or display a random Zippy quotation. With prefix arg, insert it." - (interactive "P\np") - (let ((yow (cookie yow-file yow-load-message yow-after-load-message))) - (cond (insert - (insert yow)) - ((not display) - yow) - (t - (message "%s" yow))))) - -(defsubst read-zippyism (prompt &optional require-match) - "Read a Zippyism from the minibuffer with completion, prompting with PROMPT. -If optional second arg is non-nil, require input to match a completion." - (cookie-read prompt yow-file yow-load-message yow-after-load-message - require-match)) - -;;;###autoload -(defun insert-zippyism (&optional zippyism) - "Prompt with completion for a known Zippy quotation, and insert it at point." - (interactive (list (read-zippyism "Pinhead wisdom: " t))) - (insert zippyism)) - -;;;###autoload -(defun apropos-zippy (regexp) - "Return a list of all Zippy quotes matching REGEXP. -If called interactively, display a list of matches." - (interactive "sApropos Zippy (regexp): ") - (cookie-apropos regexp yow-file (called-interactively-p 'interactive))) - - -;; Yowza!! Feed zippy quotes to the doctor. Watch results. -;; fun, fun, fun. Entertainment for hours... -;; -;; written by Kayvan Aghaiepour - -(declare-function doctor-ret-or-read "doctor" (arg)) - -;;;###autoload -(defun psychoanalyze-pinhead () - "Zippy goes to the analyst." - (interactive) - (cookie-doctor yow-file)) - -(provide 'yow) - -;;; yow.el ends here commit e3c45b9d707db824588e2bd9ae34c05911dfcc5a Author: F. Jason Park Date: Sun Sep 29 11:02:48 2024 -0700 Remove erc-fill binding for cycling visual movement * etc/ERC-NEWS: Announce removal of troublesome key binding first introduced in ERC 5.6 as part of the `erc-fill-wrap' module. * lisp/erc/erc-fill.el (erc-fill-wrap-mode-map): Remove key binding for `erc-fill-wrap-cycle-visual-movement'. * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap-visual-keys--body) (erc-fill-wrap-visual-keys--prompt): Replace "C-c a" key simulations. (Bug#73553) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 34cf9ceb377..b267db5502e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -26,6 +26,11 @@ In fast-moving channels and in queries with long-winded bots, the on account of a rather stingy buffering threshold of 512 characters. Now configurable, its default has been relaxed eightfold to 4096. +** Stray key binding removed from 'erc-fill-wrap-mode-map'. +The command 'erc-fill-wrap-cycle-visual-movement' was mistakenly given +the key binding "C-c a" in an inadvertent holdover from development. It +has been removed. + ** New option determines 'keep-place-indicator's influence on 'truncate'. Option 'erc-keep-place-indicator-truncation' manages the tension between truncation and place keeping, prioritizing one or the other. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c499789b2e4..1e81adbf6ba 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -413,7 +413,6 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " " #'erc-fill-wrap-toggle-truncate-lines " " #'erc-fill--wrap-next-line " " #'erc-fill--wrap-previous-line - "C-c a" #'erc-fill-wrap-cycle-visual-movement ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index b52a996f184..bab1695a171 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -341,7 +341,7 @@ (should (search-forward "done to her." nil t))) (ert-info ("Value: nil") - (execute-kbd-macro "\C-ca") + (call-interactively #'erc-fill-wrap-cycle-visual-movement) (should-not erc-fill--wrap-visual-keys) (goto-char (point-min)) (should (search-forward "in debug mode" nil t)) @@ -351,7 +351,7 @@ (should (eql ?\] (char-before (point))))) (ert-info ("Value: t") - (execute-kbd-macro "\C-ca") + (call-interactively #'erc-fill-wrap-cycle-visual-movement) (should (eq erc-fill--wrap-visual-keys t)) (goto-char (point-min)) (should (search-forward "that he hath" nil t)) @@ -387,7 +387,7 @@ (should (eobp))) (ert-info ("Value: nil") ; same - (execute-kbd-macro "\C-ca") + (call-interactively #'erc-fill-wrap-cycle-visual-movement) (should-not erc-fill--wrap-visual-keys) (execute-kbd-macro "\C-y") (should (looking-back "its buffer\\.")) @@ -397,7 +397,7 @@ (should (eobp))) (ert-info ("Value: non-input") - (execute-kbd-macro "\C-ca") + (call-interactively #'erc-fill-wrap-cycle-visual-movement) (should (eq erc-fill--wrap-visual-keys t)) (execute-kbd-macro "\C-y") (execute-kbd-macro "\C-a") commit df593b5a619d63b620f8fd569ecf032dab2602d9 Author: F. Jason Park Date: Mon Sep 23 13:48:19 2024 -0700 Skip indentation when gathering faces in erc-track * lisp/erc/erc-nicks.el (erc-nicks-mode, erc-nicks-enable) (erc-nicks-disable): Use correct name for `track' module hook. (erc-nicks--check-normals): Remove falsity from doc string. * lisp/erc/erc-track.el (erc-make-mode-line-buffer-name): Don't error when optional COUNT is nil. (erc-track-modified-channels): Use new name for preferred face-finding function. (erc-track--get-faces-in-current-message, erc-track--collect-faces-in): Rename former to latter to better reflect expanded utility, which now includes spanning gaps, including newlines and indentation that may be lacking in face-related properties. * test/lisp/erc/erc-track-tests.el (erc-track--collect-faces-in): New test. (Bug#73443) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index ccf65f15abd..a0d6d17d732 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -580,7 +580,7 @@ Abandon search after examining LIMIT faces." (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal) #'erc-nicks-customize-face) (erc-nicks--setup-track-integration) - (add-hook 'erc-track-mode #'erc-nicks--setup-track-integration 50 t) + (add-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration 50 t) (advice-add 'widget-create-child-and-convert :filter-args #'erc-nicks--redirect-face-widget-link)) ((kill-local-variable 'erc-nicks--face-table) @@ -598,6 +598,7 @@ Abandon search after examining LIMIT faces." #'erc-nicks--highlight-button) (remove-function (local 'erc-track--alt-normals-function) #'erc-nicks--check-normals) + (remove-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration t) (setf (alist-get "Edit face" erc-button--nick-popup-alist nil 'remove #'equal) nil) @@ -736,7 +737,7 @@ Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"." "Return a viable `nicks'-owned face from NORMALS in CONTENDERS. But only do so if the CURRENT face is also one of ours and in NORMALS and if the highest ranked CONTENDER among new faces is -`erc-default-face', the lowest ranking default priority face." +`erc-default-face'." (and-let* (((eq contender 'erc-default-face)) ((or (null current) (gethash current normals))) (spkr (or (null current) (erc-nicks--oursp current)))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 39a4775ddca..f40960e4a22 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -768,7 +768,7 @@ is displayed according to `erc-track-mouse-face'." ;; (really?), 3. the defun needs to switch to BUFFER, so we would ;; need to save that value somewhere. (let ((map (make-sparse-keymap)) - (name (if erc-track-showcount + (name (if (and count erc-track-showcount) (concat string erc-track-showcount-string (int-to-string count)) @@ -992,7 +992,7 @@ the current buffer is in `erc-mode'." (when-let ((faces (if erc-track-ignore-normal-contenders-p (erc-faces-in (buffer-string)) - (erc-track--get-faces-in-current-message))) + (erc-track--collect-faces-in))) (normals erc-track--normal-faces) (erc-track-faces-priority-list `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) @@ -1057,25 +1057,25 @@ the current buffer is in `erc-mode'." (defvar erc-track--face-reject-function nil "Function called with face in current buffer to massage or reject.") -(defun erc-track--get-faces-in-current-message () - "Collect all faces in the narrowed buffer. -Return a cons of a hash table and a list ordered from most -recently seen to earliest seen." - (let ((i (text-property-not-all (point-min) (point-max) 'font-lock-face nil)) - (seen (make-hash-table :test #'equal)) - ;; - (rfaces ()) - (faces (make-hash-table :test #'equal))) - (while-let ((i) - (cur (get-text-property i 'face))) - (unless (gethash cur seen) - (puthash cur t seen) - (when erc-track--face-reject-function - (setq cur (funcall erc-track--face-reject-function cur))) - (when cur - (push cur rfaces) - (puthash cur t faces))) - (setq i (next-single-property-change i 'font-lock-face))) +(defun erc-track--collect-faces-in () + "Collect all faces in the (presumably narrowed) current buffer. +Return a cons cell of a hash table and a list ordered from most recently +seen to least." + (let* ((prop (if noninteractive 'font-lock-face 'face)) + (p (text-property-not-all (point-min) (point-max) prop nil)) + (seen (and p (make-hash-table :test #'equal))) + (faces (make-hash-table :test #'equal)) + (rfaces ())) + (while p + (when-let ((cur (get-text-property p prop))) + (unless (gethash cur seen) + (puthash cur t seen) + (when erc-track--face-reject-function + (setq cur (funcall erc-track--face-reject-function cur))) + (when cur + (push cur rfaces) + (puthash cur t faces)))) + (setq p (next-single-property-change p prop))) (cons faces rfaces))) ;;; Buffer switching diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index 3288c42a42e..8149138a971 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el @@ -22,8 +22,12 @@ ;;; Code: -(require 'ert) (require 'erc-track) +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (ert-deftest erc-track--shorten-aggressive-nil () "Test non-aggressive erc track buffer name shortening." @@ -286,4 +290,124 @@ (a b (b a)) (a b (a b))))) +(ert-deftest erc-track--collect-faces-in () + (with-current-buffer (get-buffer-create "*erc-track--get-faces-in*") + (erc-tests-common-prep-for-insertion) + (goto-char (point-min)) + (skip-chars-forward "\n") + + (let ((ts #("[04:37]" + 0 1 ( erc--msg 0 field erc-timestamp + font-lock-face erc-timestamp-face) + 1 7 ( field erc-timestamp + font-lock-face erc-timestamp-face))) + bounds) + + (with-silent-modifications + + (push (list (point)) bounds) + (insert ; JOIN + ts " " ; iniital `fill' indentation lacks properties + #("*** You have joined channel #chan" 0 33 + (font-lock-face erc-notice-face)) + "\n") + (setcdr (car bounds) (point)) + + (push (list (point)) bounds) + (insert ; 353 + ts " " + #("*** Users on #chan: bob alice dummy tester" + 0 30 (font-lock-face erc-notice-face) + 30 35 (font-lock-face erc-current-nick-face) + 35 42 (font-lock-face erc-notice-face)) + "\n" #(" @fsbot" ; but intervening HAS properties + 0 23 (font-lock-face erc-notice-face))) + (setcdr (car bounds) (point)) + + (push (list (point)) bounds) + (insert ; PRIVMSG + "\n" ts " " + #(" bob: Thou canst not come to me: I come to" + 0 1 (font-lock-face erc-default-face) + ;; erc-dangerous-host-face -> erc-nicks-alice-face (undefined) + 1 6 (font-lock-face (erc-dangerous-host-face erc-nick-default-face)) + 6 8 (font-lock-face erc-default-face) + ;; erc-pal-face -> erc-nicks-bob-face (undefined) + 8 11 (font-lock-face (erc-pal-face erc-default-face)) + 11 49 (font-lock-face erc-default-face)) + "\n" #(" thee." + 0 22 (font-lock-face erc-default-face)) + "\n") + (setcdr (car bounds) (point))) + + (goto-char (point-max)) + (should (equal (setq bounds (nreverse bounds)) + '((3 . 50) (50 . 129) (129 . 212)))) + + ;; For these result assertions, the insertion order of the table + ;; elements should mirror that of the consed lists. + + ;; Baseline + (narrow-to-region 1 3) + (let ((result (erc-track--collect-faces-in))) + (should-not (map-pairs (car result))) + (should-not (cdr result))) + + ;; JOIN + (narrow-to-region (car (nth 0 bounds)) (cdr (nth 0 bounds))) + (let ((result (erc-track--collect-faces-in))) + (should (seq-set-equal-p + (map-pairs (car result)) '((erc-timestamp-face . t) + (erc-notice-face . t)))) + (should (equal (cdr result) '(erc-notice-face erc-timestamp-face)))) + + ;; 353 + (narrow-to-region (car (nth 1 bounds)) (cdr (nth 1 bounds))) + (let ((result (erc-track--collect-faces-in))) + (should (seq-set-equal-p (map-pairs (car result)) + '((erc-timestamp-face . t) + (erc-notice-face . t) + (erc-current-nick-face . t)))) + (should (equal (cdr result) '(erc-current-nick-face + erc-notice-face + erc-timestamp-face)))) + + ;; PRIVMSG + (narrow-to-region (car (nth 2 bounds)) (cdr (nth 2 bounds))) + (let ((result (erc-track--collect-faces-in))) + (should (seq-set-equal-p + (map-pairs (car result)) + '((erc-timestamp-face . t) + (erc-default-face . t) + ((erc-dangerous-host-face erc-nick-default-face) . t) + ((erc-pal-face erc-default-face) . t)))) + (should (equal (cdr result) + '((erc-pal-face erc-default-face) + (erc-dangerous-host-face erc-nick-default-face) + erc-default-face + erc-timestamp-face)))) + + ;; Entire buffer. + (narrow-to-region (car (nth 0 bounds)) erc-insert-marker) + (let ((result (erc-track--collect-faces-in))) + (should (seq-set-equal-p + (map-pairs (car result)) + '((erc-timestamp-face . t) + (erc-notice-face . t) + (erc-current-nick-face . t) + (erc-default-face . t) + ((erc-dangerous-host-face erc-nick-default-face) . t) + ((erc-pal-face erc-default-face) . t)))) + (should (equal (cdr result) + '((erc-pal-face erc-default-face) + (erc-dangerous-host-face erc-nick-default-face) + erc-default-face + erc-current-nick-face + erc-notice-face + erc-timestamp-face))))) + + (widen) + (when noninteractive + (kill-buffer)))) + ;;; erc-track-tests.el ends here commit 4d7f41716e1485fb57efc6eac9f45f2879c90266 Author: F. Jason Park Date: Mon Sep 9 15:23:46 2024 -0700 Make erc-keep-place-indicator aware of erc-truncate * etc/ERC-NEWS: Entry mentioning `erc-keep-place-indicator-truncation'. * lisp/erc/erc-goodies.el (erc-keep-place-indicator-truncation): New option. Something like this should have accompanied the module's introduction. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable) (erc-keep-place-indicator-disable): Arrange to take necessary measures to avoid losing the indicator on `erc--clear-function'. This module was first introduced by bug#59943. (erc--keep-place-move-hook): New variable. (erc--keep-place-indicator-adjust-on-clear): New function. (erc-keep-place-move): Try to ensure the overlay resides at the beginning of a message. Run hook `erc--keep-place-move-hook'. * test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el: New file. * test/lisp/erc/erc-scenarios-keep-place-indicator.el (erc-scenarios-keep-place-indicator--follow): Fix missing test description. (Bug#72736) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 135f3936572..34cf9ceb377 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -26,6 +26,10 @@ In fast-moving channels and in queries with long-winded bots, the on account of a rather stingy buffering threshold of 512 characters. Now configurable, its default has been relaxed eightfold to 4096. +** New option determines 'keep-place-indicator's influence on 'truncate'. +Option 'erc-keep-place-indicator-truncation' manages the tension between +truncation and place keeping, prioritizing one or the other. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 9837ec302ee..38c2918af8f 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -308,6 +308,19 @@ buffer than the window's start." :package-version '(ERC . "5.6") :type 'boolean) +(defcustom erc-keep-place-indicator-truncation nil + "What to do when truncation occurs and the buffer is trimmed. +If nil, a truncation event moves the indicator, effectively resetting it +to `point-min'. If this option's value is t, the indicator stays put +and limits the operation, but only when it resides on an actual message. +That is, if it remains at its initial position at or near `point-min', +truncation will still occur. As of ERC 5.6.1, this option only +influences the behavior of the `truncate' module, rather than truncation +resulting from a /CLEAR." + :group 'erc + :package-version '(ERC . "5.6.1") + :type 'boolean) + (defface erc-keep-place-indicator-line '((((class color) (min-colors 88) (background light) (supports :underline (:style wave))) @@ -370,6 +383,8 @@ and `keep-place-indicator' in different buffers." #'erc--keep-place-indicator-on-window-buffer-change 40) (add-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module 40) + (add-function :before (local 'erc--clear-function) + #'erc--keep-place-indicator-adjust-on-clear '((depth . 40))) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) @@ -401,7 +416,9 @@ and `keep-place-indicator' in different buffers." (remove-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module) (remove-hook 'window-buffer-change-functions - #'erc--keep-place-indicator-on-window-buffer-change))) + #'erc--keep-place-indicator-on-window-buffer-change) + (remove-function (local 'erc--clear-function) + #'erc--keep-place-indicator-adjust-on-clear))) (when (local-variable-p 'erc-insert-pre-hook) (remove-hook 'erc-insert-pre-hook #'erc-keep-place t)) (remove-hook 'erc-keep-place-mode-hook @@ -418,6 +435,21 @@ Do this by simulating `keep-place' in all buffers where (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))) +(defvar erc--keep-place-move-hook nil + "Hook run when `erc-keep-place-move' moves the indicator.") + +(defun erc--keep-place-indicator-adjust-on-clear (beg end) + "Either shrink region bounded by BEG to END to preserve overlay, or reset." + (when-let ((pos (overlay-start erc--keep-place-indicator-overlay)) + ((<= beg pos end))) + (if (and erc-keep-place-indicator-truncation + (not erc--called-as-input-p)) + (when-let ((pos (erc--get-inserted-msg-beg pos))) + (set-marker end pos)) + (let (erc--keep-place-move-hook) + ;; Move earlier than `beg', which may delimit date stamps, etc. + (erc-keep-place-move (point-min)))))) + (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. For use with `keep-place-indicator' module. When called @@ -441,6 +473,9 @@ window's first line. Interpret an integer as an offset in lines." (let ((inhibit-field-text-motion t)) (when pos (goto-char pos)) + (when-let ((pos (erc--get-inserted-msg-beg))) + (goto-char pos)) + (run-hooks 'erc--keep-place-move-hook) (move-overlay erc--keep-place-indicator-overlay (line-beginning-position) (line-end-position))))) diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el b/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el new file mode 100644 index 00000000000..d6d50ab09a6 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el @@ -0,0 +1,94 @@ +;;; erc-scenarios-keep-place-indicator-trunc.el --- `truncate' integration -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-keep-place-indicator-trunc () + :tags `(:expensive-test + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) + + (when (and noninteractive (= emacs-major-version 27)) + (ert-skip "Times out")) + + (defvar erc-max-buffer-size) + (defvar erc-truncate-padding-size) + + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "keep-place") + (dumb-server (erc-d-run "localhost" t 'follow)) + (port (process-contact dumb-server :service)) + (erc-modules `( keep-place-indicator scrolltobottom + truncate ,@erc-modules)) + (erc-server-flood-penalty 0.1) + (erc-max-buffer-size 300) + (erc-truncate-padding-size 200) + (erc-keep-place-indicator-truncation t) + (erc-autojoin-channels-alist '((foonet "#chan" "#spam"))) + (expect (erc-d-t-make-expecter))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester" + :user "tester") + (funcall expect 10 "debug mode")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + + (ert-info ("Truncation occurs because indicator still at start pos") + (funcall expect 10 "]\n bob: And what I spake") + (redisplay) + (should (= (overlay-start erc--keep-place-indicator-overlay) 2)) + (funcall expect 10 "Yes, faith will I") + (goto-char (point-max))) + + (switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower + (funcall expect 10 " tester, welcome!") + (erc-scenarios-common-say "one") + (erc-scenarios-common-say "two") + (funcall expect 10 " Cause they take") + (erc-scenarios-common-say "three") + (goto-char (point-max)) + + (ert-info ("Truncation limited by indicator") + (switch-to-buffer "#chan") + (funcall expect 10 " Ready") + (redisplay) + (funcall expect 10 "]\n Yes, faith will I" (point-min)) + (should (= (overlay-start erc--keep-place-indicator-overlay) + (pos-bol))) + (should (> (buffer-size) 500))) + + (ert-info ("Normal keep-place behavior still present") + (switch-to-buffer "#spam") + (should (< (point) erc-input-marker))) + + (erc-keep-place-mode -1) + (erc-scrolltobottom-mode -1)))) + +;;; erc-scenarios-keep-place-indicator-trunc.el ends here diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index ccd6f81b7d2..435bbcef304 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -125,11 +125,10 @@ (save-excursion (goto-char (window-point)) (should (looking-back (rx "you can cog"))) - (should (= (pos-bol) (window-start))) - (should (= (overlay-start erc--keep-place-indicator-overlay) - (pos-bol))))) + (should (= (pos-bol) (window-start) + (overlay-start erc--keep-place-indicator-overlay))))) - (ert-info ("description") + (ert-info ("Point formerly at prompt resides at last arrived message") (erc-send-input-line "#spam" "three") (save-excursion (erc-d-t-search-for 10 "Ready")) (switch-to-buffer "#spam") commit 51d5419fdc3805a95190f8913e8ea349f243f11d Author: F. Jason Park Date: Tue Aug 27 01:00:04 2024 -0700 Redo ERC truncation and /CLEAR hook mechanism * etc/ERC-NEWS: Mention option `erc-truncate-padding-size'. * lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable) (erc-fill-wrap-disable): Manage membership in the `erc--clear-function' advice stack for own function that massages a buffer's oldest inserted message, post truncation. (erc-fill--wrap-massage-initial-message-post-clear): New function. * lisp/erc/erc-log.el (erc-log-mode, erc-log-enable): Don't add `erc-save-buffer-in-logs' to `erc--pre-clear-functions'. Use local advice around common interface variable instead, as noted below. (erc-log-disable): Likewise, don't remove `erc-save-buffer-in-logs' from `erc--pre-clear-functions'. (erc-log-setup-logging): Add `erc-log--save-on-clear' to `erc--clear-function'. (erc-log-disable-logging): Remove `erc-log--save-on-clear' to `erc-clear-function'. (erc-save-buffer-in-logs): Abort when `erc--insert-marker' is non-nil. (erc-log--save-on-clear): New function, a thin wrapper around `erc-save-buffer-in-logs', adapting it to the `erc--clear-function' advice interface. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable): Don't add `erc-stamp--reset-on-clear' to `erc--pre-clear-functions'. (erc-stamp-disable): Don't remove `erc-stamp--reset-on-clear' from `erc--pre-clear-functions'. (erc-stamp--find-insertion-point): Account for initial position being `bobp'. (erc-stamp--defer-date-insertion-on-post-modify): Accommodate the rare non-list `erc-insert-post-hook' when shadowing. (erc-stamp--setup): Add and remove `erc-stamp--reset-on-clear' to and from `erc--clear-function' advice stack. (erc-stamp--redo-right-stamp-post-clear): New function. (erc-stamp--update-saved-position): Remove unused function. This was originally added along with `erc-stamp--reset-on-clear' as part of bug#60936. (erc-stamp--reset-on-clear): Expect end of truncation boundary to be at `erc-insert-marker'. Rework to use new `erc--clear-function' interface and run on `erc-timer-hook' instead of `erc-insert-done-hook'. * lisp/erc/erc-truncate.el (erc-truncate-padding-size): New option to help tamp down on disruptions when reading scroll back caused by overly frequent truncation. (erc-truncate-enable, erc-truncate-disable): Add and remove `erc-truncate--setup' to and from `erc-mode-hook', and run it when needed. (erc-truncate--buffer-size): New variable. (erc-truncate--setup): New function. (erc-truncate-buffer-to-size): Guard execution with `erc-truncate--padding-size' and `erc--inhibit-clear-p'. Reflow for readability, removing obsolete comments. Call hooks with marker instead of buffer position, as per the new `erc--clear-function' interface. (erc-truncate-buffer): Defer execution to `erc-timer-hook' when running post-insertion via a response handler. (erc-truncate--inhibit-when-local-and-interactive): New function. * lisp/erc/erc.el (erc-mode): Add `erc--skip-past-headroom-on-clear' to `erc--clear-function' in all ERC buffers. (erc--with-spliced-insertion): Account for marker being `bobp'. (erc--insert-before-markers-transplanting-hidden): Make more robust by accommodating initial `point' possibly being `bobp'. (erc--clear-function): New variable, a function-valued local-advice interface to replace `erc--pre-clear-functions'. (erc--pre-clear-functions): Remove unused variable. (erc--skip-past-headroom-on-clear): New function. (erc--inhibit-clear-p): New variable. (erc-cmd-CLEAR): Call hooks with markers instead of position. Signal `user-error' when `erc--inhbiit-clear-p' is non-nil. * test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp) (erc-scenarios-log--cmd-clear/date-stamps): Rename former to latter, update assertions, and use common helper. (erc-scenarios-log--cmd-clear/left-stamps): New test. (erc-scenarios-log--truncate): Move body to function of the same name, and update assertions. (erc-scenarios-log--truncate/left-stamps): New test. (Bug#72736) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 0b5385f0589..135f3936572 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -20,6 +20,12 @@ purposes. Modules can instead use the function 'erc-sync-banlist' to guarantee that the variable 'erc-channel-banlist' remains synced for the remainder of an IRC session. +** Option 'erc-truncate-padding-size' controls truncation frequency. +In fast-moving channels and in queries with long-winded bots, the +'truncate' module has historically been asked to work overtime, mostly +on account of a rather stingy buffering threshold of 512 characters. +Now configurable, its default has been relaxed eightfold to 4096. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index fa9d2071ccd..c499789b2e4 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -547,6 +547,9 @@ via `erc-fill-wrap-mode-hook'." (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) + (add-function :after (local 'erc--clear-function) + #'erc-fill--wrap-massage-initial-message-post-clear + '((depth . 50))) (erc-stamp--display-margin-mode +1) (visual-line-mode +1)) ((visual-line-mode -1) @@ -557,6 +560,8 @@ via `erc-fill-wrap-mode-hook'." (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (remove-function (local 'erc--clear-function) + #'erc-fill--wrap-massage-initial-message-post-clear) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions @@ -674,6 +679,24 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t." (erc-fill--wrap-continued-predicate #'ignore)) (erc-fill--wrap-rejigger-region (1- beg) (1+ end) nil 'repairp)))))) +(defun erc-fill--wrap-massage-initial-message-post-clear (beg end) + "Maybe reveal hidden speaker or add stamp on initial message after END." + (if erc-stamp--date-mode + (erc-stamp--redo-right-stamp-post-clear beg end) + ;; With other non-date stamp-insertion functions, remove hidden + ;; speaker continuation on first spoken message in buffer. + (when-let (((< end (1- erc-insert-marker))) + (next (text-property-not-all end (min erc-insert-marker + (+ 4096 end)) + 'erc--msg nil)) + (bounds (erc--get-inserted-msg-bounds next)) + (found (text-property-not-all (car bounds) (cdr bounds) + 'erc-fill--wrap-merge nil)) + (erc-fill--wrap-continued-predicate #'ignore)) + (erc-fill--wrap-rejigger-region (max (1- (car bounds)) (point-min)) + (min (1+ (cdr bounds)) erc-insert-marker) + nil 'repairp)))) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 66420662c23..6bb240f56d7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -231,7 +231,7 @@ also be a predicate function. To only log when you are not set away, use: (add-hook 'erc-part-hook #'erc-conditional-save-buffer) ;; append, so that 'erc-initialize-log-marker runs first (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append) - (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50) + ;; FIXME use proper local "setup" function and major-mode hook. (dolist (buffer (erc-buffer-list)) (erc-log-setup-logging buffer)) (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs)) @@ -244,7 +244,6 @@ also be a predicate function. To only log when you are not set away, use: (remove-hook 'erc-quit-hook #'erc-conditional-save-queries) (remove-hook 'erc-part-hook #'erc-conditional-save-buffer) (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging) - (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs) (dolist (buffer (erc-buffer-list)) (erc-log-disable-logging buffer)) (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs))) @@ -259,6 +258,8 @@ The current buffer is given by BUFFER." (auto-save-mode -1) (setq buffer-file-name nil) (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t) + (add-function :before (local 'erc--clear-function) + #'erc-log--save-on-clear '((depth . 50))) (when erc-log-insert-log-on-open (ignore-errors (save-excursion @@ -271,6 +272,7 @@ The current buffer is given by BUFFER." "Disable logging in BUFFER." (when (erc-logging-enabled buffer) (with-current-buffer buffer + (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear) (setq buffer-offer-save nil erc-enable-logging nil)))) @@ -415,6 +417,7 @@ You can save every individual message by putting this function on (widen) ;; early on in the initialization, don't try and write the log out (when (and (markerp erc-last-saved-position) + (null erc--insert-marker) ; suppress when splicing (> erc-insert-marker (1+ erc-last-saved-position))) (let ((start (1+ (marker-position erc-last-saved-position))) (end (marker-position erc-insert-marker))) @@ -446,6 +449,9 @@ You can save every individual message by putting this function on (set-buffer-modified-p nil)))))) t) +(defun erc-log--save-on-clear (_ end) + (erc-save-buffer-in-logs end)) + ;; This is a kludge to avoid littering erc-truncate.el with forward ;; declarations needed only for a corner-case compatibility check. (defun erc-log--call-when-logging-enabled-sans-module (fn) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bebc1d0be38..b0ecd67eef7 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -182,13 +182,11 @@ from entering them and instead jump over them." (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) (erc-buffer-do #'erc-stamp--setup))) (defvar erc-stamp--invisible-property nil @@ -707,7 +705,8 @@ Return P or, if found, a position less than P." ;; Continue searching after encountering a message without a ;; timestamp because date stamps must be unique, and ;; "Re-establishing connection" messages should have stamps. - (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (while-let ((pp (max (1- p) (point-min))) + (q (previous-single-property-change pp 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) ((not (time-less-p ts target-time)))) @@ -753,7 +752,7 @@ non-nil." (set-marker marker (point-min)) (set-marker-insertion-type marker t) (erc--hide-message 'timestamp)) - ,@erc-insert-post-hook)) + ,@(ensure-list erc-insert-post-hook))) (erc-insert-timestamp-function #'erc-stamp--propertize-left-date-stamp) (pos (erc-stamp--find-insertion-point marker aligned)) @@ -980,11 +979,16 @@ For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-stamp--manage-local-options-state) + (progn + (erc-stamp--manage-local-options-state) + (add-function :around (local 'erc--clear-function) + #'erc-stamp--reset-on-clear '((depth . 40)))) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' + (remove-function (local 'erc--clear-function) + #'erc-stamp--reset-on-clear) (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) @@ -1023,6 +1027,8 @@ enabled when the message was inserted." (defvar-local erc-stamp--last-stamp nil) +;; FIXME rename this to avoid confusion with IRC messages. +;; Something like `erc-stamp--on-clear-echo-area-message'. (defun erc-stamp--on-clear-message (&rest _) "Return `dont-clear-message' when operating inside the same stamp." (and erc-stamp--last-stamp erc-echo-timestamps @@ -1052,25 +1058,81 @@ with the option `erc-echo-timestamps', see the companion option (defun erc--echo-ts-csf (_window _before dir) (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts))) -(defun erc-stamp--update-saved-position (&rest _) - (remove-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position t) - (move-marker erc-last-saved-position (1- (point-max)))) - -(defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker. -And discard stale references in `erc-stamp--date-stamps'." - (when erc-stamp--date-stamps - (setq erc-stamp--date-stamps - (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) - erc-stamp--date-stamps))) - (when (= pos (1- erc-insert-marker)) - (when erc-stamp--date-mode - (add-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position 0 t)) - (setq erc-timestamp-last-inserted nil - erc-timestamp-last-inserted-left nil - erc-timestamp-last-inserted-right nil))) +(defun erc-stamp--redo-right-stamp-post-clear (_ end) + "Append new right stamp to first inserted message after END." + ;; During truncation, the last existing right stamp is often deleted + ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6, + ;; recreating inserted messages from scratch isn't doable. (Although, + ;; attempting surgery like this is likely unwise.) + (when-let ((erc-stamp--date-mode) + ((< end (1- erc-insert-marker))) ; not a /CLEAR + (bounds (erc--get-inserted-msg-bounds (1+ end))) + (ts (get-text-property (car bounds) 'erc--ts)) + (format (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (or erc-timestamp-format-right erc-timestamp-format))) + (rendered (erc-format-timestamp ts format)) + ((not (equal rendered erc-timestamp-last-inserted-right))) + ((not (eq 'erc-timestamp (field-at-pos (1- (cdr bounds)))))) + (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) + (save-excursion + (save-restriction + (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted) + (erc-timestamp-last-inserted-right + erc-timestamp-last-inserted-right)) + (narrow-to-region (car bounds) (1+ (cdr bounds))) + (cl-assert (= ?\n (char-before (point-max)))) + (erc-add-timestamp)))))) + +(defun erc-stamp--reset-on-clear (orig beg end) + "Forget date stamps older than POS and remake newest culled. +Call ORIG, an `erc--clear-function', with BEG and END markers." + (let ((fullp (= (1- erc-insert-marker) end)) ; /CLEAR-p + (skipp (or (erc--memq-msg-prop 'erc--skip 'stamp) + (and erc--msg-prop-overrides + (memq 'stamp (alist-get 'erc--skip + erc--msg-prop-overrides))))) + (culled ())) + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + ;; Assume `seq-filter' visits items in order. + (seq-filter (lambda (o) + (or (> (erc-stamp--date-marker o) end) + (ignore + (set-marker (erc-stamp--date-marker o) nil) + (push o culled)))) + erc-stamp--date-stamps))) + ;; Before /CLEAR'ing a data stamp, skip past last blank in headroom. + (when (and fullp culled (not skipp) (< 1 beg 3 end)) + (set-marker beg 3)) + (funcall orig beg end) + (when-let ((culled) + ((not skipp)) + (ct (erc-stamp--date-ts (car culled))) + (hook (make-symbol "temporary-hook")) + (rendered (erc-stamp--format-date-stamp ct)) + (data (make-erc-stamp--date :ts ct :str rendered))) + (cl-assert erc-stamp--date-mode) + ;; Object successfully removed from model but snapshot remains. + (cl-assert (null (cl-find rendered erc-stamp--date-stamps + :test #'string= + :key #'erc-stamp--date-str))) + (let ((erc-stamp--deferred-date-stamp data) + ;; At midnight, `rendered' may still be yesterday while + ;; `erc-timestamp-last-inserted-left' is already today. + (erc-timestamp-last-inserted-left nil)) + (erc-stamp--defer-date-insertion-on-post-modify hook) + (set-marker (erc-stamp--date-marker data) end) + (run-hooks hook) + ;; After /CLEAR'ing, remove new date stamp's trailing newline + ;; because one resides between `end' and `erc-input-marker' + ;; (originally meant to protect `erc-last-saved-position'). + (when (and fullp (= end erc-last-saved-position)) + (cl-assert (or erc--called-as-input-p (null erc--msg-props))) + (delete-region (1- end) end))) + (when fullp + (setq erc-timestamp-last-inserted-right nil + erc-timestamp-last-inserted nil))))) (defun erc-stamp--dedupe-date-stamps (old-stamps) "Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS. diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 711a2988302..393b2af2ba1 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -36,11 +36,17 @@ :group 'erc) (defcustom erc-max-buffer-size 30000 - "Maximum size in chars of each ERC buffer. -Used only when auto-truncation is enabled. -\(Also see `erc-truncate-buffer'.)" + "Buffer size in characters after truncation. +Only applies when the `truncate' module is enabled." :type 'integer) +(defcustom erc-truncate-padding-size 4096 + "Headroom threshold triggering truncation and determining its frequency. +Truncation occurs when the buffer's size meets or exceeds this value +plus `erc-max-buffer-size'." + :type 'integer + :package-version '(ERC . "5.6.1")) + ;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t) (define-erc-module truncate nil "Truncate a query buffer if it gets too large. @@ -49,10 +55,31 @@ bring any grown Emacs to its knees after a few days worth of tracking heavy-traffic channels." ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)) + (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (add-hook 'erc-mode-hook #'erc-truncate--setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))) + (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (remove-hook 'erc-mode-hook #'erc-truncate--setup) + (erc-buffer-do #'erc-truncate--setup))) + +(defvar-local erc-truncate--buffer-size nil + "Temporary buffer-local override for `erc-max-buffer-size'.") + +(defun erc-truncate--setup () + "Enable or disable buffer-local `erc-truncate-mode' modifications." + (if erc-truncate-mode + (progn + (when-let ((priors (or erc--server-reconnecting erc--target-priors)) + (val (alist-get 'erc-truncate--buffer-size priors))) + (setq erc-truncate--buffer-size val)) + (add-function :before (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive + '((depth . 20)))) + (remove-function (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive) + (kill-local-variable 'erc-truncate--buffer-size))) (defun erc-truncate--warn-about-logging (&rest _) (when (and (not erc--target) @@ -90,46 +117,60 @@ present in `erc-modules'." (setq buffer (current-buffer)) (unless (get-buffer buffer) (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) - (when (> (buffer-size buffer) (+ size 512)) + (when (and (> (buffer-size buffer) (+ size erc-truncate-padding-size)) + (not (buffer-local-value 'erc--inhibit-clear-p buffer))) (with-current-buffer buffer - ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. - (save-restriction - (widen) - (let ((end (- erc-insert-marker size))) - ;; Truncate at message boundary (formerly line boundary - ;; before 5.6). - (goto-char end) - (goto-char (or (erc--get-inserted-msg-beg end) - (pos-bol))) - (setq end (point)) - ;; try to save the current buffer using - ;; `erc-save-buffer-in-logs'. We use this, in case the - ;; user has both `erc-save-buffer-in-logs' and - ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If - ;; this is the case, only the non-saved part of the current - ;; buffer should be saved. Rather than appending the - ;; deleted part of the buffer to the log file. - ;; - ;; Alternatively this could be made conditional on: - ;; (not (memq 'erc-save-buffer-in-logs - ;; erc-insert-post-hook)) - ;; Comments? - ;; The comments above concern pre-5.6 behavior and reflect - ;; an obsolete understanding of how `erc-logging-enabled' - ;; behaves in practice. - (run-hook-with-args 'erc--pre-clear-functions end) - ;; disable undoing for the truncating - (buffer-disable-undo) - (let ((inhibit-read-only t)) - (delete-region (point-min) end))) - (buffer-enable-undo))))) + (let ((wc (and (get-buffer-window) (current-window-configuration)))) + (save-excursion + ;; Widen to preserve pre-5.5 behavior. + (save-restriction + (widen) + (let ((beg (point-min-marker)) + (end (goto-char (- erc-insert-marker size)))) + ;; Truncate at message boundary (formerly line boundary + ;; before 5.6). + (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol))) + (setq end (point-marker)) + (with-silent-modifications + (let ((erc--inhibit-clear-p t)) + (funcall erc--clear-function beg end))) + (set-marker beg nil) + (set-marker end nil)))) + (when wc + (set-window-configuration wc)))))) ;;;###autoload (defun erc-truncate-buffer () "Truncate current buffer to `erc-max-buffer-size'." (interactive) + ;; This `save-excursion' only exists for historical reasons because + ;; `erc-truncate-buffer-to-size' normally runs in a different buffer. (save-excursion - (erc-truncate-buffer-to-size erc-max-buffer-size))) + (if (and erc--parsed-response erc--msg-props) + (when-let + (((not erc--inhibit-clear-p)) + ((not (erc--memq-msg-prop 'erc--skip 'truncate))) + ;; Determine here because this may be a target buffer and + ;; the hook always runs in the server buffer. + (size (if (and erc-truncate--buffer-size + (> erc-truncate--buffer-size erc-max-buffer-size)) + erc-truncate--buffer-size + erc-max-buffer-size)) + (symbol (make-symbol "erc-truncate--buffer-deferred")) + (buffer (current-buffer))) + (fset symbol + (lambda (&rest _) + (remove-hook 'erc-timer-hook symbol t) + (erc-truncate-buffer-to-size size buffer))) + (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t))) + (unless erc--inhibit-clear-p + (erc-truncate-buffer-to-size erc-max-buffer-size))))) + +(defun erc-truncate--inhibit-when-local-and-interactive (&rest _) + "Ensure `erc-truncate--buffer-size' is nil on /CLEAR." + (when (and erc--called-as-input-p erc-truncate--buffer-size) + (message "Resetting max buffer size to %d" erc-max-buffer-size) + (setq erc-truncate--buffer-size nil))) (provide 'erc-truncate) ;;; erc-truncate.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b61456a9893..7de3b375752 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1794,7 +1794,9 @@ Defaults to the server buffer." (setq-local completion-ignore-case t) (add-hook 'post-command-hook #'erc-check-text-conversion nil t) (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t) - (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) + (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t) + (add-function :before (local 'erc--clear-function) + #'erc--skip-past-headroom-on-clear '((depth . 30)))) ;; activation @@ -2690,6 +2692,9 @@ side effect of setting the current buffer to the one it returns. Use (defun erc-initialize-log-marker (buffer) "Initialize the `erc-last-saved-position' marker to a sensible position. BUFFER is the current buffer." + ;; Note that in 5.6, `erc-input-marker' itself became a "sensible + ;; position" when its insertion type changed to t. However, + ;; decrementing still makes sense for compatibility. (with-current-buffer buffer (unless (markerp erc-last-saved-position) (setq erc-last-saved-position (make-marker)) @@ -3387,7 +3392,8 @@ a history backlog." (declare (indent 1)) (let ((marker (make-symbol "marker"))) `(progn - (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (or (= ,marker-or-pos (point-min)) + (= ?\n (char-before ,marker-or-pos)))) (cl-assert (null erc--insert-line-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) @@ -3703,7 +3709,8 @@ them from the previous newline, and add them to the newline suffixing the inserted version of STRING." (let* ((after (and (not erc-legacy-invisible-bounds-p) (get-text-property (point) 'erc--hide))) - (before (and after (get-text-property (1- (point)) 'invisible))) + (before (and after (> (point) (point-min)) + (get-text-property (1- (point)) 'invisible))) (a (and after (ensure-list after))) (b (and before (ensure-list before))) (new (and before (erc--solo (cl-intersection b a))))) @@ -4475,21 +4482,42 @@ of `erc-ignore-list'." (when-let ((existing (erc--find-ignore-timer user buffer))) (cancel-timer existing))))) -(defvar erc--pre-clear-functions nil - "Abnormal hook run when truncating buffers. -Called with position indicating boundary of interval to be excised.") +(defvar erc--clear-function #'delete-region + "Function to truncate buffer. +Called with two markers, LOWER and UPPER, indicating the bounds of the +interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.") + +(defun erc--skip-past-headroom-on-clear (beg end) + "Move marker BEG past the two newlines added by `erc--initialize-markers'." + (when (and (not (buffer-narrowed-p)) (= beg (point-min))) + (save-excursion + (goto-char (point-min)) + (let ((pos (skip-chars-forward "\n" (if erc--called-as-input-p 2 3)))) + (set-marker beg (min (1+ pos) end erc-input-marker)))))) + +(defvar erc--inhibit-clear-p nil + "When non-nil, ERC inhibits buffer truncation.") (defun erc-cmd-CLEAR () "Clear messages in current buffer after informing active modules. Expect modules to perform housekeeping tasks to withstand the disruption. When called from Lisp code, only clear messages up to but not including the one occupying the current line." + (when erc--inhibit-clear-p + (user-error "Truncation currently inhibited")) (with-silent-modifications - (let ((max (if (>= (point) erc-insert-marker) - (1- erc-insert-marker) - (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) - (run-hook-with-args 'erc--pre-clear-functions max) - (delete-region (point-min) max))) + (let ((end (copy-marker + ;; Leave a final newline for compatibility, even though + ;; it complicates `erc--clear-function' handling. + (cond ((>= (point) erc-insert-marker) + (max (point-min) (1- erc-insert-marker))) + ((erc--get-inserted-msg-beg (point))) + ((pos-bol))))) + (beg (point-min-marker))) + (let ((erc--inhibit-clear-p t)) + (funcall erc--clear-function beg end)) + (set-marker beg nil) + (set-marker end nil))) t) (put 'erc-cmd-CLEAR 'process-not-needed t) diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c738822f96..4ff1b956aea 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -76,16 +76,26 @@ (add-hook 'kill-emacs-hook (lambda () (delete-directory tempdir :recursive)))))) -;; This shows that, in addition to truncating the buffer, /clear also -;; syncs the log. - -(ert-deftest erc-scenarios-log--clear-stamp () +;; These next tests show that, in addition to truncating the buffer, +;; /CLEAR also syncs the log. They differ from the tests further below +;; involving the `truncate' module in that, here, the upper truncation +;; boundary doesn't reside on an `erc--msg' char but rather on a newline +;; (the final one before `erc-insert-marker'). This was initially done +;; to safeguard `erc-last-saved-position' because `erc-insert-marker' +;; originally had a nil insertion type. This staggered alignment means +;; truncation resulting from a /CLEAR actually demands more twiddling +;; and care than that triggered by the `truncate' module. +(ert-deftest erc-scenarios-log--cmd-clear/date-stamps () :tags '(:expensive-test) (require 'erc-stamp) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/assoc/bouncer-history") (dumb-server (erc-d-run "localhost" t 'foonet)) (tempdir (make-temp-file "erc-tests-log." t nil nil)) + (erc-scenarios-common-extra-teardown + (and noninteractive + (lambda () + (run-at-time 0 nil #'delete-directory tempdir :recursive)))) (erc-log-channels-directory tempdir) (erc-modules (cons 'log erc-modules)) (erc-timestamp-format-left "\n[%a %b %e %Y @@STAMP@@]\n") @@ -113,14 +123,18 @@ (funcall expect 10 "Grows, lives") (should-not (file-exists-p logfile)) (goto-char (point-max)) - (erc-cmd-CLEAR) + (erc-scenarios-common-say "/clear") (should (file-exists-p logfile)) (funcall expect 10 "please your lordship") (ert-info ("Buffer truncated") - (goto-char (point-min)) - (funcall expect 10 "@@STAMP@@" (point)) ; reset + (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset + ;; Requisite two blank lines plus date stamp are present. + (should (string-prefix-p "\n\n\n[" (buffer-string))) (funcall expect -0.1 "Grows, lives") - (funcall expect 1 "For these two"))) + (funcall expect 1 "For these two") + ;; Stamp resides just before `erc-last-saved-position'. + (should (looking-back (rx "]\n alice: For these two"))) + (should (= erc-last-saved-position (1- (pos-bol)))))) (ert-info ("Current contents saved") (with-temp-buffer @@ -129,7 +143,7 @@ (funcall expect 1 "You have joined") (funcall expect 1 "Playback Complete.") (funcall expect 1 "Grows, lives") - (funcall expect -0.01 "please your lordship"))) + (funcall expect -0.001 "alice: For these two hours"))) (ert-info ("Remainder saved, timestamp printed when option non-nil") (with-current-buffer "foonet" @@ -145,11 +159,84 @@ (should (looking-at (rx " alice: For these two hours,"))) (funcall expect 1 "please your lordship"))) - (erc-log-mode -1) - (when noninteractive (delete-directory tempdir :recursive)))) + (erc-log-mode -1))) -(ert-deftest erc-scenarios-log--truncate () - :tags '(:expensive-test :unstable) +(ert-deftest erc-scenarios-log--cmd-clear/left-stamps () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/assoc/bouncer-history") + (dumb-server (erc-d-run "localhost" t 'foonet)) + (tempdir (make-temp-file "erc-tests-log." t nil nil)) + (erc-scenarios-common-extra-teardown + (and noninteractive + (lambda () + (run-at-time 0 nil #'delete-directory tempdir :recursive)))) + (erc-log-channels-directory tempdir) + (erc-modules (cons 'log erc-modules)) + (erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-timestamp-only-if-changed-flag nil) + (port (process-contact dumb-server :service)) + (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port) + tempdir)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (unless noninteractive + (add-hook 'kill-emacs-hook + (lambda () (delete-directory tempdir :recursive)))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "foonet:changeme" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "foonet"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (funcall expect 10 "Grows, lives") + (should (string-prefix-p "\n\n[" (buffer-string))) + (should-not (file-exists-p logfile)) + (goto-char (point-max)) + (erc-scenarios-common-say "/clear") + (should (file-exists-p logfile)) + (funcall expect 10 "please your lordship") + + ;; During truncation, `erc--clear-function' inserts exactly two + ;; blanks, regardless of the following content. + (ert-info ("Buffer truncated") + (funcall expect -0.1 "Grows, lives") + (funcall expect 1 "For these two" (goto-char (point-min))) + (should (string-prefix-p "\n\n[" (buffer-string))) + (should (looking-back (rx "] alice: For these two"))) + (should (= erc-last-saved-position 2)))) + + (ert-info ("Current contents saved") + (with-temp-buffer + (insert-file-contents logfile) + (should (string-prefix-p "[" (buffer-string))) + (funcall expect 1 "]*** You have joined") + (funcall expect 1 "Playback Complete.") + (funcall expect 1 "] bob: Grows, lives") + (funcall expect -0.001 " alice: For these two hours"))) + + (ert-info ("Remainder saved, timestamp printed when option non-nil") + (with-current-buffer "foonet" + (delete-process erc-server-process) + (funcall expect 5 "failed")) + (kill-buffer "#chan") + (with-temp-buffer + (insert-file-contents logfile) + (funcall expect 1 "] bob: Grows, lives") + (forward-line 1) ; no blank, no timestamp + (should (looking-at (rx "[" (+ (in ":0-9")) + "] alice: For these two hours,"))) + (funcall expect 1 "] bob: As't please your lordship"))) + + (erc-log-mode -1))) + +(defun erc-scenarios-log--truncate (assert-truncation assert-log) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/assoc/bouncer-history") (dumb-server (erc-d-run "localhost" t 'foonet)) @@ -157,6 +244,7 @@ (erc-log-channels-directory tempdir) (erc-modules (cons 'truncate (cons 'log erc-modules))) (erc-max-buffer-size 512) + (erc-truncate-padding-size 512) (port (process-contact dumb-server :service)) (logchan (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port) tempdir)) @@ -179,8 +267,8 @@ (should (string= (buffer-name) (format "127.0.0.1:%d" port))) (should-not (file-exists-p logserv)) (should-not (file-exists-p logchan)) - (funcall expect 10 "*** MAXLIST=beI:60") - (should (= (pos-bol) (point-min))) + ;; Verify that truncation actally happens where it should. + (funcall assert-truncation expect) (should (file-exists-p logserv)))) (ert-info ("Log file ahead of truncation point") @@ -198,14 +286,47 @@ (with-temp-buffer (insert-file-contents logchan) (funcall expect 1 "You have joined") - (funcall expect 1 "[07:04:37] alice: Here,") - (funcall expect 1 "loathed enemy") - (funcall expect -0.1 "please your lordship"))) + ;; No unwanted duplicates. + (funcall expect 1 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [07:04:42] bob: By my troth") + (funcall expect 1 "I will grant it") + (funcall assert-log expect))) (erc-log-mode -1) (erc-truncate-mode -1) (when noninteractive (delete-directory tempdir :recursive)))) +(ert-deftest erc-scenarios-log--truncate () + :tags '(:expensive-test :unstable) + (erc-scenarios-log--truncate + + (lambda (expect) + (funcall expect 10 "*** MAXLIST=beI:60") + (should (= (pos-bol) 22)) + ;; Exactly two + 1 (for date stamp) newlines preserved. + (should (string-prefix-p "\n\n\n[" (buffer-string)))) + + (lambda (expect) + (funcall expect -0.001 "loathed enemy")))) + +(ert-deftest erc-scenarios-log--truncate/left-stamps () + :tags '(:expensive-test :unstable) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-timestamp-only-if-changed-flag nil)) + + (erc-scenarios-log--truncate + + (lambda (expect) + ;; Exactly two leading newlines preserved. + (funcall expect 10 + '(: "\n\n[" (= 5 (in "0-9:")) "]*** There are 0 users"))) + + (lambda (expect) + (funcall expect 1 "loathed enemy") + (funcall expect -0.001 "please your lordship"))))) + (defvar erc-insert-timestamp-function) (declare-function erc-insert-timestamp-left "erc-stamp" (string)) commit 08f662da1123f50f3f62d0af747bff88d2c73938 Author: F. Jason Park Date: Tue Aug 27 23:05:35 2024 -0700 Fix overlooked case in erc--get-inserted-msg-beg-at * lisp/erc/erc.el (erc--get-inserted-msg-beg-at): Account for the start of a props header being `bobp' when searching backwards. (erc--get-inserted-msg-prop): Add optional `point' parameter. * test/lisp/erc/erc-goodies-tests.el (erc--get-inserted-msg-beg/truncated/readonly): New test. * test/lisp/erc/erc-tests.el (erc--get-inserted-msg-beg/truncated): New test. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-assert-get-inserted-msg/truncated): New test helper. (Bug#72736) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b39ea6d8efb..b61456a9893 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3324,10 +3324,14 @@ value. Otherwise, return the stored value." (macroexp-let2* nil ((point point) (at-start-p at-start-p)) `(or (and ,at-start-p ,point) - (and-let* ((p (previous-single-property-change ,point 'erc--msg))) - (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) - p - (1- p)))))) + (let ((p (previous-single-property-change ,point 'erc--msg))) + (cond + ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p) + (p (1- p)) + ((and (null p) + (> ,point (point-min)) + (get-text-property (1- point) 'erc--msg)) + (1- point))))))) (defmacro erc--get-inserted-msg-end-at (point at-start-p) (macroexp-let2 nil point point @@ -3356,9 +3360,9 @@ if not found." (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) (cons b (erc--get-inserted-msg-end-at point at-start-p))))) -(defun erc--get-inserted-msg-prop (prop) +(defun erc--get-inserted-msg-prop (prop &optional point) "Return the value of text property PROP for some message at point." - (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) + (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point))))) (get-text-property stack-pos prop))) ;; FIXME improve this nascent "message splicing" facility to include a diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 038434b3880..1d74025c5ce 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -597,6 +597,11 @@ #'erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/readonly () (erc-tests-common-assert-get-inserted-msg-readonly-with #'erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 72ea11aeba1..eddb3a5b2c8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1934,6 +1934,10 @@ (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated () + (erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/basic () (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index b5bb1fb09c3..1cd54a1f715 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -184,6 +184,13 @@ For simplicity, assume string evaluates to itself." (should (looking-back " hi")) (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) +(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (with-silent-modifications (delete-region 1 3)) + (goto-char 9) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 1 9 test-fn)) + ;; This is a "mixin" and requires a base assertion function, like ;; `erc-tests-common-assert-get-inserted-msg/basic', to work. (defun erc-tests-common-assert-get-inserted-msg-readonly-with commit 054602533ca08a7ab734aa3f750a03a7a8ccf25a Author: F. Jason Park Date: Sun Aug 18 22:58:11 2024 -0700 Improve inconsistent handling of ban lists in ERC * etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section for ERC 5.6.1. * lisp/erc/erc-backend.el (erc-server-MODE): Don't call `erc-banlist-update'. * lisp/erc/erc-fill.el (erc--determine-fill-column-function): New method for `fill' and `fill-wrap' modules. * lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST) (pcomplete/erc-mode/BL) (pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB): New functions. * lisp/erc/erc.el: Map ERC 5.6.1 to Emacs 31.1 in `customize-package-emacs-version-alist'. (erc-channel-banlist): Deprecate practice of using the symbol property `received-from-server' of as a state flag because it's error-prone and bleeds into other connections. (erc--channel-banlist-synchronized-p): New variable to indicate whether the ban list has been initialized. The presence of a local binding for `erc-channel-banlist' could probably be used for the same purpose but would surely require rewriting `erc-cmd-BANLIST' and `erc-cmd-MASSUNBAN'. (erc-sync-banlist): New function, announced in ERC-NEWS. (erc--wrap-banlist-cmd): New function. (erc-banlist-fill-padding): New variable. (erc--determine-fill-column-function): New generic function. (erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from top level into function body. Always reset `received-from-server' to nil. Improve column calculations. (erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil. (erc-banlist-finished): Deprecate function unused since 2003. (erc--banlist-update): New function. (erc-banlist-update): Deprecate function because its logic is faulty and it doesn't handle mixed mode letters, like "MODE #foobar +mb *@127.0.0.1". See https://modern.ircdocs.horse/#mode-message. It also depends on an obsolete convention regarding the symbol property `received-from-server' of `erc-channel-banlist'. Basically, this function used to run upon receipt of any "MODE" command from the server. However, actual updates to the variable `erc-channel-banlist' only happened if `received-from-server' was t, which could only be the case after the user issued a /MASSUNBAN. And that behavior was determined to be a bug. This mode framework stuff was introduced as part of bug#67220 for ERC 5.6. (erc--handle-channel-mode): New function, a method for standard channel-mode letter "b". * test/lisp/erc/erc-tests.el (erc--channel-modes) (erc--channel-modes/graphic-p): Assert contents of `erc-channel-banlist' updated on "MODE". (Bug#72736) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 9803c3ff379..0b5385f0589 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,15 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.6.1 + +** Reliable library access for ban lists. +Say goodbye to continually running "/BANLIST" for programmatic +purposes. Modules can instead use the function 'erc-sync-banlist' to +guarantee that the variable 'erc-channel-banlist' remains synced for +the remainder of an IRC session. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d999cf57db8..16e8cae4733 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1851,8 +1851,8 @@ add things to `%s' instead." ?t tgt ?m mode) (erc-display-message parsed 'notice buf 'MODE ?n nick ?u login - ?h host ?t tgt ?m mode))) - (erc-banlist-update proc parsed)))) + ?h host ?t tgt ?m mode))))) + nil) (defun erc--wrangle-query-buffers-on-nick-change (old new) "Create or reuse a query buffer for NEW nick after considering OLD nick. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 986314822ba..fa9d2071ccd 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -896,6 +896,12 @@ decorations applied by third-party modules." (length (format-time-string erc-timestamp-format)) 0)) +(cl-defmethod erc--determine-fill-column-function + (&context (erc-fill-mode (eql t))) + (if erc-fill-wrap-mode + (- (window-width) erc-fill--wrap-value 1) + erc-fill-column)) + (provide 'erc-fill) ;;; erc-fill.el ends here diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 05cbaf3872f..afbe3895667 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -187,6 +187,14 @@ for use on `completion-at-point-function'." (pcomplete-here '("cancel")) (pcomplete-opt "a")) +(defun pcomplete/erc-mode/BANLIST () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST) + +(defun pcomplete/erc-mode/MASSUNBAN () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN) + ;;; Functions that provide possible completions. (defun pcomplete-erc-commands () diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8b3eef94ee4..b39ea6d8efb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -87,7 +87,8 @@ ("5.4" . "28.1") ("5.4.1" . "29.1") ("5.5" . "29.1") - ("5.6" . "30.1"))) + ("5.6" . "30.1") + ("5.6.1" . "31.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." @@ -5555,109 +5556,117 @@ If CHANNEL is not specified, clear the topic for the default channel." (defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. - -Each ban is an alist of the form: - (WHOSET . MASK) - -The property `received-from-server' indicates whether -or not the ban list has been requested from the server.") +Entries are cons cells of the form (OP . MASK), where OP is the channel +operator who issued the ban. Modules needing such a list should call +`erc-sync-banlist' once per session in the channel before accessing the +variable. Interactive users need only issue a /BANLIST. Note that +older versions of ERC relied on a deprecated convention involving a +property of the symbol `erc-channel-banlist' to indicate whether a ban +list had been received in full; this was found to be unreliable.") (put 'erc-channel-banlist 'received-from-server nil) -(defvar erc-fill-column) - -(defun erc-cmd-BANLIST () - "Pretty-print the contents of `erc-channel-banlist'. - -The ban list is fetched from the server if necessary." - (let ((chnl (erc-default-target)) - (chnl-name (buffer-name))) - - (cond - ((not (erc-channel-p chnl)) - (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store - erc-channel-banlist nil) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl-name - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-BANLIST) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - - ((null erc-channel-banlist) - (erc-display-message nil 'notice 'active - (format "No bans for channel: %s\n" chnl)) +(defvar-local erc--channel-banlist-synchronized-p nil + "Whether the full channel ban list has been fetched since joining.") + +(defun erc-sync-banlist (&optional done-fn) + "Initialize syncing of current channel's `erc-channel-banlist'. +Arrange for it to remain synced for the rest of the IRC session. When +DONE-FN is non-nil, call it with no args once fully updated. Expect it +to return non-nil, if necessary, to inhibit further processing." + (unless (erc-channel-p (current-buffer)) + (error "Not a channel buffer")) + (let ((channel (erc-target)) + (buffer (current-buffer)) + (hook (lambda (&rest r) (apply #'erc-banlist-store r) t))) + (setq erc-channel-banlist nil) + (erc-with-server-buffer + (add-hook 'erc-server-367-functions hook -98 t) + (erc-once-with-server-event + 368 (lambda (&rest _) + (remove-hook 'erc-server-367-functions hook t) + (with-current-buffer buffer + (prog1 (if done-fn (funcall done-fn) t) + (setq erc--channel-banlist-synchronized-p t))))) + (erc-server-send (format "MODE %s b" channel))))) + +(defun erc--wrap-banlist-cmd (slashcmd) + (lambda () + (put 'erc-channel-banlist 'received-from-server t) + (unwind-protect (funcall slashcmd) (put 'erc-channel-banlist 'received-from-server nil)) + t)) - (t - (let* ((erc-fill-column (or (and (boundp 'erc-fill-column) - erc-fill-column) - (and (boundp 'fill-column) - fill-column) - (1- (window-width)))) - (separator (make-string erc-fill-column ?=)) - (fmt (concat - "%-" (number-to-string (/ erc-fill-column 2)) "s" - "%" (number-to-string (/ erc-fill-column 2)) "s"))) +(defvar erc-banlist-fill-padding 1.0 + "Scaling factor from 0 to 1 of free space between entries, if any.") - (erc-display-message - nil 'notice 'active - (format "Ban list for channel: %s\n" (erc-default-target))) - - (erc-display-line separator 'active) - (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) - (erc-display-line separator 'active) - - (mapc - (lambda (x) - (erc-display-line - (format fmt - (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) - (if (car x) - (truncate-string-to-width (car x) (/ erc-fill-column 2)) - "")) - 'active)) - erc-channel-banlist) - - (erc-display-message nil 'notice 'active "End of Ban list") - (put 'erc-channel-banlist 'received-from-server nil))))) +(cl-defgeneric erc--determine-fill-column-function () + fill-column) + +(defun erc-cmd-BANLIST (&rest args) + "Print the list of ban masks for the current channel. +When uninitialized or with option -f, resync `erc-channel-banlist'." + (cond + ((not (erc-channel-p (current-buffer))) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST))) + ((null erc-channel-banlist) + (erc-display-message nil 'notice 'active + (format "No bans for channel: %s\n" (erc-target)))) + ((let ((max-width (erc--determine-fill-column-function)) + (lw 0) (rw 0) separator fmt) + (dolist (entry erc-channel-banlist) + (setq rw (max (length (car entry)) rw) + lw (max (length (cdr entry)) lw))) + (let ((maxw (* 1.0 (min max-width (+ rw lw))))) + (when (< maxw (+ rw lw)) ; scale down when capped + (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw))) + lw (/ (* lw maxw) (* 1.0 (+ rw lw))))) + (when-let ((larger (max rw lw)) ; cap ratio at 3:1 + (wavg (* maxw 0.75)) + ((> larger wavg))) + (setq rw (if (eql larger rw) wavg (- maxw wavg)) + lw (- maxw rw))) + (cl-psetq rw (+ rw (* erc-banlist-fill-padding + (- (/ (* rw max-width) maxw) rw))) + lw (+ lw (* erc-banlist-fill-padding + (- (/ (* lw max-width) maxw) lw))))) + (setq rw (truncate rw) + lw (truncate lw)) + (cl-assert (<= (+ rw lw) max-width)) + (setq separator (make-string (+ rw lw 1) ?=) + fmt (concat "%-" (number-to-string lw) "s " + "%" (number-to-string rw) "s")) + (erc-display-message + nil 'notice 'active + (format "Ban list for channel: %s%s\n" (erc-target) + (if erc--channel-banlist-synchronized-p " (cached)" ""))) + (erc-display-line separator 'active) + (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) + (erc-display-line separator 'active) + (dolist (entry erc-channel-banlist) + (erc-display-line + (format fmt (truncate-string-to-width (cdr entry) lw) + (truncate-string-to-width (car entry) rw)) + 'active)) + (erc-display-message nil 'notice 'active "End of Ban list")))) + (put 'erc-channel-banlist 'received-from-server nil) t) (defalias 'erc-cmd-BL #'erc-cmd-BANLIST) -(defun erc-cmd-MASSUNBAN () - "Mass Unban. - -Unban all currently banned users in the current channel." +(defun erc-cmd-MASSUNBAN (&rest args) + "Remove all bans in the current channel." (let ((chnl (erc-default-target))) (cond - ((not (erc-channel-p chnl)) (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-MASSUNBAN) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN))) (t (let ((bans (mapcar #'cdr erc-channel-banlist))) (when bans ;; Glob the bans into groups of three, and carry out the unban. @@ -5668,8 +5677,9 @@ Unban all currently banned users in the current channel." (format "MODE %s -%s %s" (erc-default-target) (make-string (length x) ?b) (mapconcat #'identity x " ")))) - (erc-group-list bans 3)))) - t)))) + (erc-group-list bans 3)))))) + (put 'erc-channel-banlist 'received-from-server nil) + t)) (defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN) @@ -6639,17 +6649,31 @@ See also: `erc-echo-notice-in-user-buffers', erc-channel-banlist)))))) nil) +;; This was a default member of `erc-server-368-functions' (nee -hook) +;; between January and June of 2003 (but not as part of any release). (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." + (declare (obsolete "uses obsolete and likely faulty logic" "31.1")) (let* ((channel (nth 1 (erc-response.command-args parsed))) (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) t) ; suppress the 'end of banlist' message +(defun erc--banlist-update (statep mask) + "Add or remove a mask from `erc-channel-banlist'." + (if statep + (let ((whoset (erc-response.sender erc--parsed-response))) + (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal)) + (let ((upcased (upcase mask))) + (setq erc-channel-banlist + (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased)) + erc-channel-banlist))))) + (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 + (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1")) (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) @@ -7732,6 +7756,11 @@ Remember when STATE is non-nil and forget otherwise." (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal) (delete (char-to-string c) erc-channel-modes)))) +;; We could specialize on type A, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg) + "Update `erc-channel-banlist' when synchronized." + (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg))) + ;; We could specialize on type C, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) "Update channel user limit, remembering ARG when STATE is non-nil." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b11f994bce8..72ea11aeba1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -929,13 +929,19 @@ (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) (erc-tests-common-init-server-proc "sleep" "1") - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*") + ("chop!~u@gnu.org" . "fool!*@*"))))) (should (equal (erc--channel-modes 'string) "klt")) (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) @@ -980,11 +986,16 @@ (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*"))))) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) commit 15545e15a343cc45561a3ff6b8ea930835b7ff08 Author: F. Jason Park Date: Sun Aug 18 23:50:58 2024 -0700 Bind current erc-response around all handlers * lisp/erc/erc-backend.el (erc--parsed-response): New variable to be the internal version of the ancient `erc-message-parsed', which is only available during `erc-display-message', and therefore of somewhat limited utility. (erc-call-hooks): Bind `erc--parsed-response' to the parsed `erc-response' object for the duration of its handling. Bind `erc--msg-prop-overrides' around all hooks to allow response handlers to influence inserted msg props for any `erc-display-message' calls. (Bug#72736) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9aedc110067..d999cf57db8 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1534,11 +1534,15 @@ See also `erc-server-responses'." (gethash (format (if (numberp command) "%03i" "%s") command) erc-server-responses)) +(defvar erc--parsed-response nil) + (defun erc-call-hooks (process message) "Call hooks associated with MESSAGE in PROCESS. Finds hooks by looking in the `erc-server-responses' hash table." - (let ((hook (or (erc-get-hook (erc-response.command message)) + (let ((erc--parsed-response message) + (erc--msg-prop-overrides erc--msg-prop-overrides) + (hook (or (erc-get-hook (erc-response.command message)) 'erc-default-server-functions))) (run-hook-with-args-until-success hook process message) ;; Some handlers, like `erc-cmd-JOIN', open new targets without commit b0ebb82076315f8e50159aff6caded4c5ee4438c Author: F. Jason Park Date: Tue Aug 6 19:13:51 2024 -0700 Store one string per user in erc--spkr msg prop * lisp/erc/erc.el (erc--msg-props): Mention that the `erc--spkr' msg-prop value is taken from the `nickname' slot of the user's `erc-server-users' entry. (erc--speakerize-nick): Avoid using the provided NICK parameter for the `erc--spkr' property. Instead, use the version from the `nickname' slot of its `erc-server-users' item, which is itself an `erc-server-user' object. These text props were originally introduced in ERC 5.6 as part of bug#67677. * test/lisp/erc/erc-tests.el (erc--refresh-prompt) (erc--check-prompt-input-functions, erc-send-current-line) (erc--check-prompt-input-for-multiline-blanks) (erc-send-whitespace-lines): Use more convenient helper utility to create fake server buffer where possible. (erc--speakerize-nick): New test. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Don't use ERT temp buffer's name for dialed server, etc., because it contains unwanted chars. (erc-tests-common-with-process-input-spy): Defer to each test to set up its own prompt, etc. (Bug#72736) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5e8fa3051c7..8b3eef94ee4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -173,7 +173,8 @@ as of ERC 5.6: and help text, and on outgoing messages unless echoed back by the server (assuming future support) - - `erc--spkr': a string, the nick of the person speaking + - `erc--spkr': a string, the non-case-mapped nick of the speaker as + stored in the `nickname' slot of its `erc-server-users' item - `erc--ctcp': a CTCP command, like `ACTION' @@ -6339,20 +6340,18 @@ rely on their presence, and cleaner ways exist)." "Template for a CTCP ACTION status message from current client.") (defun erc--speakerize-nick (nick &optional disp) - "Propertize NICK with `erc--speaker' if not already present. -Do so to DISP instead if it's non-nil. In either case, assign -NICK, sans properties, as the `erc--speaker' value. As a side -effect, pair the latter string (the same `eq'-able object) with -the symbol `erc--spkr' in the \"msg prop\" environment for any -imminent `erc-display-message' invocations. While doing so, -include any overrides defined in `erc--message-speaker-catalog'." - (let ((plain-nick (substring-no-properties nick))) - (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog - 'erc--msg-prop-overrides)) - (if (text-property-not-all 0 (length (or disp nick)) - 'erc--speaker nil (or disp nick)) - (or disp nick) - (propertize (or disp nick) 'erc--speaker plain-nick)))) + "Return propertized NICK with canonical NICK in `erc--speaker'. +Return propertized DISP instead if given. As a side effect, pair NICK +with `erc--spkr' in the \"msg prop\" environment for any imminent +`erc-display-message' invocations, and include any overrides defined in +`erc--message-speaker-catalog'. Expect NICK (but not necessarily DISP) +to be absent of any existing text properties." + (when-let ((erc-server-process) + (cusr (erc-get-server-user nick))) + (setq nick (erc-server-user-nickname cusr))) + (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog + 'erc--msg-prop-overrides)) + (propertize (or disp nick) 'erc--speaker nick)) (defun erc--determine-speaker-message-format-args (nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f65c1496087..b11f994bce8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -330,16 +330,12 @@ (ert-info ("Server buffer") (with-current-buffer (get-buffer-create "ServNet") - (erc-tests-common-prep-for-insertion) + (erc-tests-common-make-server-buf "ServNet") (goto-char erc-insert-marker) (should (looking-at-p "ServNet 3>")) (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) - (setq erc-network 'ServNet - erc-server-current-nick "tester" - erc-networks--id (erc-networks--id-create nil) - erc-server-users (make-hash-table :test 'equal)) - (set-process-query-on-exit-flag erc-server-process nil) + (setq erc-server-current-nick "tester") ;; Incoming message redraws prompt (erc-display-message nil 'notice nil "Welcome") (should (looking-at-p (rx "*** Welcome"))) @@ -364,6 +360,8 @@ (should-not (search-forward (rx (any "3-5") ">") nil t))))) (ert-info ("Channel buffer") + ;; Create buffer manually instead of using `erc--open-target' in + ;; order to show prompt before/after network is known. (with-current-buffer (get-buffer-create "#chan") (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) @@ -1521,6 +1519,7 @@ (ert-deftest erc--check-prompt-input-functions () (erc-tests-common-with-process-input-spy (lambda (next) + (erc-tests-common-prep-for-insertion) (ert-info ("Errors when point not in prompt area") ; actually just dings (insert "/msg #chan hi") @@ -1556,7 +1555,7 @@ (ert-deftest erc-send-current-line () (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "1") + (erc-tests-common-make-server-buf (buffer-name)) (should (= 0 erc-last-input-time)) (ert-info ("Simple command") @@ -1639,7 +1638,8 @@ (ert-with-message-capture messages (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "300") + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc-send-whitespace-lines) (should erc-warn-about-blank-lines) @@ -1717,7 +1717,8 @@ (ert-deftest erc-send-whitespace-lines () (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests-common-init-server-proc "sleep" "1") + (erc-tests-common-make-server-buf (buffer-name)) + (setq-local erc-send-whitespace-lines t) (ert-info ("Multiline hunk with blank line correctly split") @@ -2653,6 +2654,58 @@ (erc--determine-speaker-message-format-args nick msg privp msgp inputp nil pfx)))) +;; This test demonstrates that ERC uses the same string for the +;; `erc--spkr' and `erc--speaker' text properties, which it gets from +;; the `nickname' shot of the speaker's server user. +(ert-deftest erc--speakerize-nick () + (erc-tests-common-make-server-buf) + (setq erc-server-current-nick "tester") + + (let ((sentinel "alice")) + (with-current-buffer (erc--open-target "#chan") + (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil + "example.org" "~u" "bob") + (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil + "fsf.org" "~u" "alice")) + + (erc-call-hooks nil (make-erc-response + :sender "alice!~u@fsf.org" + :command "PRIVMSG" + :command-args '("#chan" "one") + :contents "one" + :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one")) + (erc-call-hooks nil (make-erc-response + :sender "bob!~u@example.org" + :command "PRIVMSG" + :command-args '("#chan" "hi") + :contents "hi" + :unparsed ":bob!~u@example.org PRIVMSG #chan :hi")) + (erc-call-hooks nil (make-erc-response + :sender "alice!~u@fsf.org" + :command "PRIVMSG" + :command-args '("#chan" "two") + :contents "two" + :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two")) + + (with-current-buffer (get-buffer "#chan") + (should (eq sentinel + (erc-server-user-nickname (erc-get-server-user "alice")))) + (goto-char (point-min)) + + (should (search-forward " one")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (should (search-forward " hi" nil t)) + + (should (search-forward " two")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (when noninteractive (kill-buffer))))) + ;; This asserts that `erc--determine-speaker-message-format-args' ;; behaves identically to `erc-format-privmessage', the function whose ;; role it basically replaced. diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 2ec32db77cd..b5bb1fb09c3 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -103,16 +103,17 @@ recently passed to the mocked `erc-process-input-line'. Make (lambda (&rest r) (push r calls))) ((symbol-function 'erc-server-buffer) (lambda () (current-buffer)))) - (erc-tests-common-prep-for-insertion) (funcall test-fn (lambda () (pop calls))))) (when noninteractive (kill-buffer)))) (defun erc-tests-common-make-server-buf (&optional name) "Return a server buffer named NAME, creating it if necessary. Use NAME for the network and the session server as well." - (unless name - (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name))))) - (with-current-buffer (get-buffer-create name) + (with-current-buffer (if name + (get-buffer-create name) + (and (string-search "temp" (buffer-name)) + (setq name "foonet") + (buffer-name))) (erc-tests-common-prep-for-insertion) (erc-tests-common-init-server-proc "sleep" "1") (setq erc-session-server (concat "irc." name ".org") commit 8f326e0ba23f88ee5ef25fb89f6c7cedbdbda89e Author: F. Jason Park Date: Mon Aug 19 22:40:25 2024 -0700 ; Rename internal variable in erc-fill * lisp/erc/erc-fill.el (erc--fill-wrap-scrolltobottom-exempt-p): Rename to `erc-fill--wrap-scrolltobottom-exempt-p' so prefix matches library and feature. (erc-fill--wrap-ensure-dependencies): Update variable name. * lisp/erc/erc-truncate.el (erc-max-buffer-size): Don't mention `erc-insert-post-hook' in doc string because truncation now happens elsewhere. (erc-truncate-buffer-to-size): Update obsolete comment that describes pre-5.5/Emacs 29 behavior. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Update variable name. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-u--canned-load-dialog--basic) (erc-d-u--canned-load-dialog--intermingled) (erc-d-u--rewrite-for-slow-mo): Timeouts. * test/lisp/erc/resources/erc-d/resources/basic.eld: Timeouts. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Use updated variable name. (Bug#72736) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c863d99a339..986314822ba 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -421,7 +421,7 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) -(defvar erc--fill-wrap-scrolltobottom-exempt-p nil) +(defvar erc-fill--wrap-scrolltobottom-exempt-p nil) (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) @@ -435,7 +435,7 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) - (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p + (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p (memq 'scrolltobottom erc-modules)) (push 'scrolltobottom missing-deps) (erc-scrolltobottom-mode +1)) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 4b602074ebb..711a2988302 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -38,7 +38,7 @@ (defcustom erc-max-buffer-size 30000 "Maximum size in chars of each ERC buffer. Used only when auto-truncation is enabled. -\(see `erc-truncate-buffer' and `erc-insert-post-hook')." +\(Also see `erc-truncate-buffer'.)" :type 'integer) ;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -92,10 +92,7 @@ present in `erc-modules'." (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) (when (> (buffer-size buffer) (+ size 512)) (with-current-buffer buffer - ;; Note that when erc-insert-post-hook runs, the buffer is - ;; narrowed to the new message. So do this delicate widening. - ;; I am not sure, I think this was not recommended behavior in - ;; Emacs 20. + ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. (save-restriction (widen) (let ((end (- erc-insert-marker size))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index f8bfc362085..b52a996f184 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,7 +52,7 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) - (erc--fill-wrap-scrolltobottom-exempt-p t) + (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index dd0d5f8cb87..63d304907ea 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -50,7 +50,7 @@ '(0 ":irc.example.org 422 tester :MOTD File is missing")))) (should (equal (car (funcall reap)) '(mode-user 5 "MODE tester +i"))) (should (equal (funcall reap) - '((mode-chan 1.2 "MODE #chan") + '((mode-chan 3.2 "MODE #chan") (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")))) ;; See `define-error' site for `iter-end-of-sequence' (ert-info ("EOB detected") (should-not (erc-d-u--read-dialog exes)))) @@ -74,7 +74,7 @@ (should (equal (funcall user) '(user 0.2 "USER user 0 * :tester"))) (should (equal (funcall modu) '(mode-user 5 "MODE tester +i"))) - (should (equal (funcall modc) '(mode-chan 1.2 "MODE #chan"))) + (should (equal (funcall modc) '(mode-chan 3.2 "MODE #chan"))) (cl-loop repeat 8 do (funcall user)) ; skip a few (should (equal (funcall user) @@ -147,7 +147,7 @@ (should (equal (car (funcall reap exes)) '(mode-user 15 "MODE tester +i"))) (should (equal (car (funcall reap exes)) - '(mode-chan 11.2 "MODE #chan"))) + '(mode-chan 13.2 "MODE #chan"))) (should-not (erc-d-u--read-dialog exes))) (ert-info ("Rewrite for slowmo bounded") @@ -176,7 +176,7 @@ (should (equal (car (funcall reap exes-custom)) '(mode-user 10 "MODE tester +i"))) (should (equal (car (funcall reap exes-custom)) - '(mode-chan 2.4 "MODE #chan"))) + '(mode-chan 6.4 "MODE #chan"))) (should-not (erc-d-u--read-dialog exes-custom)))) (should-not (get-buffer "basic.eld")) diff --git a/test/lisp/erc/resources/erc-d/resources/basic.eld b/test/lisp/erc/resources/erc-d/resources/basic.eld index 80e46d9a279..bbc8713d699 100644 --- a/test/lisp/erc/resources/erc-d/resources/basic.eld +++ b/test/lisp/erc/resources/erc-d/resources/basic.eld @@ -27,5 +27,5 @@ (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ;; Some comment (to prevent regression) -((mode-chan 1.2 "MODE #chan") +((mode-chan 3.2 "MODE #chan") (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0dc82c98d5f..130b0aae109 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -150,7 +150,7 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) - (erc--fill-wrap-scrolltobottom-exempt-p t) + (erc-fill--wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) commit dd4c67907eb3084c6f55828c51bca1675a98376d Author: Stefan Kangas Date: Sun Sep 29 23:29:54 2024 +0200 Try "python" before "python3" in python-mode Prefer whatever version of Python that "python" might point to; use "python3" if it doesn't exist. On recent versions of typical GNU/Linux distributions, "python" either does not exist or it points to Python 3. In (presumed rare) cases where "python" points to Python 2 instead, users are now expected to manually customize these variables if they want to use Python 3. * lisp/progmodes/python.el (python-interpreter) (python-shell-interpreter): Prefer "python" to "python3". Ref: https://lists.gnu.org/r/emacs-devel/2024-09/msg00885.html diff --git a/etc/NEWS b/etc/NEWS index aaf3783f006..c8a1e75d68f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -444,6 +444,17 @@ toggle. Putting (require 'midnight) in your init file no longer activates the mode. Now, one needs to say (midnight-mode +1) instead. +** Python mode + +--- +*** Prefer "python" for 'python-interpreter' and 'python-shell-interpreter'. +On recent versions of mainstream GNU/Linux distributions, "python" +either does not exist or it points to Python 3. These user options now +default to using "python", falling back to "python3" if it does not +exist. If "python" points to Python 2 on your system, you now have to +customize these variables to "python3" if you want to use Python 3 +instead. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 39efeaf9122..d4a213466f3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -313,8 +313,8 @@ :link '(emacs-commentary-link "python")) (defcustom python-interpreter - (cond ((executable-find "python3") "python3") - ((executable-find "python") "python") + (cond ((executable-find "python") "python") + ((executable-find "python3") "python3") (t "python3")) "Python interpreter for noninteractive use. Some Python interpreters also require changes to @@ -2739,8 +2739,8 @@ position, else returns nil." :safe 'stringp) (defcustom python-shell-interpreter - (cond ((executable-find "python3") "python3") - ((executable-find "python") "python") + (cond ((executable-find "python") "python") + ((executable-find "python3") "python3") (t "python3")) "Python interpreter for interactive use. @@ -2748,7 +2748,7 @@ Some Python interpreters also require changes to `python-shell-interpreter-args'. In particular, setting `python-shell-interpreter' to \"ipython3\" requires setting `python-shell-interpreter-args' to \"--simple-prompt\"." - :version "28.1" + :version "31.1" :type 'string) (defcustom python-shell-internal-buffer-name "Python Internal" commit 4003d5f12673d243d2cf5e36f6d124d166cc96be Author: Mattias Engdegård Date: Sun Sep 29 19:23:11 2024 +0200 ; Reword :reverse-video warning * lisp/emacs-lisp/bytecomp.el (bytecomp--check-cus-face-spec): * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-defface-spec): Clarify. (See bug#73552.) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 47df26f01d6..5ed058e0a14 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5406,7 +5406,7 @@ FORM is used to provide location, `bytecomp--cus-function' and ((eq attr :reverse-video) (bytecomp--cus-warn (list atts sp spec) - (concat "Face attribute `:reverse-video' is obsolete;" + (concat "Face attribute `:reverse-video' has been removed;" " use `:inverse-video' instead"))) (t (bytecomp--cus-warn diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 39c3732581a..ca9849f351b 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -2001,7 +2001,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (rx "`:inverse' is not a valid face attribute keyword") (df '((t (:background "blue" :inverse t))))) ; old attr list syntax (bytecomp--with-warning-test - (rx "Face attribute `:reverse-video' is obsolete;" + (rx "Face attribute `:reverse-video' has been removed;" " use `:inverse-video' instead") (df '((t :background "red" :reverse-video t)))) (bytecomp--with-warning-test commit 0c28a1b0fab26dd726ea54927661d0402f8047dc Author: Mattias Engdegård Date: Sun Sep 29 16:24:42 2024 +0200 Cease accepting the :reverse-video face attribute (bug#73552) It was an old alias for :inverse-video that hasn't worked very well for many years. * src/xfaces.c (merge_face_ref, Finternal_set_lisp_face_attribute) (Finternal_set_lisp_face_attribute_from_resource) (Finternal_get_lisp_face_attribute) (Finternal_lisp_face_attribute_values, syms_of_xfaces): Stop recognising :reverse-video. * etc/NEWS: Announce. diff --git a/etc/NEWS b/etc/NEWS index 876fd137a4d..aaf3783f006 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,7 +471,7 @@ All the characters that belong to the 'symbol' script (according to * Lisp Changes in Emacs 31.1 --- -** The face attribute ':reverse-video' is obsolete. +** The obsolete face attribute ':reverse-video' has been removed. Use ':inverse-video' instead. +++ diff --git a/src/xfaces.c b/src/xfaces.c index bbc3448e457..e248279e9b7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2693,9 +2693,7 @@ merge_face_ref (struct window *w, Lisp_Object keyword = XCAR (face_ref_tem); Lisp_Object value = XCAR (XCDR (face_ref_tem)); - if (EQ (keyword, face_attr_sym[attr_filter]) - || (attr_filter == LFACE_INVERSE_INDEX - && EQ (keyword, QCreverse_video))) + if (EQ (keyword, face_attr_sym[attr_filter])) { attr_filter_seen = true; if (NILP (value)) @@ -2831,8 +2829,7 @@ merge_face_ref (struct window *w, else err = true; } - else if (EQ (keyword, QCinverse_video) - || EQ (keyword, QCreverse_video)) + else if (EQ (keyword, QCinverse_video)) { if (EQ (value, Qt) || NILP (value)) to[LFACE_INVERSE_INDEX] = value; @@ -3461,8 +3458,7 @@ FRAME 0 means change the face on all frames, and change the default old_value = LFACE_BOX (lface); ASET (lface, LFACE_BOX_INDEX, value); } - else if (EQ (attr, QCinverse_video) - || EQ (attr, QCreverse_video)) + else if (EQ (attr, QCinverse_video)) { if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value) @@ -3980,8 +3976,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth)) value = intern (SSDATA (value)); - else if (EQ (attr, QCreverse_video) - || EQ (attr, QCinverse_video) + else if (EQ (attr, QCinverse_video) || EQ (attr, QCextend)) value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCunderline) @@ -4192,8 +4187,7 @@ frames). If FRAME is omitted or nil, use the selected frame. */) value = LFACE_STRIKE_THROUGH (lface); else if (EQ (keyword, QCbox)) value = LFACE_BOX (lface); - else if (EQ (keyword, QCinverse_video) - || EQ (keyword, QCreverse_video)) + else if (EQ (keyword, QCinverse_video)) value = LFACE_INVERSE (lface); else if (EQ (keyword, QCforeground)) value = LFACE_FOREGROUND (lface); @@ -4237,7 +4231,6 @@ Value is nil if ATTR doesn't have a discrete set of valid values. */) if (EQ (attr, QCunderline) || EQ (attr, QCoverline) || EQ (attr, QCstrike_through) || EQ (attr, QCinverse_video) - || EQ (attr, QCreverse_video) || EQ (attr, QCextend)) result = list2 (Qt, Qnil); @@ -7372,7 +7365,6 @@ syms_of_xfaces (void) DEFSYM (QCslant, ":slant"); DEFSYM (QCunderline, ":underline"); DEFSYM (QCinverse_video, ":inverse-video"); - DEFSYM (QCreverse_video, ":reverse-video"); DEFSYM (QCforeground, ":foreground"); DEFSYM (QCbackground, ":background"); DEFSYM (QCstipple, ":stipple"); commit 8e3205a0c80a39f8e64209fd5905c541c92e46a6 Author: Mattias Engdegård Date: Sun Sep 29 16:57:07 2024 +0200 * lisp/custom.el (custom-fix-face-spec): Fix :reverse-video case The :reverse-video keyword is no longer used but we might just as well fix the code that is supposed to migrate away from it (bug#73552). diff --git a/lisp/custom.el b/lisp/custom.el index a806059d0dd..c7ce47d4e57 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -977,7 +977,7 @@ Also change :reverse-video to :inverse-video." (when (listp spec) (if (or (memq :bold spec) (memq :italic spec) - (memq :inverse-video spec)) + (memq :reverse-video spec)) (let (result) (while spec (let ((key (car spec)) commit a0957595fe8ee298ab066a4ca553aa44de5fa059 Author: Mattias Engdegård Date: Sun Sep 29 16:59:20 2024 +0200 Stop using :reverse-video in make-mode * lisp/progmodes/make-mode.el (makefile-space, makefile-makepp-perl): Stop using a long obsolete attribute keyword. diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 87ebe81ca4c..60b87142850 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -83,7 +83,7 @@ (defface makefile-space '((((class color)) (:background "hotpink")) - (t (:reverse-video t))) + (t (:inverse-video t))) "Face to use for highlighting leading spaces in Font-Lock mode.") (defface makefile-targets @@ -102,7 +102,7 @@ (defface makefile-makepp-perl '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book (((class color) (background dark)) (:background "DarkBlue")) - (t (:reverse-video t))) + (t (:inverse-video t))) "Face to use for additionally highlighting Perl code in Font-Lock mode." :version "22.1") commit 8d0c8076c3f2c27bd8ff0dbc72d046c64e1dde44 Author: Mattias Engdegård Date: Sat Sep 28 22:04:19 2024 +0200 Warn about :reverse-video in defface This attribute keyword has been non-working in defface for 14 years, thus warning about it is both safe and decent. * lisp/emacs-lisp/bytecomp.el (bytecomp--check-cus-face-spec): Warn and suggest :inverse-video to be used instead. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-defface-spec): Add a test case. * etc/NEWS: Notify the user. diff --git a/etc/NEWS b/etc/NEWS index 498e8f2db2d..876fd137a4d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -470,6 +470,10 @@ All the characters that belong to the 'symbol' script (according to * Lisp Changes in Emacs 31.1 +--- +** The face attribute ':reverse-video' is obsolete. +Use ':inverse-video' instead. + +++ ** Support interactive D-Bus authorization. A new ':authorizable t' parameter has been added to 'dbus-call-method' diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1c84fe0804b..47df26f01d6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5396,15 +5396,18 @@ FORM is used to provide location, `bytecomp--cus-function' and :underline :overline :strike-through :box :inverse-video :stipple :font ;; FIXME: obsolete keywords, warn about them too? - ;; `:reverse-video' is very rare. :bold ; :bold t = :weight bold :italic ; :italic t = :slant italic - :reverse-video ; alias for :inverse-video )) (when (eq (car-safe val) 'quote) (bytecomp--cus-warn (list val atts sp spec) "Value for face attribute `%s' should not be quoted" attr))) + ((eq attr :reverse-video) + (bytecomp--cus-warn + (list atts sp spec) + (concat "Face attribute `:reverse-video' is obsolete;" + " use `:inverse-video' instead"))) (t (bytecomp--cus-warn (list atts sp spec) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index cce6b1221fc..39c3732581a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -2000,6 +2000,10 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (bytecomp--with-warning-test (rx "`:inverse' is not a valid face attribute keyword") (df '((t (:background "blue" :inverse t))))) ; old attr list syntax + (bytecomp--with-warning-test + (rx "Face attribute `:reverse-video' is obsolete;" + " use `:inverse-video' instead") + (df '((t :background "red" :reverse-video t)))) (bytecomp--with-warning-test (rx "Value for face attribute `:inherit' should not be quoted") (df '((t :inherit 'other)))) commit dfdeee839ac5475a7788707228dcbc998426ad7f Author: Dmitry Gutov Date: Sun Sep 29 04:11:52 2024 +0300 Use directory-name-p in vc-git--file-list-is-rootdir * lisp/vc/vc-git.el (vc-git--file-list-is-rootdir): Use directory-name-p. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2a7c8ae5fc4..05400523048 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -2211,7 +2211,7 @@ The difference to `vc-do-command' is that this function always invokes (let ((file (or (car-safe file-or-list) file-or-list))) (and file - (eq ?/ (aref file (1- (length file)))) + (directory-name-p file) (equal file (vc-git-root file)))))) (defun vc-git--empty-db-p () commit 8d9a4647fbc6c57e82045ecd2b3f157ece399e9e Author: Sean Allred Date: Sun Sep 29 04:00:32 2024 +0300 project--vc-list-files: Use '--sparse' with 'git ls-files' When dealing with exceptionally large Git repositories, the performance of `project-find-file` can suffer dramatically as the list of files is collected for completion. This adds insult to injury when you consider cases where the developer has configured the repository to use a sparse checkout where the vast majority of these files are not even present on disk and are not valid candidates for completion. * lisp/progmodes/project.el (project--vc-list-files): Pass 'sparse' to 'git ls-files' when Git is recent enough. Filter out file names that end with '/' (bug#73320). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b29d5ed5404..599a350e5ce 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -663,7 +663,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (pcase backend (`Git (let* ((default-directory (expand-file-name (file-name-as-directory dir))) - (args '("-z")) + (args '("-z" "-c" "--exclude-standard")) (vc-git-use-literal-pathspecs nil) (include-untracked (project--value-in-dir 'project-vc-include-untracked @@ -671,7 +671,8 @@ See `project-vc-extra-root-markers' for the marker value format.") (submodules (project--git-submodules)) files) (setq args (append args - '("-c" "--exclude-standard") + (and (version<= "2.35" (vc-git--program-version)) + '("--sparse")) (and include-untracked '("-o")))) (when extra-ignores (setq args (append args @@ -703,7 +704,10 @@ See `project-vc-extra-root-markers' for the marker value format.") (delq nil (mapcar (lambda (file) - (unless (member file submodules) + (unless (or (member file submodules) + ;; Should occur for sparse directories + ;; only, when sparse index is enabled. + (directory-name-p file)) (if project-files-relative-names file (concat default-directory file)))) commit c934450d14dacfef5e846a743d9637ba1ec6f5a3 Author: Eli Zaretskii Date: Sat Sep 28 19:53:30 2024 +0300 ; Fix 'python-ts-mode' * lisp/progmodes/python.el (python-ts-mode): Fix setting up 'auto-mode-alist'. (Bug#73531) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 79fd0982115..39efeaf9122 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7219,7 +7219,7 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist '(python--auto-mode-alist-regexp . python-ts-mode)) + (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) (derived-mode-add-parents 'python-ts-mode '(python-mode)) commit a8a3f04f8a7330e0d7e238e32715b4088c9e4275 Merge: c90eb98dab0 e2b01d164cd Author: Eli Zaretskii Date: Sat Sep 28 08:09:32 2024 -0400 Merge from origin/emacs-30 e2b01d164cd ; Fix last changes in php-ts-mode.el commit e2b01d164cddcfda053334f735e099aef86547da Author: Eli Zaretskii Date: Sat Sep 28 15:06:44 2024 +0300 ; Fix last changes in php-ts-mode.el * lisp/progmodes/php-ts-mode.el (php-ts-mode--test-namespace-name-as-prefix-p) (php-ts-mode--test-namespace-aliasing-clause-p) (php-ts-mode--test-namespace-use-group-clause-p): Doc fixes. (treesit-query-compile): Declare. diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index 87aefaf451f..d2559e5a45f 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -77,6 +77,7 @@ (declare-function treesit-parser-included-ranges "treesit.c") (declare-function treesit-parser-list "treesit.c") (declare-function treesit-parser-language "treesit.c") +(declare-function treesit-query-compile "treesit.c") (declare-function treesit-search-forward "treesit.c") (declare-function treesit-node-prev-sibling "treesit.c") (declare-function treesit-node-first-child-for-pos "treesit.c") @@ -774,17 +775,17 @@ characters of the current line." "PHP predefined constant.") (defun php-ts-mode--test-namespace-name-as-prefix-p () - "Return t if the namespace_name_as_prefix keyword is a namded node, nil otherwise." + "Return t if namespace_name_as_prefix keyword is a named node, nil otherwise." (ignore-errors (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) (defun php-ts-mode--test-namespace-aliasing-clause-p () - "Return t if the namespace_name_as_prefix keyword is a namded node, nil otherwise." + "Return t if namespace_name_as_prefix keyword is named node, nil otherwise." (ignore-errors (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) (defun php-ts-mode--test-namespace-use-group-clause-p () - "Return t if the namespace_use_group_clause keyword is a namded node, nil otherwise." + "Return t if namespace_use_group_clause keyword is named node, nil otherwise." (ignore-errors (progn (treesit-query-compile 'php "(namespace_use_group_clause)" t) t))) commit c90eb98dab09ed4fcb33c1e394a1e0b31f53465e Merge: daba97699ba e8830015b07 Author: Eli Zaretskii Date: Sat Sep 28 07:59:16 2024 -0400 Merge from origin/emacs-30 e8830015b07 Require ert-x for use by 'ert-font-lock-deftest-file' a1841b4d8e7 ; * admin/authors.el (authors-aliases): Don't ignore "one... 69d8f9d1b70 Fix php-ts-mode font-lock for latest PHP grammar (bug#73516) 68f53e43488 eieio.texi: Fix bug#73505 53c887fdf6d ; cperl-mode.el: Fix an invalid face specification f5cd5585f46 ; Recommend GNU Find for 'find-dired' 65e589698e6 ; * lisp/filesets.el (filesets-homepage): Fix URL. 1f243a97806 Delete duplicated line in Viper refcard d63bff4d88f Fix Tramp shortdoc integration 759b18a33c0 * lisp/imenu.el (imenu-flatten): More limitations in docs... 794bb2a2e31 remember-data-file: Don't unconditionally call set-visite... 7766ba84199 Align columns in which-key with wide characters properly bd25a98b4e7 bibtex-mode: fix patch bibtex validation for non-file buf... 4729065ee78 Document 'buttonize-region' in manual f189457e5aa ; * lisp/yank-media.el (yank-media-handler): Fix docstrin... 2b53e11a087 Use black-on-white by default for doc-view-svg-face. 32d0c8f6af5 etags-regen-file-extensions: Enable for more extensions 8f265b49e3d ; Fix last change c8ed48b9901 ; Improve documentation of 'append' c1f2501f55d Update and improve UI of sql-read-product (bug#73412) 4f5fc519f09 Insert correct commit data into VC package descriptions 98177d4b3d1 Document reporting security issues in user manual b986e2018a4 * BUGS: Minor copy edit. commit e8830015b0714173a1eca75ea606d88bce1af48b Author: Morgan Willcock Date: Tue Sep 24 20:19:08 2024 +0100 Require ert-x for use by 'ert-font-lock-deftest-file' This fixes a void-function error when 'ert-font-lock-deftest-file' is called when ert-x has not already been loaded. * lisp/emacs-lisp/ert-font-lock.el (ert): Require ert-x so that 'ert-resource-file' is available for use within 'ert-font-lock-deftest-file'. (Bug#73254) diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el index c6fd65e1507..58c6c0311cd 100644 --- a/lisp/emacs-lisp/ert-font-lock.el +++ b/lisp/emacs-lisp/ert-font-lock.el @@ -36,6 +36,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'newcomment) (require 'pcase) commit daba97699ba04256e782dfa4b88805e5f053a90b Author: Manuel Giraud Date: Fri Sep 20 17:52:59 2024 +0200 * etc/images/kitchen-sink.xpm: New file. diff --git a/etc/images/kitchen-sink.xpm b/etc/images/kitchen-sink.xpm new file mode 100644 index 00000000000..407b43996a1 --- /dev/null +++ b/etc/images/kitchen-sink.xpm @@ -0,0 +1,56 @@ +/* XPM */ +static const char *kitchen_sink[] = { +/* columns rows colors chars-per-pixel */ +"48 48 2 2 ", +".. c None", +"## c black", +/* pixels */ +"................................................................................................", +"................................................................................................", +"..................................................................############........######....", +"..........................................................................####........######....", +"..................................................................##########################....", +"................................................................##....................######....", +"..............................................................##....########################....", +"..............................................................##..##..................######....", +"............................................................##########................######....", +"......................................................................................######....", +"......................................................................................######....", +"......................................................................................######....", +"......................................................................................######....", +"............................................................##........##..............######....", +"............................................................####....####..............######....", +"................................................................####..................######....", +"............##################################################################################..", +"..........##..################################################################################..", +"..........##....############################################################################....", +"..........##......########........########################################################......", +"..........##......######..################################################################......", +"..................######..############......####..####..##################################......", +"..................######..####......##..####..##..####..##################################......", +"..........##......######..########..##..####..##..####..##################################......", +"........####......######..########..##..####..##..####..##################################......", +"..........##......########........####..####..####......##################################......", +"..................########################################################################......", +"..................########################################################################......", +"..................############..........##################################################......", +"........##........############..##########################################################......", +"........####......############..##########....##....####......######....######......######......", +"..........##......############........####..##..##..##..####..####..####..##..############......", +"..................############..##########..##..##..##..####..####..##########....########......", +"..................############..##########..######..##..####..####..####..########..######......", +"..................############..........##..######..####....##..####....####......########......", +"..................########################################################################......", +"..........##........####################################################################........", +"..........##..........################################################################..........", +"........####................................####..####..........................................", +"..............................................##..##........########............................", +"..............................................##..##......##........##..........................", +"..............................................##..##....##....####....##........................", +"..............................................##..##....##..##....##..##........................", +"..........##..................................##....####....##....##..##........................", +"..........##....................................##........##......##..##........................", +"........##..##....................................########........##..##........................", +"..................................................................##..##........................", +"................................................................................................" +}; commit c12cb25199ebbb665548a1c3f7ec57a4536b76ad Author: shynur Date: Fri Sep 20 12:15:06 2024 +0000 Enable 'sh-mode' for files created by Bash 'fc' command * lisp/files.el (auto-mode-alist): Recognize bash-fc.XXXX files. (Bug#73380) diff --git a/lisp/files.el b/lisp/files.el index a81f742bbb4..58b5a26a492 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2998,6 +2998,9 @@ since only a single case-insensitive search through the alist is made." ("\\.scm\\.[0-9]*\\'" . scheme-mode) ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) + ;; Bash builtin 'fc' creates a temp file named "bash-fc.XXXXXX" + ;; to edit shell commands from its history list. + ("/bash-fc\\.[0-9A-Za-z]\\{6\\}\\'" . sh-mode) ("/PKGBUILD\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) commit a1841b4d8e72e58d907847887cc0d51cb56b33c3 Author: Eli Zaretskii Date: Sat Sep 28 12:28:24 2024 +0300 ; * admin/authors.el (authors-aliases): Don't ignore "one.last.kiss". diff --git a/admin/authors.el b/admin/authors.el index bcb06953df3..50f3d1ae68d 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -213,7 +213,7 @@ files.") ("Noorul Islam" "Noorul Islam K M") ;;; ("Tetsurou Okazaki" "OKAZAKI Tetsurou") ; FIXME? (nil "odanoburu@") - (nil "one\\.last\\.kiss@outlook\\.com") + ("Xie Qi" "one\\.last\\.kiss@outlook\\.com" "shynur") ("Cao ZhenXiang" "mail@ookami\\.one") ("Óscar Fuentes" "Oscar Fuentes") (nil "pillule") commit 9c994537cfabd327ada70a3aa4204bc5aae6a9a2 Author: Eli Zaretskii Date: Sat Sep 28 12:11:57 2024 +0300 ; Improve documentation of last change * lisp/doc-view.el (doc-view-register-alist) (doc-view-page-to-register, doc-view-jump-to-register): Doc fixes. * etc/NEWS: * doc/emacs/misc.texi (DocView Navigation): Improve wording. (Bug#73293) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e19e554fb26..b074eb034b2 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -593,6 +593,7 @@ can further customize how @code{imenu} items are formatted and displayed using the variables @code{doc-view-imenu-format} and @code{doc-view-imenu-flatten}. +@cindex registers, in DocView mode @findex doc-view-page-to-register @findex doc-view-jump-to-register @kindex m @r{(DocView mode)} @@ -600,7 +601,7 @@ displayed using the variables @code{doc-view-imenu-format} and You can save the current page to a register with @kbd{m} (@code{doc-view-page-to-register}) (@pxref{Registers}). However, these registers are not shared across buffers and stay local to the DocView -buffer. You can later jump to the register with @kbd{'} +buffer. You can later jump to the saved page with @kbd{'} (@code{doc-view-jump-to-register}). @node DocView Searching diff --git a/etc/NEWS b/etc/NEWS index 9bea6588349..498e8f2db2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -346,10 +346,10 @@ DocView now creates a dedicated buffer to display it. 'C-c C-c' gets you back to real DocView buffer if it still exists. +++ -*** New commands to save and restore pages in buffer local registers. -Docview can store current page to buffer local registers with the new -command 'doc-view-page-to-register' (bound to 'm'), and later can be -restored with 'doc-view-jump-to-register' (bound to '''). +*** New commands to save and restore pages in buffer-local registers. +Docview can store current page to buffer-local registers with the new +command 'doc-view-page-to-register' (bound to 'm'), and later the stored +page can be restored with 'doc-view-jump-to-register' (bound to '''). ** Tramp diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 395993e6263..5cbf3040338 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -2476,11 +2476,12 @@ See the command `doc-view-mode' for more information on this mode." (defvar-local doc-view-register-alist nil "Register alist containing only doc-view registers for current buffer. Each doc-view register entry is of the form (doc-view . ALIST) where -ALIST has the keys `buffer', `file', and `page'. `buffer' is the buffer -the `file' is visiting. `page' is the page number to be show.") +ALIST has the keys `buffer', `file', and `page'. The value of `buffer' +is the buffer which visits the file specified by the value of `file'. +The value of `page' is the page stored in the register.") (defun doc-view-page-to-register (register) - "Store the current page to the register REGISTER." + "Store the current page to the specified REGISTER." (interactive (let ((register-alist doc-view-register-alist)) (list (register-read-with-preview "Page to register: ")))) @@ -2493,7 +2494,7 @@ the `file' is visiting. `page' is the page number to be show.") (setq doc-view-register-alist register-alist))) (defun doc-view-jump-to-register (register) - "Jump to the register REGISTER." + "Jump to the specified REGISTER." (interactive (let ((register-alist doc-view-register-alist)) (list (register-read-with-preview "Jump to register: ")))) commit fb3aa693562dd61540d5f1d6f46bcfbd8668853a Author: Visuwesh Date: Sun Sep 15 13:56:21 2024 +0530 Add buffer-local register commands to DocView * lisp/doc-view.el (doc-view-register-alist): New defvar to keep track of buffer-local register-alist. (doc-view-page-to-register, doc-view-jump-to-register): Add new commands to set and jump to buffer-local registers. (register-val-insert, register-val-describe) (register-val-jump-to): Register defmethod to save and restore doc-view registers. (doc-view-mode-map): Bind the new commands. * doc/emacs/misc.texi (DocView Navigation): Document the new commands. (Bug#73293) * etc/NEWS: Announce the change. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index eb157c146e7..e19e554fb26 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -593,6 +593,16 @@ can further customize how @code{imenu} items are formatted and displayed using the variables @code{doc-view-imenu-format} and @code{doc-view-imenu-flatten}. +@findex doc-view-page-to-register +@findex doc-view-jump-to-register +@kindex m @r{(DocView mode)} +@kindex ' @r{(DocView mode)} + You can save the current page to a register with @kbd{m} +(@code{doc-view-page-to-register}) (@pxref{Registers}). However, these +registers are not shared across buffers and stay local to the DocView +buffer. You can later jump to the register with @kbd{'} +(@code{doc-view-jump-to-register}). + @node DocView Searching @subsection DocView Searching diff --git a/etc/NEWS b/etc/NEWS index cc89815082b..9bea6588349 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -345,6 +345,12 @@ When switching to the plain text contents with 'doc-view-open-text', DocView now creates a dedicated buffer to display it. 'C-c C-c' gets you back to real DocView buffer if it still exists. ++++ +*** New commands to save and restore pages in buffer local registers. +Docview can store current page to buffer local registers with the new +command 'doc-view-page-to-register' (bound to 'm'), and later can be +restored with 'doc-view-jump-to-register' (bound to '''). + ** Tramp +++ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 0d89d63e03e..395993e6263 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -556,7 +556,10 @@ Typically \"page-%s.png\".") "C-c C-c" #'doc-view-toggle-display ;; Open a new buffer with doc's text contents "C-c C-t" #'doc-view-open-text - "r" #'revert-buffer) + "r" #'revert-buffer + ;; Registers + "m" #'doc-view-page-to-register + "'" #'doc-view-jump-to-register) (define-obsolete-function-alias 'doc-view-revert-buffer #'revert-buffer "27.1") (defvar revert-buffer-preserve-modes) @@ -2468,6 +2471,55 @@ See the command `doc-view-mode' for more information on this mode." (put 'doc-view-bookmark-jump 'bookmark-handler-type "DocView") +;;; Register integration + +(defvar-local doc-view-register-alist nil + "Register alist containing only doc-view registers for current buffer. +Each doc-view register entry is of the form (doc-view . ALIST) where +ALIST has the keys `buffer', `file', and `page'. `buffer' is the buffer +the `file' is visiting. `page' is the page number to be show.") + +(defun doc-view-page-to-register (register) + "Store the current page to the register REGISTER." + (interactive + (let ((register-alist doc-view-register-alist)) + (list (register-read-with-preview "Page to register: ")))) + (let ((register-alist doc-view-register-alist)) + (set-register register + `(doc-view + (buffer . ,(current-buffer)) + (file . ,(buffer-file-name)) + (page . ,(doc-view-current-page)))) + (setq doc-view-register-alist register-alist))) + +(defun doc-view-jump-to-register (register) + "Jump to the register REGISTER." + (interactive + (let ((register-alist doc-view-register-alist)) + (list (register-read-with-preview "Jump to register: ")))) + (let ((register-alist doc-view-register-alist)) + (jump-to-register register))) + +(cl-defmethod register-val-insert ((val (head doc-view))) + (prin1 val)) + +(cl-defmethod register-val-describe ((val (head doc-view)) _verbose) + (let* ((alist (cdr val)) + (name (or (file-name-nondirectory (alist-get 'file alist)) + (buffer-name (alist-get 'buffer alist))))) + (princ name) + (princ " p. ") + (princ (alist-get 'page alist)))) + +(cl-defmethod register-val-jump-to ((val (head doc-view)) _arg) + (let* ((alist (cdr val)) + (buffer (or (alist-get 'buffer alist) + (find-buffer-visiting (alist-get 'file alist))))) + (unless buffer + (user-error "Cannot find the doc-view buffer to jump to")) + (switch-to-buffer buffer) + (doc-view-goto-page (alist-get 'page alist)))) + ;; Obsolete. (defun doc-view-intersection (l1 l2) commit 69d8f9d1b709de36f45c0ce1dd04b8b30f0fa019 Author: Vincenzo Pupillo Date: Fri Sep 27 13:07:06 2024 +0200 Fix php-ts-mode font-lock for latest PHP grammar (bug#73516) Version 0.23 of the PHP grammar introduced some changes that affect the font lock. * lisp/progmodes/php-ts-mode.el (php-ts-mode--language-source-alist): Update php, html, js and css grammars version. (php-ts-mode--parent-html-heuristic): Fix docstring (php-ts-mode--test-namespace-name-as-prefix-p): New function. (php-ts-mode--test-namespace-aliasing-clause-p): New function. (php-ts-mode--test-namespace-use-group-clause-p): New function. (php-ts-mode--font-lock-settings): Use the new functions. diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el index 3f89de14075..87aefaf451f 100644 --- a/lisp/progmodes/php-ts-mode.el +++ b/lisp/progmodes/php-ts-mode.el @@ -83,12 +83,12 @@ ;;; Install treesitter language parsers (defvar php-ts-mode--language-source-alist - '((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.22.8" "php/src")) + '((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.23.0" "php/src")) (phpdoc . ("https://github.com/claytonrcarter/tree-sitter-phpdoc")) - (html . ("https://github.com/tree-sitter/tree-sitter-html" "v0.20.3")) - (javascript . ("https://github.com/tree-sitter/tree-sitter-javascript" "v0.21.2")) - (jsdoc . ("https://github.com/tree-sitter/tree-sitter-jsdoc" "v0.21.0")) - (css . ("https://github.com/tree-sitter/tree-sitter-css" "v0.21.0"))) + (html . ("https://github.com/tree-sitter/tree-sitter-html" "v0.23.0")) + (javascript . ("https://github.com/tree-sitter/tree-sitter-javascript" "v0.23.0")) + (jsdoc . ("https://github.com/tree-sitter/tree-sitter-jsdoc" "v0.23.0")) + (css . ("https://github.com/tree-sitter/tree-sitter-css" "v0.23.0"))) "Treesitter language parsers required by `php-ts-mode'. You can customize this variable if you want to stick to a specific commit and/or use different parsers.") @@ -490,7 +490,7 @@ characters of the current line." (treesit-node-start parent))))) (defun php-ts-mode--parent-html-heuristic (node parent _bol &rest _) - "Returns position based on html indentation. + "Return position based on html indentation. Returns 0 if the NODE is after the , otherwise returns the indentation point of the last word before the NODE, plus the @@ -773,6 +773,21 @@ characters of the current line." "__FUNCTION__" "__LINE__" "__METHOD__" "__NAMESPACE__" "__TRAIT__") "PHP predefined constant.") +(defun php-ts-mode--test-namespace-name-as-prefix-p () + "Return t if the namespace_name_as_prefix keyword is a namded node, nil otherwise." + (ignore-errors + (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) + +(defun php-ts-mode--test-namespace-aliasing-clause-p () + "Return t if the namespace_name_as_prefix keyword is a namded node, nil otherwise." + (ignore-errors + (progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t))) + +(defun php-ts-mode--test-namespace-use-group-clause-p () + "Return t if the namespace_use_group_clause keyword is a namded node, nil otherwise." + (ignore-errors + (progn (treesit-query-compile 'php "(namespace_use_group_clause)" t) t))) + (defun php-ts-mode--font-lock-settings () "Tree-sitter font-lock settings." (treesit-font-lock-rules @@ -866,7 +881,7 @@ characters of the current line." :language 'php :feature 'definition :override t - '((php_tag) @font-lock-preprocessor-face + `((php_tag) @font-lock-preprocessor-face ("?>") @font-lock-preprocessor-face ;; Highlights identifiers in declarations. (class_declaration @@ -889,10 +904,16 @@ characters of the current line." ("=>") @font-lock-keyword-face (object_creation_expression (name) @font-lock-type-face) - (namespace_name_as_prefix "\\" @font-lock-delimiter-face) - (namespace_name_as_prefix (namespace_name (name)) @font-lock-type-face) - (namespace_use_clause (name) @font-lock-property-use-face) - (namespace_aliasing_clause (name) @font-lock-type-face) + ,@(when (php-ts-mode--test-namespace-name-as-prefix-p) + '((namespace_name_as_prefix "\\" @font-lock-delimiter-face) + (namespace_name_as_prefix + (namespace_name (name)) @font-lock-type-face))) + ,@(if (php-ts-mode--test-namespace-aliasing-clause-p) + '((namespace_aliasing_clause (name) @font-lock-type-face)) + '((namespace_use_clause alias: (name) @font-lock-type-face))) + ,@(when (not (php-ts-mode--test-namespace-use-group-clause-p)) + '((namespace_use_group + (namespace_use_clause (name) @font-lock-type-face)))) (namespace_name "\\" @font-lock-delimiter-face) (namespace_name (name) @font-lock-type-face) (use_declaration (name) @font-lock-property-use-face)) @@ -931,8 +952,10 @@ characters of the current line." :language 'php :feature 'base-clause :override t - '((base_clause (name) @font-lock-type-face) + `((base_clause (name) @font-lock-type-face) (use_as_clause (name) @font-lock-property-use-face) + ,@(when (not (php-ts-mode--test-namespace-name-as-prefix-p)) + '((qualified_name prefix: "\\" @font-lock-delimiter-face))) (qualified_name (name) @font-lock-constant-face)) :language 'php commit bba14a27678317eee68e87a343e7314b3949f6c7 Author: Mattias Engdegård Date: Fri Sep 27 11:48:14 2024 +0200 Warn about bad face specs in `defface` at compile time * lisp/emacs-lisp/bytecomp.el (byte-compile--custom-declare-face): Byte-compile `defface` forms, or the byte-compile handler won't be called. (bytecomp--check-cus-face-spec): New. (bytecomp--custom-declare): Call it. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test-defface-spec): New tests. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 88167fc7ebd..1c84fe0804b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2713,7 +2713,7 @@ Call from the source buffer." (let ((newdocs (byte-compile--docstring docs kind name))) (unless (eq docs newdocs) (setq form (byte-compile--list-with-n form 3 newdocs))))) - form)) + (byte-compile-keep-pending form))) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -5361,6 +5361,56 @@ FORM is used to provide location, `bytecomp--cus-function' and (bytecomp--cus-warn type "`%s' is not a valid type" type)) ))) +(defun bytecomp--check-cus-face-spec (spec) + "Check for mistakes in a `defface' SPEC argument." + (when (consp spec) + (dolist (sp spec) + (let ((display (car-safe sp)) + (atts (cdr-safe sp))) + (cond ((listp display) + (dolist (condition display) + (unless (memq (car-safe condition) + '(type class background min-colors supports)) + (bytecomp--cus-warn + (list sp spec) + "Bad face display condition `%S'" (car condition))))) + ((not (memq display '(t default))) + (bytecomp--cus-warn + (list sp spec) "Bad face display `%S'" display))) + (when (and (consp atts) (null (cdr atts))) + (setq atts (car atts))) ; old (DISPLAY ATTS) syntax + (while atts + (let ((attr (car atts)) + (val (cadr atts))) + (cond + ((not (keywordp attr)) + (bytecomp--cus-warn + (list atts sp spec) + "Non-keyword in face attribute list: `%S'" attr)) + ((null (cdr atts)) + (bytecomp--cus-warn + (list atts sp spec) "Missing face attribute `%s' value" attr)) + ((memq attr '( :inherit :extend + :family :foundry :width :height :weight :slant + :foreground :distant-foreground :background + :underline :overline :strike-through :box + :inverse-video :stipple :font + ;; FIXME: obsolete keywords, warn about them too? + ;; `:reverse-video' is very rare. + :bold ; :bold t = :weight bold + :italic ; :italic t = :slant italic + :reverse-video ; alias for :inverse-video + )) + (when (eq (car-safe val) 'quote) + (bytecomp--cus-warn + (list val atts sp spec) + "Value for face attribute `%s' should not be quoted" attr))) + (t + (bytecomp--cus-warn + (list atts sp spec) + "`%s' is not a valid face attribute keyword" attr)))) + (setq atts (cddr atts))))))) + ;; Unified handler for multiple functions with similar arguments: ;; (NAME SOMETHING DOC KEYWORD-ARGS...) (byte-defop-compiler-1 define-widget bytecomp--custom-declare) @@ -5394,6 +5444,13 @@ FORM is used to provide location, `bytecomp--cus-function' and (eq (car-safe type-arg) 'quote)) (bytecomp--check-cus-type (cadr type-arg))))))) + (when (eq fun 'custom-declare-face) + (let ((face-arg (nth 2 form))) + (when (and (eq (car-safe face-arg) 'quote) + (consp (cdr face-arg)) + (null (cddr face-arg))) + (bytecomp--check-cus-face-spec (nth 1 face-arg))))) + ;; Check :group (when (cond ((memq fun '(custom-declare-variable custom-declare-face)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e3ce87cc9af..cce6b1221fc 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1985,6 +1985,32 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (dc 'integerp)) )) +(ert-deftest bytecomp-test-defface-spec () + (cl-flet ((df (spec) `(defface mytest ',spec "doc" :group 'test))) + (bytecomp--with-warning-test + (rx "Bad face display condition `max-colors'") + (df '((((class color grayscale) (max-colors 75) (background light)) + :foreground "cyan")))) + (bytecomp--with-warning-test + (rx "Bad face display `defualt'") + (df '((defualt :foreground "cyan")))) + (bytecomp--with-warning-test + (rx "`:inverse' is not a valid face attribute keyword") + (df '((t :background "blue" :inverse t)))) + (bytecomp--with-warning-test + (rx "`:inverse' is not a valid face attribute keyword") + (df '((t (:background "blue" :inverse t))))) ; old attr list syntax + (bytecomp--with-warning-test + (rx "Value for face attribute `:inherit' should not be quoted") + (df '((t :inherit 'other)))) + (bytecomp--with-warning-test + (rx "Missing face attribute `:extend' value") + (df '((t :foundry "abc" :extend)))) + (bytecomp--with-warning-test + (rx "Non-keyword in face attribute list: `\"green\"'") + (df '((t :foreground "white" "green")))) + )) + (ert-deftest bytecomp-function-attributes () ;; Check that `byte-compile' keeps the declarations, interactive spec and ;; doc string of the function (bug#55830). commit 09d63ba32bbd0ddbd8c9deb4fcfe8e4356ea0e8d Author: Mattias Engdegård Date: Fri Sep 27 12:58:32 2024 +0200 * lisp/custom.el (defface): Add missing attributes to doc string. diff --git a/lisp/custom.el b/lisp/custom.el index c049e8f8be0..a806059d0dd 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -461,10 +461,10 @@ Each DISPLAY can have the following values: `display-supports-face-attributes-p' for more information on exactly how testing is done. -In the ATTS property list, possible attributes are `:family', -`:width', `:height', `:weight', `:slant', `:underline', -`:overline', `:strike-through', `:box', `:foreground', -`:background', `:stipple', `:inverse-video', and `:inherit'. +In the ATTS property list, possible attributes are `:family', `:font', +`:foundry', `:width', `:height', `:weight', `:slant', `:underline', +`:overline', `:strike-through', `:box', `:foreground', `:distant-foreground', +`:background', `:stipple', `:inverse-video', `:extend', and `:inherit'. See Info node `(elisp) Faces' in the Emacs Lisp manual for more information." commit 68f53e43488648a7508444736d16f90fed248ef5 Author: Stefan Monnier Date: Fri Sep 27 10:35:18 2024 -0400 eieio.texi: Fix bug#73505 * doc/misc/eieio.texi (Introduction): Remove "missing features" which aren't missing any more. (Generics, Methods): Delete sections. (Inheritance): Adjust reference accordingly. (Static Methods): Merge into the parent node. (Writing Methods): Refer to the ELisp manual for `cl-defmethod/defgeneric`. diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 02cb51e6fdd..039588b311d 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -232,12 +232,6 @@ and you cannot define your own. The @code{:metaclass} tag in should return instances of the metaclass, behave differently in @eieio{} in that they return symbols or plain structures instead. -@item EQL specialization -EIEIO does not support it. - -@item @code{:around} method tag -This CLOS method tag is non-functional. - @item :default-initargs in @code{defclass} Each slot can have an @code{:initform} tag, so this is not really necessary. @@ -381,7 +375,7 @@ name, then the superclass showing up in the list first defines the slot attributes. Inheritance in @eieio{} is more than just combining different slots. -It is also important in method invocation. @ref{Methods}. +It is also important in method invocation. @ref{Writing Methods}. If a method is called on an instance of @code{my-subclass}, and that method only has an implementation on @code{my-baseclass}, or perhaps @@ -810,158 +804,19 @@ variable name of the same name as the slot. @node Writing Methods @chapter Writing Methods -Writing a method in @eieio{} is similar to writing a function. The -differences are that there are some extra options and there can be +Writing a method in @eieio{} is similar to writing a function. +The differences are that there are some extra options and there can be multiple definitions under the same function symbol. -Where a method defines an implementation for a particular data type, a -@dfn{generic method} accepts any argument, but contains no code. It -is used to provide the dispatching to the defined methods. A generic -method has no body, and is merely a symbol upon which methods are -attached. It also provides the base documentation for what methods -with that name do. - -@menu -* Generics:: -* Methods:: -* Static Methods:: -@end menu - -@node Generics -@section Generics - -Each @eieio{} method has one corresponding generic. This generic -provides a function binding and the base documentation for the method -symbol (@pxref{Symbol Components,,,elisp,GNU Emacs Lisp Reference -Manual}). - -@defmac cl-defgeneric method arglist [doc-string] -This macro turns the (unquoted) symbol @var{method} into a function. -@var{arglist} is the default list of arguments to use (not implemented -yet). @var{doc-string} is the documentation used for this symbol. - -A generic function acts as a placeholder for methods. There is no -need to call @code{cl-defgeneric} yourself, as @code{cl-defmethod} will call -it if necessary. Currently the argument list is unused. - -@code{cl-defgeneric} signals an error if you attempt to turn an existing -Emacs Lisp function into a generic function. - -You can also create a generic method with @code{cl-defmethod} -(@pxref{Methods}). When a method is created and there is no generic -method in place with that name, then a new generic will be created, -and the new method will use it. -@end defmac - -@node Methods -@section Methods - -A method is a function that is executed if the arguments passed -to it matches the method's specializers. Different @eieio{} classes may -share the same method names. - -Methods are created with the @code{cl-defmethod} macro, which is similar -to @code{defun}. - -@defmac cl-defmethod method [:before | :around | :after ] arglist [doc-string] forms - -@var{method} is the name of the function to create. - -@code{:before}, @code{:around}, and @code{:after} specify execution order -(i.e., when this form is called). If none of these symbols are present, the -method is said to be a @emph{primary}. - -@var{arglist} is the list of arguments to this method. The mandatory arguments -in this list may have a type specializer (see the example below) which means -that the method will only apply when those arguments match the given type -specializer. An argument with no type specializer means that the method -applies regardless of its value. - -@var{doc-string} is the documentation attached to the implementation. -All method doc-strings are incorporated into the generic method's -function documentation. - -@var{forms} is the body of the function. - -@end defmac - -@noindent -In the following example, we create a method @code{mymethod} for the -@code{classname} class: - -@example -(cl-defmethod mymethod ((obj classname) secondarg) - "Doc string" ) -@end example - -@noindent -This method only executes if the @var{obj} argument passed to it is an -@eieio{} object of class @code{classname}. - -A method with no type specializer is a @dfn{default method}. If a given -class has no implementation, then the default method is called when -that method is used on a given object of that class. - -Only one method per combination of specializers and qualifiers (@code{:before}, -@code{:around}, or @code{:after}) is kept. If two @code{cl-defmethod}s appear -with the same specializers and the same qualifiers, then the second -implementation replaces the first. - -When a method is called on an object, but there is no method specified -for that object, but there is a method specified for object's parent -class, the parent class's method is called. If there is a method -defined for both, only the child's method is called. A child method -may call a parent's method using @code{cl-call-next-method}, described -below. - -If multiple methods and default methods are defined for the same -method and class, they are executed in this order: - -@enumerate -@item :around methods -The most specific @code{:around} method is called first, which may invoke the -less specific ones via @code{cl-call-next-method}. If it doesn't invoke -@code{cl-call-next-method}, then no other methods will be executed. When there -are no more @code{:around} methods to call, falls through to run the other -(non-@code{:around}) methods. -@item :before methods -Called in sequence from most specific to least specific. -@item primary methods -The most specific method is called, which may invoke the less specific -ones via @code{cl-call-next-method}. -@item :after methods -Called in sequence from least specific to most specific. -@end enumerate - -If no methods exist, Emacs signals a @code{cl-no-applicable-method} error. -@xref{Signals}. If methods exist but none of them are primary, Emacs -signals a @code{cl-no-primary-method} error. @xref{Signals}. - -@defun cl-call-next-method &rest replacement-args -@anchor{cl-call-next-method} - -This function calls the superclass method from a subclass method. -This is the ``next method'' specified in the current method list. - -If @var{replacement-args} is non-@code{nil}, then use them instead of the -arguments originally provided to the method. - -Can only be used from within the lexical body of a primary or around method. -@end defun - -@defun cl-next-method-p -@anchor{cl-next-method-p} -Non-@code{nil} if there is a next method. - -Can only be used from within the lexical body of a primary or around method. -@end defun - -@node Static Methods -@section Static Methods +You do it using Emacs Lisp's built-in support for CLOS-style generic +functions via the @code{cl-defgeneric} and @code{cl-defmethod} macros +(@pxref{Generic Functions,,,elisp,GNU Emacs Lisp Reference Manual}). -Static methods do not depend on an object instance, but instead -operate on a class. You can create a static method by using -the @code{subclass} specializer with @code{cl-defmethod}: +EIEIO provides one extension to @code{cl-defmethod} to allow mathods to +dispatch on a class argument: so-called ``static'' methods do not depend +on an object instance, but instead operate on a class. You can create +a static method by using the @code{subclass} specializer with +@code{cl-defmethod}: @example (cl-defmethod make-instance ((class (subclass mychild)) &rest args) commit 0a1628bf69086f85f9b983e2e62660fc90b6d568 Author: Alan Mackenzie Date: Fri Sep 27 13:42:40 2024 +0000 CC Mode: Parse C++ lambda functions more correctly This fixes bug#72695. * lisp/progmodes/cc-align.el (c-lineup-topmost-intro-cont): Do not indent further a line following a closing brace of a requires clause. * lisp/progmodes/cc-engine.el (c-forward-keyword-clause): Separate the handling of "any-paren-kwds" into "type-paren-kwds" and "nontype-paren-kwds", simplifying the handling of the latter. (c-forward-primary-expression): Recognize (...) followed by { as a primary expression. (c-looking-at-or-maybe-in-bracelist): No longer recognize an enum list as a brace list. Remove the handling of enum lists. (c-looking-at-c++-lambda-expression) (c-backward-over-lambda-expression): New functions. (c-c++-vsemi-p): Don't recognize the end of requires clauses as virtual semicolons. (c-guess-basic-syntax): CASE 5U - new cond arm to recognize being after a requires clause. These lines now get syntax topmost-intro-cont rather than topmost-intro, and their anchor positions are now on the topmost-intro line rather than the previous topmost-intro-cont. Throughout the file: simplify handling of c-fun-name-substitute-key, where there is no need to check for a following _ character, and introduce c-requires-clause-key for greater accuracy in parsing, even though both of these are just "requires". * lisp/progmodes/cc-fonts.el (c-get-fontification-context): Tidy up the handling of c-fun-name-substitue-key, as in cc-engine.el. * lisp/progmodes/cc-langs.el (c-lambda-spec-kwds) (c-lambda-spec-key): New lang vars. (c-fun-name-substitute-key): Now an adorned expression. (c-requires-clause-kwds, c-requires-clause-key): New lang vars. diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 8384749789e..f2edf6f5f06 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -91,7 +91,10 @@ Works with: topmost-intro-cont." (c-backward-syntactic-ws (c-langelem-pos langelem)) (if (and (memq (char-before) '(?} ?,)) (not (and c-overloadable-operators-regexp - (c-after-special-operator-id)))) + (c-after-special-operator-id))) + (or (not (eq (char-before) ?})) + (not (eq (cdr-safe (c-in-requires-or-at-end-of-clause)) + t)))) c-basic-offset)))) (defun c-lineup-gnu-DEFUN-intro-cont (langelem) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index aeb82e0703e..f6c255dfab1 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8668,7 +8668,7 @@ multi-line strings (but not C++, for example)." (c-forward-syntactic-ws) (c-forward-id-comma-list ref t t)) - ((and (c-keyword-member kwd-sym 'c-paren-any-kwds) + ((and (c-keyword-member kwd-sym 'c-paren-type-kwds) (eq (char-after) ?\()) ;; There's an open paren after a keyword in `c-paren-any-kwds'. @@ -8689,6 +8689,12 @@ multi-line strings (but not C++, for example)." (setq safe-pos (point))) (c-forward-syntactic-ws)) + ((c-keyword-member kwd-sym 'c-paren-nontype-kwds) + (when (and (eq (char-after) ?\() + (c-go-list-forward)) + (setq safe-pos (point)) + (c-forward-syntactic-ws))) + ((and (c-keyword-member kwd-sym 'c-<>-sexp-kwds) (eq (char-after) ?<) (c-forward-<>-arglist (c-keyword-member kwd-sym 'c-<>-type-kwds))) @@ -9893,9 +9899,6 @@ point unchanged and return nil." ;; ;; Note that this function is incomplete, handling only those cases expected ;; to be common in a C++20 requires clause. - ;; - ;; Note also that (...) is not recognized as a primary expression if the - ;; next token is an open brace. (let ((here (point)) (c-restricted-<>-arglists t) (c-parse-and-markup-<>-arglists nil) @@ -9908,12 +9911,10 @@ point unchanged and return nil." ((eq (char-after) ?\() (and (c-go-list-forward (point) limit) (eq (char-before) ?\)) - (let ((after-paren (point))) - (c-forward-syntactic-ws limit) - (prog1 - (not (eq (char-after) ?{)) - (when stop-at-end - (goto-char after-paren)))))) + (progn + (unless stop-at-end + (c-forward-syntactic-ws limit)) + t))) ((c-forward-over-compound-identifier) (let ((after-id (point))) (c-forward-syntactic-ws limit) @@ -9932,9 +9933,7 @@ point unchanged and return nil." (c-forward-over-compound-identifier) (c-forward-syntactic-ws limit)))))) (goto-char after-id))) - ((and - (looking-at c-fun-name-substitute-key) ; "requires" - (not (eq (char-after (match-end 0)) ?_))) + ((looking-at c-fun-name-substitute-key) ; "requires" (goto-char (match-end 1)) (c-forward-syntactic-ws limit) (and @@ -10186,9 +10185,7 @@ point unchanged and return nil." ((looking-at c-type-decl-suffix-key) (cond ((save-match-data - (and - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))) + (looking-at c-requires-clause-key)) (c-forward-c++-requires-clause)) ((eq (char-after) ?\() (if (c-forward-decl-arglist not-top decorated limit) @@ -10645,10 +10642,8 @@ This function might do hidden buffer changes." (c-forward-keyword-clause 1) (when (and (c-major-mode-is 'c++-mode) (c-keyword-member kwd-sym 'c-<>-sexp-kwds) - (save-match-data - (and - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_))))) + (save-match-data ; Probably unnecessary (2024-09-20) + (looking-at c-requires-clause-key))) (c-forward-c++-requires-clause)) (setq kwd-clause-end (point)))) ((and c-opt-cpp-prefix @@ -11006,9 +11001,7 @@ This function might do hidden buffer changes." ((save-match-data (looking-at "\\s(")) (c-safe (c-forward-sexp 1) t)) ((save-match-data - (and - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))) ; C++ requires + (looking-at c-requires-clause-key)) (c-forward-c++-requires-clause)) (t (goto-char (match-end 1)) t)) @@ -13169,229 +13162,218 @@ comment at the start of cc-engine.el for more info." ;; ;; Here, "brace list" does not include the body of an enum. (save-excursion - (let ((start (point)) - (braceassignp 'dontknow) - inexpr-brace-list bufpos macro-start res pos after-type-id-pos - pos2 in-paren parens-before-brace - paren-state paren-pos) + (unless (and (c-major-mode-is 'c++-mode) + (c-backward-over-lambda-expression lim)) + (let ((start (point)) + (braceassignp 'dontknow) + inexpr-brace-list bufpos macro-start res pos after-type-id-pos + pos2 in-paren paren-state paren-pos) - (setq res - (or (progn (c-backward-syntactic-ws) - (c-back-over-compound-identifier)) - (c-backward-token-2 1 t lim))) - ;; Checks to do only on the first sexp before the brace. - ;; Have we a C++ initialization, without an "="? - (if (and (c-major-mode-is 'c++-mode) - (cond - ((and (or (not (memq res '(t 0))) - (eq (char-after) ?,)) - (setq paren-state (c-parse-state)) - (setq paren-pos (c-pull-open-brace paren-state)) - (eq (char-after paren-pos) ?\()) - (goto-char paren-pos) - (setq braceassignp 'c++-noassign - in-paren 'in-paren)) - ((looking-at c-pre-brace-non-bracelist-key) - (setq braceassignp nil)) - ((and - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_))) - (setq braceassignp nil)) - ((looking-at c-return-key)) - ((and (looking-at c-symbol-start) - (not (looking-at c-keywords-regexp))) - (if (save-excursion - (and (zerop (c-backward-token-2 1 t lim)) - (looking-at c-pre-id-bracelist-key))) - (setq braceassignp 'c++-noassign) - (setq after-type-id-pos (point)))) - ((eq (char-after) ?\() - (setq parens-before-brace t) - ;; Have we a requires with a parenthesis list? - (when (save-excursion - (and (zerop (c-backward-token-2 1 nil lim)) - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))) - (setq braceassignp nil)) - nil) - (t nil)) - (save-excursion + (setq res + (or (progn (c-backward-syntactic-ws) + (c-back-over-compound-identifier)) + (c-backward-token-2 1 t lim))) + ;; Checks to do only on the first sexp before the brace. + ;; Have we a C++ initialization, without an "="? + (if (and (c-major-mode-is 'c++-mode) (cond - ((or (not (memq res '(t 0))) - (eq (char-after) ?,)) - (and (setq paren-state (c-parse-state)) + ((and (or (not (memq res '(t 0))) + (eq (char-after) ?,)) + (setq paren-state (c-parse-state)) (setq paren-pos (c-pull-open-brace paren-state)) - (eq (char-after paren-pos) ?\() - (setq in-paren 'in-paren) - (goto-char paren-pos))) - ((looking-at c-pre-brace-non-bracelist-key)) + (eq (char-after paren-pos) ?\()) + (goto-char paren-pos) + (setq braceassignp 'c++-noassign + in-paren 'in-paren)) + ((looking-at c-pre-brace-non-bracelist-key) + (setq braceassignp nil)) + ((looking-at c-fun-name-substitute-key) + (setq braceassignp nil)) ((looking-at c-return-key)) ((and (looking-at c-symbol-start) - (not (looking-at c-keywords-regexp)) - (save-excursion - (and (zerop (c-backward-token-2 1 t lim)) - (looking-at c-pre-id-bracelist-key))))) - (t (setq after-type-id-pos (point)) - nil)))) - (setq braceassignp 'c++-noassign)) - - (when (and c-opt-inexpr-brace-list-key - (eq (char-after) ?\[)) - ;; In Java, an initialization brace list may follow - ;; directly after "new Foo[]", so check for a "new" - ;; earlier. - (while (eq braceassignp 'dontknow) - (setq braceassignp - (cond ((/= (c-backward-token-2 1 t lim) 0) nil) - ((looking-at c-opt-inexpr-brace-list-key) - (setq inexpr-brace-list t) - t) - ((looking-at "\\sw\\|\\s_\\|[.[]") - ;; Carry on looking if this is an - ;; identifier (may contain "." in Java) - ;; or another "[]" sexp. - 'dontknow) - (t nil))))) + (not (looking-at c-keywords-regexp))) + (if (save-excursion + (and (zerop (c-backward-token-2 1 t lim)) + (looking-at c-pre-id-bracelist-key))) + (setq braceassignp 'c++-noassign) + (setq after-type-id-pos (point)))) + ((eq (char-after) ?\() + ;; Have we a requires with a parenthesis list? + (when (save-excursion + (and (zerop (c-backward-token-2 1 nil lim)) + (looking-at c-fun-name-substitute-key))) + (setq braceassignp nil)) + nil) + (t nil)) + (save-excursion + (cond + ((or (not (memq res '(t 0))) + (eq (char-after) ?,)) + (and (setq paren-state (c-parse-state)) + (setq paren-pos (c-pull-open-brace paren-state)) + (eq (char-after paren-pos) ?\() + (setq in-paren 'in-paren) + (goto-char paren-pos))) + ((looking-at c-pre-brace-non-bracelist-key)) + ((looking-at c-return-key)) + ((and (looking-at c-symbol-start) + (not (looking-at c-keywords-regexp)) + (save-excursion + (and (zerop (c-backward-token-2 1 t lim)) + (looking-at c-pre-id-bracelist-key))))) + (t (setq after-type-id-pos (point)) + nil)))) + (setq braceassignp 'c++-noassign)) + + (when (and c-opt-inexpr-brace-list-key + (eq (char-after) ?\[)) + ;; In Java, an initialization brace list may follow + ;; directly after "new Foo[]", so check for a "new" + ;; earlier. + (while (eq braceassignp 'dontknow) + (setq braceassignp + (cond ((/= (c-backward-token-2 1 t lim) 0) nil) + ((looking-at c-opt-inexpr-brace-list-key) + (setq inexpr-brace-list t) + t) + ((looking-at "\\sw\\|\\s_\\|[.[]") + ;; Carry on looking if this is an + ;; identifier (may contain "." in Java) + ;; or another "[]" sexp. + 'dontknow) + (t nil))))) - (setq pos (point)) - (cond - ((not braceassignp) - nil) - ((and after-type-id-pos - (goto-char after-type-id-pos) - (setq res (c-back-over-member-initializers)) - (goto-char res) - (eq (car (c-beginning-of-decl-1 lim)) 'same)) - (cons (point) nil)) ; Return value. - - ((and after-type-id-pos - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?\())) - ;; Single identifier between '(' and '{'. We have a bracelist. - (cons after-type-id-pos 'in-paren)) + (setq pos (point)) + (cond + ((not braceassignp) + nil) + ((and after-type-id-pos + (goto-char after-type-id-pos) + (setq res (c-back-over-member-initializers)) + (goto-char res) + (eq (car (c-beginning-of-decl-1 lim)) 'same)) + (cons (point) nil)) ; Return value. - ;; Are we at the parens of a C++ lambda expression? - ((and parens-before-brace - (save-excursion - (and - (zerop (c-backward-token-2 1 t lim)) - (c-looking-at-c++-lambda-capture-list)))) - nil) ; a lambda expression isn't a brace list. + ((and after-type-id-pos + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\())) + ;; Single identifier between '(' and '{'. We have a bracelist. + (cons after-type-id-pos 'in-paren)) - (t - (goto-char pos) - (when (eq braceassignp 'dontknow) - (let* ((cache-entry (and containing-sexp - (c-laomib-get-cache containing-sexp pos))) - (lim2 (or (cadr cache-entry) lim)) - sub-bassign-p) - (if cache-entry - (cond - ((<= (point) (cadr cache-entry)) - ;; We're inside the region we've already scanned over, so - ;; just go to that scan's end position. - (goto-char (nth 2 cache-entry)) - (setq braceassignp (nth 3 cache-entry))) - ((> (point) (cadr cache-entry)) - ;; We're beyond the previous scan region, so just scan as - ;; far as the end of that region. - (setq sub-bassign-p (c-laomib-loop lim2)) - (if (<= (point) (cadr cache-entry)) - (progn - (c-laomib-put-cache containing-sexp - start (nth 2 cache-entry) - (nth 3 cache-entry) ;; sub-bassign-p - ) - (setq braceassignp (nth 3 cache-entry)) - (goto-char (nth 2 cache-entry))) - (c-laomib-put-cache containing-sexp - start (point) sub-bassign-p) - (setq braceassignp sub-bassign-p))) - (t)) - - (setq braceassignp (c-laomib-loop lim)) - (when lim - (c-laomib-put-cache lim start (point) braceassignp))))) + (t + (goto-char pos) + (when (eq braceassignp 'dontknow) + (let* ((cache-entry (and containing-sexp + (c-laomib-get-cache containing-sexp pos))) + (lim2 (or (cadr cache-entry) lim)) + sub-bassign-p) + (if cache-entry + (cond + ((<= (point) (cadr cache-entry)) + ;; We're inside the region we've already scanned over, so + ;; just go to that scan's end position. + (goto-char (nth 2 cache-entry)) + (setq braceassignp (nth 3 cache-entry))) + ((> (point) (cadr cache-entry)) + ;; We're beyond the previous scan region, so just scan as + ;; far as the end of that region. + (setq sub-bassign-p (c-laomib-loop lim2)) + (if (<= (point) (cadr cache-entry)) + (progn + (c-laomib-put-cache containing-sexp + start (nth 2 cache-entry) + (nth 3 cache-entry) ;; sub-bassign-p + ) + (setq braceassignp (nth 3 cache-entry)) + (goto-char (nth 2 cache-entry))) + (c-laomib-put-cache containing-sexp + start (point) sub-bassign-p) + (setq braceassignp sub-bassign-p))) + (t)) + + (setq braceassignp (c-laomib-loop lim)) + (when lim + (c-laomib-put-cache lim start (point) braceassignp))))) - (cond - (braceassignp - ;; We've hit the beginning of the aggregate list. - (setq pos2 (point)) - (cons - (if (eq (c-beginning-of-statement-1 containing-sexp) 'same) - (point) - pos2) - (or in-paren inexpr-brace-list))) - ((and after-type-id-pos - (save-excursion - (when (eq (char-after) ?\;) - (c-forward-over-token-and-ws t)) - (setq bufpos (point)) - (when (looking-at c-opt-<>-sexp-key) - (c-forward-over-token-and-ws) - (when (and (eq (char-after) ?<) - (c-get-char-property (point) 'syntax-table)) - (c-go-list-forward nil after-type-id-pos) - (c-forward-syntactic-ws))) - (if (and (not (eq (point) after-type-id-pos)) - (or (not (looking-at c-class-key)) - (save-excursion - (goto-char (match-end 1)) - (c-forward-syntactic-ws) - (not (eq (point) after-type-id-pos))))) - (progn - (setq res - (c-forward-decl-or-cast-1 (c-point 'bosws) - nil nil)) - (and (consp res) - (cond - ((eq (car res) after-type-id-pos)) - ((> (car res) after-type-id-pos) nil) - (t - (catch 'find-decl + (cond + (braceassignp + ;; We've hit the beginning of the aggregate list. + (setq pos2 (point)) + (cons + (if (eq (c-beginning-of-statement-1 containing-sexp) 'same) + (point) + pos2) + (or in-paren inexpr-brace-list))) + ((and after-type-id-pos + (save-excursion + (when (eq (char-after) ?\;) + (c-forward-over-token-and-ws t)) + (setq bufpos (point)) + (when (looking-at c-opt-<>-sexp-key) + (c-forward-over-token-and-ws) + (when (and (eq (char-after) ?<) + (c-get-char-property (point) 'syntax-table)) + (c-go-list-forward nil after-type-id-pos) + (c-forward-syntactic-ws))) + (if (and (not (eq (point) after-type-id-pos)) + (or (not (looking-at c-class-key)) (save-excursion - (goto-char (car res)) - (c-do-declarators - (point-max) t nil nil - (lambda (id-start _id-end _tok _not-top _func _init) - (cond - ((> id-start after-type-id-pos) - (throw 'find-decl nil)) - ((eq id-start after-type-id-pos) - (throw 'find-decl t))))) - nil)))))) - (save-excursion - (goto-char start) - (not (c-looking-at-statement-block)))))) - (cons bufpos (or in-paren inexpr-brace-list))) - ((or (eq (char-after) ?\;) - ;; Brace lists can't contain a semicolon, so we're done. - (save-excursion - (c-backward-syntactic-ws) - (eq (char-before) ?})) - ;; They also can't contain a bare }, which is probably the end - ;; of a function. - ) - nil) - ((and (setq macro-start (point)) - (c-forward-to-cpp-define-body) - (eq (point) start)) - ;; We've a macro whose expansion starts with the '{'. - ;; Heuristically, if we have a ';' in it we've not got a - ;; brace list, otherwise we have. - (let ((macro-end (progn (c-end-of-macro) (point)))) - (goto-char start) - (forward-char) - (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t) - (eq (char-before) ?\;)) - nil - (cons macro-start nil)))) ; (2016-08-30): Lazy! We have no + (goto-char (match-end 1)) + (c-forward-syntactic-ws) + (not (eq (point) after-type-id-pos))))) + (progn + (setq res + (c-forward-decl-or-cast-1 (c-point 'bosws) + nil nil)) + (and (consp res) + (cond + ((eq (car res) after-type-id-pos)) + ((> (car res) after-type-id-pos) nil) + (t + (catch 'find-decl + (save-excursion + (goto-char (car res)) + (c-do-declarators + (point-max) t nil nil + (lambda (id-start _id-end _tok _not-top _func _init) + (cond + ((> id-start after-type-id-pos) + (throw 'find-decl nil)) + ((eq id-start after-type-id-pos) + (throw 'find-decl t))))) + nil)))))) + (save-excursion + (goto-char start) + (not (c-looking-at-statement-block)))))) + (cons bufpos (or in-paren inexpr-brace-list))) + ((or (eq (char-after) ?\;) + ;; Brace lists can't contain a semicolon, so we're done. + (save-excursion + (c-backward-syntactic-ws) + (eq (char-before) ?})) + ;; They also can't contain a bare }, which is probably the end + ;; of a function. + ) + nil) + ((and (setq macro-start (point)) + (c-forward-to-cpp-define-body) + (eq (point) start)) + ;; We've a macro whose expansion starts with the '{'. + ;; Heuristically, if we have a ';' in it we've not got a + ;; brace list, otherwise we have. + (let ((macro-end (progn (c-end-of-macro) (point)))) + (goto-char start) + (forward-char) + (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t) + (eq (char-before) ?\;)) + nil + (cons macro-start nil)))) ; (2016-08-30): Lazy! We have no ; languages where ; `c-opt-inexpr-brace-list-key' is ; non-nil and we have macros. - (t t)))) ;; The caller can go up one level. - ))) + (t t)))) ;; The caller can go up one level. + )))) (defun c-inside-bracelist-p (containing-sexp paren-state accept-in-paren) ;; return the buffer position of the beginning of the brace list statement @@ -13637,7 +13619,7 @@ comment at the start of cc-engine.el for more info." nil)) ((progn (goto-char req-pos) - (if (looking-at c-fun-name-substitute-key) + (if (looking-at c-requires-clause-key) (setq found-clause (c-forward-c++-requires-clause nil t)) (and (c-forward-concept-fragment) (setq found-clause (point)))) @@ -13848,18 +13830,84 @@ comment at the start of cc-engine.el for more info." (looking-at c-pre-lambda-tokens-re))) (not (c-in-literal)))) +(defun c-looking-at-c++-lambda-expression (&optional lim) + ;; If point is at the [ opening a C++ lambda expressions's capture list, + ;; and the lambda expression is complete, return the position of the { which + ;; opens the body form, otherwise return nil. LIM is the limit for forward + ;; searching for the {. + (let ((here (point)) + (lim-or-max (or lim (point-max))) + got-params) + (when (and (c-looking-at-c++-lambda-capture-list) + (c-go-list-forward nil lim)) + (c-forward-syntactic-ws lim) + (when (c-forward-<>-arglist t) + (c-forward-syntactic-ws lim) + (when (looking-at c-requires-clause-key) + (c-forward-c++-requires-clause lim nil))) + (when (looking-at "\\(alignas\\)\\([^a-zA-Z0-9_$]\\|$\\)") + (c-forward-keyword-clause 1)) + (when (and (eq (char-after) ?\() + (c-go-list-forward nil lim)) + (setq got-params t) + (c-forward-syntactic-ws lim)) + (while (and c-lambda-spec-key (looking-at c-lambda-spec-key)) + (goto-char (match-end 1)) + (c-forward-syntactic-ws lim)) + (let (after-except-pos) + (while + (and (<= (point) lim-or-max) + (cond + ((save-excursion + (and (looking-at "throw\\([^a-zA-Z0-9_]\\|$\\)") + (progn (goto-char (match-beginning 1)) + (c-forward-syntactic-ws lim) + (eq (char-after) ?\()) + (c-go-list-forward nil lim) + (progn (c-forward-syntactic-ws lim) + (setq after-except-pos (point))))) + (goto-char after-except-pos) + (c-forward-syntactic-ws lim) + t) + ((looking-at c-paren-nontype-key) ; "noexcept" or "alignas" + (c-forward-keyword-clause 1)))))) + (and (<= (point) lim-or-max) + (looking-at c-haskell-op-re) + (goto-char (match-end 0)) + (progn (c-forward-syntactic-ws lim) + (c-forward-type t))) ; t is BRACE-BLOCK-TOO. + (and got-params + (<= (point) lim-or-max) + (looking-at c-requires-clause-key) + (c-forward-c++-requires-clause lim nil)) + (prog1 (and (<= (point) lim-or-max) + (eq (char-after) ?{) + (point)) + (goto-char here))))) + +(defun c-backward-over-lambda-expression (&optional lim) + ;; Point is at a {. Move back over the lambda expression this is a part of, + ;; stopping at the [ of the capture list, if this is the case, returning + ;; the position of that opening bracket. If we're not at such a list, leave + ;; point unchanged and return nil. + (let ((here (point))) + (c-syntactic-skip-backward "^;}]" lim t) + (if (and (eq (char-before) ?\]) + (c-go-list-backward nil lim) + (eq (c-looking-at-c++-lambda-expression (1+ here)) + here)) + (point) + (goto-char here) + nil))) + (defun c-c++-vsemi-p (&optional pos) ;; C++ Only - Is there a "virtual semicolon" at POS or point? ;; (See cc-defs.el for full details of "virtual semicolons".) ;; ;; This is true when point is at the last non syntactic WS position on the - ;; line, and either there is a "macro with semicolon" just before it (see - ;; `c-at-macro-vsemi-p') or there is a "requires" clause which ends there. - (let (res) - (cond - ((setq res (c-in-requires-or-at-end-of-clause pos)) - (and res (eq (cdr res) t))) - ((c-at-macro-vsemi-p))))) + ;; line, and there is a "macro with semicolon" just before it (see + ;; `c-at-macro-vsemi-p'). + (c-at-macro-vsemi-p pos)) (defun c-at-macro-vsemi-p (&optional pos) ;; Is there a "virtual semicolon" at POS or point? @@ -14849,7 +14897,6 @@ comment at the start of cc-engine.el for more info." (progn (c-backward-syntactic-ws lim) (zerop (c-backward-token-2 nil nil lim))) (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)) (setq placeholder (point)))) (goto-char placeholder) (back-to-indentation) @@ -15275,6 +15322,15 @@ comment at the start of cc-engine.el for more info." ;; NOTE: The point is at the end of the previous token here. + ;; CASE 5U: We are just after a requires clause. + ((and (setq placeholder (c-in-requires-or-at-end-of-clause)) + (eq (cdr-safe placeholder) t)) + (goto-char (car placeholder)) + (c-beginning-of-statement-1 + (or (c-safe-position (point) paren-state) + (c-determine-limit 1000))) + (c-add-syntax 'topmost-intro-cont (point))) + ;; CASE 5J: we are at the topmost level, make ;; sure we skip back past any access specifiers ((and @@ -15818,8 +15874,7 @@ comment at the start of cc-engine.el for more info." (c-go-list-backward nil lim)) (progn (c-backward-syntactic-ws lim) (zerop (c-backward-token-2 nil nil lim))) - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))) + (looking-at c-fun-name-substitute-key))) (goto-char containing-sexp) (back-to-indentation) (c-add-stmt-syntax 'defun-close nil t lim paren-state)) @@ -15983,8 +16038,7 @@ comment at the start of cc-engine.el for more info." (c-go-list-backward nil lim)) (progn (c-backward-syntactic-ws lim) (zerop (c-backward-token-2 nil nil lim))) - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))) + (looking-at c-fun-name-substitute-key))) (goto-char containing-sexp) (back-to-indentation) (c-add-syntax 'defun-block-intro (point))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 64694444ffd..0f086f8e812 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1389,8 +1389,7 @@ casts and declarations are fontified. Used on level 2 and higher." (memq type '(c-decl-arg-start c-decl-type-start)))))))) ((and (zerop (c-backward-token-2)) - (looking-at c-fun-name-substitute-key) - (not (eq (char-after (match-end 0)) ?_)))))))))) + (looking-at c-fun-name-substitute-key))))))))) ;; Cache the result of this test for next time around. (c-put-char-property (1- match-pos) 'c-type 'c-decl-arg-start) (cons 'decl nil)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index c93ca2fafc9..010b0ed6b04 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2673,6 +2673,19 @@ will be handled." t (c-make-keywords-re t (c-lang-const c-equals-type-clause-kwds))) (c-lang-defvar c-equals-type-clause-key (c-lang-const c-equals-type-clause-key)) +(c-lang-defconst c-lambda-spec-kwds + "Keywords which are specifiers of certain elements of a C++ lambda function. +This is only used in C++ Mode." + t nil + c++ '("mutable" "constexpr" "consteval" "static")) + +(c-lang-defconst c-lambda-spec-key + ;; A regular expression which matches a member of `c-lambda-spec-kwds', + ;; or nil. + t (if (c-lang-const c-lambda-spec-kwds) + (c-make-keywords-re t (c-lang-const c-lambda-spec-kwds)))) +(c-lang-defvar c-lambda-spec-key (c-lang-const c-lambda-spec-key)) + (c-lang-defconst c-equals-nontype-decl-kwds "Keywords which are followed by an identifier then an \"=\" sign, which declares the identifier to be something other than a @@ -2691,20 +2704,33 @@ type." (c-lang-defconst c-fun-name-substitute-kwds "Keywords which take the place of type+declarator at the beginning of a function-like structure, such as a C++20 \"requires\" -clause. An arglist may or may not follow such a keyword." +expression. An arglist may or may not follow such a keyword. +Not to be confused with `c-requires-clause-kwds'." t nil c++ '("requires")) (c-lang-defconst c-fun-name-substitute-key ;; An unadorned regular expression which matches any member of ;; `c-fun-name-substitute-kwds'. - t (c-make-keywords-re 'appendable (c-lang-const c-fun-name-substitute-kwds))) + t (c-make-keywords-re t (c-lang-const c-fun-name-substitute-kwds))) ;; We use 'appendable, so that we get "\\>" on the regexp, but without a further ;; character, which would mess up backward regexp search from just after the ;; keyword. If only XEmacs had \\_>. ;-( (c-lang-defvar c-fun-name-substitute-key (c-lang-const c-fun-name-substitute-key)) +(c-lang-defconst c-requires-clause-kwds + "Keywords which introduce a C++ requires clause, or something analogous. +This should not be confused with `c-fun-name-substitute-kwds'." + t nil + c++ '("requires")) + +(c-lang-defconst c-requires-clause-key + ;; A regexp matching any member of `c-requires-clause-kwds'. + t (c-make-keywords-re t (c-lang-const c-requires-clause-kwds))) +;; See `c-fun-name-substitute-key' for the justification of appendable. +(c-lang-defvar c-requires-clause-key (c-lang-const c-requires-clause-key)) + (c-lang-defconst c-modifier-kwds "Keywords that can prefix normal declarations of identifiers \(and typically act as flags). Things like argument declarations commit d98a2b70d730308d91e7cdd1940ee4a1ac273a54 Author: Michael Albinus Date: Fri Sep 27 09:33:51 2024 +0200 * lisp/mail/emacsbug.el (submit-emacs-patch): Insert empty X-Debbugs-Cc (Bug##57877) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index e89e66cc7cb..a58be4dccf0 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -532,6 +532,8 @@ Message buffer where you can explain more about the patch." (view-mode 1) (button-mode 1)) (compose-mail-other-window report-emacs-bug-address subject) + (rfc822-goto-eoh) + (insert "X-Debbugs-Cc: \n") (message-goto-body) (insert "\n\n\n") (emacs-build-description) commit 57c552b8b9071b137451299534bd870616b952e9 Author: Eli Zaretskii Date: Fri Sep 27 09:19:19 2024 +0300 ; * src/cm.c (cmgoto): Fix last change. diff --git a/src/cm.c b/src/cm.c index e1014af5298..8eb799c9eb6 100644 --- a/src/cm.c +++ b/src/cm.c @@ -317,7 +317,7 @@ losecursor (void) #define USELL 2 #define USECR 3 -/* Move the cursor to (row, col), by computing the optimal way. */ +/* Move the cursor to (ROW, COL), by computing the optimal way. */ void cmgoto (struct tty_display_info *tty, int row, int col) commit bfbed2f3ee40ac6dba46e80d1665a820d64ba091 Author: Jeremy Bryant Date: Wed Sep 25 22:28:04 2024 +0100 ; * src/cm.c (cmgoto): Add function documentation (bug#73487). diff --git a/src/cm.c b/src/cm.c index ad419ce0af1..e1014af5298 100644 --- a/src/cm.c +++ b/src/cm.c @@ -317,6 +317,8 @@ losecursor (void) #define USELL 2 #define USECR 3 +/* Move the cursor to (row, col), by computing the optimal way. */ + void cmgoto (struct tty_display_info *tty, int row, int col) { commit ff4082284a06de319a3c4e5ed1144f15f5226eca Author: Eli Zaretskii Date: Fri Sep 27 08:49:46 2024 +0300 ; * lisp/emacs-lisp/easy-mmode.el (easy-mmode--prev): Doc fix. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 7a94d832273..db00e929ea9 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -764,7 +764,7 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." ;;; (defun easy-mmode--prev (re name count &optional endfun narrowfun) - "Go to the previous COUNT'th occurence of RE. + "Go to the COUNT'th previous occurence of RE. If none, error with NAME. commit 8e08e37166fbd3f99c895a9d2cea24939d75ac9b Author: Eli Zaretskii Date: Fri Sep 27 08:47:13 2024 +0300 ; * etc/NEWS: Fix recently added entry. diff --git a/etc/NEWS b/etc/NEWS index 76c58c0f269..cc89815082b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -371,10 +371,10 @@ This is useful to undo or revert changes, committed and uncommitted, when you are in buffers generated by 'C-x v =' and 'C-x v D'. --- -*** diff-file-prev and diff-hunk-prev reliably move to start of header. -Previously, diff-file-prev and diff-hunk-prev would move when point is -after the corresponding file or hunk header, but not when inside it. -Now they will reliably move to the start of the current header. +*** 'diff-file-prev' and 'diff-hunk-prev' always move to start of header. +Previously, 'diff-file-prev' and 'diff-hunk-prev' would move when point +is after the corresponding file or hunk header, but not when inside it. +Now they will always move to the start of the current header. ** php-ts-mode commit 42eb2265e64c4615f4a6111afc80ee25c782ef1e Author: Eli Zaretskii Date: Fri Sep 27 08:44:35 2024 +0300 ; * lisp/progmodes/python.el (python-interpreter): Fix :version. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 2b11aaf524e..79fd0982115 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -322,7 +322,7 @@ Some Python interpreters also require changes to To customize the Python interpreter for interactive use, modify `python-shell-interpreter' instead." - :version "30.1" + :version "31.1" :type 'string) (defcustom python-interpreter-args "" commit bdfeb45bfcf1bf29a820d3086f007d07147b0598 Author: Stefan Kangas Date: Fri Sep 27 07:11:22 2024 +0200 Bind "J" to bookmark-jump in bookmark-bmenu-mode * lisp/bookmark.el (bookmark-bmenu-mode-map): Bind "J" to bookmark-jump. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 223a7fedc8d..d43f9f740ca 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1857,6 +1857,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." "a" #'bookmark-bmenu-show-annotation "A" #'bookmark-bmenu-show-all-annotations "e" #'bookmark-bmenu-edit-annotation + "J" #'bookmark-jump "/" #'bookmark-bmenu-search "" #'bookmark-bmenu-other-window-with-mouse) commit 7f0a252f2160dd4d168bc77e2f6e6c9901b67465 Author: Stefan Kangas Date: Thu Sep 26 17:11:56 2024 +0200 Prefer python3 for python-interpreter * lisp/progmodes/python.el (python-interpreter): Prefer "python3" when it exists, to be consistent with python-shell-interpreter. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index be76390c680..2b11aaf524e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -312,14 +312,17 @@ :version "24.3" :link '(emacs-commentary-link "python")) -(defcustom python-interpreter "python" +(defcustom python-interpreter + (cond ((executable-find "python3") "python3") + ((executable-find "python") "python") + (t "python3")) "Python interpreter for noninteractive use. Some Python interpreters also require changes to `python-interpreter-args'. To customize the Python interpreter for interactive use, modify `python-shell-interpreter' instead." - :version "29.1" + :version "30.1" :type 'string) (defcustom python-interpreter-args "" commit e776903b31cf2b2d21d91cbc7d6b7dbc1e9d442f Author: Spencer Baugh Date: Tue Sep 10 14:18:39 2024 -0400 Move to start of current header in diff-{file,hunk}-prev If point was after a file or hunk header, the diff-file-prev and diff-hunk-prev commands would move to the start of that header. But if point was *within* the header, they would not move, and would report "No previous file" or "No previous hunk". This differs from the behavior of most other movement commands, e.g. backward-sexp or backward-sentence. This commit fixes diff-file-prev and diff-hunk-prev, as well as other easy-mmode-define-navigation BASE-prev commands. Now these commands move to the start of the containing "thing" just like other movement commands. * lisp/emacs-lisp/easy-mmode.el (easy-mmode--prev): Move to start of current match first. (bug#73172) * etc/NEWS: Document the behavior change. diff --git a/etc/NEWS b/etc/NEWS index 85504afa1a4..76c58c0f269 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -370,6 +370,12 @@ hunk), and then removes the hunk from the diffs. This is useful to undo or revert changes, committed and uncommitted, when you are in buffers generated by 'C-x v =' and 'C-x v D'. +--- +*** diff-file-prev and diff-hunk-prev reliably move to start of header. +Previously, diff-file-prev and diff-hunk-prev would move when point is +after the corresponding file or hunk header, but not when inside it. +Now they will reliably move to the start of the current header. + ** php-ts-mode --- diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index d3dcab899d6..7a94d832273 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -772,6 +772,17 @@ ENDFUN and NARROWFUN are treated like in `easy-mmode-define-navigation'." (unless count (setq count 1)) (if (< count 0) (easy-mmode--next re name (- count) endfun narrowfun) (let ((re-narrow (and narrowfun (prog1 (buffer-narrowed-p) (widen))))) + ;; If point is inside a match for RE, move to its beginning like + ;; `backward-sexp' and other movement commands. + (when (and (not (zerop count)) + (save-excursion + ;; Make sure we're out of the current match if any. + (goto-char (if (re-search-backward re nil t 1) + (match-end 0) (point-min))) + (re-search-forward re nil t 1)) + (< (match-beginning 0) (point) (match-end 0))) + (goto-char (match-beginning 0)) + (setq count (1- count))) (unless (re-search-backward re nil t count) (user-error "No previous %s" name)) (when re-narrow (funcall narrowfun))))) commit da1416fc6998718d1e36e32961b4415045949632 Author: Spencer Baugh Date: Tue Sep 10 13:46:18 2024 -0400 Move easy-mmode-define-navigation logic to helper functions The functions defined by easy-mmode-define-navigation are useful even if the easy-mmode-define-navigation macro is not used. Let's take a step towards exposing them by moving them out as helpers. This also makes the macro much easier to modify and work on. * lisp/emacs-lisp/easy-mmode.el (easy-mmode--prev) (easy-mmode--next): Add (bug#73172). (easy-mmode-define-navigation): Use easy-mmode--prev and easy-mmode--next. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index a140027839e..d3dcab899d6 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -763,6 +763,48 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." ;;; easy-mmode-define-navigation ;;; +(defun easy-mmode--prev (re name count &optional endfun narrowfun) + "Go to the previous COUNT'th occurence of RE. + +If none, error with NAME. + +ENDFUN and NARROWFUN are treated like in `easy-mmode-define-navigation'." + (unless count (setq count 1)) + (if (< count 0) (easy-mmode--next re name (- count) endfun narrowfun) + (let ((re-narrow (and narrowfun (prog1 (buffer-narrowed-p) (widen))))) + (unless (re-search-backward re nil t count) + (user-error "No previous %s" name)) + (when re-narrow (funcall narrowfun))))) + +(defun easy-mmode--next (re name count &optional endfun narrowfun) + "Go to the next COUNT'th occurence of RE. + +If none, error with NAME. + +ENDFUN and NARROWFUN are treated like in `easy-mmode-define-navigation'." + (unless count (setq count 1)) + (if (< count 0) (easy-mmode--prev re name (- count) endfun narrowfun) + (if (looking-at re) (setq count (1+ count))) + (let ((re-narrow (and narrowfun (prog1 (buffer-narrowed-p) (widen))))) + (if (not (re-search-forward re nil t count)) + (if (looking-at re) + (goto-char (or (if endfun (funcall endfun)) (point-max))) + (user-error "No next %s" name)) + (goto-char (match-beginning 0)) + (when (and (eq (current-buffer) (window-buffer)) + (called-interactively-p 'interactive)) + (let ((endpt (or (save-excursion + (if endfun (funcall endfun) + (re-search-forward re nil t 2))) + (point-max)))) + (unless (pos-visible-in-window-p endpt nil t) + (let ((ws (window-start))) + (recenter '(0)) + (if (< (window-start) ws) + ;; recenter scrolled in the wrong direction! + (set-window-start nil ws))))))) + (when re-narrow (funcall narrowfun))))) + (defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun &rest body) "Define BASE-next and BASE-prev to navigate in the buffer. @@ -780,53 +822,23 @@ BODY is executed after moving to the destination location." (let* ((base-name (symbol-name base)) (prev-sym (intern (concat base-name "-prev"))) (next-sym (intern (concat base-name "-next"))) - (when-narrowed - (lambda (body) - (if (null narrowfun) body - `(let ((was-narrowed (prog1 (buffer-narrowed-p) (widen)))) - ,body - (when was-narrowed (funcall #',narrowfun))))))) + (endfun (when endfun `#',endfun)) + (narrowfun (when narrowfun `#',narrowfun))) (unless name (setq name base-name)) - ;; FIXME: Move most of those functions's bodies to helper functions! `(progn (defun ,next-sym (&optional count) ,(format "Go to the next COUNT'th %s. Interactively, COUNT is the prefix numeric argument, and defaults to 1." name) (interactive "p") - (unless count (setq count 1)) - (if (< count 0) (,prev-sym (- count)) - (if (looking-at ,re) (setq count (1+ count))) - ,(funcall when-narrowed - `(if (not (re-search-forward ,re nil t count)) - (if (looking-at ,re) - (goto-char (or ,(if endfun `(funcall #',endfun)) (point-max))) - (user-error "No next %s" ,name)) - (goto-char (match-beginning 0)) - (when (and (eq (current-buffer) (window-buffer)) - (called-interactively-p 'interactive)) - (let ((endpt (or (save-excursion - ,(if endfun `(funcall #',endfun) - `(re-search-forward ,re nil t 2))) - (point-max)))) - (unless (pos-visible-in-window-p endpt nil t) - (let ((ws (window-start))) - (recenter '(0)) - (if (< (window-start) ws) - ;; recenter scrolled in the wrong direction! - (set-window-start nil ws)))))))) - ,@body)) + (easy-mmode--next ,re ,name count ,endfun ,narrowfun) + ,@body) (put ',next-sym 'definition-name ',base) (defun ,prev-sym (&optional count) ,(format "Go to the previous COUNT'th %s. -Interactively, COUNT is the prefix numeric argument, and defaults to 1." - (or name base-name)) +Interactively, COUNT is the prefix numeric argument, and defaults to 1." name) (interactive "p") - (unless count (setq count 1)) - (if (< count 0) (,next-sym (- count)) - ,(funcall when-narrowed - `(unless (re-search-backward ,re nil t count) - (user-error "No previous %s" ,name))) - ,@body)) + (easy-mmode--prev ,re ,name count ,endfun ,narrowfun) + ,@body) (put ',prev-sym 'definition-name ',base)))) ;; When deleting these two, also delete them from loaddefs-gen.el. commit c95620ffbf8c2caebdb6a7aba7dbe9cd223fa2f4 Author: Stefan Monnier Date: Thu Sep 26 17:03:28 2024 -0400 (pcase-tests-quote-optimization): Fix warning * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-quote-optimization): Fix confusing code. diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index e777b71920c..5f2927d1aff 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -85,7 +85,7 @@ (`(,_ . ,_) (BAR)) ('(a b) (FOO)))))) (let ((exp1 (macroexpand '(pcase EXP - (`(`(,(or 'a1 'b1)) (FOO1))) + (`((,(or 'a1 'b1))) (FOO1)) ('(c) (FOO2)) ('(d) (FOO3)))))) (should (= 1 (with-temp-buffer (prin1 exp1 (current-buffer)) commit 4591d93a8e5e79e7fea8a67c84c6adf0ea8add28 Author: Stefan Monnier Date: Thu Sep 26 16:40:54 2024 -0400 * lisp/emacs-lisp/pcase.el (pcase--expand-\`): Improve warning message And also move the warning "out of the way" so it doesn't confuse optimizations. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index fe62820f0cb..898d460c144 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1172,12 +1172,13 @@ The predicate is the logical-AND of: (upatd (pcase--expand-\` (cdr qpat)))) (if (and (eq (car-safe upata) 'quote) (eq (car-safe upatd) 'quote)) `'(,(cadr upata) . ,(cadr upatd)) - `(and ,@(when (eq (car qpat) '\`) - `((guard ,(macroexp-warn-and-return - "Nested ` are not supported" t nil nil qpat)))) - (pred consp) + `(and (pred consp) (app car-safe ,upata) - (app cdr-safe ,upatd))))) + (app cdr-safe ,upatd) + ,@(when (eq (car qpat) '\`) + `((guard ,(macroexp-warn-and-return + "Nested ` are not supported in Pcase patterns" + t nil nil qpat)))))))) ((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat) ;; In all other cases just raise an error so we can't break ;; backward compatibility when adding \` support for other commit 37bed70f4c0a2e33de238eab90d7470d34366f13 Author: Sean Whitton Date: Thu Sep 26 20:02:05 2024 +0100 ; * etc/NEWS: Don't say that C-c M-r can undo whole commits. diff --git a/etc/NEWS b/etc/NEWS index cdc7f47b7a9..85504afa1a4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -366,8 +366,9 @@ command attempts to look up and copy the text in-between the hunks. +++ *** New command 'diff-revert-and-kill-hunk' bound to C-c M-r. This command reverts the hunk at point (i.e., applies the reverse of the -hunk), and then removes the hunk from the diffs. This is useful to undo -commits when you are in buffers generated by 'C-x v =' and 'C-x v D'. +hunk), and then removes the hunk from the diffs. +This is useful to undo or revert changes, committed and uncommitted, when +you are in buffers generated by 'C-x v =' and 'C-x v D'. ** php-ts-mode commit b9d103c16e9299f2bd8f1f8a5b5cc75a1295c29f Author: Gerd Möllmann Date: Thu Sep 26 17:35:38 2024 +0200 ; Fix build error with last change in python.el diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index cfa71fc3a74..be76390c680 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -293,6 +293,7 @@ (autoload 'comint-mode "comint") (autoload 'help-function-arglist "help-fns") +;;;###autoload (defconst python--auto-mode-alist-regexp (rx "." (or "py" "pth" ; Python Path Configuration File commit 2f485e68ff96cc66a17df2c0a58e272bbfc24765 Author: Stefan Kangas Date: Thu Sep 26 17:04:31 2024 +0200 Add Python "*.pth" files to auto-mode-alist * lisp/progmodes/python.el (python--auto-mode-alist-regexp): New variable. (auto-mode-alist, python-ts-mode): Use above new variable. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6a258892f16..cfa71fc3a74 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -293,8 +293,15 @@ (autoload 'comint-mode "comint") (autoload 'help-function-arglist "help-fns") +(defconst python--auto-mode-alist-regexp + (rx "." (or "py" + "pth" ; Python Path Configuration File + "pyi" ; Python Stub File (PEP 484) + "pyw") ; MS-Windows specific extension + eos)) + ;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode)) +(add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode)) @@ -7208,7 +7215,7 @@ implementations: `python-mode' and `python-ts-mode'." (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) + (add-to-list 'auto-mode-alist '(python--auto-mode-alist-regexp . python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) (derived-mode-add-parents 'python-ts-mode '(python-mode)) commit 4c567892e044ada0e09889ec520fefa07f52b20b Author: Andrea Corallo Date: Thu Sep 26 16:15:04 2024 +0200 * Clean-up unused condition-case * lisp/emacs-lisp/comp.el (comp--native-compile): Remove unused condition-case. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9447f68c362..f1c8f02ebc3 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3583,7 +3583,6 @@ the deferred compilation mechanism." do (comp-log (format "Pass %s took: %fs." pass time) 0)))) - (native-compiler-skip) (t (let ((err-val (cdr err))) ;; If we are doing an async native compilation print the commit 53c887fdf6ddd907a411d063fee69bfdc2a5757a Author: Harald Jörg Date: Thu Sep 26 15:20:01 2024 +0200 ; cperl-mode.el: Fix an invalid face specification * lisp/progmodes/cperl-mode.el (cperl-method-call): Avoid doubly quoting the parent face. This made htmlize-buffer fail. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3353bffdf05..e129e2df552 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6225,7 +6225,7 @@ default function." (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) (defface cperl-method-call - '((t (:inherit 'default ))) + '((t (:inherit default ))) "Font Lock mode face for method calls. Usually, method calls are not fontified. We use this face to prevent calls to methods which look like commit c86e7a29e78e75b487ea36f0711f327f66f93c10 Author: Eli Zaretskii Date: Thu Sep 26 14:24:18 2024 +0300 ; Fix documentation of last change * lisp/vc/diff-mode.el (diff-ask-before-revert-and-kill-hunk): Add ':version' tag. (diff-revert-and-kill-hunk, diff-apply-buffer): Doc fixes. * etc/NEWS: * doc/emacs/files.texi (Diff Mode): Fix last change; add indexing. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index b7d6b6f9f7b..a3a8c854aa6 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1675,6 +1675,7 @@ In a multi-file patch, kill the current file part. @findex diff-apply-hunk @cindex patches, applying +@cindex reverse-apply diffs @item C-c C-a Apply this hunk to its target file (@code{diff-apply-hunk}). With a prefix argument of @kbd{C-u}, revert this hunk, i.e.@: apply the @@ -1684,18 +1685,18 @@ hunk to the ``old'' version of the file instead. @findex diff-revert-and-kill-hunk @item C-c M-r -Reverse-apply this hunk to the target file, and then kill it +Revert this hunk, and then remove the hunk from the diffs (@code{diff-revert-and-kill-hunk}). Save the buffer visiting the target file. This command is useful in buffers generated by @w{@kbd{C-x v =}} and @w{@kbd{C-x v D}} (@pxref{Old Revisions}). These buffers present you -with a view of the changes you've made, and then you can use this -command to drop changes you didn't intend, or no longer want. +with a view of the changes you've made, and you can use this command to +undo changes you didn't intend to do, or no longer want. This is a destructive operation, so by default, this command asks you to -confirm you really want to reverse-apply and kill the hunk. You can -customize @code{diff-ask-before-revert-and-kill-hunk} to change that. +confirm you really want to revert and kill the hunk. You can customize +@code{diff-ask-before-revert-and-kill-hunk} to control that. @findex diff-apply-buffer @item C-c @key{RET} a diff --git a/etc/NEWS b/etc/NEWS index feadc54c17a..cdc7f47b7a9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -365,8 +365,9 @@ command attempts to look up and copy the text in-between the hunks. +++ *** New command 'diff-revert-and-kill-hunk' bound to C-c M-r. -This command reverse-applies the hunk at point, and then kills it. -This is useful in buffers generated by C-x v = and C-x v D. +This command reverts the hunk at point (i.e., applies the reverse of the +hunk), and then removes the hunk from the diffs. This is useful to undo +commits when you are in buffers generated by 'C-x v =' and 'C-x v D'. ** php-ts-mode diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index c59c0954ae1..25c6238765d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2055,7 +2055,8 @@ With a prefix argument, try to REVERSE the hunk." (defcustom diff-ask-before-revert-and-kill-hunk t "If non-nil, `diff-revert-and-kill-hunk' will ask for confirmation." - :type 'boolean) + :type 'boolean + :version "31.1") (defun diff-revert-and-kill-hunk () "Reverse-apply and then kill the hunk at point. Save changed buffer. @@ -2068,7 +2069,7 @@ to permanently drop changes you didn't intend, or no longer want. This is a destructive operation, so by default, this command asks you to confirm you really want to reverse-apply and kill the hunk. You can -customize `diff-ask-before-revert-and-kill-hunk' to change that." +customize `diff-ask-before-revert-and-kill-hunk' to control that." (interactive) (when (or (not diff-ask-before-revert-and-kill-hunk) (yes-or-no-p "Really reverse-apply and kill this hunk?")) @@ -2078,11 +2079,11 @@ customize `diff-ask-before-revert-and-kill-hunk' to change that." (defun diff-apply-buffer (&optional beg end reverse) "Apply the diff in the entire diff buffer. -When applying all hunks was successful, then save the changed buffers. +If applying all hunks succeeds, save the changed buffers. When called from Lisp with optional arguments, restrict the application -to hunks lying between BEG and END, and reverse-apply when REVERSE is -non-nil. Returns nil if buffers were saved, or the number of failed -applications." +to hunks lying between BEG and END, and reverse-apply them when REVERSE is +non-nil. Returns nil if buffers were successfully modified and saved, or +the number of failed hunk applications otherwise." (interactive) (let ((buffer-edits nil) (failures 0) commit f2e3e563d4909ff503bb2d3aeb6d2de9804e3047 Author: Sean Whitton Date: Tue Sep 24 09:38:43 2024 +0100 New command diff-revert-and-kill-hunk * lisp/vc/diff-mode.el (diff-revert-and-kill-hunk): New command (bug#73407). (diff-ask-before-revert-and-kill-hunk): New user option. (diff-apply-buffer): New optional BEG, END and REVERSE arguments. Return nil if buffers were saved, or the number of failed applications. (diff-mode-map): Bind the new command to C-c M-r. (diff-mode-menu): New entry for the new command. * doc/emacs/files.texi (Diff Mode): * etc/NEWS: Document the change. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 709cb0910e6..b7d6b6f9f7b 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1682,6 +1682,21 @@ reverse of the hunk, which changes the ``new'' version into the ``old'' version. If @code{diff-jump-to-old-file} is non-@code{nil}, apply the hunk to the ``old'' version of the file instead. +@findex diff-revert-and-kill-hunk +@item C-c M-r +Reverse-apply this hunk to the target file, and then kill it +(@code{diff-revert-and-kill-hunk}). Save the buffer visiting the target +file. + +This command is useful in buffers generated by @w{@kbd{C-x v =}} and +@w{@kbd{C-x v D}} (@pxref{Old Revisions}). These buffers present you +with a view of the changes you've made, and then you can use this +command to drop changes you didn't intend, or no longer want. + +This is a destructive operation, so by default, this command asks you to +confirm you really want to reverse-apply and kill the hunk. You can +customize @code{diff-ask-before-revert-and-kill-hunk} to change that. + @findex diff-apply-buffer @item C-c @key{RET} a Apply all the hunks in the buffer (@code{diff-apply-buffer}). If the diff --git a/etc/NEWS b/etc/NEWS index 2241f0f9a4a..feadc54c17a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -363,6 +363,11 @@ according to diffs in the current buffer, but without applying the diffs to the original text. If the selected range extends a hunk, the command attempts to look up and copy the text in-between the hunks. ++++ +*** New command 'diff-revert-and-kill-hunk' bound to C-c M-r. +This command reverse-applies the hunk at point, and then kills it. +This is useful in buffers generated by C-x v = and C-x v D. + ** php-ts-mode --- diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index b8a9484627c..c59c0954ae1 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -218,6 +218,7 @@ The default \"-b\" means to ignore whitespace-only changes, "C-x 4 A" #'diff-add-change-log-entries-other-window ;; Misc operations. "C-c C-a" #'diff-apply-hunk + "C-c M-r" #'diff-revert-and-kill-hunk "C-c C-m a" #'diff-apply-buffer "C-c C-e" #'diff-ediff-patch "C-c C-n" #'diff-restrict-view @@ -242,6 +243,8 @@ The default \"-b\" means to ignore whitespace-only changes, :help "Apply the current hunk to the source file and go to the next"] ["Test applying hunk" diff-test-hunk :help "See whether it's possible to apply the current hunk"] + ["Revert and kill hunk" diff-revert-and-kill-hunk + :help "Reverse-apply and then kill the current hunk."] ["Apply all hunks" diff-apply-buffer :help "Apply all hunks in the current diff buffer"] ["Apply diff with Ediff" diff-ediff-patch @@ -2050,24 +2053,52 @@ With a prefix argument, try to REVERSE the hunk." (diff-hunk-kill) (diff-hunk-next))))) -(defun diff-apply-buffer () +(defcustom diff-ask-before-revert-and-kill-hunk t + "If non-nil, `diff-revert-and-kill-hunk' will ask for confirmation." + :type 'boolean) + +(defun diff-revert-and-kill-hunk () + "Reverse-apply and then kill the hunk at point. Save changed buffer. + +This command is useful in buffers generated by \\[vc-diff] and \\[vc-root-diff], +especially when preparing to commit the patch with \\[vc-next-action]. +You can use \\\\[diff-hunk-kill] to temporarily remove changes that you intend to +include in a separate commit or commits, and you can use this command +to permanently drop changes you didn't intend, or no longer want. + +This is a destructive operation, so by default, this command asks you to +confirm you really want to reverse-apply and kill the hunk. You can +customize `diff-ask-before-revert-and-kill-hunk' to change that." + (interactive) + (when (or (not diff-ask-before-revert-and-kill-hunk) + (yes-or-no-p "Really reverse-apply and kill this hunk?")) + (cl-destructuring-bind (beg end) (diff-bounds-of-hunk) + (when (null (diff-apply-buffer beg end t)) + (diff-hunk-kill))))) + +(defun diff-apply-buffer (&optional beg end reverse) "Apply the diff in the entire diff buffer. -When applying all hunks was successful, then save the changed buffers." +When applying all hunks was successful, then save the changed buffers. +When called from Lisp with optional arguments, restrict the application +to hunks lying between BEG and END, and reverse-apply when REVERSE is +non-nil. Returns nil if buffers were saved, or the number of failed +applications." (interactive) (let ((buffer-edits nil) (failures 0) (diff-refine nil)) (save-excursion - (goto-char (point-min)) + (goto-char (or beg (point-min))) (diff-beginning-of-hunk t) (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched) - (diff-find-source-location nil nil))) + (diff-find-source-location nil reverse))) (cond ((and line-offset (not switched)) (push (cons pos dst) (alist-get buf buffer-edits))) (t (setq failures (1+ failures)))) (and (not (eq (prog1 (point) (ignore-errors (diff-hunk-next))) (point))) + (or (not end) (< (point) end)) (looking-at-p diff-hunk-header-re))))) (cond ((zerop failures) (dolist (buf-edits (reverse buffer-edits)) @@ -2080,11 +2111,13 @@ When applying all hunks was successful, then save the changed buffers." (delete-region (car pos) (cdr pos)) (insert (car dst)))) (save-buffer))) - (message "Saved %d buffers" (length buffer-edits))) + (message "Saved %d buffers" (length buffer-edits)) + nil) (t (message (ngettext "%d hunk failed; no buffers changed" "%d hunks failed; no buffers changed" - failures)))))) + failures)) + failures)))) (defalias 'diff-mouse-goto-source #'diff-goto-source) commit f5cd5585f46600857060ab70655f3b9782c70bb8 Author: Eli Zaretskii Date: Thu Sep 26 10:30:56 2024 +0300 ; Recommend GNU Find for 'find-dired' * lisp/find-dired.el (find-dired): Doc fix (bug#73455). diff --git a/lisp/find-dired.el b/lisp/find-dired.el index e52adaa9d9f..5b4ee0d70aa 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -174,6 +174,11 @@ The command run (after changing into DIR) is essentially except that the car of the variable `find-ls-option' specifies what to use in place of \"-ls\" as the final argument. +If your `find' program is not a GNU Find, the columns in the produced +Dired display might fail to align. We recommend to install GNU Find in +those cases (you may need to customize the value of `find-program' if +you do so), which attempts to align the columns. + Collect output in the \"*Find*\" buffer. To kill the job before it finishes, type \\[kill-find]. commit 8ffb680d09bc6b18d36941765e0f4ca881b565c9 Author: Eli Zaretskii Date: Thu Sep 26 10:30:15 2024 +0300 Revert "; Recommend GNU Find for 'find-dired'" This reverts commit 5f8c2d5bf9638c38fdba7eb840d3bc7b252bb687. It was committed by mistake on this branch. diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 5b4ee0d70aa..e52adaa9d9f 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -174,11 +174,6 @@ The command run (after changing into DIR) is essentially except that the car of the variable `find-ls-option' specifies what to use in place of \"-ls\" as the final argument. -If your `find' program is not a GNU Find, the columns in the produced -Dired display might fail to align. We recommend to install GNU Find in -those cases (you may need to customize the value of `find-program' if -you do so), which attempts to align the columns. - Collect output in the \"*Find*\" buffer. To kill the job before it finishes, type \\[kill-find]. commit 5f8c2d5bf9638c38fdba7eb840d3bc7b252bb687 Author: Eli Zaretskii Date: Thu Sep 26 10:28:20 2024 +0300 ; Recommend GNU Find for 'find-dired' * lisp/find-dired.el (find-dired): Doc fix (bug#73455). diff --git a/lisp/find-dired.el b/lisp/find-dired.el index e52adaa9d9f..5b4ee0d70aa 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -174,6 +174,11 @@ The command run (after changing into DIR) is essentially except that the car of the variable `find-ls-option' specifies what to use in place of \"-ls\" as the final argument. +If your `find' program is not a GNU Find, the columns in the produced +Dired display might fail to align. We recommend to install GNU Find in +those cases (you may need to customize the value of `find-program' if +you do so), which attempts to align the columns. + Collect output in the \"*Find*\" buffer. To kill the job before it finishes, type \\[kill-find]. commit 65e589698e64908d5a6a418594b3078342a7e6fd Author: Stefan Kangas Date: Thu Sep 26 02:10:16 2024 +0200 ; * lisp/filesets.el (filesets-homepage): Fix URL. diff --git a/lisp/filesets.el b/lisp/filesets.el index d6ba303b9eb..3af6f37b423 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -25,7 +25,7 @@ (defvar filesets-version "1.8.4") (defvar filesets-homepage - "http://members.a1.net/t.link/CompEmacsFilesets.html") + "https://web.archive.org/web/20210225032922/https://members.a1.net/t.link/CompEmacsFilesets.html") ;;; Commentary: commit 89abbb843a01f799c320ad776d139835e80ecf61 Author: Stefan Kangas Date: Thu Sep 26 02:04:03 2024 +0200 Deprecate 'Homepage' header in favor of 'URL' * doc/lispref/tips.texi (Library Headers): Document the 'Homepage' header as deprecated in favor of 'URL'. diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index e3d695b2347..14eabb3558f 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1158,8 +1158,8 @@ the place to write arbitrary keywords that describe their package, rather than just the relevant Finder keywords. @item URL -@itemx Homepage -These lines state the website of the library. +This line states the website of the library. @samp{Homepage} is a +deprecated alternative to @samp{URL}. @item Package-Version If @samp{Version} is not suitable for use by the package manager, then commit 1f243a978061919900eba3ef1127aae80c66b6c7 Author: Andrés Ramírez Date: Thu Sep 26 01:50:52 2024 +0200 Delete duplicated line in Viper refcard * etc/refcards/viperCard.tex: Delete duplicated line. (Bug#73480) Copyright-paperwork-exempt: yes diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex index 3675c024a98..b722f99121c 100644 --- a/etc/refcards/viperCard.tex +++ b/etc/refcards/viperCard.tex @@ -301,7 +301,6 @@ \section{Insert Mode} \key{delete line word}{C-u} \key{indent shiftwidth forward}{C-t} \key{indent shiftwidth backward}{C-d} -\key{delete line word}{C-u} \key{quote following character}{C-v} \key{emulate Meta key in emacs state}{C-$\backslash$} \key{escape to Vi state for one command}{C-z} commit 0c861b820b79d9bd8b3ed2c445c79ca806b1cb67 Author: Jeremy Bryant Date: Wed Sep 25 22:04:23 2024 +0100 ; * src/cm.c (calccost): Fix typo. (Bug#73485) diff --git a/src/cm.c b/src/cm.c index 67fafa29bcc..ad419ce0af1 100644 --- a/src/cm.c +++ b/src/cm.c @@ -193,7 +193,7 @@ calccost (struct tty_display_info *tty, tabcost; register const char *p; - /* If have just wrapped on a terminal with xn, + /* If we have just wrapped on a terminal with xn, don't believe the cursor position: give up here and force use of absolute positioning. */ commit 3a0db55b5094686423b73b74ebdf9eba62d384f2 Author: Alan Mackenzie Date: Wed Sep 25 21:06:07 2024 +0000 * etc/NEWS: Describe the change to enum handling in CC Mode diff --git a/etc/NEWS b/etc/NEWS index ffe88c81ba8..2241f0f9a4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -248,6 +248,28 @@ will now automatically turn on 'visual-wrap-prefix-mode' in addition to near window edge and the continuation lines are indented using prefixes computed from surrounding context. +** CC Mode + ++++ +*** New type of 'c-offsets-alist' element. +The cdr of such an alist element may now be a syntactic symbol. A +source line with a syntactic element whose symbol is the car of that +alist element is indented as though it were the cdr. + ++++ +*** Enums now have their own syntactic symbols. +The new symbols 'enum-open', 'enum-close', 'enum-intro' and +'enum-entry' are used in the analysis of enum constructs. Previously +they were given 'brace-list-open', etc. These are fully described in +the CC Mode manual. + ++++ +*** Enums are now, by default, indented like classes, not brace-lists. +To get the old behavior back, add an element '(enum-open +. brace-list-open)' to 'c-offsets-alist' in your CC Mode style, or amend +'c-offsets-alist' likewise in any of the other ways detailed in the CC +Mode manual page "Config Basics". + ** Go-ts mode +++ commit f28793822d86b9c4135c70498b4588629f0c6ea7 Author: Eli Zaretskii Date: Wed Sep 25 20:33:30 2024 +0100 ; Improve use of ngettext diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index be3d94db011..b8a9484627c 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2082,8 +2082,9 @@ When applying all hunks was successful, then save the changed buffers." (save-buffer))) (message "Saved %d buffers" (length buffer-edits))) (t - (message "%d %s failed; no buffers changed" - failures (if (> failures 1) "hunks" "hunk")))))) + (message (ngettext "%d hunk failed; no buffers changed" + "%d hunks failed; no buffers changed" + failures)))))) (defalias 'diff-mouse-goto-source #'diff-goto-source) commit d63bff4d88f32c31fa16f313f11ad2ab7485d4f9 Author: Michael Albinus Date: Wed Sep 25 19:43:07 2024 +0200 Fix Tramp shortdoc integration * lisp/net/tramp-integration.el (tramp-syntax): Declare. (shortdoc): Check, that Tramp has `default' syntax. diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 8d039c25eae..465b7dbbaec 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -54,6 +54,7 @@ (defvar shortdoc--groups) (defvar tramp-current-connection) (defvar tramp-postfix-host-format) +(defvar tramp-syntax) (defvar tramp-use-connection-share) ;;; Fontification of `read-file-name': @@ -277,7 +278,8 @@ NAME must be equal to `tramp-current-connection'." (tramp--with-startup (with-eval-after-load 'shortdoc ;; Some packages deactivate Tramp. They don't deserve a shortdoc entry then. - (when (file-remote-p "/ssh:user@host:/tmp/foo") + (when (and (file-remote-p "/ssh:user@host:/tmp/foo") + (eq tramp-syntax 'default)) (dolist (elem `((file-remote-p :eval (file-remote-p "/ssh:user@host:/tmp/foo") :eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method) commit 759b18a33c0a18550b0c5ec341dc76f1f0bc16c7 Author: Juri Linkov Date: Wed Sep 25 20:14:12 2024 +0300 * lisp/imenu.el (imenu-flatten): More limitations in docstring (bug#73117) diff --git a/lisp/imenu.el b/lisp/imenu.el index 8f1b1f22a67..2d64970bfcf 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -158,10 +158,18 @@ If the value is `annotation', annotate each completion candidate with a suffix that is the section name to which it belongs. If the value is `group', split completion candidates into groups according to the sections. +Any other value is treated as `prefix'. + Since the values `annotation' and `group' rely on text properties, you can use them only by selecting candidates from the completions -buffer, not by typing in the minibuffer. -Any other value is treated as `prefix'. +buffer, not by typing in the minibuffer. This also means that +if you use `minibuffer-next-completion' (`M-') to select +a completion while point stays in the minibuffer, you need +to customize `minibuffer-completion-auto-choose' to nil that +doesn't insert completion candidates to the minibuffer. +Also note that for using the value `group' you need to customize +`completions-group' to the value t, and `completions-format' +to the value `vertical'. The value of `imenu-level-separator', a string, is used to separate names from different flattened levels, such as section names, from the commit 794bb2a2e31f3027e1db9e027af28151f11a32ed Author: Sean Whitton Date: Wed Sep 25 16:02:53 2024 +0100 remember-data-file: Don't unconditionally call set-visited-file-name * lisp/textmodes/remember.el (remember-data-file): Don't unconditionally call set-visited-file-name. diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index c75a9b758e7..cc3496da33c 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -378,8 +378,15 @@ exists) might be changed." (set-default symbol value) (when (buffer-live-p buf) (with-current-buffer buf - (set-visited-file-name - (expand-file-name remember-data-file)))))) + ;; Don't unconditionally call `set-visited-file-name' + ;; because that will probably change the major mode and + ;; rename the buffer. + ;; These must be avoided in the case where + ;; `remember-notes-buffer-name' is "*scratch*", a + ;; supported configuration. + (let ((value (expand-file-name value))) + (unless (string= buffer-file-name value) + (set-visited-file-name value))))))) :initialize #'custom-initialize-default) (defcustom remember-leader-text "** " commit a06a7209028363a1bb2f727ffaecdf4d02296b2e Author: Robert Pluim Date: Tue Sep 24 10:52:35 2024 +0200 ; Really disable 'button-mode' in 'emacs-news-mode' * lisp/textmodes/emacs-news-mode.el (emacs-news-mode): Call 'button-mode' with -1 arg. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 48e9244a4ef..6321bd8efad 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -114,7 +114,7 @@ (define-derived-mode emacs-news-mode text-mode "NEWS" "Major mode for editing the Emacs NEWS file." ;; Disable buttons. - (button-mode nil) + (button-mode -1) ;; And make the buffer writable. This is used when toggling ;; emacs-news-mode. (setq buffer-read-only nil) commit 1b1b922992946f0d17f6a2a2d3515b36a955244e Author: Robert Pluim Date: Thu Sep 19 10:06:20 2024 +0200 Test 'network-lookup-address-info' argument type checking * test/src/process-tests.el (lookup-hints-values): Pass in non-string values, which should result in type errors. diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 19b14f2d0cb..862416a49a9 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -462,7 +462,9 @@ See Bug#30460." (ipv6-addrs '("fe80::1" "e301::203:1" "e301:203::1" "e301:0203::1" "::1" "::0" - "0343:1:2::3" "343:001:2::3"))) + "0343:1:2::3" "343:001:2::3")) + (invalid-values + '(1 a 1.0))) (dolist (a ipv4-invalid-addrs) (should-not (network-lookup-address-info a nil 'numeric)) (should-not (network-lookup-address-info a 'ipv4 'numeric))) @@ -471,6 +473,8 @@ See Bug#30460." (dolist (a ipv4-addrs) (should (network-lookup-address-info a nil 'numeric)) (should (network-lookup-address-info a 'ipv4 'numeric))) + (dolist (a invalid-values) + (should-error (network-lookup-address-info a))) (when (ipv6-is-available) (dolist (a ipv4-addrs) (should-not (network-lookup-address-info a 'ipv6 'numeric))) commit 7766ba8419955104fb675a6f4134a8a34ea73e43 Author: Thomas Voss Date: Wed Sep 25 02:17:49 2024 +0200 Align columns in which-key with wide characters properly In the case that a character takes up multple columns (such as `…' when used as a truncation character), make sure that the columns are still aligned properly. * lisp/which-key.el (which-key--pad-column): Use `string-width' instead of `length'. (Bug#73463) Copyright-paperwork-exempt: yes diff --git a/lisp/which-key.el b/lisp/which-key.el index 91eb05c4dc7..fb0685cd3a9 100644 --- a/lisp/which-key.el +++ b/lisp/which-key.el @@ -2037,7 +2037,7 @@ that width." (mapcar (pcase-lambda (`(,key ,sep ,desc ,_doc)) (concat (format col-format key sep desc) - (make-string (- col-desc-width (length desc)) ?\s))) + (make-string (- col-desc-width (string-width desc)) ?\s))) col-keys)))) (defun which-key--partition-list (n list) commit 29c610a83243c82aeb1bfefea26adad0b34ff011 Author: Michael Albinus Date: Wed Sep 25 11:36:28 2024 +0200 ; Tramp cosmetic change * lisp/net/tramp.el (tramp-file-name-handler): Adapt `tramp-verbose' when completing host names. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 732eb930937..806010624b2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2480,8 +2480,11 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; We flush connection properties ;; "process-name" and "process-buffer", ;; because the operations shall be applied - ;; in the main connection process. - ;; If `non-essential' is non-nil, Tramp shall + ;; in the main connection process. In order + ;; to avoid suspicious debug buffers during + ;; host name completion, we adapt + ;; `tramp-verbose'. + ;; If `non-essential' is non-nil, Tramp shall ;; not open a new connection. ;; If Tramp detects that it shouldn't continue ;; to work, it throws the `suppress' event. @@ -2491,8 +2494,11 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; In both cases, we try the default handler then. (with-tramp-saved-connection-properties v '("process-name" "process-buffer") - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") + (let ((tramp-verbose + (if minibuffer-completing-file-name + 0 tramp-verbose))) + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer")) (setq result (catch 'non-essential (catch 'suppress commit 4b76af49281e5522dcabbf2fc6be8f1b8bc535ac Author: Andrea Corallo Date: Wed Sep 25 10:19:12 2024 +0200 ; * Clean-up compilation warning in cc-vars.el * lisp/progmodes/cc-vars.el (c-offsets-alist): Move definition to clean-up byte-compiler warning. diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index b714dea4ebd..f0e4c957ea5 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -207,6 +207,192 @@ the value set here overrides the style system (there is a variable ,expanded-doc ,@(plist-put args :type aggregate))))) +(defcustom c-offsets-alist nil + "Alist of syntactic element symbols and indentation offsets. +As described below, each cons cell in this list has the form: + + (SYNTACTIC-SYMBOL . OFFSET) + +When a line is indented, CC Mode first determines the syntactic +context of it by generating a list of symbols called syntactic +elements. The global variable `c-syntactic-context' is bound to that +list. Each element in the list is in turn a list where the first +element is a syntactic symbol which tells what kind of construct the +indentation point is located within. More elements in the syntactic +element lists are optional. If there is one more and it isn't nil, +then it's the anchor position for that construct. + +After generating the syntactic context for the line, CC Mode +calculates the absolute indentation: First the base indentation is +found by using the anchor position for the first syntactic element +that provides one. If none does, zero is used as base indentation. +Then CC Mode looks at each syntactic element in the context in turn. +It compares the car of the syntactic element against the +SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it finds a match, it +adds OFFSET to the base indentation. The sum of this calculation is +the absolute offset for line being indented. + +If the syntactic element does not match any in the `c-offsets-alist', +the element is ignored. + +OFFSET can specify an offset in several different ways: + + If OFFSET is nil then it's ignored. + + If OFFSET is an integer then it's used as relative offset, i.e. it's + added to the base indentation. + + If OFFSET is one of the symbols `+', `-', `++', `--', `*', or `/' + then a positive or negative multiple of `c-basic-offset' is added to + the base indentation; 1, -1, 2, -2, 0.5, and -0.5, respectively. + + If OFFSET is a symbol with a value binding then that value, which + must be an integer, is used as relative offset. + + If OFFSET is a vector then its first element, which must be an + integer, is used as an absolute indentation column. This overrides + the previous base indentation and the relative offsets applied to + it, and it becomes the new base indentation. + + If OFFSET is a function or a lambda expression then it's called with + a single argument containing the cons of the syntactic symbol and + the anchor position (or nil if there is none). The return value + from the function is then reinterpreted as an offset specification. + + If OFFSET is a list then its elements are evaluated recursively as + offset specifications. If the first element is any of the symbols + below then it isn't evaluated but instead specifies how the + remaining offsets in the list should be combined. If it's something + else then the list is combined according the method `first'. The + valid combination methods are: + + `first' -- Use the first offset (that doesn't evaluate to nil). + `min' -- Use the minimum of all the offsets. All must be either + relative or absolute - they can't be mixed. + `max' -- Use the maximum of all the offsets. All must be either + relative or absolute - they can't be mixed. + `add' -- Add all the evaluated offsets together. Exactly one of + them may be absolute, in which case the result is + absolute. Any relative offsets that preceded the + absolute one in the list will be ignored in that case. + +`c-offsets-alist' is a style variable. This means that the offsets on +this variable are normally taken from the style system in CC Mode +\(see `c-default-style' and `c-style-alist'). However, any offsets +put explicitly on this list will override the style system when a CC +Mode buffer is initialized (there is a variable +`c-old-style-variable-behavior' that changes this, though). + +Here is the current list of valid syntactic element symbols: + + string -- Inside multi-line string. + c -- Inside a multi-line C style block comment. + defun-open -- Brace that opens a function definition. + defun-close -- Brace that closes a function definition. + defun-block-intro -- The first line in a top-level defun. + class-open -- Brace that opens a class definition. + class-close -- Brace that closes a class definition. + inline-open -- Brace that opens an in-class inline method. + inline-close -- Brace that closes an in-class inline method. + func-decl-cont -- The region between a function definition's + argument list and the function opening brace + (excluding K&R argument declarations). In C, you + cannot put anything but whitespace and comments + between them; in C++ and Java, throws declarations + and other things can appear in this context. + knr-argdecl-intro -- First line of a K&R C argument declaration. + knr-argdecl -- Subsequent lines in a K&R C argument declaration. + topmost-intro -- The first line in a topmost construct definition. + topmost-intro-cont -- Topmost definition continuation lines. + constraint-cont -- Continuation line of a C++ requires clause (not + to be confused with a \"requires expression\") or + concept. + annotation-top-cont -- Topmost definition continuation line where only + annotations are on previous lines. + annotation-var-cont -- A continuation of a C (or like) statement where + only annotations are on previous lines. + member-init-intro -- First line in a member initialization list. + member-init-cont -- Subsequent member initialization list lines. + inher-intro -- First line of a multiple inheritance list. + inher-cont -- Subsequent multiple inheritance lines. + block-open -- Statement block open brace. + block-close -- Statement block close brace. + brace-list-open -- Open brace of an enum or static array list. + brace-list-close -- Close brace of an enum or static array list. + brace-list-intro -- First line in an enum or static array list. + brace-list-entry -- Subsequent lines in an enum or static array list. + brace-entry-open -- Subsequent lines in an enum or static array + list that start with an open brace. + statement -- A C (or like) statement. + statement-cont -- A continuation of a C (or like) statement. + statement-block-intro -- The first line in a new statement block. + statement-case-intro -- The first line in a case \"block\". + statement-case-open -- The first line in a case block starting with brace. + substatement -- The first line after an if/while/for/do/else. + substatement-open -- The brace that opens a substatement block. + substatement-label -- Labeled line after an if/while/for/do/else. + case-label -- A \"case\" or \"default\" label. + access-label -- C++ private/protected/public access label. + label -- Any ordinary label. + do-while-closure -- The \"while\" that ends a do/while construct. + else-clause -- The \"else\" of an if/else construct. + catch-clause -- The \"catch\" or \"finally\" of a try/catch construct. + comment-intro -- A line containing only a comment introduction. + arglist-intro -- The first line in an argument list. + arglist-cont -- Subsequent argument list lines when no + arguments follow on the same line as the + arglist opening paren. + arglist-cont-nonempty -- Subsequent argument list lines when at + least one argument follows on the same + line as the arglist opening paren. + arglist-close -- The solo close paren of an argument list. + stream-op -- Lines continuing a stream operator construct. + inclass -- The construct is nested inside a class definition. + Used together with e.g. `topmost-intro'. + cpp-macro -- The start of a C preprocessor macro definition. + cpp-macro-cont -- Inside a multi-line C preprocessor macro definition. + friend -- A C++ friend declaration. + objc-method-intro -- The first line of an Objective-C method definition. + objc-method-args-cont -- Lines continuing an Objective-C method definition. + objc-method-call-cont -- Lines continuing an Objective-C method call. + extern-lang-open -- Brace that opens an \"extern\" block. + extern-lang-close -- Brace that closes an \"extern\" block. + inextern-lang -- Analogous to the `inclass' syntactic symbol, + but used inside \"extern\" blocks. + namespace-open, namespace-close, innamespace + -- Similar to the three `extern-lang' symbols, but for + C++ \"namespace\" blocks. + module-open, module-close, inmodule + -- Similar to the three `extern-lang' symbols, but for + CORBA IDL \"module\" blocks. + composition-open, composition-close, incomposition + -- Similar to the three `extern-lang' symbols, but for + CORBA CIDL \"composition\" blocks. + template-args-cont -- C++ template argument list continuations. + inlambda -- In the header or body of a lambda function. + lambda-intro-cont -- Continuation of the header of a lambda function. + inexpr-statement -- The statement is inside an expression. + inexpr-class -- The class is inside an expression. Used e.g. for + Java anonymous classes." + :type + `(set :format "%{%t%}: + Override style setting + | Syntax Offset +%v" + ,@(mapcar + (lambda (elt) + `(cons :format "%v" + :value ,elt + ,(c-constant-symbol (car elt) 25) + (sexp :format "%v" + :validate + (lambda (widget) + (unless (c-valid-offset (widget-value widget)) + (widget-put widget :error "Invalid offset") + widget))))) + (get 'c-offsets-alist 'c-stylevar-fallback))) + :group 'c) + (defun c-valid-offset (offset) "Return non-nil if OFFSET is a valid offset for a syntactic symbol. See `c-offsets-alist'." @@ -1254,191 +1440,6 @@ can always override the use of `c-default-style' by making calls to (inexpr-class . +) ;; Anchor pos: None. )) -(defcustom c-offsets-alist nil - "Alist of syntactic element symbols and indentation offsets. -As described below, each cons cell in this list has the form: - - (SYNTACTIC-SYMBOL . OFFSET) - -When a line is indented, CC Mode first determines the syntactic -context of it by generating a list of symbols called syntactic -elements. The global variable `c-syntactic-context' is bound to that -list. Each element in the list is in turn a list where the first -element is a syntactic symbol which tells what kind of construct the -indentation point is located within. More elements in the syntactic -element lists are optional. If there is one more and it isn't nil, -then it's the anchor position for that construct. - -After generating the syntactic context for the line, CC Mode -calculates the absolute indentation: First the base indentation is -found by using the anchor position for the first syntactic element -that provides one. If none does, zero is used as base indentation. -Then CC Mode looks at each syntactic element in the context in turn. -It compares the car of the syntactic element against the -SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it finds a match, it -adds OFFSET to the base indentation. The sum of this calculation is -the absolute offset for line being indented. - -If the syntactic element does not match any in the `c-offsets-alist', -the element is ignored. - -OFFSET can specify an offset in several different ways: - - If OFFSET is nil then it's ignored. - - If OFFSET is an integer then it's used as relative offset, i.e. it's - added to the base indentation. - - If OFFSET is one of the symbols `+', `-', `++', `--', `*', or `/' - then a positive or negative multiple of `c-basic-offset' is added to - the base indentation; 1, -1, 2, -2, 0.5, and -0.5, respectively. - - If OFFSET is a symbol with a value binding then that value, which - must be an integer, is used as relative offset. - - If OFFSET is a vector then its first element, which must be an - integer, is used as an absolute indentation column. This overrides - the previous base indentation and the relative offsets applied to - it, and it becomes the new base indentation. - - If OFFSET is a function or a lambda expression then it's called with - a single argument containing the cons of the syntactic symbol and - the anchor position (or nil if there is none). The return value - from the function is then reinterpreted as an offset specification. - - If OFFSET is a list then its elements are evaluated recursively as - offset specifications. If the first element is any of the symbols - below then it isn't evaluated but instead specifies how the - remaining offsets in the list should be combined. If it's something - else then the list is combined according the method `first'. The - valid combination methods are: - - `first' -- Use the first offset (that doesn't evaluate to nil). - `min' -- Use the minimum of all the offsets. All must be either - relative or absolute - they can't be mixed. - `max' -- Use the maximum of all the offsets. All must be either - relative or absolute - they can't be mixed. - `add' -- Add all the evaluated offsets together. Exactly one of - them may be absolute, in which case the result is - absolute. Any relative offsets that preceded the - absolute one in the list will be ignored in that case. - -`c-offsets-alist' is a style variable. This means that the offsets on -this variable are normally taken from the style system in CC Mode -\(see `c-default-style' and `c-style-alist'). However, any offsets -put explicitly on this list will override the style system when a CC -Mode buffer is initialized (there is a variable -`c-old-style-variable-behavior' that changes this, though). - -Here is the current list of valid syntactic element symbols: - - string -- Inside multi-line string. - c -- Inside a multi-line C style block comment. - defun-open -- Brace that opens a function definition. - defun-close -- Brace that closes a function definition. - defun-block-intro -- The first line in a top-level defun. - class-open -- Brace that opens a class definition. - class-close -- Brace that closes a class definition. - inline-open -- Brace that opens an in-class inline method. - inline-close -- Brace that closes an in-class inline method. - func-decl-cont -- The region between a function definition's - argument list and the function opening brace - (excluding K&R argument declarations). In C, you - cannot put anything but whitespace and comments - between them; in C++ and Java, throws declarations - and other things can appear in this context. - knr-argdecl-intro -- First line of a K&R C argument declaration. - knr-argdecl -- Subsequent lines in a K&R C argument declaration. - topmost-intro -- The first line in a topmost construct definition. - topmost-intro-cont -- Topmost definition continuation lines. - constraint-cont -- Continuation line of a C++ requires clause (not - to be confused with a \"requires expression\") or - concept. - annotation-top-cont -- Topmost definition continuation line where only - annotations are on previous lines. - annotation-var-cont -- A continuation of a C (or like) statement where - only annotations are on previous lines. - member-init-intro -- First line in a member initialization list. - member-init-cont -- Subsequent member initialization list lines. - inher-intro -- First line of a multiple inheritance list. - inher-cont -- Subsequent multiple inheritance lines. - block-open -- Statement block open brace. - block-close -- Statement block close brace. - brace-list-open -- Open brace of an enum or static array list. - brace-list-close -- Close brace of an enum or static array list. - brace-list-intro -- First line in an enum or static array list. - brace-list-entry -- Subsequent lines in an enum or static array list. - brace-entry-open -- Subsequent lines in an enum or static array - list that start with an open brace. - statement -- A C (or like) statement. - statement-cont -- A continuation of a C (or like) statement. - statement-block-intro -- The first line in a new statement block. - statement-case-intro -- The first line in a case \"block\". - statement-case-open -- The first line in a case block starting with brace. - substatement -- The first line after an if/while/for/do/else. - substatement-open -- The brace that opens a substatement block. - substatement-label -- Labeled line after an if/while/for/do/else. - case-label -- A \"case\" or \"default\" label. - access-label -- C++ private/protected/public access label. - label -- Any ordinary label. - do-while-closure -- The \"while\" that ends a do/while construct. - else-clause -- The \"else\" of an if/else construct. - catch-clause -- The \"catch\" or \"finally\" of a try/catch construct. - comment-intro -- A line containing only a comment introduction. - arglist-intro -- The first line in an argument list. - arglist-cont -- Subsequent argument list lines when no - arguments follow on the same line as the - arglist opening paren. - arglist-cont-nonempty -- Subsequent argument list lines when at - least one argument follows on the same - line as the arglist opening paren. - arglist-close -- The solo close paren of an argument list. - stream-op -- Lines continuing a stream operator construct. - inclass -- The construct is nested inside a class definition. - Used together with e.g. `topmost-intro'. - cpp-macro -- The start of a C preprocessor macro definition. - cpp-macro-cont -- Inside a multi-line C preprocessor macro definition. - friend -- A C++ friend declaration. - objc-method-intro -- The first line of an Objective-C method definition. - objc-method-args-cont -- Lines continuing an Objective-C method definition. - objc-method-call-cont -- Lines continuing an Objective-C method call. - extern-lang-open -- Brace that opens an \"extern\" block. - extern-lang-close -- Brace that closes an \"extern\" block. - inextern-lang -- Analogous to the `inclass' syntactic symbol, - but used inside \"extern\" blocks. - namespace-open, namespace-close, innamespace - -- Similar to the three `extern-lang' symbols, but for - C++ \"namespace\" blocks. - module-open, module-close, inmodule - -- Similar to the three `extern-lang' symbols, but for - CORBA IDL \"module\" blocks. - composition-open, composition-close, incomposition - -- Similar to the three `extern-lang' symbols, but for - CORBA CIDL \"composition\" blocks. - template-args-cont -- C++ template argument list continuations. - inlambda -- In the header or body of a lambda function. - lambda-intro-cont -- Continuation of the header of a lambda function. - inexpr-statement -- The statement is inside an expression. - inexpr-class -- The class is inside an expression. Used e.g. for - Java anonymous classes." - :type - `(set :format "%{%t%}: - Override style setting - | Syntax Offset -%v" - ,@(mapcar - (lambda (elt) - `(cons :format "%v" - :value ,elt - ,(c-constant-symbol (car elt) 25) - (sexp :format "%v" - :validate - (lambda (widget) - (unless (c-valid-offset (widget-value widget)) - (widget-put widget :error "Invalid offset") - widget))))) - (get 'c-offsets-alist 'c-stylevar-fallback))) - :group 'c) ;; The syntactic symbols that can occur inside code blocks. Used by ;; `c-gnu-impose-minimum'. commit bd25a98b4e70dbdcb6db92b0b39122a6c7386044 Author: Roland Winkler Date: Tue Sep 24 23:14:27 2024 -0500 bibtex-mode: fix patch bibtex validation for non-file buffers diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 1473fc2bd6b..cbcea8af012 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -4638,16 +4638,17 @@ Return t if test was successful, nil otherwise." (bibtex-progress-message 'done))))) (if error-list - (let* ((file-p (buffer-file-name)) - (file (if file-p (file-name-nondirectory file-p) (buffer-name))) + (let* ((is-file (buffer-file-name)) + (file (if is-file (file-name-nondirectory is-file) (buffer-name))) (dir default-directory) (err-buf "*BibTeX validation errors*")) (setq error-list (sort error-list #'car-less-than-car)) (with-current-buffer (get-buffer-create err-buf) (setq default-directory dir) (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (setq-local compilation-parse-errors-filename-function - (if file-p #'identity #'get-buffer)) + (unless is-file + (setq-local compilation-parse-errors-filename-function + #'get-buffer)) (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (insert (substitute-command-keys commit 4729065ee78c260538974c2d8010246dce0ebf0c Author: Robert Pluim Date: Tue Sep 24 17:03:49 2024 +0200 Document 'buttonize-region' in manual It was added in emacs-29, but never added to the lisp reference manual. * doc/lispref/display.texi (Making Buttons): Document 'buttonize-region'. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c0fbde5d96a..9075ff678e0 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7955,6 +7955,15 @@ will be called when the user clicks on the button. The optional is called. If @code{nil}, the button is used as the parameter instead. @end defun +@defun buttonize-region start end callback &optional data help-echo +Sometimes it's more convenient to convert existing text in a buffer to a +button instead of inserting new text. This function makes the region +between @var{start} and @var{end} into a button. Arguments +@var{callback} and @var{data} have the same meanings as for +@code{buttonize}. Optional argument @var{help-echo} is used as the +@code{help-echo} property of the button. +@end defun + @node Manipulating Buttons @subsection Manipulating Buttons @cindex manipulating buttons commit f189457e5aa98b6a073713da74884f363098411f Author: Robert Pluim Date: Tue Sep 24 17:02:21 2024 +0200 ; * lisp/yank-media.el (yank-media-handler): Fix docstring typo. diff --git a/lisp/yank-media.el b/lisp/yank-media.el index e33c36da5b6..563aae85419 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -93,7 +93,7 @@ TYPES should be a MIME media type symbol, a regexp, or a list that can contain both symbols and regexps. HANDLER is a function that will be called with two arguments: The -MIME type (a symbol on the form `image/png') and the selection +MIME type (a symbol of the form `image/png') and the selection data (a string)." (make-local-variable 'yank-media--registered-handlers) (dolist (type (ensure-list types)) commit 2b53e11a087be54f9ba7cd39334f7c14e89946ca Author: Tassilo Horn Date: Mon Sep 23 18:50:29 2024 +0200 Use black-on-white by default for doc-view-svg-face. * lisp/doc-view.el (doc-view-svg-face): Define black on white as default value instead of using the current theme's values. * etc/NEWS: Adjust entry for doc-view-svg-face. diff --git a/etc/NEWS b/etc/NEWS index 8ed16cfeeff..c72a87787f3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1544,10 +1544,12 @@ default is non-nil if your system supports display of SVG images. --- *** New face 'doc-view-svg-face'. This replaces 'doc-view-svg-foreground' and 'doc-view-svg-background'. -If you don't like the colors produced by the default definition of -this new face when DocView displays documents, customize this face to -restore the colors you were used to, or to get colors more to your -liking. +By default, this face has black foreground on white background and +inherits from the default face. When unsetting the foreground and +background values, the display in DocView is styled according to the +current theme. However, this, or any non-standard values, can result in +poor contrast for documents which aren't simply black text on white +background. --- *** DocView buffers now display a new tool bar. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 15352630d25..1ed0c71febe 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -238,10 +238,15 @@ showing only titles and no page number." :type 'boolean :version "29.1") -(defface doc-view-svg-face '((t :inherit default)) +(defface doc-view-svg-face '((t :inherit default + :background "white" + :foreground "black")) "Face used for SVG images. -Only background and foreground colors are used. -See `doc-view-mupdf-use-svg'." +See `doc-view-mupdf-use-svg'. + +Only background and foreground colors are used as the SVG image's +descriptors, see (info \"(elisp) SVG Images\"). Non-standard values may +cause low-contrast issues with certain documents." :version "30.1") (make-obsolete 'doc-view-svg-background 'doc-view-svg-face "30.1") commit 32d0c8f6af52cd8db363456d817c3d214eea4c00 Author: Dmitry Gutov Date: Mon Sep 23 21:35:00 2024 +0300 etags-regen-file-extensions: Enable for more extensions * lisp/progmodes/etags-regen.el (etags-regen-file-extensions): Add more extensions, but remove "a". From the ones recognized by etags, also omit "t", "ml", "l", "def" and "inc", see https://lists.gnu.org/archive/html/emacs-devel/2024-09/msg00735.html. (etags-regen--all-files): Use 'string-match-p' for performance. Bind 'case-fold-search' to t to match extensions in any case. diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el index a8e67197070..11073c76ac6 100644 --- a/lisp/progmodes/etags-regen.el +++ b/lisp/progmodes/etags-regen.el @@ -118,9 +118,13 @@ We currently support only Emacs's etags program with this option." ;; when it cannot determine the type of the file. ;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html (defcustom etags-regen-file-extensions - '("rb" "js" "py" "pl" "pm" "el" "c" "cpp" "cc" "h" "hh" "hpp" - "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl" - "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada") + '("ads" "adb" "ada" "asm" "ins" "s" "sa" "S" "src" + "c" "h" "c++" "cc" "cpp" "cxx" "h++" "hh" "hpp" "hxx" "m" "pdb" + "cs" "hs" "erl" "hrl" "fth" "tok" "f" "f90" "for" "go" + "java" "cl" "clisp" "el" "lisp" "lsp" "lua" "lm" "p" "pas" + "pl" "pm" "php" "php3" "php4" "pc" "prolog" "py" "rb" "ru" "rbw" + "rs" "oak" "rkt" "sch" "scheme" "scm" "sm" "ss" + "y" "y++" "ym" "yxx" "yy") "Code file extensions for `etags-regen-mode'. File extensions to generate the tags for." @@ -242,11 +246,12 @@ File extensions to generate the tags for." (ir-start (1- (length root))) (ignores-regexps (mapcar #'etags-regen--ignore-regexp - etags-regen-ignores))) + etags-regen-ignores)) + (case-fold-search t)) (cl-delete-if (lambda (f) (or (not (string-match-p match-re f)) (string-match-p "/\\.#" f) ;Backup files. - (cl-some (lambda (ignore) (string-match ignore f ir-start)) + (cl-some (lambda (ignore) (string-match-p ignore f ir-start)) ignores-regexps))) files))) commit 8f265b49e3d3b4403ab0cdd4a5b94d2e335297cb Author: Eli Zaretskii Date: Mon Sep 23 17:13:31 2024 +0300 ; Fix last change * doc/lispref/lists.texi (Building Lists): * src/fns.c (Fappend): Fix last change (bug#73427). Suggested by Mattias Engdegård . diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 816af4a4ff7..19c4614ebad 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -670,6 +670,7 @@ This once was the usual way to copy a list, before the function @cindex list of characters of a string @cindex convert string to list of its characters +@findex string-to-list Here's how to convert a string into a list of its characters: @example @@ -679,6 +680,9 @@ This once was the usual way to copy a list, before the function @end group @end example +@noindent +The function @code{string-to-list} is a handy shortcut for the above. + With the help of @code{apply} (@pxref{Calling Functions}), we can append all the lists in a list of lists: @@ -717,7 +721,7 @@ any other non-list final argument. As an exception, if all the arguments but the last are @code{nil} and the last argument is not a list, the return value is that last argument -unchanged: +unchanged (i.e., in this case the return value is not a list): @example @group diff --git a/src/fns.c b/src/fns.c index 33079cf926a..e196d5419cb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -724,7 +724,7 @@ a list, this results in a dotted list. As an exception, if all the arguments except the last are nil, and the last argument is not a list, the return value is that last argument -unaltered. +unaltered, not a list. usage: (append &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) commit c8ed48b9901790fdabcf91ef15a6ba47c96b48c8 Author: Eli Zaretskii Date: Mon Sep 23 14:41:34 2024 +0300 ; Improve documentation of 'append' * doc/lispref/lists.texi (Building Lists): * src/fns.c (Fappend): Improve documentation of 'append'. (Bug#73427) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 6f4d838042a..816af4a4ff7 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -666,6 +666,17 @@ This once was the usual way to copy a list, before the function (append [a b] "cd" nil) @result{} (a b 99 100) @end group +@end example + +@cindex list of characters of a string +@cindex convert string to list of its characters + Here's how to convert a string into a list of its characters: + +@example +@group +(append "abcd" nil) + @result{} (97 98 99 100) +@end group @end example With the help of @code{apply} (@pxref{Calling Functions}), we can append @@ -690,10 +701,12 @@ all the lists in a list of lists: Here are some examples where the final argument is not a list: @example +@group (append '(x y) 'z) @result{} (x y . z) (append '(x y) [z]) @result{} (x y . [z]) +@end group @end example @noindent @@ -702,6 +715,17 @@ not a list, the sequence's elements do not become elements of the resulting list. Instead, the sequence becomes the final @sc{cdr}, like any other non-list final argument. + As an exception, if all the arguments but the last are @code{nil} and +the last argument is not a list, the return value is that last argument +unchanged: + +@example +@group +(append nil nil "abcd") + @result{} "abcd" +@end group +@end example + @defun copy-tree tree &optional vectors-and-records This function returns a copy of the tree @var{tree}. If @var{tree} is a cons cell, this makes a new cons cell with the same @sc{car} and diff --git a/src/fns.c b/src/fns.c index 6133c20573a..33079cf926a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -719,7 +719,12 @@ The result is a list whose elements are the elements of all the arguments. Each argument may be a list, vector or string. All arguments except the last argument are copied. The last argument -is just used as the tail of the new list. +is just used as the tail of the new list. If the last argument is not +a list, this results in a dotted list. + +As an exception, if all the arguments except the last are nil, and the +last argument is not a list, the return value is that last argument +unaltered. usage: (append &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) commit c1f2501f55d7454222389244512f732ac5e778b4 Author: Stephen Berman Date: Sat Sep 21 22:23:11 2024 +0200 Update and improve UI of sql-read-product (bug#73412) * lisp/progmodes/sql.el (sql-read-product): In invocation of completing-read use format-prompt and make deprecated argument INITIAL-INPUT nil. (sql-set-product, sql-product-interactive): In invocation of sql-read-product adjust prompt to use of format-prompt. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 5273ba2bee1..a0b350ce54f 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2666,11 +2666,11 @@ highlighting rules in SQL mode.") "Read a valid SQL product." (let ((init (or (and initial (symbol-name initial)) "ansi"))) (intern (completing-read - prompt + (format-prompt prompt init) (mapcar (lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match - init 'sql-product-history init)))) + nil 'sql-product-history init)))) (defun sql-add-product (product display &rest plist) "Add support for a database product in `sql-mode'. @@ -2912,7 +2912,7 @@ adds a fontification pattern to fontify identifiers ending in (defun sql-set-product (product) "Set `sql-product' to PRODUCT and enable appropriate highlighting." (interactive - (list (sql-read-product "SQL product: "))) + (list (sql-read-product "SQL product"))) (if (stringp product) (setq product (intern product))) (when (not (assoc product sql-product-alist)) (user-error "SQL product %s is not supported; treated as ANSI" product) @@ -4546,7 +4546,7 @@ the call to \\[sql-product-interactive] with (setq product (cond ((= (prefix-numeric-value product) 4) ; C-u, prompt for product - (sql-read-product "SQL product: " sql-product)) + (sql-read-product "SQL product" sql-product)) ((assoc product sql-product-alist) ; Product specified product) (t sql-product))) ; Default to sql-product commit 4f5fc519f0921f3ad2f78210e9fb765705fc4cad Author: Philip Kaludercic Date: Thu Sep 19 22:27:26 2024 +0200 Insert correct commit data into VC package descriptions * lisp/emacs-lisp/package-vc.el (package-vc-commit): Rename argument from PKG to PKG-DESC. (package-vc--generate-description-file): Update the "extras" section of the package description with the revision string at generation time. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 34610102aa0..e168096e153 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -265,13 +265,13 @@ asynchronously." (add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20) -(defun package-vc-commit (pkg) - "Return the last commit of a development package PKG." - (cl-assert (package-vc-p pkg)) +(defun package-vc-commit (pkg-desc) + "Return the last commit of a development package PKG-DESC." + (cl-assert (package-vc-p pkg-desc)) ;; FIXME: vc should be extended to allow querying the commit of a ;; directory (as is possible when dealing with git repositories). ;; This should be a fallback option. - (cl-loop with dir = (package-desc-dir pkg) + (cl-loop with dir = (package-desc-dir pkg-desc) for file in (directory-files dir t "\\.el\\'" t) when (vc-working-revision file) return it finally return "unknown")) @@ -359,7 +359,11 @@ asynchronously." requires)))) (list :kind 'vc) (package--alist-to-plist-args - (package-desc-extras pkg-desc)))) + (let ((extras (copy-alist (package-desc-extras pkg-desc)))) + (setf (alist-get :commit extras) + (package-vc-commit pkg-desc)) + extras) + ))) "\n") nil pkg-file nil 'silent)))) commit 98177d4b3d15e5b7a9c14d1588c13a928ed62da1 Author: Stefan Kangas Date: Sat Sep 21 13:25:00 2024 +0200 Document reporting security issues in user manual * doc/emacs/trouble.texi (Bugs): Document how to report important security issues. diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index c385d6b0b3d..2e2ee2dc961 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -550,6 +550,13 @@ investigating and fixing the bug, where you will receive copies of email messages discussing the bug, in which we might ask you to provide more information, test possible fixes, etc. +@cindex security, reporting issues +@item +If you think you may have found a security issue that needs to be +communicated privately, please contact the GNU Emacs maintainers +directly. See the file @file{admin/MAINTAINERS} in the Emacs +distribution for their contact details. + @item Finally, if you want to propose specific changes to Emacs, whether to fix a bug, add a new feature, or improve our documentation, please see commit b986e2018a489893ceae26d47aeccefd24bca69f Author: Stefan Kangas Date: Sat Sep 21 13:23:35 2024 +0200 * BUGS: Minor copy edit. diff --git a/BUGS b/BUGS index f23faa7c756..c2574b6367a 100644 --- a/BUGS +++ b/BUGS @@ -21,9 +21,9 @@ If necessary, you can read the manual without an info program: cat info/emacs* | more "+/^File: emacs.*, Node: Bugs," -If you think you may have found a critical security issue that needs -to be communicated privately, please contact the GNU Emacs maintainers -directly. See admin/MAINTAINERS for their contact details. +If you think you may have found a security issue that needs to be +communicated privately, please contact the GNU Emacs maintainers +directly. See the file admin/MAINTAINERS for their contact details. Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to