[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/emulation/viper-util.el
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/emulation/viper-util.el |
|
Date: |
Fri, 04 Apr 2003 01:22:04 -0500 |
Index: emacs/lisp/emulation/viper-util.el
diff -c emacs/lisp/emulation/viper-util.el:1.48
emacs/lisp/emulation/viper-util.el:1.49
*** emacs/lisp/emulation/viper-util.el:1.48 Wed Sep 18 00:23:27 2002
--- emacs/lisp/emulation/viper-util.el Tue Feb 4 07:56:03 2003
***************
*** 136,155 ****
(eq (device-class (selected-device)) 'color) ; xemacs
(x-display-color-p) ; emacs
))
!
(defsubst viper-get-cursor-color ()
(viper-cond-compile-for-xemacs-or-emacs
;; xemacs
(color-instance-name (frame-property (selected-frame) 'cursor-color))
(cdr (assoc 'cursor-color (frame-parameters))) ; emacs
))
!
;; OS/2
(cond ((eq (viper-device-type) 'pm)
(fset 'viper-color-defined-p
(lambda (color) (assoc color pm-color-alist)))))
!
;; cursor colors
(defun viper-change-cursor-color (new-color)
--- 136,155 ----
(eq (device-class (selected-device)) 'color) ; xemacs
(x-display-color-p) ; emacs
))
!
(defsubst viper-get-cursor-color ()
(viper-cond-compile-for-xemacs-or-emacs
;; xemacs
(color-instance-name (frame-property (selected-frame) 'cursor-color))
(cdr (assoc 'cursor-color (frame-parameters))) ; emacs
))
!
;; OS/2
(cond ((eq (viper-device-type) 'pm)
(fset 'viper-color-defined-p
(lambda (color) (assoc color pm-color-alist)))))
!
;; cursor colors
(defun viper-change-cursor-color (new-color)
***************
*** 163,169 ****
(selected-frame) (list (cons 'cursor-color new-color)))
)
))
!
;; By default, saves current frame cursor color in the
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
(defun viper-save-cursor-color (before-which-mode)
--- 163,169 ----
(selected-frame) (list (cons 'cursor-color new-color)))
)
))
!
;; By default, saves current frame cursor color in the
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
(defun viper-save-cursor-color (before-which-mode)
***************
*** 180,186 ****
'viper-saved-cursor-color-in-insert-mode)
color)))
))))
!
(defsubst viper-get-saved-cursor-color-in-replace-mode ()
(or
--- 180,186 ----
'viper-saved-cursor-color-in-insert-mode)
color)))
))))
!
(defsubst viper-get-saved-cursor-color-in-replace-mode ()
(or
***************
*** 197,203 ****
(selected-frame)
'viper-saved-cursor-color-in-insert-mode)
viper-vi-state-cursor-color))
!
;; restore cursor color from replace overlay
(defun viper-restore-cursor-color(after-which-mode)
(if (viper-overlay-p viper-replace-overlay)
--- 197,203 ----
(selected-frame)
'viper-saved-cursor-color-in-insert-mode)
viper-vi-state-cursor-color))
!
;; restore cursor color from replace overlay
(defun viper-restore-cursor-color(after-which-mode)
(if (viper-overlay-p viper-replace-overlay)
***************
*** 206,212 ****
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode))
)))
!
;; Check the current version against the major and minor version numbers
;; using op: cur-vers op major.minor If emacs-major-version or
--- 206,212 ----
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode))
)))
!
;; Check the current version against the major and minor version numbers
;; using op: cur-vers op major.minor If emacs-major-version or
***************
*** 234,247 ****
(error "%S: Invalid op in viper-check-version" op))))
(cond ((memq op '(= > >=)) nil)
((memq op '(< <=)) t))))
!
(defun viper-get-visible-buffer-window (wind)
(if viper-xemacs-p
(get-buffer-window wind t)
(get-buffer-window wind 'visible)))
!
!
;; Return line position.
;; If pos is 'start then returns position of line start.
;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
--- 234,247 ----
(error "%S: Invalid op in viper-check-version" op))))
(cond ((memq op '(= > >=)) nil)
((memq op '(< <=)) t))))
!
(defun viper-get-visible-buffer-window (wind)
(if viper-xemacs-p
(get-buffer-window wind t)
(get-buffer-window wind 'visible)))
!
!
;; Return line position.
;; If pos is 'start then returns position of line start.
;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
***************
*** 286,292 ****
;; Like move-marker but creates a virgin marker if arg isn't already a marker.
;; The first argument must eval to a variable name.
;; Arguments: (var-name position &optional buffer).
! ;;
;; This is useful for moving markers that are supposed to be local.
;; For this, VAR-NAME should be made buffer-local with nil as a default.
;; Then, each time this var is used in `viper-move-marker-locally' in a new
--- 286,292 ----
;; Like move-marker but creates a virgin marker if arg isn't already a marker.
;; The first argument must eval to a variable name.
;; Arguments: (var-name position &optional buffer).
! ;;
;; This is useful for moving markers that are supposed to be local.
;; For this, VAR-NAME should be made buffer-local with nil as a default.
;; Then, each time this var is used in `viper-move-marker-locally' in a new
***************
*** 309,322 ****
;;; List/alist utilities
!
;; Convert LIST to an alist
(defun viper-list-to-alist (lst)
(let ((alist))
(while lst
(setq alist (cons (list (car lst)) alist))
(setq lst (cdr lst)))
! alist))
;; Convert ALIST to a list.
(defun viper-alist-to-list (alst)
--- 309,322 ----
;;; List/alist utilities
!
;; Convert LIST to an alist
(defun viper-list-to-alist (lst)
(let ((alist))
(while lst
(setq alist (cons (list (car lst)) alist))
(setq lst (cdr lst)))
! alist))
;; Convert ALIST to a list.
(defun viper-alist-to-list (alst)
***************
*** 334,341 ****
(if (string-match regexp (car (car inalst)))
(setq outalst (cons (car inalst) outalst)))
(setq inalst (cdr inalst)))
! outalst))
!
;; Filter LIST using REGEXP. Return list whose elements match the regexp.
(defun viper-filter-list (regexp lst)
(interactive "s x")
--- 334,341 ----
(if (string-match regexp (car (car inalst)))
(setq outalst (cons (car inalst) outalst)))
(setq inalst (cdr inalst)))
! outalst))
!
;; Filter LIST using REGEXP. Return list whose elements match the regexp.
(defun viper-filter-list (regexp lst)
(interactive "s x")
***************
*** 344,352 ****
(if (string-match regexp (car inlst))
(setq outlst (cons (car inlst) outlst)))
(setq inlst (cdr inlst)))
! outlst))
-
;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
;; LIS2 is modified by filtering it: deleting its members of the form
;; \(car elt\) such that (car elt') is in LIS1.
--- 344,352 ----
(if (string-match regexp (car inlst))
(setq outlst (cons (car inlst) outlst)))
(setq inlst (cdr inlst)))
! outlst))
!
;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
;; LIS2 is modified by filtering it: deleting its members of the form
;; \(car elt\) such that (car elt') is in LIS1.
***************
*** 359,365 ****
(while (setq elt (assoc (car (car temp)) lis2))
(setq lis2 (delq elt lis2)))
(setq temp (cdr temp)))
!
(nconc lis1 lis2)))
--- 359,365 ----
(while (setq elt (assoc (car (car temp)) lis2))
(setq lis2 (delq elt lis2)))
(setq temp (cdr temp)))
!
(nconc lis1 lis2)))
***************
*** 380,386 ****
(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
(t (format "ls -1 -d %s" filespec))))
status)
! (save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(setq status
--- 380,386 ----
(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
(t (format "ls -1 -d %s" filespec))))
status)
! (save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(setq status
***************
*** 425,431 ****
((looking-at "'")
(setq delim ?')
(re-search-forward "[^']+" nil t)) ; noerror
! (t
(re-search-forward
(concat "[^" skip-chars "]+") nil t))) ;noerror
(setq fname
--- 425,431 ----
((looking-at "'")
(setq delim ?')
(re-search-forward "[^']+" nil t)) ; noerror
! (t
(re-search-forward
(concat "[^" skip-chars "]+") nil t))) ;noerror
(setq fname
***************
*** 459,472 ****
(defun viper-glob-mswindows-files (filespec)
(let ((case-fold-search t)
tmp tmp2)
! (save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(insert filespec)
(goto-char (point-min))
(setq tmp (viper-get-filenames-from-buffer))
(while tmp
! (setq tmp2 (cons (directory-files
;; the directory part
(or (file-name-directory (car tmp))
"")
--- 459,472 ----
(defun viper-glob-mswindows-files (filespec)
(let ((case-fold-search t)
tmp tmp2)
! (save-excursion
(set-buffer (get-buffer-create viper-ex-tmp-buf-name))
(erase-buffer)
(insert filespec)
(goto-char (point-min))
(setq tmp (viper-get-filenames-from-buffer))
(while tmp
! (setq tmp2 (cons (directory-files
;; the directory part
(or (file-name-directory (car tmp))
"")
***************
*** 495,501 ****
(t (car ring))))
(viper-current-ring-item ring)
)))
!
(defun viper-special-ring-rotate1 (ring dir)
(if (memq viper-intermediate-command
'(repeating-display-destructive-command
--- 495,501 ----
(t (car ring))))
(viper-current-ring-item ring)
)))
!
(defun viper-special-ring-rotate1 (ring dir)
(if (memq viper-intermediate-command
'(repeating-display-destructive-command
***************
*** 503,516 ****
(viper-ring-rotate1 ring dir)
;; don't rotate otherwise
(viper-ring-rotate1 ring 0)))
!
;; current ring item; if N is given, then so many items back from the
;; current
(defun viper-current-ring-item (ring &optional n)
(setq n (or n 0))
(if (and (ring-p ring) (> (ring-length ring) 0))
(aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
!
;; Push item onto ring. The second argument is a ring-variable, not value.
(defun viper-push-onto-ring (item ring-var)
(or (ring-p (eval ring-var))
--- 503,516 ----
(viper-ring-rotate1 ring dir)
;; don't rotate otherwise
(viper-ring-rotate1 ring 0)))
!
;; current ring item; if N is given, then so many items back from the
;; current
(defun viper-current-ring-item (ring &optional n)
(setq n (or n 0))
(if (and (ring-p ring) (> (ring-length ring) 0))
(aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
!
;; Push item onto ring. The second argument is a ring-variable, not value.
(defun viper-push-onto-ring (item ring-var)
(or (ring-p (eval ring-var))
***************
*** 532,538 ****
(viper-array-to-string (this-command-keys))))
(viper-ring-insert (eval ring-var) item))
)
!
;; removing elts from ring seems to break it
(defun viper-cleanup-ring (ring)
--- 532,538 ----
(viper-array-to-string (this-command-keys))))
(viper-ring-insert (eval ring-var) item))
)
!
;; removing elts from ring seems to break it
(defun viper-cleanup-ring (ring)
***************
*** 542,548 ****
(if (equal (viper-current-ring-item ring)
(viper-current-ring-item ring 1))
(viper-ring-pop ring))))
!
;; ring-remove seems to be buggy, so we concocted this for our purposes.
(defun viper-ring-pop (ring)
(let* ((ln (ring-length ring))
--- 542,548 ----
(if (equal (viper-current-ring-item ring)
(viper-current-ring-item ring 1))
(viper-ring-pop ring))))
!
;; ring-remove seems to be buggy, so we concocted this for our purposes.
(defun viper-ring-pop (ring)
(let* ((ln (ring-length ring))
***************
*** 551,570 ****
(hd (car ring))
(idx (max 0 (ring-minus1 hd ln)))
(top-elt (aref vec idx)))
!
;; shift elements
(while (< (1+ idx) veclen)
(aset vec idx (aref vec (1+ idx)))
(setq idx (1+ idx)))
(aset vec idx nil)
!
(setq hd (max 0 (ring-minus1 hd ln)))
(if (= hd (1- ln)) (setq hd 0))
(setcar ring hd) ; move head
(setcar (cdr ring) (max 0 (1- ln))) ; adjust length
top-elt
))
!
(defun viper-ring-insert (ring item)
(let* ((ln (ring-length ring))
(vec (cdr (cdr ring)))
--- 551,570 ----
(hd (car ring))
(idx (max 0 (ring-minus1 hd ln)))
(top-elt (aref vec idx)))
!
;; shift elements
(while (< (1+ idx) veclen)
(aset vec idx (aref vec (1+ idx)))
(setq idx (1+ idx)))
(aset vec idx nil)
!
(setq hd (max 0 (ring-minus1 hd ln)))
(if (= hd (1- ln)) (setq hd 0))
(setcar ring hd) ; move head
(setcar (cdr ring) (max 0 (1- ln))) ; adjust length
top-elt
))
!
(defun viper-ring-insert (ring item)
(let* ((ln (ring-length ring))
(vec (cdr (cdr ring)))
***************
*** 572,578 ****
(hd (car ring))
(vecpos-after-hd (if (= hd 0) ln hd))
(idx ln))
!
(if (= ln veclen)
(progn
(aset vec hd item) ; hd is always 1+ the actual head index in vec
--- 572,578 ----
(hd (car ring))
(vecpos-after-hd (if (= hd 0) ln hd))
(idx ln))
!
(if (= ln veclen)
(progn
(aset vec hd item) ; hd is always 1+ the actual head index in vec
***************
*** 584,590 ****
(setq idx (1- idx)))
(aset vec vecpos-after-hd item))
item))
!
;;; String utilities
--- 584,590 ----
(setq idx (1- idx)))
(aset vec vecpos-after-hd item))
item))
!
;;; String utilities
***************
*** 592,603 ****
;; PRE-STRING is a string to prepend to the abbrev string.
;; POST-STRING is a string to append to the abbrev string.
;; ABBREV_SIGN is a string to be inserted before POST-STRING
! ;; if the orig string was truncated.
(defun viper-abbreviate-string (string max-len
pre-string post-string abbrev-sign)
(let (truncated-str)
(setq truncated-str
! (if (stringp string)
(substring string 0 (min max-len (length string)))))
(cond ((null truncated-str) "")
((> (length string) max-len)
--- 592,603 ----
;; PRE-STRING is a string to prepend to the abbrev string.
;; POST-STRING is a string to append to the abbrev string.
;; ABBREV_SIGN is a string to be inserted before POST-STRING
! ;; if the orig string was truncated.
(defun viper-abbreviate-string (string max-len
pre-string post-string abbrev-sign)
(let (truncated-str)
(setq truncated-str
! (if (stringp string)
(substring string 0 (min max-len (length string)))))
(cond ((null truncated-str) "")
((> (length string) max-len)
***************
*** 610,616 ****
(save-excursion
(beginning-of-line)
(looking-at "^[ \t]*$")))
!
;;; Saving settings in custom file
--- 610,616 ----
(save-excursion
(beginning-of-line)
(looking-at "^[ \t]*$")))
!
;;; Saving settings in custom file
***************
*** 644,650 ****
(sit-for 2)
(message "")))
))
!
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
;; match this pattern.
(defun viper-save-string-in-file (string custom-file &optional pattern)
--- 644,650 ----
(sit-for 2)
(message "")))
))
!
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
;; match this pattern.
(defun viper-save-string-in-file (string custom-file &optional pattern)
***************
*** 670,676 ****
;; Can happen only in Emacs, since XEmacs has file-remote-p
(ange-ftp-ftp-name file-name))))))
!
;; This is a simple-minded check for whether a file is under version control.
;; If file,v exists but file doesn't, this file is considered to be not
checked
--- 670,676 ----
;; Can happen only in Emacs, since XEmacs has file-remote-p
(ange-ftp-ftp-name file-name))))))
!
;; This is a simple-minded check for whether a file is under version control.
;; If file,v exists but file doesn't, this file is considered to be not
checked
***************
*** 721,729 ****
(viper-abbreviate-file-name file))))
(with-current-buffer buf
(command-execute checkout-function)))))
-
!
;;; Overlays
(defun viper-put-on-search-overlay (beg end)
--- 721,729 ----
(viper-abbreviate-file-name file))))
(with-current-buffer buf
(command-execute checkout-function)))))
!
!
;;; Overlays
(defun viper-put-on-search-overlay (beg end)
***************
*** 756,762 ****
(defsubst viper-move-replace-overlay (beg end)
(viper-move-overlay viper-replace-overlay beg end))
!
(defun viper-set-replace-overlay (beg end)
(if (viper-overlay-live-p viper-replace-overlay)
(viper-move-replace-overlay beg end)
--- 756,762 ----
(defsubst viper-move-replace-overlay (beg end)
(viper-move-overlay viper-replace-overlay beg end))
!
(defun viper-set-replace-overlay (beg end)
(if (viper-overlay-live-p viper-replace-overlay)
(viper-move-replace-overlay beg end)
***************
*** 764,770 ****
;; never detach
(viper-overlay-put
viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil)
! (viper-overlay-put
viper-replace-overlay 'priority viper-replace-overlay-priority)
;; If Emacs will start supporting overlay maps, as it currently supports
;; text-property maps, we could do away with viper-replace-minor-mode and
--- 764,770 ----
;; never detach
(viper-overlay-put
viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil)
! (viper-overlay-put
viper-replace-overlay 'priority viper-replace-overlay-priority)
;; If Emacs will start supporting overlay maps, as it currently supports
;; text-property maps, we could do away with viper-replace-minor-mode and
***************
*** 773,787 ****
;; viper-replace-overlay
;; (if viper-xemacs-p 'keymap 'local-map)
;; viper-replace-map)
! )
(if (viper-has-face-support-p)
(viper-overlay-put
viper-replace-overlay 'face viper-replace-overlay-face))
(viper-save-cursor-color 'before-replace-mode)
(viper-change-cursor-color viper-replace-overlay-cursor-color)
)
!
!
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
(or (viper-overlay-live-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
--- 773,787 ----
;; viper-replace-overlay
;; (if viper-xemacs-p 'keymap 'local-map)
;; viper-replace-map)
! )
(if (viper-has-face-support-p)
(viper-overlay-put
viper-replace-overlay 'face viper-replace-overlay-face))
(viper-save-cursor-color 'before-replace-mode)
(viper-change-cursor-color viper-replace-overlay-cursor-color)
)
!
!
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
(or (viper-overlay-live-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
***************
*** 791,797 ****
(after-name (if viper-xemacs-p 'end-glyph 'after-string)))
(viper-overlay-put viper-replace-overlay before-name before-glyph)
(viper-overlay-put viper-replace-overlay after-name after-glyph))))
!
(defun viper-hide-replace-overlay ()
(viper-set-replace-overlay-glyphs nil nil)
(viper-restore-cursor-color 'after-replace-mode)
--- 791,797 ----
(after-name (if viper-xemacs-p 'end-glyph 'after-string)))
(viper-overlay-put viper-replace-overlay before-name before-glyph)
(viper-overlay-put viper-replace-overlay after-name after-glyph))))
!
(defun viper-hide-replace-overlay ()
(viper-set-replace-overlay-glyphs nil nil)
(viper-restore-cursor-color 'after-replace-mode)
***************
*** 799,810 ****
(if (viper-has-face-support-p)
(viper-overlay-put viper-replace-overlay 'face nil)))
!
(defsubst viper-replace-start ()
(viper-overlay-start viper-replace-overlay))
(defsubst viper-replace-end ()
(viper-overlay-end viper-replace-overlay))
!
;; Minibuffer
--- 799,810 ----
(if (viper-has-face-support-p)
(viper-overlay-put viper-replace-overlay 'face nil)))
!
(defsubst viper-replace-start ()
(viper-overlay-start viper-replace-overlay))
(defsubst viper-replace-end ()
(viper-overlay-end viper-replace-overlay))
!
;; Minibuffer
***************
*** 814,820 ****
(progn
(viper-overlay-put
viper-minibuffer-overlay 'face viper-minibuffer-current-face)
! (viper-overlay-put
viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
;; never detach
(viper-overlay-put
--- 814,820 ----
(progn
(viper-overlay-put
viper-minibuffer-overlay 'face viper-minibuffer-current-face)
! (viper-overlay-put
viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
;; never detach
(viper-overlay-put
***************
*** 828,834 ****
(viper-overlay-put viper-minibuffer-overlay 'start-open nil)
(viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
)))
!
(defun viper-check-minibuffer-overlay ()
(if (viper-overlay-live-p viper-minibuffer-overlay)
(viper-move-overlay
--- 828,834 ----
(viper-overlay-put viper-minibuffer-overlay 'start-open nil)
(viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
)))
!
(defun viper-check-minibuffer-overlay ()
(if (viper-overlay-live-p viper-minibuffer-overlay)
(viper-move-overlay
***************
*** 849,855 ****
(defsubst viper-is-in-minibuffer ()
(save-match-data
(string-match "\*Minibuf-" (buffer-name))))
!
;;; XEmacs compatibility
--- 849,855 ----
(defsubst viper-is-in-minibuffer ()
(save-match-data
(string-match "\*Minibuf-" (buffer-name))))
!
;;; XEmacs compatibility
***************
*** 861,868 ****
;; emacs
(abbreviate-file-name file)
))
!
! ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
(if viper-xemacs-p
--- 861,868 ----
;; emacs
(abbreviate-file-name file)
))
!
! ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
(if viper-xemacs-p
***************
*** 883,889 ****
(save-excursion
(set-buffer buf)
(and (<= pos (point-max)) (<= (point-min) pos))))))
!
(defsubst viper-mark-marker ()
(viper-cond-compile-for-xemacs-or-emacs
(mark-marker t) ; xemacs
--- 883,889 ----
(save-excursion
(set-buffer buf)
(and (<= pos (point-max)) (<= (point-min) pos))))))
!
(defsubst viper-mark-marker ()
(viper-cond-compile-for-xemacs-or-emacs
(mark-marker t) ; xemacs
***************
*** 896,902 ****
(setq mark-ring (delete (viper-mark-marker) mark-ring))
(set-mark-command nil)
(setq viper-saved-mark (point)))
!
;; In transient mark mode (zmacs mode), it is annoying when regions become
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
;; the user explicitly wants highlighting, e.g., by hitting '' or ``
--- 896,902 ----
(setq mark-ring (delete (viper-mark-marker) mark-ring))
(set-mark-command nil)
(setq viper-saved-mark (point)))
!
;; In transient mark mode (zmacs mode), it is annoying when regions become
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
;; the user explicitly wants highlighting, e.g., by hitting '' or ``
***************
*** 927,934 ****
(and (<= ?A reg) (<= reg ?Z)))
))
!
!
;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
--- 927,934 ----
(and (<= ?A reg) (<= reg ?Z)))
))
!
!
;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
***************
*** 936,950 ****
(copy-event event) ; xemacs
event ; emacs
))
!
;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
! (not (viper-sit-for-short
(if (viper-ESC-event-p last-input-event)
viper-ESC-keyseq-timeout
viper-fast-keyseq-timeout)
t)))
!
;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
(let (event)
--- 936,950 ----
(copy-event event) ; xemacs
event ; emacs
))
!
;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
! (not (viper-sit-for-short
(if (viper-ESC-event-p last-input-event)
viper-ESC-keyseq-timeout
viper-fast-keyseq-timeout)
t)))
!
;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
(let (event)
***************
*** 978,984 ****
;; keysequence. Otherwise, viper-fast-keysequence-p will be
;; always t -- whether there is anything after ESC or not
(viper-set-unread-command-events keyseq)
! (setq keyseq (read-key-sequence nil)))
(viper-set-unread-command-events keyseq)
(setq keyseq (read-key-sequence nil)))))
keyseq))
--- 978,984 ----
;; keysequence. Otherwise, viper-fast-keysequence-p will be
;; always t -- whether there is anything after ESC or not
(viper-set-unread-command-events keyseq)
! (setq keyseq (read-key-sequence nil)))
(viper-set-unread-command-events keyseq)
(setq keyseq (read-key-sequence nil)))))
keyseq))
***************
*** 989,1001 ****
;; macros, since it enables certain macros to be shared between X and TTY
modes
;; by correctly mapping key sequences for Left/Right/... (one an ascii
;; terminal) into logical keys left, right, etc.
! (defun viper-read-key ()
! (let ((overriding-local-map viper-overriding-map)
(inhibit-quit t)
! help-char key)
! (use-global-map viper-overriding-map)
(unwind-protect
! (setq key (elt (viper-read-key-sequence nil) 0))
(use-global-map global-map))
key))
--- 989,1001 ----
;; macros, since it enables certain macros to be shared between X and TTY
modes
;; by correctly mapping key sequences for Left/Right/... (one an ascii
;; terminal) into logical keys left, right, etc.
! (defun viper-read-key ()
! (let ((overriding-local-map viper-overriding-map)
(inhibit-quit t)
! help-char key)
! (use-global-map viper-overriding-map)
(unwind-protect
! (setq key (elt (viper-read-key-sequence nil) 0))
(use-global-map global-map))
key))
***************
*** 1019,1025 ****
(event-key event))
((button-event-p event)
(concat "mouse-" (prin1-to-string (event-button event))))
! (t
(error "viper-event-key: Unknown event, %S" event)))
;; Emacs doesn't handle capital letters correctly, since
;; \S-a isn't considered the same as A (it behaves as
--- 1019,1025 ----
(event-key event))
((button-event-p event)
(concat "mouse-" (prin1-to-string (event-button event))))
! (t
(error "viper-event-key: Unknown event, %S" event)))
;; Emacs doesn't handle capital letters correctly, since
;; \S-a isn't considered the same as A (it behaves as
***************
*** 1053,1059 ****
(if mod
(append mod (list basis))
basis))))
!
(defun viper-key-to-emacs-key (key)
(let (key-name char-p modifiers mod-char-list base-key base-key-name)
(cond (viper-xemacs-p key)
--- 1053,1059 ----
(if mod
(append mod (list basis))
basis))))
!
(defun viper-key-to-emacs-key (key)
(let (key-name char-p modifiers mod-char-list base-key base-key-name)
(cond (viper-xemacs-p key)
***************
*** 1109,1115 ****
"viper-eventify-list-xemacs: can't convert to event, %S"
elt))))
lis))
!
;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
--- 1109,1115 ----
"viper-eventify-list-xemacs: can't convert to event, %S"
elt))))
lis))
!
;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
***************
*** 1154,1160 ****
(and (vectorp vec)
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
!
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
(and
--- 1154,1160 ----
(and (vectorp vec)
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
!
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
(and
***************
*** 1164,1171 ****
(mapcar (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1)))
vec)))))
!
!
(defun viper-char-array-p (array)
(eval (cons 'and (mapcar 'viper-characterp array))))
--- 1164,1171 ----
(mapcar (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1)))
vec)))))
!
!
(defun viper-char-array-p (array)
(eval (cons 'and (mapcar 'viper-characterp array))))
***************
*** 1188,1194 ****
(t (prin1-to-string (vconcat temp)))))
((viper-char-symbol-sequence-p event-seq)
(mapconcat 'symbol-name event-seq ""))
! ((and (vectorp event-seq)
(viper-char-array-p
(setq temp (mapcar 'viper-key-to-character event-seq))))
(mapconcat 'char-to-string temp ""))
--- 1188,1194 ----
(t (prin1-to-string (vconcat temp)))))
((viper-char-symbol-sequence-p event-seq)
(mapconcat 'symbol-name event-seq ""))
! ((and (vectorp event-seq)
(viper-char-array-p
(setq temp (mapcar 'viper-key-to-character event-seq))))
(mapconcat 'char-to-string temp ""))
***************
*** 1201,1208 ****
)
events
""))
!
!
(defun viper-read-char-exclusive ()
(let (char
(echo-keystrokes 1))
--- 1201,1208 ----
)
events
""))
!
!
(defun viper-read-char-exclusive ()
(let (char
(echo-keystrokes 1))
***************
*** 1230,1242 ****
(= 1 (length (symbol-name (nth 1 key)))))
(read (format "?\\C-%s" (symbol-name (nth 1 key)))))
(t key)))
!
!
(defun viper-setup-master-buffer (&rest other-files-or-buffers)
"Set up the current buffer as a master buffer.
Arguments become related buffers. This function should normally be used in
the `Local variables' section of a file."
! (setq viper-related-files-and-buffers-ring
(make-ring (1+ (length other-files-or-buffers))))
(mapcar '(lambda (elt)
(viper-ring-insert viper-related-files-and-buffers-ring elt))
--- 1230,1242 ----
(= 1 (length (symbol-name (nth 1 key)))))
(read (format "?\\C-%s" (symbol-name (nth 1 key)))))
(t key)))
!
!
(defun viper-setup-master-buffer (&rest other-files-or-buffers)
"Set up the current buffer as a master buffer.
Arguments become related buffers. This function should normally be used in
the `Local variables' section of a file."
! (setq viper-related-files-and-buffers-ring
(make-ring (1+ (length other-files-or-buffers))))
(mapcar '(lambda (elt)
(viper-ring-insert viper-related-files-and-buffers-ring elt))
***************
*** 1277,1283 ****
;; Set Viper syntax classes and related variables according to
! ;; `viper-syntax-preference'.
(defun viper-update-syntax-classes (&optional set-default)
(let ((preference (cond ((eq viper-syntax-preference 'emacs)
"w") ; Viper words have only Emacs word chars
--- 1277,1283 ----
;; Set Viper syntax classes and related variables according to
! ;; `viper-syntax-preference'.
(defun viper-update-syntax-classes (&optional set-default)
(let ((preference (cond ((eq viper-syntax-preference 'emacs)
"w") ; Viper words have only Emacs word chars
***************
*** 1338,1344 ****
`emacs' means Viper words are the same as Emacs words as specified by Emacs
syntax tables.
This option is appropriate if you like Emacs-style words."
! :type '(radio (const strict-vi) (const reformed-vi)
(const extended) (const emacs))
:set 'viper-set-syntax-preference
:group 'viper)
--- 1338,1344 ----
`emacs' means Viper words are the same as Emacs words as specified by Emacs
syntax tables.
This option is appropriate if you like Emacs-style words."
! :type '(radio (const strict-vi) (const reformed-vi)
(const extended) (const emacs))
:set 'viper-set-syntax-preference
:group 'viper)
***************
*** 1382,1388 ****
(defun viper-skip-alpha-forward (&optional addl-chars)
(or (stringp addl-chars) (setq addl-chars ""))
(viper-skip-syntax
! 'forward
(cond ((eq viper-syntax-preference 'strict-vi)
"")
(t viper-ALPHA-char-class))
--- 1382,1388 ----
(defun viper-skip-alpha-forward (&optional addl-chars)
(or (stringp addl-chars) (setq addl-chars ""))
(viper-skip-syntax
! 'forward
(cond ((eq viper-syntax-preference 'strict-vi)
"")
(t viper-ALPHA-char-class))
***************
*** 1393,1399 ****
(defun viper-skip-alpha-backward (&optional addl-chars)
(or (stringp addl-chars) (setq addl-chars ""))
(viper-skip-syntax
! 'backward
(cond ((eq viper-syntax-preference 'strict-vi)
"")
(t viper-ALPHA-char-class))
--- 1393,1399 ----
(defun viper-skip-alpha-backward (&optional addl-chars)
(or (stringp addl-chars) (setq addl-chars ""))
(viper-skip-syntax
! 'backward
(cond ((eq viper-syntax-preference 'strict-vi)
"")
(t viper-ALPHA-char-class))
***************
*** 1404,1410 ****
;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
(if (eq viper-syntax-preference 'strict-vi)
! (if within-line
(skip-chars-forward viper-strict-SEP-chars-sans-newline)
(skip-chars-forward viper-strict-SEP-chars))
(viper-skip-syntax 'forward
--- 1404,1410 ----
;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
(if (eq viper-syntax-preference 'strict-vi)
! (if within-line
(skip-chars-forward viper-strict-SEP-chars-sans-newline)
(skip-chars-forward viper-strict-SEP-chars))
(viper-skip-syntax 'forward
***************
*** 1413,1419 ****
(if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
(if (eq viper-syntax-preference 'strict-vi)
! (if within-line
(skip-chars-backward viper-strict-SEP-chars-sans-newline)
(skip-chars-backward viper-strict-SEP-chars))
(viper-skip-syntax 'backward
--- 1413,1419 ----
(if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
(if (eq viper-syntax-preference 'strict-vi)
! (if within-line
(skip-chars-backward viper-strict-SEP-chars-sans-newline)
(skip-chars-backward viper-strict-SEP-chars))
(viper-skip-syntax 'backward
***************
*** 1437,1443 ****
'forward
(concat "^" viper-ALPHA-char-class viper-SEP-char-class)
;; Emacs may consider some of these as words, but we don't want them
! viper-non-word-characters
(viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
(if (eq viper-syntax-preference 'strict-vi)
--- 1437,1443 ----
'forward
(concat "^" viper-ALPHA-char-class viper-SEP-char-class)
;; Emacs may consider some of these as words, but we don't want them
! viper-non-word-characters
(viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
(if (eq viper-syntax-preference 'strict-vi)
***************
*** 1475,1482 ****
(t nil)))
(if (memq ?^ syntax) (setq negated-syntax t))
! (while (and (not (= local 0))
! (cond ((eq direction 'forward)
(not (eobp)))
(t (not (bobp)))))
(setq char-looked-at (viper-char-at-pos direction)
--- 1475,1482 ----
(t nil)))
(if (memq ?^ syntax) (setq negated-syntax t))
! (while (and (not (= local 0))
! (cond ((eq direction 'forward)
(not (eobp)))
(t (not (bobp)))))
(setq char-looked-at (viper-char-at-pos direction)
***************
*** 1507,1517 ****
(setq total (+ total local)))
total
))
-
!
(provide 'viper-util)
!
;;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
--- 1507,1517 ----
(setq total (+ total local)))
total
))
!
!
(provide 'viper-util)
!
;;; Local Variables:
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/emulation/viper-util.el,
Miles Bader <=