Mercurial > hg > xemacs-beta

comparison lisp/viper/viper-ex.el @ 80:1ce6082ce73f r20-0b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents c7528f8e288d
children 6a378aca36af
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
17 ;; You should have received a copy of the GNU General Public License 17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA. 20 ;; Boston, MA 02111-1307, USA.
21 21
22
23 ;; Code 22 ;; Code
24 23
25 (require 'viper-util) 24 (provide 'viper-ex)
26 25
27 ;; Compiler pacifier 26 ;; Compiler pacifier
28 (defvar read-file-name-map) 27 (defvar read-file-name-map)
29 ;; end compiler pacifier 28 (defvar vip-use-register)
29 (defvar vip-s-string)
30 (defvar vip-shift-width)
31 (defvar vip-ex-history)
32 (defvar vip-related-files-and-buffers-ring)
33 (defvar vip-local-search-start-marker)
34 (defvar vip-expert-level)
35 (defvar vip-custom-file-name)
36 (defvar vip-case-fold-search)
37
38 (eval-when-compile
39 (let ((load-path (cons "." load-path)))
40 (or (featurep 'viper-util)
41 (load "viper-util.el" nil nil 'nosuffix))
42 (or (featurep 'viper-keym)
43 (load "viper-keym.el" nil nil 'nosuffix))
44 ))
45 ;; end pacifier
46
47
48 (require 'viper-util)
49
30 50
31 ;;; Variables 51 ;;; Variables
32 52
33 (defconst vip-ex-work-buf-name " *ex-working-space*") 53 (defconst vip-ex-work-buf-name " *ex-working-space*")
34 (defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 54 (defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
283 303
284 ;; Get an ex-token which is either an address or a command. 304 ;; Get an ex-token which is either an address or a command.
285 ;; A token has a type, \(command, address, end-mark\), and a value 305 ;; A token has a type, \(command, address, end-mark\), and a value
286 (defun vip-get-ex-token () 306 (defun vip-get-ex-token ()
287 (save-window-excursion 307 (save-window-excursion
288 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 308 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
289 (set-buffer vip-ex-work-buf) 309 (set-buffer vip-ex-work-buf)
290 (skip-chars-forward " \t|") 310 (skip-chars-forward " \t|")
291 (cond ((looking-at "#") 311 (cond ((looking-at "#")
292 (setq ex-token-type 'command) 312 (setq ex-token-type 'command)
293 (setq ex-token (char-to-string (following-char))) 313 (setq ex-token (char-to-string (following-char)))
419 "\\|" "![ \t]*[a-zA-Z].*" 439 "\\|" "![ \t]*[a-zA-Z].*"
420 "\\)" 440 "\\)"
421 "!*"))) 441 "!*")))
422 442
423 (save-window-excursion ;; put cursor at the end of the Ex working buffer 443 (save-window-excursion ;; put cursor at the end of the Ex working buffer
424 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 444 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
425 (set-buffer vip-ex-work-buf) 445 (set-buffer vip-ex-work-buf)
426 (goto-char (point-max))) 446 (goto-char (point-max)))
427 (cond ((vip-looking-back quit-regex1) (exit-minibuffer)) 447 (cond ((vip-looking-back quit-regex1) (exit-minibuffer))
428 ((vip-looking-back stay-regex) (insert " ")) 448 ((vip-looking-back stay-regex) (insert " "))
429 ((vip-looking-back quit-regex2) (exit-minibuffer)) 449 ((vip-looking-back quit-regex2) (exit-minibuffer))
497 'vip-ex-history 517 'vip-ex-history
498 (car vip-ex-history) 518 (car vip-ex-history)
499 map))) 519 map)))
500 (save-window-excursion 520 (save-window-excursion
501 ;; just a precaution 521 ;; just a precaution
502 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 522 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
503 (set-buffer vip-ex-work-buf) 523 (set-buffer vip-ex-work-buf)
504 (delete-region (point-min) (point-max)) 524 (delete-region (point-min) (point-max))
505 (insert com-str "\n") 525 (insert com-str "\n")
506 (goto-char (point-min))) 526 (goto-char (point-min)))
507 (setq ex-token-type nil 527 (setq ex-token-type nil
592 c))) 612 c)))
593 613
594 ;; get an ex command 614 ;; get an ex command
595 (defun vip-get-ex-command () 615 (defun vip-get-ex-command ()
596 (save-window-excursion 616 (save-window-excursion
597 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 617 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
598 (set-buffer vip-ex-work-buf) 618 (set-buffer vip-ex-work-buf)
599 (if (looking-at "/") (forward-char 1)) 619 (if (looking-at "/") (forward-char 1))
600 (skip-chars-forward " \t") 620 (skip-chars-forward " \t")
601 (cond ((looking-at "[a-z]") 621 (cond ((looking-at "[a-z]")
602 (vip-get-ex-com-subr) 622 (vip-get-ex-com-subr)
608 (t (error vip-BadExCommand))))) 628 (t (error vip-BadExCommand)))))
609 629
610 ;; Get an Ex option g or c 630 ;; Get an Ex option g or c
611 (defun vip-get-ex-opt-gc (c) 631 (defun vip-get-ex-opt-gc (c)
612 (save-window-excursion 632 (save-window-excursion
613 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 633 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
614 (set-buffer vip-ex-work-buf) 634 (set-buffer vip-ex-work-buf)
615 (if (looking-at (format "%c" c)) (forward-char 1)) 635 (if (looking-at (format "%c" c)) (forward-char 1))
616 (skip-chars-forward " \t") 636 (skip-chars-forward " \t")
617 (cond ((looking-at "g") 637 (cond ((looking-at "g")
618 (setq ex-token "g") 638 (setq ex-token "g")
720 (defun vip-get-ex-buffer () 740 (defun vip-get-ex-buffer ()
721 (setq ex-buffer nil) 741 (setq ex-buffer nil)
722 (setq ex-count nil) 742 (setq ex-count nil)
723 (setq ex-flag nil) 743 (setq ex-flag nil)
724 (save-window-excursion 744 (save-window-excursion
725 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 745 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
726 (set-buffer vip-ex-work-buf) 746 (set-buffer vip-ex-work-buf)
727 (skip-chars-forward " \t") 747 (skip-chars-forward " \t")
728 (if (looking-at "[a-zA-Z]") 748 (if (looking-at "[a-zA-Z]")
729 (progn 749 (progn
730 (setq ex-buffer (following-char)) 750 (setq ex-buffer (following-char))
746 (defun vip-get-ex-count () 766 (defun vip-get-ex-count ()
747 (setq ex-variant nil 767 (setq ex-variant nil
748 ex-count nil 768 ex-count nil
749 ex-flag nil) 769 ex-flag nil)
750 (save-window-excursion 770 (save-window-excursion
751 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 771 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
752 (set-buffer vip-ex-work-buf) 772 (set-buffer vip-ex-work-buf)
753 (skip-chars-forward " \t") 773 (skip-chars-forward " \t")
754 (if (looking-at "!") 774 (if (looking-at "!")
755 (progn 775 (progn
756 (setq ex-variant t) 776 (setq ex-variant t)
808 ex-append nil 828 ex-append nil
809 ex-offset nil 829 ex-offset nil
810 ex-cmdfile nil) 830 ex-cmdfile nil)
811 (save-excursion 831 (save-excursion
812 (save-window-excursion 832 (save-window-excursion
813 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 833 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
814 (set-buffer vip-ex-work-buf) 834 (set-buffer vip-ex-work-buf)
815 (skip-chars-forward " \t") 835 (skip-chars-forward " \t")
816 (if (looking-at "!") 836 (if (looking-at "!")
817 (if (and (not (vip-looking-back "[ \t]")) 837 (if (and (not (vip-looking-back "[ \t]"))
818 ;; read doesn't have a corresponding :r! form, so ! is 838 ;; read doesn't have a corresponding :r! form, so ! is
1181 (goto-char (point-min))) 1201 (goto-char (point-min)))
1182 (switch-to-buffer file)) 1202 (switch-to-buffer file))
1183 (if ex-offset 1203 (if ex-offset
1184 (progn 1204 (progn
1185 (save-window-excursion 1205 (save-window-excursion
1186 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1206 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1187 (set-buffer vip-ex-work-buf) 1207 (set-buffer vip-ex-work-buf)
1188 (delete-region (point-min) (point-max)) 1208 (delete-region (point-min) (point-max))
1189 (insert ex-offset "\n") 1209 (insert ex-offset "\n")
1190 (goto-char (point-min))) 1210 (goto-char (point-min)))
1191 (goto-char (vip-get-ex-address)) 1211 (goto-char (vip-get-ex-address))
1253 (beginning-of-line) 1273 (beginning-of-line)
1254 (if (bobp) (setq cont nil) 1274 (if (bobp) (setq cont nil)
1255 (forward-line -1) 1275 (forward-line -1)
1256 (end-of-line))))) 1276 (end-of-line)))))
1257 (save-window-excursion 1277 (save-window-excursion
1258 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1278 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1259 (set-buffer vip-ex-work-buf) 1279 (set-buffer vip-ex-work-buf)
1260 (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) 1280 (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
1261 (while marks 1281 (while marks
1262 (goto-char (car marks)) 1282 (goto-char (car marks))
1263 (vip-ex com-str) 1283 (vip-ex com-str)
1325 (let (char) 1345 (let (char)
1326 (if (null ex-addresses) 1346 (if (null ex-addresses)
1327 (setq ex-addresses 1347 (setq ex-addresses
1328 (cons (point) nil))) 1348 (cons (point) nil)))
1329 (save-window-excursion 1349 (save-window-excursion
1330 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1350 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1331 (set-buffer vip-ex-work-buf) 1351 (set-buffer vip-ex-work-buf)
1332 (skip-chars-forward " \t") 1352 (skip-chars-forward " \t")
1333 (if (looking-at "[a-z]") 1353 (if (looking-at "[a-z]")
1334 (progn 1354 (progn
1335 (setq char (following-char)) 1355 (setq char (following-char))
1460 1480
1461 ;; Ex quit command 1481 ;; Ex quit command
1462 (defun ex-quit () 1482 (defun ex-quit ()
1463 ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc. 1483 ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
1464 (save-excursion 1484 (save-excursion
1465 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1485 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1466 (set-buffer vip-ex-work-buf) 1486 (set-buffer vip-ex-work-buf)
1467 (if (looking-at "!") (forward-char 1))) 1487 (if (looking-at "!") (forward-char 1)))
1468 (if (< vip-expert-level 3) 1488 (if (< vip-expert-level 3)
1469 (save-buffers-kill-emacs) 1489 (save-buffers-kill-emacs)
1470 (kill-buffer (current-buffer)))) 1490 (kill-buffer (current-buffer))))
1694 ;; In inline args, skip regex-forw and (optionally) chars-back. 1714 ;; In inline args, skip regex-forw and (optionally) chars-back.
1695 ;; Optional 3d arg is a string that should replace ' ' to prevent its 1715 ;; Optional 3d arg is a string that should replace ' ' to prevent its
1696 ;; special meaning 1716 ;; special meaning
1697 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str) 1717 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
1698 (save-excursion 1718 (save-excursion
1699 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1719 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1700 (set-buffer vip-ex-work-buf) 1720 (set-buffer vip-ex-work-buf)
1701 (goto-char (point-min)) 1721 (goto-char (point-min))
1702 (re-search-forward regex-forw nil t) 1722 (re-search-forward regex-forw nil t)
1703 (let ((beg (point)) 1723 (let ((beg (point))
1704 end) 1724 end)
1828 1848
1829 ;; Ex tag command 1849 ;; Ex tag command
1830 (defun ex-tag () 1850 (defun ex-tag ()
1831 (let (tag) 1851 (let (tag)
1832 (save-window-excursion 1852 (save-window-excursion
1833 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1853 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1834 (set-buffer vip-ex-work-buf) 1854 (set-buffer vip-ex-work-buf)
1835 (skip-chars-forward " \t") 1855 (skip-chars-forward " \t")
1836 (set-mark (point)) 1856 (set-mark (point))
1837 (skip-chars-forward "^ |\t\n") 1857 (skip-chars-forward "^ |\t\n")
1838 (setq tag (buffer-substring (mark t) (point)))) 1858 (setq tag (buffer-substring (mark t) (point))))
1905 (insert-file-contents ex-file)) 1925 (insert-file-contents ex-file))
1906 (goto-char (point-max)) 1926 (goto-char (point-max))
1907 (insert region) 1927 (insert region)
1908 (save-buffer) 1928 (save-buffer)
1909 (ex-write-info file-exists ex-file (point-min) (point-max)) 1929 (ex-write-info file-exists ex-file (point-min) (point-max))
1910 ) 1930 ))
1911 (set-buffer temp-buf) 1931 (set-buffer temp-buf)
1912 (set-buffer-modified-p nil) 1932 (set-buffer-modified-p nil)
1913 (kill-buffer temp-buf) 1933 (kill-buffer temp-buf)
1914 )) 1934 ))
1915 )
1916 ;; this prevents the loss of data if writing part of the buffer 1935 ;; this prevents the loss of data if writing part of the buffer
1917 (if (and (buffer-file-name) writing-same-file) 1936 (if (and (buffer-file-name) writing-same-file)
1918 (set-visited-file-modtime)) 1937 (set-visited-file-modtime))
1919 (or writing-whole-file 1938 (or writing-whole-file
1920 (not writing-same-file) 1939 (not writing-same-file)
1962 1981
1963 ;; Execute shell command 1982 ;; Execute shell command
1964 (defun ex-command () 1983 (defun ex-command ()
1965 (let (command) 1984 (let (command)
1966 (save-window-excursion 1985 (save-window-excursion
1967 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 1986 (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
1968 (set-buffer vip-ex-work-buf) 1987 (set-buffer vip-ex-work-buf)
1969 (skip-chars-forward " \t") 1988 (skip-chars-forward " \t")
1970 (setq command (buffer-substring (point) (point-max))) 1989 (setq command (buffer-substring (point) (point-max)))
1971 (end-of-line)) 1990 (end-of-line))
1972 (setq command (ex-expand-filsyms command (current-buffer))) 1991 (setq command (ex-expand-filsyms command (current-buffer)))
2022 (vip-read-event) 2041 (vip-read-event)
2023 (kill-buffer " *vip-info*"))) 2042 (kill-buffer " *vip-info*")))
2024 )) 2043 ))
2025 2044
2026 2045
2027 (provide 'viper-ex)
2028
2029 ;;; viper-ex.el ends here 2046 ;;; viper-ex.el ends here