Mercurial > hg > xemacs-beta

comparison lisp/viper/viper-ex.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 441bb1e64a06
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; viper-ex.el --- functions implementing the Ex commands for Viper 1 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
2 2
3 ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
4 4
5 ;; This file is part of GNU Emacs. 5 ;; This file is part of GNU Emacs.
6 6
7 ;; GNU Emacs is free software; you can redistribute it and/or modify 7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by 8 ;; it under the terms of the GNU General Public License as published by
34 (defvar vip-expert-level) 34 (defvar vip-expert-level)
35 (defvar vip-custom-file-name) 35 (defvar vip-custom-file-name)
36 (defvar vip-case-fold-search) 36 (defvar vip-case-fold-search)
37 37
38 (eval-when-compile 38 (eval-when-compile
39 (let ((load-path (cons "." load-path))) 39 (let ((load-path (cons (expand-file-name ".") load-path)))
40 (or (featurep 'viper-util) 40 (or (featurep 'viper-util)
41 (load "viper-util.el" nil nil 'nosuffix)) 41 (load "viper-util.el" nil nil 'nosuffix))
42 (or (featurep 'viper-keym) 42 (or (featurep 'viper-keym)
43 (load "viper-keym.el" nil nil 'nosuffix)) 43 (load "viper-keym.el" nil nil 'nosuffix))
44 (or (featurep 'viper)
45 (load "viper.el" nil nil 'nosuffix))
44 )) 46 ))
45 ;; end pacifier 47 ;; end pacifier
46
47 48
48 (require 'viper-util) 49 (require 'viper-util)
49 50
50 51
51 ;;; Variables 52 ;;; Variables
655 (setq ex-addresses 656 (setq ex-addresses
656 (cons (car ex-addresses) ex-addresses))))) 657 (cons (car ex-addresses) ex-addresses)))))
657 658
658 ;; Get an ex-address as a marker and set ex-flag if a flag is found 659 ;; Get an ex-address as a marker and set ex-flag if a flag is found
659 (defun vip-get-ex-address () 660 (defun vip-get-ex-address ()
660 (let ((address (point-marker)) (cont t)) 661 (let ((address (point-marker))
662 (cont t))
661 (setq ex-token "") 663 (setq ex-token "")
662 (setq ex-flag nil) 664 (setq ex-flag nil)
663 (while cont 665 (while cont
664 (vip-get-ex-token) 666 (vip-get-ex-token)
665 (cond ((eq ex-token-type 'command) 667 (cond ((eq ex-token-type 'command)
1870 1872
1871 ;; Ex write command 1873 ;; Ex write command
1872 (defun ex-write (q-flag) 1874 (defun ex-write (q-flag)
1873 (vip-default-ex-addresses t) 1875 (vip-default-ex-addresses t)
1874 (vip-get-ex-file) 1876 (vip-get-ex-file)
1875 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) 1877 (let ((end (car ex-addresses))
1878 (beg (car (cdr ex-addresses)))
1879 (orig-buf (current-buffer))
1880 (orig-buf-file-name (buffer-file-name))
1881 (buff-changed-p (buffer-modified-p))
1876 temp-buf writing-same-file region 1882 temp-buf writing-same-file region
1877 file-exists writing-whole-file) 1883 file-exists writing-whole-file)
1878 (if (> beg end) (error vip-FirstAddrExceedsSecond)) 1884 (if (> beg end) (error vip-FirstAddrExceedsSecond))
1879 (if ex-cmdfile 1885 (if ex-cmdfile
1880 (progn 1886 (progn
1893 ;; if ex-file is a directory use the file portion of the buffer file name 1899 ;; if ex-file is a directory use the file portion of the buffer file name
1894 (if (and (file-directory-p ex-file) 1900 (if (and (file-directory-p ex-file)
1895 buffer-file-name 1901 buffer-file-name
1896 (not (file-directory-p buffer-file-name))) 1902 (not (file-directory-p buffer-file-name)))
1897 (setq ex-file 1903 (setq ex-file
1898 (concat ex-file (file-name-nondirectory buffer-file-name)))) 1904 (concat (file-name-as-directory ex-file)
1899 1905 (file-name-nondirectory buffer-file-name))))
1906
1900 (setq file-exists (file-exists-p ex-file) 1907 (setq file-exists (file-exists-p ex-file)
1901 writing-same-file (string= ex-file (buffer-file-name))) 1908 writing-same-file (string= ex-file (buffer-file-name)))
1902 1909
1903 (if (and writing-whole-file writing-same-file) 1910 (if (and writing-whole-file writing-same-file)
1904 (if (not (buffer-modified-p)) 1911 (if (not (buffer-modified-p))
1905 (message "(No changes need to be saved)") 1912 (message "(No changes need to be saved)")
1906 (save-buffer) 1913 (save-buffer)
1907 (ex-write-info file-exists ex-file beg end)) 1914 (save-restriction
1908 ;; writing some other file or portion of the currents 1915 (widen)
1909 ;; file---create temp buffer for it 1916 (ex-write-info file-exists ex-file (point-min) (point-max))
1910 ;; disable undo in that buffer, for efficiency 1917 ))
1911 (buffer-disable-undo (setq temp-buf (create-file-buffer ex-file))) 1918 ;; writing some other file or portion of the current file
1912 (unwind-protect 1919 (cond ((and file-exists
1913 (save-excursion 1920 (not writing-same-file)
1914 (if (and file-exists 1921 (not (yes-or-no-p
1915 (not writing-same-file) 1922 (format "File %s exists. Overwrite? " ex-file))))
1916 (not (yes-or-no-p 1923 (error "Quit"))
1917 (format "File %s exists. Overwrite? " ex-file)))) 1924 ((and writing-whole-file (not ex-append))
1918 (error "Quit") 1925 (unwind-protect
1919 (vip-enlarge-region beg end) 1926 (progn
1920 (setq region (buffer-substring (point) (mark t))) 1927 (set-visited-file-name ex-file)
1921 (set-buffer temp-buf) 1928 (set-buffer-modified-p t)
1922 (set-visited-file-name ex-file) 1929 (save-buffer))
1923 (erase-buffer) 1930 ;; restore the buffer file name
1924 (if (and file-exists ex-append) 1931 (set-visited-file-name orig-buf-file-name)
1925 (insert-file-contents ex-file)) 1932 (set-buffer-modified-p buff-changed-p))
1926 (goto-char (point-max)) 1933 (save-restriction
1927 (insert region) 1934 (widen)
1928 (save-buffer) 1935 (ex-write-info
1929 (ex-write-info file-exists ex-file (point-min) (point-max)) 1936 file-exists ex-file (point-min) (point-max))))
1930 )) 1937 (t ; writing a region
1931 (set-buffer temp-buf) 1938 (unwind-protect
1932 (set-buffer-modified-p nil) 1939 (save-excursion
1933 (kill-buffer temp-buf) 1940 (vip-enlarge-region beg end)
1934 )) 1941 (setq region (buffer-substring (point) (mark t)))
1942 ;; create temp buffer for the region
1943 (setq temp-buf (get-buffer-create " *ex-write*"))
1944 (set-buffer temp-buf)
1945 (set-visited-file-name ex-file 'noquerry)
1946 (erase-buffer)
1947 (if (and file-exists ex-append)
1948 (insert-file-contents ex-file))
1949 (goto-char (point-max))
1950 (insert region)
1951 (save-buffer)
1952 (ex-write-info
1953 file-exists ex-file (point-min) (point-max))
1954 ))
1955 (set-buffer temp-buf)
1956 (set-buffer-modified-p nil)
1957 (kill-buffer temp-buf))
1958 ))
1959 (set-buffer orig-buf)
1935 ;; this prevents the loss of data if writing part of the buffer 1960 ;; this prevents the loss of data if writing part of the buffer
1936 (if (and (buffer-file-name) writing-same-file) 1961 (if (and (buffer-file-name) writing-same-file)
1937 (set-visited-file-modtime)) 1962 (set-visited-file-modtime))
1938 (or writing-whole-file 1963 (or writing-whole-file
1939 (not writing-same-file) 1964 (not writing-same-file)