viper-ex.el 73 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306
  1. ;;; viper-ex.el --- functions implementing the Ex commands for Viper
  2. ;; Copyright (C) 1994-1998, 2000-2012 Free Software Foundation, Inc.
  3. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
  4. ;; Package: viper
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;; Code:
  18. (provide 'viper-ex)
  19. ;; Compiler pacifier
  20. (defvar read-file-name-map)
  21. (defvar viper-use-register)
  22. (defvar viper-s-string)
  23. (defvar viper-shift-width)
  24. (defvar viper-ex-history)
  25. (defvar viper-related-files-and-buffers-ring)
  26. (defvar viper-local-search-start-marker)
  27. (defvar viper-expert-level)
  28. (defvar viper-custom-file-name)
  29. (defvar viper-case-fold-search)
  30. (defvar explicit-shell-file-name)
  31. (defvar compile-command)
  32. ;; loading happens only in non-interactive compilation
  33. ;; in order to spare non-viperized emacs from being viperized
  34. (if noninteractive
  35. (eval-when-compile
  36. (if (not (featurep 'viper-cmd))
  37. (require 'viper-cmd))
  38. ))
  39. ;; end pacifier
  40. (require 'viper-util)
  41. (defgroup viper-ex nil
  42. "Viper support for Ex commands."
  43. :prefix "ex-"
  44. :group 'viper)
  45. ;;; Variables
  46. (defconst viper-ex-work-buf-name " *ex-working-space*")
  47. (defvar viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  48. (defconst viper-ex-tmp-buf-name " *ex-tmp*")
  49. (defconst viper-ex-print-buf-name " *ex-print*")
  50. (defvar viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name))
  51. ;;; ex-commands...
  52. (defun ex-cmd-obsolete (name)
  53. (error "`%s': Obsolete command, not supported by Viper" name))
  54. (defun ex-cmd-not-yet (name)
  55. (error "`%s': Command not implemented in Viper" name))
  56. ;; alist entries: name (in any order), command, cont(??)
  57. ;; If command is a string, then that is an alias to the real command
  58. ;; to execute (for instance, ":m" -> ":move").
  59. ;; command attributes:
  60. ;; is-mashed: the command's args may be jammed right up against the command
  61. ;; one-letter: this is a one-letter token. Any text appearing after
  62. ;; the name gets appended as an argument for the command
  63. ;; i.e. ":kabc" gets turned into (ex-mark "abc")
  64. (defconst ex-token-alist '(
  65. ("!" (ex-command))
  66. ("&" (ex-substitute t))
  67. ("=" (ex-line-no))
  68. (">" (ex-line "right"))
  69. ("<" (ex-line "left"))
  70. ("Buffer" (if ex-cycle-other-window
  71. (viper-switch-to-buffer)
  72. (viper-switch-to-buffer-other-window)))
  73. ("Next" (ex-next (not ex-cycle-other-window)))
  74. ("PreviousRelatedFile" (ex-next-related-buffer -1))
  75. ("RelatedFile" (ex-next-related-buffer 1))
  76. ("W" "Write")
  77. ("WWrite" (save-some-buffers t))
  78. ("Write" (save-some-buffers))
  79. ("a" "append")
  80. ("args" (ex-args))
  81. ("buffer" (if ex-cycle-other-window
  82. (viper-switch-to-buffer-other-window)
  83. (viper-switch-to-buffer)))
  84. ("c" "change")
  85. ;; ch should be "change" but maintain old viper compatibility
  86. ("ch" "chdir")
  87. ("cd" (ex-cd))
  88. ("chdir" (ex-cd))
  89. ("copy" (ex-copy nil))
  90. ("customize" (customize-group "viper"))
  91. ("delete" (ex-delete))
  92. ("edit" (ex-edit))
  93. ("file" (ex-set-visited-file-name))
  94. ("g" "global")
  95. ("global" (ex-global nil) is-mashed)
  96. ("goto" (ex-goto))
  97. ("help" (ex-help))
  98. ("join" (ex-line "join"))
  99. ("k" (ex-mark) one-letter)
  100. ("kmark" (ex-mark))
  101. ("m" "move")
  102. ("make" (ex-compile))
  103. ; old viper doesn't specify a default for "ma" so leave it undefined
  104. ("map" (ex-map))
  105. ("mark" (ex-mark))
  106. ("move" (ex-copy t))
  107. ("next" (ex-next ex-cycle-other-window))
  108. ("p" "print")
  109. ("preserve" (ex-preserve))
  110. ("print" (ex-print))
  111. ("put" (ex-put))
  112. ("pwd" (ex-pwd))
  113. ("quit" (ex-quit))
  114. ("r" "read")
  115. ("re" "read")
  116. ("read" (ex-read))
  117. ("recover" (ex-recover))
  118. ("rewind" (ex-rewind))
  119. ("s" "substitute")
  120. ("su" "substitute")
  121. ("sub" "substitute")
  122. ("set" (ex-set))
  123. ("shell" (ex-shell))
  124. ("source" (ex-source))
  125. ("stop" (suspend-emacs))
  126. ("sr" (ex-substitute t t))
  127. ("submitReport" (viper-submit-report))
  128. ("substitute" (ex-substitute) is-mashed)
  129. ("suspend" (suspend-emacs))
  130. ("t" "transfer")
  131. ("tag" (ex-tag))
  132. ("transfer" (ex-copy nil))
  133. ("u" "undo")
  134. ("un" "undo")
  135. ("undo" (viper-undo))
  136. ("unmap" (ex-unmap))
  137. ("v" "vglobal")
  138. ("version" (viper-version))
  139. ("vglobal" (ex-global t) is-mashed)
  140. ("visual" (ex-edit))
  141. ("w" "write")
  142. ("wq" (ex-write t))
  143. ("write" (ex-write nil))
  144. ("xit" (ex-write t))
  145. ("yank" (ex-yank))
  146. ("~" (ex-substitute t t))
  147. ("append" (ex-cmd-obsolete "append"))
  148. ("change" (ex-cmd-obsolete "change"))
  149. ("insert" (ex-cmd-obsolete "insert"))
  150. ("open" (ex-cmd-obsolete "open"))
  151. ("list" (ex-cmd-not-yet "list"))
  152. ("z" (ex-cmd-not-yet "z"))
  153. ("#" (ex-cmd-not-yet "#"))
  154. ("abbreviate" (error "`%s': Vi abbreviations are obsolete. Use the more powerful Emacs abbrevs" ex-token))
  155. ("unabbreviate" (error "`%s': Vi abbreviations are obsolete. Use the more powerful Emacs abbrevs" ex-token))
  156. ))
  157. ;; No code should touch anything in the alist entry! (other than the name,
  158. ;; "car entry", of course) This way, changing this data structure
  159. ;; requires changing only the following ex-cmd functions...
  160. ;; Returns cmd if the command may be jammed right up against its
  161. ;; arguments, nil if there must be a space.
  162. ;; examples of mashable commands: g// g!// v// s// sno// sm//
  163. (defun ex-cmd-is-mashed-with-args (cmd)
  164. (if (eq 'is-mashed (car (nthcdr 2 cmd))) cmd))
  165. ;; Returns true if this is a one-letter command that may be followed
  166. ;; by anything, no whitespace needed. This is a special-case for ":k".
  167. (defun ex-cmd-is-one-letter (cmd)
  168. (if (eq 'one-letter (car (nthcdr 2 cmd))) cmd))
  169. ;; Executes the function associated with the command
  170. (defun ex-cmd-execute (cmd)
  171. (eval (cadr cmd)))
  172. ;; If this is a one-letter magic command, splice in args.
  173. (defun ex-splice-args-in-1-letr-cmd (key list)
  174. (let ((oneletter (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
  175. (if oneletter
  176. (list key
  177. (append (cadr oneletter)
  178. (if (< 1 (length key)) (list (substring key 1))))
  179. (car (cdr (cdr oneletter))) ))
  180. ))
  181. ;; Returns the alist entry for the appropriate key.
  182. ;; Tries to complete the key before using it in the alist.
  183. ;; If there is no appropriate key (no match or duplicate matches) return nil
  184. (defun ex-cmd-assoc (key list)
  185. (let ((entry (try-completion key list))
  186. result)
  187. (setq result (cond
  188. ((eq entry t) (assoc key list))
  189. ((stringp entry) (or (ex-splice-args-in-1-letr-cmd key list)
  190. (assoc entry list)))
  191. ((eq entry nil) (ex-splice-args-in-1-letr-cmd key list))
  192. (t nil)
  193. ))
  194. ;; If we end up with an alias, look up the alias...
  195. (if (stringp (cadr result))
  196. (setq result (ex-cmd-assoc (cadr result) list)))
  197. ;; and return the corresponding alist entry
  198. result
  199. ))
  200. ;; A-list of Ex variables that can be set using the :set command.
  201. (defconst ex-variable-alist
  202. '(("wrapscan") ("ws") ("wrapmargin") ("wm")
  203. ("tabstop-global") ("ts-g") ("tabstop") ("ts")
  204. ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh")
  205. ("readonly") ("ro")
  206. ("nowrapscan") ("nows") ("noshowmatch") ("nosm")
  207. ("noreadonly") ("noro") ("nomagic") ("noma")
  208. ("noignorecase") ("noic")
  209. ("noautoindent-global") ("noai-g") ("noautoindent") ("noai")
  210. ("magic") ("ma") ("ignorecase") ("ic")
  211. ("autoindent-global") ("ai-g") ("autoindent") ("ai")
  212. ("all")
  213. ))
  214. ;; Token recognized during parsing of Ex commands (e.g., "read", "comma")
  215. (defvar ex-token nil)
  216. ;; Type of token.
  217. ;; If non-nil, gives type of address; if nil, it is a command.
  218. (defvar ex-token-type nil)
  219. ;; List of addresses passed to Ex command
  220. (defvar ex-addresses nil)
  221. ;; This flag is supposed to be set only by `#', `print', and `list',
  222. ;; none of which is implemented. So, it and the pieces of the code it
  223. ;; controls are dead weight. We keep it just in case this might be
  224. ;; needed in the future.
  225. (defvar ex-flag nil)
  226. ;; "buffer" where Ex commands keep deleted data.
  227. ;; In Emacs terms, this is a register.
  228. (defvar ex-buffer nil)
  229. ;; Value of ex count.
  230. (defvar ex-count nil)
  231. ;; Flag indicating that :global Ex command is being executed.
  232. (defvar ex-g-flag nil)
  233. ;; Flag indicating that :vglobal Ex command is being executed.
  234. (defvar ex-g-variant nil)
  235. ;; Marks to operate on during a :global Ex command.
  236. (defvar ex-g-marks nil)
  237. ;; Save reg-exp used in substitute.
  238. (defvar ex-reg-exp nil)
  239. ;; Replace pattern for substitute.
  240. (defvar ex-repl nil)
  241. ;; Pattern for global command.
  242. (defvar ex-g-pat nil)
  243. (defcustom ex-unix-type-shell
  244. (let ((case-fold-search t))
  245. (and (stringp shell-file-name)
  246. (string-match
  247. (concat
  248. "\\("
  249. "csh$\\|csh.exe$"
  250. "\\|"
  251. "ksh$\\|ksh.exe$"
  252. "\\|"
  253. "^sh$\\|sh.exe$"
  254. "\\|"
  255. "[^a-z]sh$\\|[^a-z]sh.exe$"
  256. "\\|"
  257. "bash$\\|bash.exe$"
  258. "\\)")
  259. shell-file-name)))
  260. "Is the user using a unix-type shell under a non-OS?"
  261. :type 'boolean
  262. :group 'viper-ex)
  263. (defcustom ex-unix-type-shell-options
  264. (let ((case-fold-search t))
  265. (if ex-unix-type-shell
  266. (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name)
  267. "-f") ; csh: do it fast
  268. ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name)
  269. "-noprofile") ; bash: ignore .profile
  270. )))
  271. "Options to pass to the Unix-style shell.
  272. Don't put `-c' here, as it is added automatically."
  273. :type '(choice (const nil) string)
  274. :group 'viper-ex)
  275. (defcustom ex-compile-command "make"
  276. "The command to run when the user types :make."
  277. :type 'string
  278. :group 'viper-ex)
  279. (defcustom viper-glob-function
  280. (cond (ex-unix-type-shell 'viper-glob-unix-files)
  281. (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
  282. (t 'viper-glob-unix-files) ; presumably UNIX
  283. )
  284. "Expand the file spec containing wildcard symbols.
  285. The default tries to set this variable to work with Unix, Windows,
  286. and OS/2.
  287. However, if it doesn't work right for some types of Unix shells or some OS,
  288. the user should supply the appropriate function and set this variable to the
  289. corresponding function symbol."
  290. :type 'symbol
  291. :group 'viper-ex)
  292. ;; Remembers the previous Ex tag.
  293. (defvar ex-tag nil)
  294. ;; file used by Ex commands like :r, :w, :n
  295. (defvar ex-file nil)
  296. ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
  297. (defvar ex-variant nil)
  298. ;; Specified the offset of an Ex command, such as :read.
  299. (defvar ex-offset nil)
  300. ;; Tells Ex that this is a w>> command.
  301. (defvar ex-append nil)
  302. ;; File containing the shell command to be executed at Ex prompt,
  303. ;; e.g., :r !date
  304. (defvar ex-cmdfile nil)
  305. (defvar ex-cmdfile-args "")
  306. ;; flag used in viper-ex-read-file-name to indicate that we may be reading
  307. ;; multiple file names. Used for :edit and :next
  308. (defvar viper-keep-reading-filename nil)
  309. (defcustom ex-cycle-other-window t
  310. "*If t, :n and :b cycles through files and buffers in other window.
  311. Then :N and :B cycles in the current window. If nil, this behavior is
  312. reversed."
  313. :type 'boolean
  314. :group 'viper-ex)
  315. (defcustom ex-cycle-through-non-files nil
  316. "*Cycle through *scratch* and other buffers that don't visit any file."
  317. :type 'boolean
  318. :group 'viper-ex)
  319. ;; Last shell command executed with :! command.
  320. (defvar viper-ex-last-shell-com nil)
  321. ;; Indicates if Minibuffer was exited temporarily in Ex-command.
  322. (defvar viper-incomplete-ex-cmd nil)
  323. ;; Remembers the last ex-command prompt.
  324. (defvar viper-last-ex-prompt "")
  325. ;; Get a complete ex command
  326. (defun viper-get-ex-com-subr ()
  327. (let (cmd case-fold-search)
  328. (set-mark (point))
  329. (re-search-forward "[a-zA-Z][a-zA-Z]*")
  330. (setq ex-token-type 'command)
  331. (setq ex-token (buffer-substring (point) (mark t)))
  332. (setq cmd (ex-cmd-assoc ex-token ex-token-alist))
  333. (if cmd
  334. (setq ex-token (car cmd))
  335. (setq ex-token-type 'non-command))
  336. ))
  337. ;; Get an ex-token which is either an address or a command.
  338. ;; A token has a type, \(command, address, end-mark\), and a value
  339. (defun viper-get-ex-token ()
  340. (save-window-excursion
  341. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  342. (set-buffer viper-ex-work-buf)
  343. (skip-chars-forward " \t|")
  344. (let ((case-fold-search t))
  345. (cond ((looking-at "#")
  346. (setq ex-token-type 'command)
  347. (setq ex-token (char-to-string (following-char)))
  348. (forward-char 1))
  349. ((looking-at "[a-z]") (viper-get-ex-com-subr))
  350. ((looking-at "\\.")
  351. (forward-char 1)
  352. (setq ex-token-type 'dot))
  353. ((looking-at "[0-9]")
  354. (set-mark (point))
  355. (re-search-forward "[0-9]*")
  356. (setq ex-token-type
  357. (cond ((eq ex-token-type 'plus) 'add-number)
  358. ((eq ex-token-type 'minus) 'sub-number)
  359. (t 'abs-number)))
  360. (setq ex-token
  361. (string-to-number (buffer-substring (point) (mark t)))))
  362. ((looking-at "\\$")
  363. (forward-char 1)
  364. (setq ex-token-type 'end))
  365. ((looking-at "%")
  366. (forward-char 1)
  367. (setq ex-token-type 'whole))
  368. ((looking-at "+")
  369. (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
  370. (forward-char 1)
  371. (insert "1")
  372. (backward-char 1)
  373. (setq ex-token-type 'plus))
  374. ((looking-at "+[0-9]")
  375. (forward-char 1)
  376. (setq ex-token-type 'plus))
  377. (t
  378. (error viper-BadAddress))))
  379. ((looking-at "-")
  380. (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
  381. (forward-char 1)
  382. (insert "1")
  383. (backward-char 1)
  384. (setq ex-token-type 'minus))
  385. ((looking-at "-[0-9]")
  386. (forward-char 1)
  387. (setq ex-token-type 'minus))
  388. (t
  389. (error viper-BadAddress))))
  390. ((looking-at "/")
  391. (forward-char 1)
  392. (set-mark (point))
  393. (let ((cont t))
  394. (while (and (not (eolp)) cont)
  395. ;;(re-search-forward "[^/]*/")
  396. (re-search-forward "[^/]*\\(/\\|\n\\)")
  397. (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
  398. (setq cont nil))))
  399. (backward-char 1)
  400. (setq ex-token (buffer-substring (point) (mark t)))
  401. (if (looking-at "/") (forward-char 1))
  402. (setq ex-token-type 'search-forward))
  403. ((looking-at "\\?")
  404. (forward-char 1)
  405. (set-mark (point))
  406. (let ((cont t))
  407. (while (and (not (eolp)) cont)
  408. ;;(re-search-forward "[^\\?]*\\?")
  409. (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
  410. (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
  411. (setq cont nil))
  412. (backward-char 1)
  413. (if (not (looking-at "\n")) (forward-char 1))))
  414. (setq ex-token-type 'search-backward)
  415. (setq ex-token (buffer-substring (1- (point)) (mark t))))
  416. ((looking-at ",")
  417. (forward-char 1)
  418. (setq ex-token-type 'comma))
  419. ((looking-at ";")
  420. (forward-char 1)
  421. (setq ex-token-type 'semi-colon))
  422. ((looking-at "[!=><&~]")
  423. (setq ex-token-type 'command)
  424. (setq ex-token (char-to-string (following-char)))
  425. (forward-char 1))
  426. ((looking-at "'")
  427. (setq ex-token-type 'goto-mark)
  428. (forward-char 1)
  429. (cond ((looking-at "'") (setq ex-token nil))
  430. ((looking-at "[a-z]") (setq ex-token (following-char)))
  431. (t (error "Marks are ' and a-z")))
  432. (forward-char 1))
  433. ((looking-at "\n")
  434. (setq ex-token-type 'end-mark)
  435. (setq ex-token "goto"))
  436. (t
  437. (error viper-BadExCommand))))))
  438. ;; Reads Ex command. Tries to determine if it has to exit because command
  439. ;; is complete or invalid. If not, keeps reading command.
  440. (defun ex-cmd-read-exit ()
  441. (interactive)
  442. (setq viper-incomplete-ex-cmd t)
  443. (let ((quit-regex1 (concat
  444. "\\(" "set[ \t]*"
  445. "\\|" "edit[ \t]*"
  446. "\\|" "[nN]ext[ \t]*"
  447. "\\|" "unm[ \t]*"
  448. "\\|" "^[ \t]*rep"
  449. "\\)"))
  450. (quit-regex2 (concat
  451. "[a-zA-Z][ \t]*"
  452. "\\(" "!" "\\|" ">>"
  453. "\\|" "\\+[0-9]+"
  454. "\\)"
  455. "*[ \t]*$"))
  456. (stay-regex (concat
  457. "\\(" "^[ \t]*$"
  458. "\\|" "[?/].*"
  459. "\\|" "[ktgjmsz][ \t]*$"
  460. "\\|" "^[ \t]*ab.*"
  461. "\\|" "tr[ansfer \t]*"
  462. "\\|" "sr[ \t]*"
  463. "\\|" "mo.*"
  464. "\\|" "^[ \t]*k?ma[^p]*"
  465. "\\|" "^[ \t]*fi.*"
  466. "\\|" "v?gl.*"
  467. "\\|" "[vg][ \t]*$"
  468. "\\|" "jo.*"
  469. "\\|" "^[ \t]*ta.*"
  470. "\\|" "^[ \t]*una.*"
  471. ;; don't jump up in :s command
  472. "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*"
  473. "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*"
  474. "\\|" "['`][a-z][ \t]*"
  475. ;; r! assumes that the next one is a shell command
  476. "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!"
  477. ;; w ! assumes that the next one is a shell command
  478. "\\|" "\\(w\\|wr\\|wri\\|writ.?\\)[ \t]+!"
  479. "\\|" "![ \t]*[a-zA-Z].*"
  480. "\\)"
  481. "!*")))
  482. (save-window-excursion ;; put cursor at the end of the Ex working buffer
  483. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  484. (set-buffer viper-ex-work-buf)
  485. (goto-char (point-max)))
  486. (cond ((viper-looking-back quit-regex1) (exit-minibuffer))
  487. ((viper-looking-back stay-regex) (insert " "))
  488. ((viper-looking-back quit-regex2) (exit-minibuffer))
  489. (t (insert " ")))))
  490. ;; complete Ex command
  491. (defun ex-cmd-complete ()
  492. (interactive)
  493. (let (save-pos dist compl-list string-to-complete completion-result)
  494. (save-excursion
  495. (setq dist (skip-chars-backward "[a-zA-Z!=>&~]")
  496. save-pos (point)))
  497. (if (or (= dist 0)
  498. (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
  499. (viper-looking-back
  500. "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
  501. ;; Preceding characters are not the ones allowed in an Ex command
  502. ;; or we have typed past command name.
  503. ;; Note: we didn't do parsing, so there can be surprises.
  504. (if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
  505. (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
  506. (looking-at "[^ \t\n\C-m]"))
  507. nil
  508. (with-output-to-temp-buffer "*Completions*"
  509. (display-completion-list
  510. (viper-alist-to-list ex-token-alist))))
  511. ;; Preceding chars may be part of a command name
  512. (setq string-to-complete (buffer-substring save-pos (point)))
  513. (setq completion-result
  514. (try-completion string-to-complete ex-token-alist))
  515. (cond ((eq completion-result t) ; exact match--do nothing
  516. (viper-tmp-insert-at-eob " (Sole completion)"))
  517. ((eq completion-result nil)
  518. (viper-tmp-insert-at-eob " (No match)"))
  519. (t ;; partial completion
  520. (goto-char save-pos)
  521. (delete-region (point) (point-max))
  522. (insert completion-result)
  523. (let (case-fold-search)
  524. (setq compl-list
  525. (viper-filter-alist (concat "^" completion-result)
  526. ex-token-alist)))
  527. (if (> (length compl-list) 1)
  528. (with-output-to-temp-buffer "*Completions*"
  529. (display-completion-list
  530. (viper-alist-to-list (reverse compl-list)))))))
  531. )))
  532. ;; Read Ex commands
  533. ;; ARG is a prefix argument. If given, the ex command runs on the region
  534. ;;(without the user having to specify the address :a,b
  535. ;; STRING is the command to execute. If nil, then Viper asks you to enter the
  536. ;; command.
  537. (defun viper-ex (arg &optional string)
  538. (interactive "P")
  539. (or string
  540. (setq ex-g-flag nil
  541. ex-g-variant nil))
  542. (let* ((map (copy-keymap minibuffer-local-map))
  543. (address nil)
  544. (cont t)
  545. (dot (point))
  546. reg-beg-line reg-end-line
  547. reg-beg reg-end
  548. initial-str
  549. prev-token-type com-str)
  550. (viper-add-keymap viper-ex-cmd-map map)
  551. (if arg
  552. (progn
  553. (viper-enlarge-region (mark t) (point))
  554. (if (> (point) (mark t))
  555. (setq reg-beg (mark t)
  556. reg-end (point))
  557. (setq reg-end (mark t)
  558. reg-beg (point)))
  559. (save-excursion
  560. (goto-char reg-beg)
  561. (setq reg-beg-line (1+ (count-lines (point-min) (point)))
  562. reg-end-line
  563. (+ reg-beg-line (count-lines reg-beg reg-end) -1)))))
  564. (if reg-beg-line
  565. (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))
  566. (setq com-str
  567. (if string
  568. (concat initial-str string)
  569. (viper-read-string-with-history
  570. ":"
  571. initial-str
  572. 'viper-ex-history
  573. ;; no default when working on region
  574. (if initial-str
  575. nil
  576. (car viper-ex-history))
  577. map
  578. (if initial-str
  579. " [Type command to execute on current region]"))))
  580. (save-window-excursion
  581. ;; just a precaution
  582. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  583. (set-buffer viper-ex-work-buf)
  584. (delete-region (point-min) (point-max))
  585. (insert com-str "\n")
  586. (goto-char (point-min)))
  587. (setq ex-token-type nil
  588. ex-addresses nil)
  589. (while cont
  590. (viper-get-ex-token)
  591. (cond ((memq ex-token-type '(command end-mark))
  592. (if address (setq ex-addresses (cons address ex-addresses)))
  593. (viper-deactivate-mark)
  594. (let ((cmd (ex-cmd-assoc ex-token ex-token-alist)))
  595. (if (null cmd)
  596. (error "`%s': %s" ex-token viper-BadExCommand))
  597. (ex-cmd-execute cmd)
  598. (if (or (ex-cmd-is-mashed-with-args cmd)
  599. (ex-cmd-is-one-letter cmd))
  600. (setq cont nil)
  601. (save-excursion
  602. (save-window-excursion
  603. (setq viper-ex-work-buf
  604. (get-buffer-create viper-ex-work-buf-name))
  605. (set-buffer viper-ex-work-buf)
  606. (skip-chars-forward " \t")
  607. (cond ((looking-at "|")
  608. (forward-char 1))
  609. ((looking-at "\n")
  610. (setq cont nil))
  611. (t (error
  612. "`%s': %s" ex-token viper-SpuriousText)))
  613. )))
  614. ))
  615. ((eq ex-token-type 'non-command)
  616. (error "`%s': %s" ex-token viper-BadExCommand))
  617. ((eq ex-token-type 'whole)
  618. (setq address nil)
  619. (setq ex-addresses
  620. (if ex-addresses
  621. (cons (point-max) ex-addresses)
  622. (cons (point-max) (cons (point-min) ex-addresses)))))
  623. ((eq ex-token-type 'comma)
  624. (if (eq prev-token-type 'whole)
  625. (setq address (point-min)))
  626. (setq ex-addresses
  627. (cons (if (null address) (point) address) ex-addresses)))
  628. ((eq ex-token-type 'semi-colon)
  629. (if (eq prev-token-type 'whole)
  630. (setq address (point-min)))
  631. (if address (setq dot address))
  632. (setq ex-addresses
  633. (cons (if (null address) (point) address) ex-addresses)))
  634. (t (let ((ans (viper-get-ex-address-subr address dot)))
  635. (if ans (setq address ans)))))
  636. (setq prev-token-type ex-token-type))))
  637. ;; Get a regular expression and set `ex-variant', if found
  638. ;; Viper doesn't parse the substitution or search patterns.
  639. ;; In particular, it doesn't expand ~ into the last substitution.
  640. (defun viper-get-ex-pat ()
  641. (save-window-excursion
  642. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  643. (set-buffer viper-ex-work-buf)
  644. (skip-chars-forward " \t")
  645. (if (looking-at "!")
  646. ;; this is probably a variant command r!
  647. (progn
  648. (setq ex-g-variant (not ex-g-variant)
  649. ex-g-flag (not ex-g-flag))
  650. (forward-char 1)
  651. (skip-chars-forward " \t")))
  652. (let ((c (following-char)))
  653. (cond ((string-match "[0-9A-Za-z]" (format "%c" c))
  654. (error
  655. "Global regexp must be inside matching non-alphanumeric chars"))
  656. ((= c ??) (error "`?' is not an allowed pattern delimiter here")))
  657. (if (looking-at "[^\\\\\n]")
  658. (progn
  659. (forward-char 1)
  660. (set-mark (point))
  661. (let ((cont t))
  662. ;; the use of eobp instead of eolp permits the use of newlines in
  663. ;; pat2 in s/pat1/pat2/
  664. (while (and (not (eobp)) cont)
  665. (if (not (re-search-forward (format "[^%c]*%c" c c) nil t))
  666. (if (member ex-token '("global" "vglobal"))
  667. (error "Missing closing delimiter for global regexp")
  668. (goto-char (point-max))))
  669. (if (not (viper-looking-back
  670. (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
  671. (setq cont nil)
  672. ;; we are at an escaped delimiter: unescape it and continue
  673. (delete-char -2)
  674. (insert c)
  675. (if (eolp)
  676. ;; if at eol, exit loop and go to next line
  677. ;; later, delim will be inserted at the end
  678. (progn
  679. (setq cont nil)
  680. (forward-char))))
  681. ))
  682. (setq ex-token
  683. (if (= (mark t) (point)) ""
  684. (buffer-substring (1- (point)) (mark t))))
  685. (backward-char 1)
  686. ;; if the user didn't insert the final pattern delimiter, we're
  687. ;; at newline now. In this case, insert the initial delimiter
  688. ;; specified in variable c
  689. (if (eolp)
  690. (progn
  691. (insert c)
  692. (backward-char 1)))
  693. )
  694. (setq ex-token nil))
  695. c)))
  696. ;; Get an Ex option g or c
  697. (defun viper-get-ex-opt-gc (c)
  698. (save-window-excursion
  699. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  700. (set-buffer viper-ex-work-buf)
  701. (if (looking-at (format "%c" c)) (forward-char 1))
  702. (skip-chars-forward " \t")
  703. (cond ((looking-at "g")
  704. (setq ex-token "g")
  705. (forward-char 1)
  706. t)
  707. ((looking-at "c")
  708. (setq ex-token "c")
  709. (forward-char 1)
  710. t)
  711. (t nil))))
  712. ;; Compute default addresses. WHOLE-FLAG means use the whole buffer
  713. (defun viper-default-ex-addresses (&optional whole-flag)
  714. (cond ((null ex-addresses)
  715. (setq ex-addresses
  716. (if whole-flag
  717. (list (point-max) (point-min))
  718. (list (point) (point)))))
  719. ((null (cdr ex-addresses))
  720. (setq ex-addresses
  721. (cons (car ex-addresses) ex-addresses)))))
  722. ;; Get an ex-address as a marker and set ex-flag if a flag is found
  723. (defun viper-get-ex-address ()
  724. (let ((address (point-marker))
  725. (cont t))
  726. (setq ex-token "")
  727. (setq ex-flag nil)
  728. (while cont
  729. (viper-get-ex-token)
  730. (cond ((eq ex-token-type 'command)
  731. (if (member ex-token '("print" "list" "#"))
  732. (progn
  733. (setq ex-flag t
  734. cont nil))
  735. (error "Address expected in this Ex command")))
  736. ((eq ex-token-type 'end-mark)
  737. (setq cont nil))
  738. ((eq ex-token-type 'whole)
  739. (error "Trailing address expected"))
  740. ((eq ex-token-type 'comma)
  741. (error "`%s': %s" ex-token viper-SpuriousText))
  742. (t (let ((ans (viper-get-ex-address-subr address (point-marker))))
  743. (if ans (setq address ans))))))
  744. address))
  745. ;; Returns an address as a point
  746. (defun viper-get-ex-address-subr (old-address dot)
  747. (let ((address nil))
  748. (if (null old-address) (setq old-address dot))
  749. (cond ((eq ex-token-type 'dot)
  750. (setq address dot))
  751. ((eq ex-token-type 'add-number)
  752. (save-excursion
  753. (goto-char old-address)
  754. (forward-line (if (= old-address 0) (1- ex-token) ex-token))
  755. (setq address (point-marker))))
  756. ((eq ex-token-type 'sub-number)
  757. (save-excursion
  758. (goto-char old-address)
  759. (forward-line (- ex-token))
  760. (setq address (point-marker))))
  761. ((eq ex-token-type 'abs-number)
  762. (save-excursion
  763. (goto-char (point-min))
  764. (if (= ex-token 0) (setq address 0)
  765. (forward-line (1- ex-token))
  766. (setq address (point-marker)))))
  767. ((eq ex-token-type 'end)
  768. (save-excursion
  769. (goto-char (1- (point-max)))
  770. (setq address (point-marker))))
  771. ((eq ex-token-type 'plus) t) ; do nothing
  772. ((eq ex-token-type 'minus) t) ; do nothing
  773. ((eq ex-token-type 'search-forward)
  774. (save-excursion
  775. (ex-search-address t)
  776. (setq address (point-marker))))
  777. ((eq ex-token-type 'search-backward)
  778. (save-excursion
  779. (ex-search-address nil)
  780. (setq address (point-marker))))
  781. ((eq ex-token-type 'goto-mark)
  782. (save-excursion
  783. (if (null ex-token)
  784. (exchange-point-and-mark)
  785. (goto-char
  786. (viper-register-to-point
  787. (viper-int-to-char (1+ (- ex-token ?a))) 'enforce-buffer)))
  788. (setq address (point-marker)))))
  789. address))
  790. ;; Search pattern and set address
  791. ;; Doesn't wrap around. Should it?
  792. (defun ex-search-address (forward)
  793. (if (string= ex-token "")
  794. (if (null viper-s-string)
  795. (error viper-NoPrevSearch)
  796. (setq ex-token viper-s-string))
  797. (setq viper-s-string ex-token))
  798. (if forward
  799. (progn
  800. (forward-line 1)
  801. (re-search-forward ex-token))
  802. (forward-line -1)
  803. (re-search-backward ex-token)))
  804. ;; Get a buffer name and set `ex-count' and `ex-flag' if found
  805. (defun viper-get-ex-buffer ()
  806. (setq ex-buffer nil)
  807. (setq ex-count nil)
  808. (setq ex-flag nil)
  809. (save-window-excursion
  810. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  811. (set-buffer viper-ex-work-buf)
  812. (skip-chars-forward " \t")
  813. (if (looking-at "[a-zA-Z]")
  814. (progn
  815. (setq ex-buffer (following-char))
  816. (forward-char 1)
  817. (skip-chars-forward " \t")))
  818. (if (looking-at "[0-9]")
  819. (progn
  820. (set-mark (point))
  821. (re-search-forward "[0-9][0-9]*")
  822. (setq ex-count (string-to-number (buffer-substring (point) (mark t))))
  823. (skip-chars-forward " \t")))
  824. (if (looking-at "[pl#]")
  825. (progn
  826. (setq ex-flag t)
  827. (forward-char 1)))
  828. (if (not (looking-at "[\n|]"))
  829. (error "`%s': %s" ex-token viper-SpuriousText))))
  830. (defun viper-get-ex-count ()
  831. (setq ex-variant nil
  832. ex-count nil
  833. ex-flag nil)
  834. (save-window-excursion
  835. (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
  836. (set-buffer viper-ex-work-buf)
  837. (skip-chars-forward " \t")
  838. (if (looking-at "!")
  839. (progn
  840. (setq ex-variant t)
  841. (forward-char 1)))
  842. (skip-chars-forward " \t")
  843. (if (looking-at "[0-9]")
  844. (progn
  845. (set-mark (point))
  846. (re-search-forward "[0-9][0-9]*")
  847. (setq ex-count (string-to-number (buffer-substring (point) (mark t))))
  848. (skip-chars-forward " \t")))
  849. (if (looking-at "[pl#]")
  850. (progn
  851. (setq ex-flag t)
  852. (forward-char 1)))
  853. (if (not (looking-at "[\n|]"))
  854. (error "`%s': %s"
  855. (buffer-substring
  856. (point-min) (1- (point-max))) viper-BadExCommand))))
  857. ;; Expand \% and \# in ex command
  858. (defun ex-expand-filsyms (cmd buf)
  859. (let (cf pf ret)
  860. (with-current-buffer buf
  861. (setq cf buffer-file-name)
  862. (setq pf (ex-next nil t))) ; this finds alternative file name
  863. (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
  864. (error "No current file to substitute for `%%'"))
  865. (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
  866. (error "No alternate file to substitute for `#'"))
  867. (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name)
  868. (erase-buffer)
  869. (insert cmd)
  870. (goto-char (point-min))
  871. (while (re-search-forward "%\\|#" nil t)
  872. (let ((data (match-data))
  873. (char (buffer-substring (match-beginning 0) (match-end 0))))
  874. (if (viper-looking-back (concat "\\\\" char))
  875. (replace-match char)
  876. (store-match-data data)
  877. (if (string= char "%")
  878. (replace-match cf)
  879. (replace-match pf)))))
  880. (end-of-line)
  881. (setq ret (buffer-substring (point-min) (point)))
  882. (message "%s" ret))
  883. ret))
  884. ;; Get a file name and set `ex-variant', `ex-append' and `ex-offset' if found
  885. ;; If it is r!, then get the command name and whatever args
  886. (defun viper-get-ex-file ()
  887. (let (prompt)
  888. (setq ex-file nil
  889. ex-variant nil
  890. ex-append nil
  891. ex-offset nil
  892. ex-cmdfile nil
  893. ex-cmdfile-args "")
  894. (save-excursion
  895. (with-current-buffer (setq viper-ex-work-buf
  896. (get-buffer-create viper-ex-work-buf-name))
  897. (skip-chars-forward " \t")
  898. (if (looking-at "!")
  899. (if (and (not (viper-looking-back "[ \t]"))
  900. ;; read doesn't have a corresponding :r! form, so ! is
  901. ;; immediately interpreted as a shell command.
  902. (not (string= ex-token "read")))
  903. (progn
  904. (setq ex-variant t)
  905. (forward-char 1)
  906. (skip-chars-forward " \t"))
  907. (setq ex-cmdfile t)
  908. (forward-char 1)
  909. (skip-chars-forward " \t")))
  910. (if (looking-at ">>")
  911. (progn
  912. (setq ex-append t
  913. ex-variant t)
  914. (forward-char 2)
  915. (skip-chars-forward " \t")))
  916. (if (looking-at "+")
  917. (progn
  918. (forward-char 1)
  919. (set-mark (point))
  920. (re-search-forward "[ \t\n]")
  921. (backward-char 1)
  922. (setq ex-offset (buffer-substring (point) (mark t)))
  923. (forward-char 1)
  924. (skip-chars-forward " \t")))
  925. ;; this takes care of :r, :w, etc., when they get file names
  926. ;; from the history list
  927. (if (member ex-token '("read" "write" "edit" "visual" "next"))
  928. (progn
  929. (setq ex-file (buffer-substring (point) (1- (point-max))))
  930. (setq ex-file
  931. ;; For :e, match multiple non-white strings separated
  932. ;; by white. For others, find the first non-white string
  933. (if (string-match
  934. (if (string= ex-token "edit")
  935. "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*"
  936. "[^ \t\n]+")
  937. ex-file)
  938. (progn
  939. ;; if file name comes from history, don't leave
  940. ;; minibuffer when the user types space
  941. (setq viper-incomplete-ex-cmd nil)
  942. (setq ex-cmdfile-args
  943. (substring ex-file (match-end 0) nil))
  944. ;; this must be the last clause in this progn
  945. (substring ex-file (match-beginning 0) (match-end 0))
  946. )
  947. ""))
  948. ;; this leaves only the command name in the work area
  949. ;; file names are gone
  950. (delete-region (point) (1- (point-max)))
  951. ))
  952. (goto-char (point-max))
  953. (skip-chars-backward " \t\n")
  954. (setq prompt (buffer-substring (point-min) (point)))
  955. ))
  956. (setq viper-last-ex-prompt prompt)
  957. ;; If we just finished reading command, redisplay prompt
  958. (if viper-incomplete-ex-cmd
  959. (setq ex-file (viper-ex-read-file-name (format ":%s " prompt)))
  960. ;; file was typed in-line
  961. (setq ex-file (or ex-file "")))
  962. ))
  963. ;; Completes file name or exits minibuffer. If Ex command accepts multiple
  964. ;; file names, arranges to re-enter the minibuffer.
  965. (defun viper-complete-filename-or-exit ()
  966. (interactive)
  967. (setq viper-keep-reading-filename t)
  968. ;; don't exit if directory---ex-commands don't
  969. (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer))
  970. ;; apparently the argument to an Ex command is
  971. ;; supposed to be a shell command
  972. ((viper-looking-back "^[ \t]*!.*")
  973. (setq ex-cmdfile t)
  974. (insert " "))
  975. (t
  976. (setq ex-cmdfile nil)
  977. (minibuffer-complete-word))))
  978. (defun viper-handle-! ()
  979. (interactive)
  980. (if (and (string=
  981. (buffer-string) (viper-abbreviate-file-name default-directory))
  982. (member ex-token '("read" "write")))
  983. (erase-buffer))
  984. (insert "!"))
  985. (defun ex-cmd-accepts-multiple-files-p (token)
  986. (member token '("edit" "next" "Next")))
  987. ;; Read file name from the minibuffer in an ex command.
  988. ;; If user doesn't enter anything, then "" is returned, i.e., the
  989. ;; prompt-directory is not returned.
  990. (defun viper-ex-read-file-name (prompt)
  991. (let* ((str "")
  992. (minibuffer-local-completion-map
  993. (copy-keymap minibuffer-local-completion-map))
  994. beg end cont val)
  995. (viper-add-keymap ex-read-filename-map
  996. (if (featurep 'emacs)
  997. minibuffer-local-completion-map
  998. read-file-name-map))
  999. (setq cont (setq viper-keep-reading-filename t))
  1000. (while cont
  1001. (setq viper-keep-reading-filename nil
  1002. val (read-file-name (concat prompt str) nil default-directory))
  1003. (setq val (expand-file-name val))
  1004. (if (and (string-match " " val)
  1005. (ex-cmd-accepts-multiple-files-p ex-token))
  1006. (setq val (concat "\"" val "\"")))
  1007. (setq str (concat str (if (equal val "") "" " ")
  1008. val (if (equal val "") "" " ")))
  1009. ;; Only edit, next, and Next commands accept multiple files.
  1010. ;; viper-keep-reading-filename is set in the anonymous function that is
  1011. ;; bound to " " in ex-read-filename-map.
  1012. (setq cont (and viper-keep-reading-filename
  1013. (ex-cmd-accepts-multiple-files-p ex-token)))
  1014. )
  1015. (setq beg (string-match "[^ \t]" str) ; delete leading blanks
  1016. end (string-match "[ \t]*$" str)) ; delete trailing blanks
  1017. (if (member ex-token '("read" "write"))
  1018. (if (string-match "[\t ]*!" str)
  1019. ;; this is actually a shell command
  1020. (progn
  1021. (setq ex-cmdfile t)
  1022. (setq beg (1+ beg))
  1023. (setq viper-last-ex-prompt
  1024. (concat viper-last-ex-prompt " !")))))
  1025. (substring str (or beg 0) end)))
  1026. (defun viper-undisplayed-files ()
  1027. (mapcar
  1028. (lambda (b)
  1029. (if (null (get-buffer-window b))
  1030. (let ((f (buffer-file-name b)))
  1031. (if f f
  1032. (if ex-cycle-through-non-files
  1033. (let ((s (buffer-name b)))
  1034. (if (string= " " (substring s 0 1))
  1035. nil
  1036. s))
  1037. nil)))
  1038. nil))
  1039. (buffer-list)))
  1040. (defun ex-args ()
  1041. (let ((l (viper-undisplayed-files))
  1042. (args "")
  1043. (file-count 1))
  1044. (while (not (null l))
  1045. (if (car l)
  1046. (setq args (format "%s %d) %s\n" args file-count (car l))
  1047. file-count (1+ file-count)))
  1048. (setq l (cdr l)))
  1049. (if (string= args "")
  1050. (message "All files are already displayed")
  1051. (save-excursion
  1052. (save-window-excursion
  1053. (with-output-to-temp-buffer " *viper-info*"
  1054. (princ "\n\nThese files are not displayed in any window.\n")
  1055. (princ "\n=============\n")
  1056. (princ args)
  1057. (princ "\n=============\n")
  1058. (princ "\nThe numbers can be given as counts to :next. ")
  1059. (princ "\n\nPress any key to continue...\n\n"))
  1060. (viper-read-event))))))
  1061. ;; Ex cd command. Default directory of this buffer changes
  1062. (defun ex-cd ()
  1063. (viper-get-ex-file)
  1064. (if (string= ex-file "")
  1065. (setq ex-file "~"))
  1066. (setq default-directory (file-name-as-directory (expand-file-name ex-file))))
  1067. ;; Ex copy and move command. DEL-FLAG means delete
  1068. (defun ex-copy (del-flag)
  1069. (viper-default-ex-addresses)
  1070. (let ((address (viper-get-ex-address))
  1071. (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  1072. (goto-char end)
  1073. (save-excursion
  1074. (push-mark beg t)
  1075. (viper-enlarge-region (mark t) (point))
  1076. (if del-flag
  1077. (kill-region (point) (mark t))
  1078. (copy-region-as-kill (point) (mark t)))
  1079. (if ex-flag
  1080. (progn
  1081. (with-output-to-temp-buffer " *copy text*"
  1082. (princ
  1083. (if (or del-flag ex-g-flag ex-g-variant)
  1084. (current-kill 0)
  1085. (buffer-substring (point) (mark t)))))
  1086. (condition-case nil
  1087. (progn
  1088. (read-string "[Hit return to confirm] ")
  1089. (save-excursion (kill-buffer " *copy text*")))
  1090. (quit (save-excursion (kill-buffer " *copy text*"))
  1091. (signal 'quit nil))))))
  1092. (if (= address 0)
  1093. (goto-char (point-min))
  1094. (goto-char address)
  1095. (forward-line 1))
  1096. (insert (current-kill 0))))
  1097. ;; Ex delete command
  1098. (defun ex-delete ()
  1099. (viper-default-ex-addresses)
  1100. (viper-get-ex-buffer)
  1101. (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  1102. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  1103. (save-excursion
  1104. (viper-enlarge-region beg end)
  1105. (exchange-point-and-mark)
  1106. (if ex-count
  1107. (progn
  1108. (set-mark (point))
  1109. (forward-line (1- ex-count)))
  1110. (set-mark end))
  1111. (viper-enlarge-region (point) (mark t))
  1112. (if ex-flag
  1113. ;; show text to be deleted and ask for confirmation
  1114. (progn
  1115. (with-output-to-temp-buffer " *delete text*"
  1116. (princ (buffer-substring (point) (mark t))))
  1117. (condition-case nil
  1118. (read-string "[Hit return to confirm] ")
  1119. (quit
  1120. (save-excursion (kill-buffer " *delete text*"))
  1121. (error "Viper bell")))
  1122. (save-excursion (kill-buffer " *delete text*")))
  1123. (if ex-buffer
  1124. (cond ((viper-valid-register ex-buffer '(Letter))
  1125. (viper-append-to-register
  1126. (downcase ex-buffer) (point) (mark t)))
  1127. ((viper-valid-register ex-buffer)
  1128. (copy-to-register ex-buffer (point) (mark t) nil))
  1129. (t (error viper-InvalidRegister ex-buffer))))
  1130. (kill-region (point) (mark t))))))
  1131. ;; Ex edit command
  1132. ;; In Viper, `e' and `e!' behave identically. In both cases, the user is
  1133. ;; asked if current buffer should really be discarded.
  1134. ;; This command can take multiple file names. It replaces the current buffer
  1135. ;; with the first file in its argument list
  1136. (defun ex-edit (&optional file)
  1137. (if (not file)
  1138. (viper-get-ex-file))
  1139. (cond ((and (string= ex-file "") buffer-file-name)
  1140. (setq ex-file (viper-abbreviate-file-name (buffer-file-name))))
  1141. ((string= ex-file "")
  1142. (error viper-NoFileSpecified)))
  1143. (let (msg do-edit)
  1144. (if buffer-file-name
  1145. (cond ((buffer-modified-p)
  1146. (setq msg
  1147. (format "Buffer %s is modified. Discard changes? "
  1148. (buffer-name))
  1149. do-edit t))
  1150. ((not (verify-visited-file-modtime (current-buffer)))
  1151. (setq msg
  1152. (format "File %s changed on disk. Reread from disk? "
  1153. buffer-file-name)
  1154. do-edit t))
  1155. (t (setq do-edit nil))))
  1156. (if do-edit
  1157. (if (yes-or-no-p msg)
  1158. (progn
  1159. (set-buffer-modified-p nil)
  1160. (kill-buffer (current-buffer)))
  1161. (message "Buffer %s was left intact" (buffer-name))))
  1162. ) ; let
  1163. (if (null (setq file (get-file-buffer ex-file)))
  1164. (progn
  1165. ;; this also does shell-style globbing
  1166. (ex-find-file
  1167. ;; replace # and % with the previous/current file
  1168. (ex-expand-filsyms ex-file (current-buffer)))
  1169. (or (eq major-mode 'dired-mode)
  1170. (viper-change-state-to-vi))
  1171. (goto-char (point-min)))
  1172. (switch-to-buffer file))
  1173. (if ex-offset
  1174. (progn
  1175. (with-current-buffer (setq viper-ex-work-buf
  1176. (get-buffer-create viper-ex-work-buf-name))
  1177. (delete-region (point-min) (point-max))
  1178. (insert ex-offset "\n")
  1179. (goto-char (point-min)))
  1180. (goto-char (viper-get-ex-address))
  1181. (beginning-of-line)))
  1182. (ex-fixup-history viper-last-ex-prompt ex-file))
  1183. ;; Find-file FILESPEC if it appears to specify a single file.
  1184. ;; Otherwise, assume that FILESPEC is a wildcard.
  1185. ;; In this case, split it into substrings separated by newlines.
  1186. ;; Each line is assumed to be a file name.
  1187. (defun ex-find-file (filespec)
  1188. (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
  1189. (cond ((file-exists-p filespec) (find-file filespec))
  1190. ((string-match nonstandard-filename-chars filespec)
  1191. (mapcar 'find-file (funcall viper-glob-function filespec)))
  1192. (t (find-file filespec)))
  1193. ))
  1194. ;; Ex global command
  1195. ;; This is executed in response to:
  1196. ;; :global "pattern" ex-command
  1197. ;; :vglobal "pattern" ex-command
  1198. ;; :global executes ex-command on all lines matching <pattern>
  1199. ;; :vglobal executes ex-command on all lines that don't match <pattern>
  1200. ;;
  1201. ;; With VARIANT nil, this functions executes :global
  1202. ;; With VARIANT t, executes :vglobal
  1203. (defun ex-global (variant)
  1204. (let ((gcommand ex-token))
  1205. (if (or ex-g-flag ex-g-variant)
  1206. (error "`%s' within `global' is not allowed" gcommand)
  1207. (if variant
  1208. (setq ex-g-flag nil
  1209. ex-g-variant t)
  1210. (setq ex-g-flag t
  1211. ex-g-variant nil)))
  1212. (viper-get-ex-pat)
  1213. (if (null ex-token)
  1214. (error "`%s': Missing regular expression" gcommand)))
  1215. (if (string= ex-token "")
  1216. (if (null viper-s-string)
  1217. (error viper-NoPrevSearch)
  1218. (setq ex-g-pat viper-s-string))
  1219. (setq ex-g-pat ex-token
  1220. viper-s-string ex-token))
  1221. (if (null ex-addresses)
  1222. (setq ex-addresses (list (point-max) (point-min)))
  1223. (viper-default-ex-addresses))
  1224. (setq ex-g-marks nil)
  1225. (let ((mark-count 0)
  1226. (end (car ex-addresses))
  1227. (beg (car (cdr ex-addresses)))
  1228. com-str)
  1229. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  1230. (save-excursion
  1231. (viper-enlarge-region beg end)
  1232. (exchange-point-and-mark)
  1233. (let ((cont t) (limit (point-marker)))
  1234. (exchange-point-and-mark)
  1235. ;; skip the last line if empty
  1236. (beginning-of-line)
  1237. (if (eobp) (viper-backward-char-carefully))
  1238. (while (and cont (not (bobp)) (>= (point) limit))
  1239. (beginning-of-line)
  1240. (set-mark (point))
  1241. (end-of-line)
  1242. (let ((found (re-search-backward ex-g-pat (mark t) t)))
  1243. (if (or (and ex-g-flag found)
  1244. (and ex-g-variant (not found)))
  1245. (progn
  1246. (end-of-line)
  1247. (setq mark-count (1+ mark-count))
  1248. (setq ex-g-marks (cons (point-marker) ex-g-marks)))))
  1249. (beginning-of-line)
  1250. (if (bobp) (setq cont nil)
  1251. (forward-line -1)
  1252. (end-of-line)))))
  1253. (with-current-buffer (setq viper-ex-work-buf
  1254. (get-buffer-create viper-ex-work-buf-name))
  1255. ;; com-str is the command string, i.e., g/pattern/ or v/pattern'
  1256. (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
  1257. (while ex-g-marks
  1258. (goto-char (car ex-g-marks))
  1259. (viper-ex nil com-str)
  1260. (setq mark-count (1- mark-count))
  1261. (setq ex-g-marks (cdr ex-g-marks)))))
  1262. ;; Ex goto command
  1263. (defun ex-goto ()
  1264. (if (null ex-addresses)
  1265. (setq ex-addresses (cons (point) nil)))
  1266. (push-mark (point) t)
  1267. (goto-char (car ex-addresses))
  1268. (beginning-of-line)
  1269. )
  1270. ;; Ex line commands. COM is join, shift-right or shift-left
  1271. (defun ex-line (com)
  1272. (viper-default-ex-addresses)
  1273. (viper-get-ex-count)
  1274. (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
  1275. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  1276. (save-excursion
  1277. (viper-enlarge-region beg end)
  1278. (exchange-point-and-mark)
  1279. (if ex-count
  1280. (progn
  1281. (set-mark (point))
  1282. (forward-line ex-count)))
  1283. (if ex-flag
  1284. ;; show text to be joined and ask for confirmation
  1285. (progn
  1286. (with-output-to-temp-buffer " *join text*"
  1287. (princ (buffer-substring (point) (mark t))))
  1288. (condition-case nil
  1289. (progn
  1290. (read-string "[Hit return to confirm] ")
  1291. (ex-line-subr com (point) (mark t)))
  1292. (quit (ding)))
  1293. (save-excursion (kill-buffer " *join text*")))
  1294. (ex-line-subr com (point) (mark t)))
  1295. (setq point (point)))
  1296. (goto-char (1- point))
  1297. (beginning-of-line)))
  1298. (defun ex-line-subr (com beg end)
  1299. (cond ((string= com "join")
  1300. (goto-char (min beg end))
  1301. (while (and (not (eobp)) (< (point) (max beg end)))
  1302. (end-of-line)
  1303. (if (and (<= (point) (max beg end)) (not (eobp)))
  1304. (progn
  1305. (forward-line 1)
  1306. (delete-region (point) (1- (point)))
  1307. (if (not ex-variant) (fixup-whitespace))))))
  1308. ((or (string= com "right") (string= com "left"))
  1309. (indent-rigidly
  1310. (min beg end) (max beg end)
  1311. (if (string= com "right") viper-shift-width (- viper-shift-width)))
  1312. (goto-char (max beg end))
  1313. (end-of-line)
  1314. (viper-forward-char-carefully))))
  1315. ;; Ex mark command
  1316. ;; Sets the mark to the current point.
  1317. ;; If name is omitted, get the name straight from the work buffer."
  1318. (defun ex-mark (&optional name)
  1319. (let (char)
  1320. (if (null ex-addresses)
  1321. (setq ex-addresses
  1322. (cons (point) nil)))
  1323. (if name
  1324. (if (eq 1 (length name))
  1325. (setq char (string-to-char name))
  1326. (error "`%s': Spurious text \"%s\" after mark name"
  1327. name (substring name 1)))
  1328. (with-current-buffer (setq viper-ex-work-buf
  1329. (get-buffer-create viper-ex-work-buf-name))
  1330. (skip-chars-forward " \t")
  1331. (if (looking-at "[a-z]")
  1332. (progn
  1333. (setq char (following-char))
  1334. (forward-char 1)
  1335. (skip-chars-forward " \t")
  1336. (if (not (looking-at "[\n|]"))
  1337. (error "`%s': %s" ex-token viper-SpuriousText)))
  1338. (error "`%s' requires a following letter" ex-token))))
  1339. (save-excursion
  1340. (goto-char (car ex-addresses))
  1341. (point-to-register (viper-int-to-char (1+ (- char ?a)))))))
  1342. ;; Alternate file is the file next to the first one in the buffer ring
  1343. (defun ex-next (cycle-other-window &optional find-alt-file)
  1344. (catch 'ex-edit
  1345. (let (count l)
  1346. (if (not find-alt-file)
  1347. (progn
  1348. (viper-get-ex-file)
  1349. (if (or (char-or-string-p ex-offset)
  1350. (and (not (string= "" ex-file))
  1351. (not (string-match "^[0-9]+$" ex-file))))
  1352. (progn
  1353. (ex-edit t)
  1354. (throw 'ex-edit nil))
  1355. (setq count (string-to-number ex-file))
  1356. (if (= count 0) (setq count 1))
  1357. (if (< count 0) (error "Usage: `next <count>' (count >= 0)"))))
  1358. (setq count 1))
  1359. (setq l (viper-undisplayed-files))
  1360. (while (> count 0)
  1361. (while (and (not (null l)) (null (car l)))
  1362. (setq l (cdr l)))
  1363. (setq count (1- count))
  1364. (if (> count 0)
  1365. (setq l (cdr l))))
  1366. (if find-alt-file (car l)
  1367. (progn
  1368. (if (and (car l) (get-file-buffer (car l)))
  1369. (let* ((w (if cycle-other-window
  1370. (get-lru-window) (selected-window)))
  1371. (b (window-buffer w)))
  1372. (set-window-buffer w (get-file-buffer (car l)))
  1373. (bury-buffer b)
  1374. ;; this puts "next <count>" in the ex-command history
  1375. (ex-fixup-history viper-last-ex-prompt ex-file))
  1376. (error "Not that many undisplayed files")))))))
  1377. (defun ex-next-related-buffer (direction &optional no-recursion)
  1378. (viper-ring-rotate1 viper-related-files-and-buffers-ring direction)
  1379. (let ((file-or-buffer-name
  1380. (viper-current-ring-item viper-related-files-and-buffers-ring))
  1381. (old-ring viper-related-files-and-buffers-ring)
  1382. (old-win (selected-window))
  1383. skip-rest buf wind)
  1384. (or (and (ring-p viper-related-files-and-buffers-ring)
  1385. (> (ring-length viper-related-files-and-buffers-ring) 0))
  1386. (error "This buffer has no related files or buffers"))
  1387. (or (stringp file-or-buffer-name)
  1388. (error
  1389. "File and buffer names must be strings, %S" file-or-buffer-name))
  1390. (setq buf (cond ((get-buffer file-or-buffer-name))
  1391. ((file-exists-p file-or-buffer-name)
  1392. (find-file-noselect file-or-buffer-name))
  1393. ))
  1394. (if (not (viper-buffer-live-p buf))
  1395. (error "Didn't find buffer %S or file %S"
  1396. file-or-buffer-name
  1397. (viper-abbreviate-file-name
  1398. (expand-file-name file-or-buffer-name))))
  1399. (if (equal buf (current-buffer))
  1400. (or no-recursion
  1401. ;; try again
  1402. (progn
  1403. (setq skip-rest t)
  1404. (ex-next-related-buffer direction 'norecursion))))
  1405. (if skip-rest
  1406. ()
  1407. ;; setup buffer
  1408. (if (setq wind (viper-get-visible-buffer-window buf))
  1409. ()
  1410. (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible)))
  1411. (set-window-buffer wind buf))
  1412. (if (viper-window-display-p)
  1413. (progn
  1414. (raise-frame (window-frame wind))
  1415. (if (equal (window-frame wind) (window-frame old-win))
  1416. (save-window-excursion (select-window wind) (sit-for 1))
  1417. (select-window wind)))
  1418. (save-window-excursion (select-window wind) (sit-for 1)))
  1419. (with-current-buffer buf
  1420. (setq viper-related-files-and-buffers-ring old-ring))
  1421. (setq viper-local-search-start-marker (point-marker))
  1422. )))
  1423. ;; Force auto save
  1424. (defun ex-preserve ()
  1425. (message "Autosaving all buffers that need to be saved...")
  1426. (do-auto-save t))
  1427. ;; Ex put
  1428. (defun ex-put ()
  1429. (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
  1430. (viper-get-ex-buffer)
  1431. (setq viper-use-register ex-buffer)
  1432. (goto-char point)
  1433. (if (bobp) (viper-Put-back 1) (viper-put-back 1))))
  1434. ;; Ex print working directory
  1435. (defun ex-pwd ()
  1436. (message "%s" default-directory))
  1437. ;; Ex quit command
  1438. (defun ex-quit ()
  1439. ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
  1440. (with-current-buffer (setq viper-ex-work-buf
  1441. (get-buffer-create viper-ex-work-buf-name))
  1442. (if (looking-at "!") (forward-char 1)))
  1443. (if (< viper-expert-level 3)
  1444. (save-buffers-kill-emacs)
  1445. (kill-buffer (current-buffer))))
  1446. ;; Ex read command
  1447. ;; ex-read doesn't support wildcards, because file completion is a better
  1448. ;; mechanism. We also don't support # and % (except in :r <shell-command>
  1449. ;; because file history is a better mechanism.
  1450. (defun ex-read ()
  1451. (viper-get-ex-file)
  1452. (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
  1453. command)
  1454. (goto-char point)
  1455. (viper-add-newline-at-eob-if-necessary)
  1456. (if (not (or (bobp) (eobp))) (forward-line 1))
  1457. (if (and (not ex-variant) (string= ex-file ""))
  1458. (progn
  1459. (if (null buffer-file-name)
  1460. (error viper-NoFileSpecified))
  1461. (setq ex-file buffer-file-name)))
  1462. (if ex-cmdfile
  1463. (progn
  1464. (setq command
  1465. ;; replace # and % with the previous/current file
  1466. (ex-expand-filsyms
  1467. (concat (shell-quote-argument ex-file) ex-cmdfile-args)
  1468. (current-buffer)))
  1469. (shell-command command t))
  1470. (insert-file-contents ex-file)))
  1471. (ex-fixup-history viper-last-ex-prompt ex-file ex-cmdfile-args))
  1472. ;; this function fixes ex-history for some commands like ex-read, ex-edit
  1473. (defun ex-fixup-history (&rest args)
  1474. (setq viper-ex-history
  1475. (cons (mapconcat 'identity args " ") (cdr viper-ex-history))))
  1476. ;; Ex recover from emacs \#file\#
  1477. (defun ex-recover ()
  1478. (viper-get-ex-file)
  1479. (if (or ex-append ex-offset)
  1480. (error "`recover': %s" viper-SpuriousText))
  1481. (if (string= ex-file "")
  1482. (progn
  1483. (if (null buffer-file-name)
  1484. (error "This buffer isn't visiting any file"))
  1485. (setq ex-file buffer-file-name))
  1486. (setq ex-file (expand-file-name ex-file)))
  1487. (if (and (not (string= ex-file (buffer-file-name)))
  1488. (buffer-modified-p)
  1489. (not ex-variant))
  1490. (error "No write since last change \(:rec! overrides\)"))
  1491. (recover-file ex-file))
  1492. ;; Tell that `rewind' is obsolete and to use `:next count' instead
  1493. (defun ex-rewind ()
  1494. (message
  1495. "Use `:n <count>' instead. Counts are obtained from the `:args' command"))
  1496. ;; read variable name for ex-set
  1497. (defun ex-set-read-variable ()
  1498. (let ((minibuffer-local-completion-map
  1499. (copy-keymap minibuffer-local-completion-map))
  1500. (cursor-in-echo-area t)
  1501. str batch)
  1502. (define-key
  1503. minibuffer-local-completion-map " " 'minibuffer-complete-and-exit)
  1504. (define-key minibuffer-local-completion-map "=" 'exit-minibuffer)
  1505. (if (viper-set-unread-command-events
  1506. (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m"))
  1507. (progn
  1508. (setq batch t)
  1509. (viper-set-unread-command-events ?\C-m)))
  1510. (message ":set <Variable> [= <Value>]")
  1511. (or batch (sit-for 2))
  1512. (while (string-match "^[ \\t\\n]*$"
  1513. (setq str
  1514. (completing-read ":set " ex-variable-alist)))
  1515. (message ":set <Variable> [= <Value>]")
  1516. ;; if there are unread events, don't wait
  1517. (or (viper-set-unread-command-events "") (sit-for 2))
  1518. ) ; while
  1519. str))
  1520. (defun ex-set ()
  1521. (let ((var (ex-set-read-variable))
  1522. (val 0)
  1523. (set-cmd "setq")
  1524. (ask-if-save t)
  1525. (auto-cmd-label "; don't touch or else...")
  1526. (delete-turn-on-auto-fill-pattern
  1527. "([ \t]*add-hook[ \t]+'viper-insert-state-hook[ \t]+'turn-on-auto-fill.*)")
  1528. actual-lisp-cmd lisp-cmd-del-pattern
  1529. val2 orig-var)
  1530. (setq orig-var var)
  1531. (cond ((string= var "all")
  1532. (setq ask-if-save nil
  1533. set-cmd nil))
  1534. ((member var '("ai" "autoindent"))
  1535. (setq var "viper-auto-indent"
  1536. set-cmd "setq"
  1537. ask-if-save nil
  1538. val "t"))
  1539. ((member var '("ai-g" "autoindent-global"))
  1540. (kill-local-variable 'viper-auto-indent)
  1541. (setq var "viper-auto-indent"
  1542. set-cmd "setq-default"
  1543. val "t"))
  1544. ((member var '("noai" "noautoindent"))
  1545. (setq var "viper-auto-indent"
  1546. ask-if-save nil
  1547. val "nil"))
  1548. ((member var '("noai-g" "noautoindent-global"))
  1549. (kill-local-variable 'viper-auto-indent)
  1550. (setq var "viper-auto-indent"
  1551. set-cmd "setq-default"
  1552. val "nil"))
  1553. ((member var '("ic" "ignorecase"))
  1554. (setq var "viper-case-fold-search"
  1555. val "t"))
  1556. ((member var '("noic" "noignorecase"))
  1557. (setq var "viper-case-fold-search"
  1558. val "nil"))
  1559. ((member var '("ma" "magic"))
  1560. (setq var "viper-re-search"
  1561. val "t"))
  1562. ((member var '("noma" "nomagic"))
  1563. (setq var "viper-re-search"
  1564. val "nil"))
  1565. ((member var '("ro" "readonly"))
  1566. (setq var "buffer-read-only"
  1567. val "t"))
  1568. ((member var '("noro" "noreadonly"))
  1569. (setq var "buffer-read-only"
  1570. val "nil"))
  1571. ((member var '("sm" "showmatch"))
  1572. (setq var "blink-matching-paren"
  1573. val "t"))
  1574. ((member var '("nosm" "noshowmatch"))
  1575. (setq var "blink-matching-paren"
  1576. val "nil"))
  1577. ((member var '("ws" "wrapscan"))
  1578. (setq var "viper-search-wrap-around"
  1579. val "t"))
  1580. ((member var '("nows" "nowrapscan"))
  1581. (setq var "viper-search-wrap-around"
  1582. val "nil")))
  1583. (if (and set-cmd (eq val 0)) ; value must be set by the user
  1584. (let ((cursor-in-echo-area t))
  1585. (message ":set %s = <Value>" var)
  1586. ;; if there are unread events, don't wait
  1587. (or (viper-set-unread-command-events "") (sit-for 2))
  1588. (setq val (read-string (format ":set %s = " var)))
  1589. (ex-fixup-history "set" orig-var val)
  1590. ;; check numerical values
  1591. (if (member var
  1592. '("sw" "shiftwidth"
  1593. "ts" "tabstop"
  1594. "ts-g" "tabstop-global"
  1595. "wm" "wrapmargin"))
  1596. (condition-case nil
  1597. (or (numberp (setq val2 (car (read-from-string val))))
  1598. (error "%s: Invalid value, numberp, %S" var val))
  1599. (error
  1600. (error "%s: Invalid value, numberp, %S" var val))))
  1601. (cond
  1602. ((member var '("sw" "shiftwidth"))
  1603. (setq var "viper-shift-width"))
  1604. ((member var '("ts" "tabstop"))
  1605. ;; make it take effect in curr buff and new bufs
  1606. (setq var "tab-width"
  1607. set-cmd "setq"
  1608. ask-if-save nil))
  1609. ((member var '("ts-g" "tabstop-global"))
  1610. (kill-local-variable 'tab-width)
  1611. (setq var "tab-width"
  1612. set-cmd "setq-default"))
  1613. ((member var '("wm" "wrapmargin"))
  1614. ;; make it take effect in curr buff and new bufs
  1615. (kill-local-variable 'fill-column)
  1616. (setq var "fill-column"
  1617. val (format "(- (window-width) %s)" val)
  1618. set-cmd "setq-default"))
  1619. ((member var '("sh" "shell"))
  1620. (setq var "explicit-shell-file-name"
  1621. val (format "\"%s\"" val)))))
  1622. (ex-fixup-history "set" orig-var))
  1623. (if set-cmd
  1624. (setq actual-lisp-cmd
  1625. (format "\n(%s %s %s) %s" set-cmd var val auto-cmd-label)
  1626. lisp-cmd-del-pattern
  1627. (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s"
  1628. set-cmd var auto-cmd-label)))
  1629. (if (and ask-if-save
  1630. (y-or-n-p (format "Do you want to save this setting in %s "
  1631. viper-custom-file-name)))
  1632. (progn
  1633. (viper-save-string-in-file
  1634. actual-lisp-cmd viper-custom-file-name
  1635. ;; del pattern
  1636. lisp-cmd-del-pattern)
  1637. (if (string= var "fill-column")
  1638. (if (> val2 0)
  1639. (viper-save-string-in-file
  1640. (concat
  1641. "(add-hook 'viper-insert-state-hook 'turn-on-auto-fill) "
  1642. auto-cmd-label)
  1643. viper-custom-file-name
  1644. delete-turn-on-auto-fill-pattern)
  1645. (viper-save-string-in-file
  1646. nil viper-custom-file-name delete-turn-on-auto-fill-pattern)
  1647. (viper-save-string-in-file
  1648. nil viper-custom-file-name
  1649. ;; del pattern
  1650. lisp-cmd-del-pattern)
  1651. ))
  1652. ))
  1653. (if set-cmd
  1654. (message "%s %s %s"
  1655. set-cmd var
  1656. (if (string-match "^[ \t]*$" val)
  1657. (format "%S" val)
  1658. val)))
  1659. (if actual-lisp-cmd
  1660. (eval (car (read-from-string actual-lisp-cmd))))
  1661. (if (string= var "fill-column")
  1662. (if (> val2 0)
  1663. (auto-fill-mode 1)
  1664. (auto-fill-mode -1)))
  1665. (if (string= var "all") (ex-show-vars))
  1666. ))
  1667. ;; In inline args, skip regex-forw and (optionally) chars-back.
  1668. ;; Optional 3d arg is a string that should replace ' ' to prevent its
  1669. ;; special meaning
  1670. (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
  1671. (with-current-buffer (setq viper-ex-work-buf
  1672. (get-buffer-create viper-ex-work-buf-name))
  1673. (goto-char (point-min))
  1674. (re-search-forward regex-forw nil t)
  1675. (let ((beg (point))
  1676. end)
  1677. (goto-char (point-max))
  1678. (if chars-back
  1679. (skip-chars-backward chars-back)
  1680. (skip-chars-backward " \t\n\C-m"))
  1681. (setq end (point))
  1682. ;; replace SPC with `=' to suppress the special meaning SPC has
  1683. ;; in Ex commands
  1684. (goto-char beg)
  1685. (if replace-str
  1686. (while (re-search-forward " +" nil t)
  1687. (replace-match replace-str nil t)
  1688. (viper-forward-char-carefully)))
  1689. (goto-char end)
  1690. (buffer-substring beg end))))
  1691. ;; Ex shell command
  1692. (defun ex-shell ()
  1693. (shell))
  1694. ;; Viper help. Invokes Info
  1695. (defun ex-help ()
  1696. (condition-case nil
  1697. (progn
  1698. (pop-to-buffer (get-buffer-create "*info*"))
  1699. (info (if (featurep 'xemacs) "viper.info" "viper"))
  1700. (message "Type `i' to search for a specific topic"))
  1701. (error (beep 1)
  1702. (with-output-to-temp-buffer " *viper-info*"
  1703. (princ (format "
  1704. The Info file for Viper does not seem to be installed.
  1705. This file is part of the standard distribution of %sEmacs.
  1706. Please contact your system administrator. "
  1707. (if (featurep 'xemacs) "X" "")
  1708. ))))))
  1709. ;; Ex source command. Loads the file specified as argument or `~/.viper'
  1710. (defun ex-source ()
  1711. (viper-get-ex-file)
  1712. (if (string= ex-file "")
  1713. (load viper-custom-file-name)
  1714. (load ex-file)))
  1715. ;; Ex substitute command
  1716. ;; If REPEAT use previous regexp which is ex-reg-exp or viper-s-string
  1717. (defun ex-substitute (&optional repeat r-flag)
  1718. (let ((opt-g nil)
  1719. (opt-c nil)
  1720. (matched-pos nil)
  1721. (case-fold-search viper-case-fold-search)
  1722. delim pat repl)
  1723. (if repeat (setq ex-token nil) (setq delim (viper-get-ex-pat)))
  1724. (if (null ex-token)
  1725. (progn
  1726. (setq pat (if r-flag viper-s-string ex-reg-exp))
  1727. (or (stringp pat)
  1728. (error "No previous pattern to use in substitution"))
  1729. (setq repl ex-repl
  1730. delim (string-to-char pat)))
  1731. (setq pat (if (string= ex-token "") viper-s-string ex-token))
  1732. (setq viper-s-string pat
  1733. ex-reg-exp pat)
  1734. (setq delim (viper-get-ex-pat))
  1735. (if (null ex-token)
  1736. (setq ex-token ""
  1737. ex-repl "")
  1738. (setq repl ex-token
  1739. ex-repl ex-token)))
  1740. (while (viper-get-ex-opt-gc delim)
  1741. (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
  1742. (viper-get-ex-count)
  1743. (if ex-count
  1744. (save-excursion
  1745. (if ex-addresses (goto-char (car ex-addresses)))
  1746. (set-mark (point))
  1747. (forward-line (1- ex-count))
  1748. (setq ex-addresses (cons (point) (cons (mark t) nil))))
  1749. (if (null ex-addresses)
  1750. (setq ex-addresses (cons (point) (cons (point) nil)))
  1751. (if (null (cdr ex-addresses))
  1752. (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
  1753. ;(setq G opt-g)
  1754. (let ((beg (car ex-addresses))
  1755. (end (car (cdr ex-addresses)))
  1756. eol-mark)
  1757. (save-excursion
  1758. (viper-enlarge-region beg end)
  1759. (let ((limit (save-excursion
  1760. (goto-char (max (point) (mark t)))
  1761. (point-marker))))
  1762. (goto-char (min (point) (mark t)))
  1763. (while (< (point) limit)
  1764. (save-excursion
  1765. (end-of-line)
  1766. ;; This move allows the use of newline as the last character in
  1767. ;; the substitution pattern
  1768. (viper-forward-char-carefully)
  1769. (setq eol-mark (point-marker)))
  1770. (beginning-of-line)
  1771. (if opt-g
  1772. (progn
  1773. (while (and (not (eolp))
  1774. (re-search-forward pat eol-mark t))
  1775. (if (or (not opt-c)
  1776. (progn
  1777. (viper-put-on-search-overlay (match-beginning 0)
  1778. (match-end 0))
  1779. (y-or-n-p "Replace? ")))
  1780. (progn
  1781. (viper-hide-search-overlay)
  1782. (setq matched-pos (point))
  1783. (if (not (stringp repl))
  1784. (error "Can't perform Ex substitution: No previous replacement pattern"))
  1785. (replace-match repl t))))
  1786. (end-of-line)
  1787. (viper-forward-char-carefully))
  1788. (if (null pat)
  1789. (error
  1790. "Can't repeat Ex substitution: No previous regular expression"))
  1791. (if (and (re-search-forward pat eol-mark t)
  1792. (or (not opt-c)
  1793. (progn
  1794. (viper-put-on-search-overlay (match-beginning 0)
  1795. (match-end 0))
  1796. (y-or-n-p "Replace? "))))
  1797. (progn
  1798. (viper-hide-search-overlay)
  1799. (setq matched-pos (point))
  1800. (if (not (stringp repl))
  1801. (error "Can't perform Ex substitution: No previous replacement pattern"))
  1802. (replace-match repl t)))
  1803. ;;(end-of-line)
  1804. ;;(viper-forward-char-carefully)
  1805. (goto-char eol-mark)
  1806. )))))
  1807. (if matched-pos (goto-char matched-pos))
  1808. (beginning-of-line)
  1809. (if opt-c (message "done"))))
  1810. ;; Ex tag command
  1811. (defun ex-tag ()
  1812. (let (tag)
  1813. (with-current-buffer (setq viper-ex-work-buf
  1814. (get-buffer-create viper-ex-work-buf-name))
  1815. (skip-chars-forward " \t")
  1816. (set-mark (point))
  1817. (skip-chars-forward "^ |\t\n")
  1818. (setq tag (buffer-substring (mark t) (point))))
  1819. (if (not (string= tag "")) (setq ex-tag tag))
  1820. (viper-change-state-to-emacs)
  1821. (condition-case conds
  1822. (progn
  1823. (if (string= tag "")
  1824. (find-tag ex-tag t)
  1825. (find-tag-other-window ex-tag))
  1826. (viper-change-state-to-vi))
  1827. (error
  1828. (viper-change-state-to-vi)
  1829. (viper-message-conditions conds)))))
  1830. ;; Ex write command
  1831. ;; ex-write doesn't support wildcards, because file completion is a better
  1832. ;; mechanism. We also don't support # and %
  1833. ;; because file history is a better mechanism.
  1834. (defun ex-write (q-flag)
  1835. (viper-default-ex-addresses t)
  1836. (viper-get-ex-file)
  1837. (let ((end (car ex-addresses))
  1838. (beg (car (cdr ex-addresses)))
  1839. (orig-buf (current-buffer))
  1840. ;;(orig-buf-file-name (buffer-file-name))
  1841. ;;(orig-buf-name (buffer-name))
  1842. ;;(buff-changed-p (buffer-modified-p))
  1843. temp-buf writing-same-file region
  1844. file-exists writing-whole-file)
  1845. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  1846. (if ex-cmdfile
  1847. (progn
  1848. (viper-enlarge-region beg end)
  1849. (shell-command-on-region (point) (mark t)
  1850. (concat ex-file ex-cmdfile-args)))
  1851. (if (and (string= ex-file "") (not (buffer-file-name)))
  1852. (setq ex-file
  1853. (read-file-name
  1854. (format "Buffer %s isn't visiting any file. File to save in: "
  1855. (buffer-name)))))
  1856. (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end))
  1857. ex-file (if (string= ex-file "")
  1858. (buffer-file-name)
  1859. (expand-file-name ex-file)))
  1860. ;; if ex-file is a directory use the file portion of the buffer file name
  1861. (if (and (file-directory-p ex-file)
  1862. buffer-file-name
  1863. (not (file-directory-p buffer-file-name)))
  1864. (setq ex-file
  1865. (concat (file-name-as-directory ex-file)
  1866. (file-name-nondirectory buffer-file-name))))
  1867. (setq file-exists (file-exists-p ex-file)
  1868. writing-same-file (string= ex-file (buffer-file-name)))
  1869. ;; do actual writing
  1870. (if (and writing-whole-file writing-same-file)
  1871. ;; saving whole buffer in visited file
  1872. (if (not (buffer-modified-p))
  1873. (message "(No changes need to be saved)")
  1874. (viper-maybe-checkout (current-buffer))
  1875. (save-buffer)
  1876. (save-restriction
  1877. (widen)
  1878. (ex-write-info file-exists ex-file (point-min) (point-max))
  1879. ))
  1880. ;; writing to non-visited file and it already exists
  1881. (if (and file-exists (not writing-same-file)
  1882. (not (yes-or-no-p
  1883. (format "File %s exists. Overwrite? " ex-file))))
  1884. (error "Quit"))
  1885. ;; writing a region or whole buffer to non-visited file
  1886. (unwind-protect
  1887. (save-excursion
  1888. (viper-enlarge-region beg end)
  1889. (setq region (buffer-substring (point) (mark t)))
  1890. ;; create temp buffer for the region
  1891. (setq temp-buf (get-buffer-create " *ex-write*"))
  1892. (set-buffer temp-buf)
  1893. (if (featurep 'xemacs)
  1894. (set-visited-file-name ex-file)
  1895. (set-visited-file-name ex-file 'noquery))
  1896. (erase-buffer)
  1897. (if (and file-exists ex-append)
  1898. (insert-file-contents ex-file))
  1899. (goto-char (point-max))
  1900. (insert region)
  1901. ;; ask user
  1902. (viper-maybe-checkout (current-buffer))
  1903. (setq selective-display nil)
  1904. (save-buffer)
  1905. (ex-write-info
  1906. file-exists ex-file (point-min) (point-max))
  1907. )
  1908. ;; this must be under unwind-protect so that
  1909. ;; temp-buf will be deleted in case of an error
  1910. (set-buffer temp-buf)
  1911. (set-buffer-modified-p nil)
  1912. (kill-buffer temp-buf)
  1913. ;; buffer/region has been written, now take care of details
  1914. (set-buffer orig-buf)))
  1915. ;; set the right file modification time
  1916. (if (and (buffer-file-name) writing-same-file)
  1917. (set-visited-file-modtime))
  1918. ;; prevent loss of data if saving part of the buffer in visited file
  1919. (or writing-whole-file
  1920. (not writing-same-file)
  1921. (progn
  1922. (sit-for 2)
  1923. (message "Warning: you have saved only part of the buffer!")
  1924. (set-buffer-modified-p t)))
  1925. (if q-flag
  1926. (if (< viper-expert-level 2)
  1927. (save-buffers-kill-emacs)
  1928. (kill-buffer (current-buffer))))
  1929. )))
  1930. (defun ex-write-info (exists file-name beg end)
  1931. (message "`%s'%s %d lines, %d characters"
  1932. (viper-abbreviate-file-name file-name)
  1933. (if exists "" " [New file]")
  1934. (count-lines beg (min (1+ end) (point-max)))
  1935. (- end beg)))
  1936. ;; Ex yank command
  1937. (defun ex-yank ()
  1938. (viper-default-ex-addresses)
  1939. (viper-get-ex-buffer)
  1940. (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  1941. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  1942. (save-excursion
  1943. (viper-enlarge-region beg end)
  1944. (exchange-point-and-mark)
  1945. (if (or ex-g-flag ex-g-variant)
  1946. (error "Can't execute `yank' within `global'"))
  1947. (if ex-count
  1948. (progn
  1949. (set-mark (point))
  1950. (forward-line (1- ex-count)))
  1951. (set-mark end))
  1952. (viper-enlarge-region (point) (mark t))
  1953. (if ex-flag (error "`yank': %s" viper-SpuriousText))
  1954. (if ex-buffer
  1955. (cond ((viper-valid-register ex-buffer '(Letter))
  1956. (viper-append-to-register
  1957. (downcase ex-buffer) (point) (mark t)))
  1958. ((viper-valid-register ex-buffer)
  1959. (copy-to-register ex-buffer (point) (mark t) nil))
  1960. (t (error viper-InvalidRegister ex-buffer))))
  1961. (copy-region-as-kill (point) (mark t)))))
  1962. ;; Execute shell command
  1963. (defun ex-command ()
  1964. (let (command)
  1965. (with-current-buffer (setq viper-ex-work-buf
  1966. (get-buffer-create viper-ex-work-buf-name))
  1967. (skip-chars-forward " \t")
  1968. (setq command (buffer-substring (point) (point-max)))
  1969. (end-of-line))
  1970. ;; replace # and % with the previous/current file
  1971. (setq command (ex-expand-filsyms command (current-buffer)))
  1972. (if (and (> (length command) 0) (string= "!" (substring command 0 1)))
  1973. (if viper-ex-last-shell-com
  1974. (setq command
  1975. (concat viper-ex-last-shell-com (substring command 1)))
  1976. (error "No previous shell command")))
  1977. (setq viper-ex-last-shell-com command)
  1978. (if (null ex-addresses)
  1979. (shell-command command)
  1980. (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  1981. (if (null beg) (setq beg end))
  1982. (save-excursion
  1983. (goto-char beg)
  1984. (set-mark end)
  1985. (viper-enlarge-region (point) (mark t))
  1986. (shell-command-on-region (point) (mark t) command t))
  1987. (goto-char beg)))))
  1988. (defun ex-compile ()
  1989. "Reads args from the command line, then runs make with the args.
  1990. If no args are given, then it runs the last compile command.
  1991. Type 'mak ' (including the space) to run make with no args."
  1992. (let (args)
  1993. (with-current-buffer (setq viper-ex-work-buf
  1994. (get-buffer-create viper-ex-work-buf-name))
  1995. (setq args (buffer-substring (point) (point-max)))
  1996. (end-of-line))
  1997. ;; Remove the newline that may (will?) be at the end of the args
  1998. (if (string= "\n" (substring args (1- (length args))))
  1999. (setq args (substring args 0 (1- (length args)))))
  2000. ;; Run last command if no args given, else construct a new command.
  2001. (setq args
  2002. (if (string= "" args)
  2003. (if (boundp 'compile-command)
  2004. compile-command
  2005. ex-compile-command)
  2006. (concat ex-compile-command " " args)))
  2007. (compile args)
  2008. ))
  2009. ;; Print line number
  2010. (defun ex-line-no ()
  2011. (message "%d"
  2012. (1+ (count-lines
  2013. (point-min)
  2014. (if (null ex-addresses) (point-max) (car ex-addresses))))))
  2015. ;; Give information on the file visited by the current buffer
  2016. (defun viper-info-on-file ()
  2017. (interactive)
  2018. (let ((pos1 (viper-line-pos 'start))
  2019. (pos2 (viper-line-pos 'end))
  2020. lines file info)
  2021. (setq lines (count-lines (point-min) (viper-line-pos 'end))
  2022. file (cond ((buffer-file-name)
  2023. (concat (viper-abbreviate-file-name (buffer-file-name)) ":"))
  2024. ((buffer-file-name (buffer-base-buffer))
  2025. (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
  2026. (t (concat (buffer-name) " [Not visiting any file]:")))
  2027. info (format "line=%d/%d pos=%d/%d col=%d %s"
  2028. (if (= pos1 pos2)
  2029. (1+ lines)
  2030. lines)
  2031. (count-lines (point-min) (point-max))
  2032. (point) (1- (point-max))
  2033. (1+ (current-column))
  2034. (if (buffer-modified-p) "[Modified]" "[Unchanged]")))
  2035. (if (< (+ 1 (length info) (length file))
  2036. (window-width (minibuffer-window)))
  2037. (message "%s" (concat file " " info))
  2038. (save-window-excursion
  2039. (with-output-to-temp-buffer " *viper-info*"
  2040. (princ (concat "\n" file "\n\n\t" info "\n\n")))
  2041. (let ((inhibit-quit t))
  2042. (viper-set-unread-command-events (viper-read-event)))
  2043. (kill-buffer " *viper-info*")))
  2044. ))
  2045. ;; Without arguments displays info on file. With an arg, sets the visited file
  2046. ;; name to that arg
  2047. (defun ex-set-visited-file-name ()
  2048. (viper-get-ex-file)
  2049. (if (string= ex-file "")
  2050. (viper-info-on-file)
  2051. ;; If ex-file is a directory, use the file portion of the buffer
  2052. ;; file name (like ex-write). Do this even if ex-file is a
  2053. ;; non-existent directory, since set-visited-file-name signals an
  2054. ;; error on this condition, too.
  2055. (if (and (string= (file-name-nondirectory ex-file) "")
  2056. buffer-file-name
  2057. (not (file-directory-p buffer-file-name)))
  2058. (setq ex-file (concat (file-name-as-directory ex-file)
  2059. (file-name-nondirectory buffer-file-name))))
  2060. (set-visited-file-name ex-file)))
  2061. ;; display all variables set through :set
  2062. (defun ex-show-vars ()
  2063. (with-output-to-temp-buffer " *viper-info*"
  2064. (princ (if viper-auto-indent
  2065. "autoindent (local)\n" "noautoindent (local)\n"))
  2066. (princ (if (default-value 'viper-auto-indent)
  2067. "autoindent (global) \n" "noautoindent (global) \n"))
  2068. (princ (if viper-case-fold-search "ignorecase\n" "noignorecase\n"))
  2069. (princ (if viper-re-search "magic\n" "nomagic\n"))
  2070. (princ (if buffer-read-only "readonly\n" "noreadonly\n"))
  2071. (princ (if blink-matching-paren "showmatch\n" "noshowmatch\n"))
  2072. (princ (if viper-search-wrap-around "wrapscan\n" "nowrapscan\n"))
  2073. (princ (format "shiftwidth \t\t= %S\n" viper-shift-width))
  2074. (princ (format "tabstop (local) \t= %S\n" tab-width))
  2075. (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width)))
  2076. (princ (format "wrapmargin (local) \t= %S\n"
  2077. (- (window-width) fill-column)))
  2078. (princ (format "wrapmargin (global) \t= %S\n"
  2079. (- (window-width) (default-value 'fill-column))))
  2080. (princ (format "shell \t\t\t= %S\n" (if (boundp 'explicit-shell-file-name)
  2081. explicit-shell-file-name
  2082. 'none)))
  2083. ))
  2084. (defun ex-print ()
  2085. (viper-default-ex-addresses)
  2086. (let ((end (car ex-addresses))
  2087. (beg (car (cdr ex-addresses))))
  2088. (if (> beg end) (error viper-FirstAddrExceedsSecond))
  2089. (save-excursion
  2090. (viper-enlarge-region beg end)
  2091. (if (or ex-g-flag ex-g-variant)
  2092. ;; When executing a global command, collect output of each
  2093. ;; print in viper-ex-print-buf.
  2094. (progn
  2095. (append-to-buffer viper-ex-print-buf (point) (mark t))
  2096. ;; Is this the last mark for the global command?
  2097. (unless (cdr ex-g-marks)
  2098. (with-current-buffer viper-ex-print-buf
  2099. (ex-print-display-lines (buffer-string))
  2100. (erase-buffer))))
  2101. (ex-print-display-lines (buffer-substring (point) (mark t)))))))
  2102. (defun ex-print-display-lines (lines)
  2103. (cond
  2104. ;; String doesn't contain a newline.
  2105. ((not (string-match "\n" lines))
  2106. (message "%s" lines))
  2107. ;; String contains only one newline at the end. Strip it off.
  2108. ((= (string-match "\n" lines) (1- (length lines)))
  2109. (message "%s" (substring lines 0 -1)))
  2110. ;; String spans more than one line. Use a temporary buffer.
  2111. (t
  2112. (save-current-buffer
  2113. (with-output-to-temp-buffer " *viper-info*"
  2114. (princ lines))))))
  2115. ;;; viper-ex.el ends here