136 |
(eq (device-class (selected-device)) 'color) ; xemacs |
(eq (device-class (selected-device)) 'color) ; xemacs |
137 |
(x-display-color-p) ; emacs |
(x-display-color-p) ; emacs |
138 |
)) |
)) |
139 |
|
|
140 |
(defsubst viper-get-cursor-color () |
(defsubst viper-get-cursor-color () |
141 |
(viper-cond-compile-for-xemacs-or-emacs |
(viper-cond-compile-for-xemacs-or-emacs |
142 |
;; xemacs |
;; xemacs |
143 |
(color-instance-name (frame-property (selected-frame) 'cursor-color)) |
(color-instance-name (frame-property (selected-frame) 'cursor-color)) |
144 |
(cdr (assoc 'cursor-color (frame-parameters))) ; emacs |
(cdr (assoc 'cursor-color (frame-parameters))) ; emacs |
145 |
)) |
)) |
146 |
|
|
147 |
|
|
148 |
;; OS/2 |
;; OS/2 |
149 |
(cond ((eq (viper-device-type) 'pm) |
(cond ((eq (viper-device-type) 'pm) |
150 |
(fset 'viper-color-defined-p |
(fset 'viper-color-defined-p |
151 |
(lambda (color) (assoc color pm-color-alist))))) |
(lambda (color) (assoc color pm-color-alist))))) |
152 |
|
|
153 |
|
|
154 |
;; cursor colors |
;; cursor colors |
155 |
(defun viper-change-cursor-color (new-color) |
(defun viper-change-cursor-color (new-color) |
163 |
(selected-frame) (list (cons 'cursor-color new-color))) |
(selected-frame) (list (cons 'cursor-color new-color))) |
164 |
) |
) |
165 |
)) |
)) |
166 |
|
|
167 |
;; By default, saves current frame cursor color in the |
;; By default, saves current frame cursor color in the |
168 |
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay |
;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay |
169 |
(defun viper-save-cursor-color (before-which-mode) |
(defun viper-save-cursor-color (before-which-mode) |
180 |
'viper-saved-cursor-color-in-insert-mode) |
'viper-saved-cursor-color-in-insert-mode) |
181 |
color))) |
color))) |
182 |
)))) |
)))) |
183 |
|
|
184 |
|
|
185 |
(defsubst viper-get-saved-cursor-color-in-replace-mode () |
(defsubst viper-get-saved-cursor-color-in-replace-mode () |
186 |
(or |
(or |
197 |
(selected-frame) |
(selected-frame) |
198 |
'viper-saved-cursor-color-in-insert-mode) |
'viper-saved-cursor-color-in-insert-mode) |
199 |
viper-vi-state-cursor-color)) |
viper-vi-state-cursor-color)) |
200 |
|
|
201 |
;; restore cursor color from replace overlay |
;; restore cursor color from replace overlay |
202 |
(defun viper-restore-cursor-color(after-which-mode) |
(defun viper-restore-cursor-color(after-which-mode) |
203 |
(if (viper-overlay-p viper-replace-overlay) |
(if (viper-overlay-p viper-replace-overlay) |
206 |
(viper-get-saved-cursor-color-in-replace-mode) |
(viper-get-saved-cursor-color-in-replace-mode) |
207 |
(viper-get-saved-cursor-color-in-insert-mode)) |
(viper-get-saved-cursor-color-in-insert-mode)) |
208 |
))) |
))) |
209 |
|
|
210 |
|
|
211 |
;; Check the current version against the major and minor version numbers |
;; Check the current version against the major and minor version numbers |
212 |
;; using op: cur-vers op major.minor If emacs-major-version or |
;; using op: cur-vers op major.minor If emacs-major-version or |
234 |
(error "%S: Invalid op in viper-check-version" op)))) |
(error "%S: Invalid op in viper-check-version" op)))) |
235 |
(cond ((memq op '(= > >=)) nil) |
(cond ((memq op '(= > >=)) nil) |
236 |
((memq op '(< <=)) t)))) |
((memq op '(< <=)) t)))) |
237 |
|
|
238 |
|
|
239 |
(defun viper-get-visible-buffer-window (wind) |
(defun viper-get-visible-buffer-window (wind) |
240 |
(if viper-xemacs-p |
(if viper-xemacs-p |
241 |
(get-buffer-window wind t) |
(get-buffer-window wind t) |
242 |
(get-buffer-window wind 'visible))) |
(get-buffer-window wind 'visible))) |
243 |
|
|
244 |
|
|
245 |
;; Return line position. |
;; Return line position. |
246 |
;; If pos is 'start then returns position of line start. |
;; If pos is 'start then returns position of line start. |
247 |
;; If pos is 'end, returns line end. If pos is 'mid, returns line center. |
;; If pos is 'end, returns line end. If pos is 'mid, returns line center. |
264 |
(goto-char cur-pos) |
(goto-char cur-pos) |
265 |
result)) |
result)) |
266 |
|
|
267 |
;; Emacs counts each multibyte character as several positions in the buffer, so |
;; Emacs used to count each multibyte character as several positions in the buffer, |
268 |
;; we use Emacs' chars-in-region. XEmacs is counting each char as just one pos, |
;; so we had to use Emacs' chars-in-region to count characters. Since 20.3, |
269 |
;; so we can simply subtract. |
;; Emacs counts multibyte characters as 1 position. XEmacs has always been |
270 |
|
;; counting each char as just one pos. So, now we can simply subtract beg from |
271 |
|
;; end to determine the number of characters in a region. |
272 |
(defun viper-chars-in-region (beg end &optional preserve-sign) |
(defun viper-chars-in-region (beg end &optional preserve-sign) |
273 |
(let ((count (abs (if (fboundp 'chars-in-region) |
;;(let ((count (abs (if (fboundp 'chars-in-region) |
274 |
(chars-in-region beg end) |
;; (chars-in-region beg end) |
275 |
(- end beg))))) |
;; (- end beg))))) |
276 |
|
(let ((count (abs (- end beg)))) |
277 |
(if (and (< end beg) preserve-sign) |
(if (and (< end beg) preserve-sign) |
278 |
(- count) |
(- count) |
279 |
count))) |
count))) |
286 |
;; Like move-marker but creates a virgin marker if arg isn't already a marker. |
;; Like move-marker but creates a virgin marker if arg isn't already a marker. |
287 |
;; The first argument must eval to a variable name. |
;; The first argument must eval to a variable name. |
288 |
;; Arguments: (var-name position &optional buffer). |
;; Arguments: (var-name position &optional buffer). |
289 |
;; |
;; |
290 |
;; This is useful for moving markers that are supposed to be local. |
;; This is useful for moving markers that are supposed to be local. |
291 |
;; For this, VAR-NAME should be made buffer-local with nil as a default. |
;; For this, VAR-NAME should be made buffer-local with nil as a default. |
292 |
;; Then, each time this var is used in `viper-move-marker-locally' in a new |
;; Then, each time this var is used in `viper-move-marker-locally' in a new |
309 |
|
|
310 |
|
|
311 |
;;; List/alist utilities |
;;; List/alist utilities |
312 |
|
|
313 |
;; Convert LIST to an alist |
;; Convert LIST to an alist |
314 |
(defun viper-list-to-alist (lst) |
(defun viper-list-to-alist (lst) |
315 |
(let ((alist)) |
(let ((alist)) |
316 |
(while lst |
(while lst |
317 |
(setq alist (cons (list (car lst)) alist)) |
(setq alist (cons (list (car lst)) alist)) |
318 |
(setq lst (cdr lst))) |
(setq lst (cdr lst))) |
319 |
alist)) |
alist)) |
320 |
|
|
321 |
;; Convert ALIST to a list. |
;; Convert ALIST to a list. |
322 |
(defun viper-alist-to-list (alst) |
(defun viper-alist-to-list (alst) |
334 |
(if (string-match regexp (car (car inalst))) |
(if (string-match regexp (car (car inalst))) |
335 |
(setq outalst (cons (car inalst) outalst))) |
(setq outalst (cons (car inalst) outalst))) |
336 |
(setq inalst (cdr inalst))) |
(setq inalst (cdr inalst))) |
337 |
outalst)) |
outalst)) |
338 |
|
|
339 |
;; Filter LIST using REGEXP. Return list whose elements match the regexp. |
;; Filter LIST using REGEXP. Return list whose elements match the regexp. |
340 |
(defun viper-filter-list (regexp lst) |
(defun viper-filter-list (regexp lst) |
341 |
(interactive "s x") |
(interactive "s x") |
344 |
(if (string-match regexp (car inlst)) |
(if (string-match regexp (car inlst)) |
345 |
(setq outlst (cons (car inlst) outlst))) |
(setq outlst (cons (car inlst) outlst))) |
346 |
(setq inlst (cdr inlst))) |
(setq inlst (cdr inlst))) |
347 |
outlst)) |
outlst)) |
348 |
|
|
349 |
|
|
|
|
|
350 |
;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 |
;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 |
351 |
;; LIS2 is modified by filtering it: deleting its members of the form |
;; LIS2 is modified by filtering it: deleting its members of the form |
352 |
;; \(car elt\) such that (car elt') is in LIS1. |
;; \(car elt\) such that (car elt') is in LIS1. |
359 |
(while (setq elt (assoc (car (car temp)) lis2)) |
(while (setq elt (assoc (car (car temp)) lis2)) |
360 |
(setq lis2 (delq elt lis2))) |
(setq lis2 (delq elt lis2))) |
361 |
(setq temp (cdr temp))) |
(setq temp (cdr temp))) |
362 |
|
|
363 |
(nconc lis1 lis2))) |
(nconc lis1 lis2))) |
364 |
|
|
365 |
|
|
380 |
(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec)) |
(command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec)) |
381 |
(t (format "ls -1 -d %s" filespec)))) |
(t (format "ls -1 -d %s" filespec)))) |
382 |
status) |
status) |
383 |
(save-excursion |
(save-excursion |
384 |
(set-buffer (get-buffer-create viper-ex-tmp-buf-name)) |
(set-buffer (get-buffer-create viper-ex-tmp-buf-name)) |
385 |
(erase-buffer) |
(erase-buffer) |
386 |
(setq status |
(setq status |
425 |
((looking-at "'") |
((looking-at "'") |
426 |
(setq delim ?') |
(setq delim ?') |
427 |
(re-search-forward "[^']+" nil t)) ; noerror |
(re-search-forward "[^']+" nil t)) ; noerror |
428 |
(t |
(t |
429 |
(re-search-forward |
(re-search-forward |
430 |
(concat "[^" skip-chars "]+") nil t))) ;noerror |
(concat "[^" skip-chars "]+") nil t))) ;noerror |
431 |
(setq fname |
(setq fname |
459 |
(defun viper-glob-mswindows-files (filespec) |
(defun viper-glob-mswindows-files (filespec) |
460 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
461 |
tmp tmp2) |
tmp tmp2) |
462 |
(save-excursion |
(save-excursion |
463 |
(set-buffer (get-buffer-create viper-ex-tmp-buf-name)) |
(set-buffer (get-buffer-create viper-ex-tmp-buf-name)) |
464 |
(erase-buffer) |
(erase-buffer) |
465 |
(insert filespec) |
(insert filespec) |
466 |
(goto-char (point-min)) |
(goto-char (point-min)) |
467 |
(setq tmp (viper-get-filenames-from-buffer)) |
(setq tmp (viper-get-filenames-from-buffer)) |
468 |
(while tmp |
(while tmp |
469 |
(setq tmp2 (cons (directory-files |
(setq tmp2 (cons (directory-files |
470 |
;; the directory part |
;; the directory part |
471 |
(or (file-name-directory (car tmp)) |
(or (file-name-directory (car tmp)) |
472 |
"") |
"") |
495 |
(t (car ring)))) |
(t (car ring)))) |
496 |
(viper-current-ring-item ring) |
(viper-current-ring-item ring) |
497 |
))) |
))) |
498 |
|
|
499 |
(defun viper-special-ring-rotate1 (ring dir) |
(defun viper-special-ring-rotate1 (ring dir) |
500 |
(if (memq viper-intermediate-command |
(if (memq viper-intermediate-command |
501 |
'(repeating-display-destructive-command |
'(repeating-display-destructive-command |
503 |
(viper-ring-rotate1 ring dir) |
(viper-ring-rotate1 ring dir) |
504 |
;; don't rotate otherwise |
;; don't rotate otherwise |
505 |
(viper-ring-rotate1 ring 0))) |
(viper-ring-rotate1 ring 0))) |
506 |
|
|
507 |
;; current ring item; if N is given, then so many items back from the |
;; current ring item; if N is given, then so many items back from the |
508 |
;; current |
;; current |
509 |
(defun viper-current-ring-item (ring &optional n) |
(defun viper-current-ring-item (ring &optional n) |
510 |
(setq n (or n 0)) |
(setq n (or n 0)) |
511 |
(if (and (ring-p ring) (> (ring-length ring) 0)) |
(if (and (ring-p ring) (> (ring-length ring) 0)) |
512 |
(aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) |
(aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) |
513 |
|
|
514 |
;; Push item onto ring. The second argument is a ring-variable, not value. |
;; Push item onto ring. The second argument is a ring-variable, not value. |
515 |
(defun viper-push-onto-ring (item ring-var) |
(defun viper-push-onto-ring (item ring-var) |
516 |
(or (ring-p (eval ring-var)) |
(or (ring-p (eval ring-var)) |
532 |
(viper-array-to-string (this-command-keys)))) |
(viper-array-to-string (this-command-keys)))) |
533 |
(viper-ring-insert (eval ring-var) item)) |
(viper-ring-insert (eval ring-var) item)) |
534 |
) |
) |
535 |
|
|
536 |
|
|
537 |
;; removing elts from ring seems to break it |
;; removing elts from ring seems to break it |
538 |
(defun viper-cleanup-ring (ring) |
(defun viper-cleanup-ring (ring) |
542 |
(if (equal (viper-current-ring-item ring) |
(if (equal (viper-current-ring-item ring) |
543 |
(viper-current-ring-item ring 1)) |
(viper-current-ring-item ring 1)) |
544 |
(viper-ring-pop ring)))) |
(viper-ring-pop ring)))) |
545 |
|
|
546 |
;; ring-remove seems to be buggy, so we concocted this for our purposes. |
;; ring-remove seems to be buggy, so we concocted this for our purposes. |
547 |
(defun viper-ring-pop (ring) |
(defun viper-ring-pop (ring) |
548 |
(let* ((ln (ring-length ring)) |
(let* ((ln (ring-length ring)) |
551 |
(hd (car ring)) |
(hd (car ring)) |
552 |
(idx (max 0 (ring-minus1 hd ln))) |
(idx (max 0 (ring-minus1 hd ln))) |
553 |
(top-elt (aref vec idx))) |
(top-elt (aref vec idx))) |
554 |
|
|
555 |
;; shift elements |
;; shift elements |
556 |
(while (< (1+ idx) veclen) |
(while (< (1+ idx) veclen) |
557 |
(aset vec idx (aref vec (1+ idx))) |
(aset vec idx (aref vec (1+ idx))) |
558 |
(setq idx (1+ idx))) |
(setq idx (1+ idx))) |
559 |
(aset vec idx nil) |
(aset vec idx nil) |
560 |
|
|
561 |
(setq hd (max 0 (ring-minus1 hd ln))) |
(setq hd (max 0 (ring-minus1 hd ln))) |
562 |
(if (= hd (1- ln)) (setq hd 0)) |
(if (= hd (1- ln)) (setq hd 0)) |
563 |
(setcar ring hd) ; move head |
(setcar ring hd) ; move head |
564 |
(setcar (cdr ring) (max 0 (1- ln))) ; adjust length |
(setcar (cdr ring) (max 0 (1- ln))) ; adjust length |
565 |
top-elt |
top-elt |
566 |
)) |
)) |
567 |
|
|
568 |
(defun viper-ring-insert (ring item) |
(defun viper-ring-insert (ring item) |
569 |
(let* ((ln (ring-length ring)) |
(let* ((ln (ring-length ring)) |
570 |
(vec (cdr (cdr ring))) |
(vec (cdr (cdr ring))) |
572 |
(hd (car ring)) |
(hd (car ring)) |
573 |
(vecpos-after-hd (if (= hd 0) ln hd)) |
(vecpos-after-hd (if (= hd 0) ln hd)) |
574 |
(idx ln)) |
(idx ln)) |
575 |
|
|
576 |
(if (= ln veclen) |
(if (= ln veclen) |
577 |
(progn |
(progn |
578 |
(aset vec hd item) ; hd is always 1+ the actual head index in vec |
(aset vec hd item) ; hd is always 1+ the actual head index in vec |
584 |
(setq idx (1- idx))) |
(setq idx (1- idx))) |
585 |
(aset vec vecpos-after-hd item)) |
(aset vec vecpos-after-hd item)) |
586 |
item)) |
item)) |
587 |
|
|
588 |
|
|
589 |
;;; String utilities |
;;; String utilities |
590 |
|
|
592 |
;; PRE-STRING is a string to prepend to the abbrev string. |
;; PRE-STRING is a string to prepend to the abbrev string. |
593 |
;; POST-STRING is a string to append to the abbrev string. |
;; POST-STRING is a string to append to the abbrev string. |
594 |
;; ABBREV_SIGN is a string to be inserted before POST-STRING |
;; ABBREV_SIGN is a string to be inserted before POST-STRING |
595 |
;; if the orig string was truncated. |
;; if the orig string was truncated. |
596 |
(defun viper-abbreviate-string (string max-len |
(defun viper-abbreviate-string (string max-len |
597 |
pre-string post-string abbrev-sign) |
pre-string post-string abbrev-sign) |
598 |
(let (truncated-str) |
(let (truncated-str) |
599 |
(setq truncated-str |
(setq truncated-str |
600 |
(if (stringp string) |
(if (stringp string) |
601 |
(substring string 0 (min max-len (length string))))) |
(substring string 0 (min max-len (length string))))) |
602 |
(cond ((null truncated-str) "") |
(cond ((null truncated-str) "") |
603 |
((> (length string) max-len) |
((> (length string) max-len) |
610 |
(save-excursion |
(save-excursion |
611 |
(beginning-of-line) |
(beginning-of-line) |
612 |
(looking-at "^[ \t]*$"))) |
(looking-at "^[ \t]*$"))) |
613 |
|
|
614 |
|
|
615 |
;;; Saving settings in custom file |
;;; Saving settings in custom file |
616 |
|
|
644 |
(sit-for 2) |
(sit-for 2) |
645 |
(message ""))) |
(message ""))) |
646 |
)) |
)) |
647 |
|
|
648 |
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that |
;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that |
649 |
;; match this pattern. |
;; match this pattern. |
650 |
(defun viper-save-string-in-file (string custom-file &optional pattern) |
(defun viper-save-string-in-file (string custom-file &optional pattern) |
670 |
;; Can happen only in Emacs, since XEmacs has file-remote-p |
;; Can happen only in Emacs, since XEmacs has file-remote-p |
671 |
(ange-ftp-ftp-name file-name)))))) |
(ange-ftp-ftp-name file-name)))))) |
672 |
|
|
673 |
|
|
674 |
|
|
675 |
;; This is a simple-minded check for whether a file is under version control. |
;; This is a simple-minded check for whether a file is under version control. |
676 |
;; If file,v exists but file doesn't, this file is considered to be not checked |
;; If file,v exists but file doesn't, this file is considered to be not checked |
721 |
(viper-abbreviate-file-name file)))) |
(viper-abbreviate-file-name file)))) |
722 |
(with-current-buffer buf |
(with-current-buffer buf |
723 |
(command-execute checkout-function))))) |
(command-execute checkout-function))))) |
|
|
|
724 |
|
|
725 |
|
|
726 |
|
|
727 |
|
|
728 |
;;; Overlays |
;;; Overlays |
729 |
(defun viper-put-on-search-overlay (beg end) |
(defun viper-put-on-search-overlay (beg end) |
756 |
|
|
757 |
(defsubst viper-move-replace-overlay (beg end) |
(defsubst viper-move-replace-overlay (beg end) |
758 |
(viper-move-overlay viper-replace-overlay beg end)) |
(viper-move-overlay viper-replace-overlay beg end)) |
759 |
|
|
760 |
(defun viper-set-replace-overlay (beg end) |
(defun viper-set-replace-overlay (beg end) |
761 |
(if (viper-overlay-live-p viper-replace-overlay) |
(if (viper-overlay-live-p viper-replace-overlay) |
762 |
(viper-move-replace-overlay beg end) |
(viper-move-replace-overlay beg end) |
764 |
;; never detach |
;; never detach |
765 |
(viper-overlay-put |
(viper-overlay-put |
766 |
viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil) |
viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil) |
767 |
(viper-overlay-put |
(viper-overlay-put |
768 |
viper-replace-overlay 'priority viper-replace-overlay-priority) |
viper-replace-overlay 'priority viper-replace-overlay-priority) |
769 |
;; If Emacs will start supporting overlay maps, as it currently supports |
;; If Emacs will start supporting overlay maps, as it currently supports |
770 |
;; text-property maps, we could do away with viper-replace-minor-mode and |
;; text-property maps, we could do away with viper-replace-minor-mode and |
773 |
;; viper-replace-overlay |
;; viper-replace-overlay |
774 |
;; (if viper-xemacs-p 'keymap 'local-map) |
;; (if viper-xemacs-p 'keymap 'local-map) |
775 |
;; viper-replace-map) |
;; viper-replace-map) |
776 |
) |
) |
777 |
(if (viper-has-face-support-p) |
(if (viper-has-face-support-p) |
778 |
(viper-overlay-put |
(viper-overlay-put |
779 |
viper-replace-overlay 'face viper-replace-overlay-face)) |
viper-replace-overlay 'face viper-replace-overlay-face)) |
780 |
(viper-save-cursor-color 'before-replace-mode) |
(viper-save-cursor-color 'before-replace-mode) |
781 |
(viper-change-cursor-color viper-replace-overlay-cursor-color) |
(viper-change-cursor-color viper-replace-overlay-cursor-color) |
782 |
) |
) |
783 |
|
|
784 |
|
|
785 |
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph) |
(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph) |
786 |
(or (viper-overlay-live-p viper-replace-overlay) |
(or (viper-overlay-live-p viper-replace-overlay) |
787 |
(viper-set-replace-overlay (point-min) (point-min))) |
(viper-set-replace-overlay (point-min) (point-min))) |
791 |
(after-name (if viper-xemacs-p 'end-glyph 'after-string))) |
(after-name (if viper-xemacs-p 'end-glyph 'after-string))) |
792 |
(viper-overlay-put viper-replace-overlay before-name before-glyph) |
(viper-overlay-put viper-replace-overlay before-name before-glyph) |
793 |
(viper-overlay-put viper-replace-overlay after-name after-glyph)))) |
(viper-overlay-put viper-replace-overlay after-name after-glyph)))) |
794 |
|
|
795 |
(defun viper-hide-replace-overlay () |
(defun viper-hide-replace-overlay () |
796 |
(viper-set-replace-overlay-glyphs nil nil) |
(viper-set-replace-overlay-glyphs nil nil) |
797 |
(viper-restore-cursor-color 'after-replace-mode) |
(viper-restore-cursor-color 'after-replace-mode) |
799 |
(if (viper-has-face-support-p) |
(if (viper-has-face-support-p) |
800 |
(viper-overlay-put viper-replace-overlay 'face nil))) |
(viper-overlay-put viper-replace-overlay 'face nil))) |
801 |
|
|
802 |
|
|
803 |
(defsubst viper-replace-start () |
(defsubst viper-replace-start () |
804 |
(viper-overlay-start viper-replace-overlay)) |
(viper-overlay-start viper-replace-overlay)) |
805 |
(defsubst viper-replace-end () |
(defsubst viper-replace-end () |
806 |
(viper-overlay-end viper-replace-overlay)) |
(viper-overlay-end viper-replace-overlay)) |
807 |
|
|
808 |
|
|
809 |
;; Minibuffer |
;; Minibuffer |
810 |
|
|
814 |
(progn |
(progn |
815 |
(viper-overlay-put |
(viper-overlay-put |
816 |
viper-minibuffer-overlay 'face viper-minibuffer-current-face) |
viper-minibuffer-overlay 'face viper-minibuffer-current-face) |
817 |
(viper-overlay-put |
(viper-overlay-put |
818 |
viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority) |
viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority) |
819 |
;; never detach |
;; never detach |
820 |
(viper-overlay-put |
(viper-overlay-put |
828 |
(viper-overlay-put viper-minibuffer-overlay 'start-open nil) |
(viper-overlay-put viper-minibuffer-overlay 'start-open nil) |
829 |
(viper-overlay-put viper-minibuffer-overlay 'end-open nil))) |
(viper-overlay-put viper-minibuffer-overlay 'end-open nil))) |
830 |
))) |
))) |
831 |
|
|
832 |
(defun viper-check-minibuffer-overlay () |
(defun viper-check-minibuffer-overlay () |
833 |
(if (viper-overlay-live-p viper-minibuffer-overlay) |
(if (viper-overlay-live-p viper-minibuffer-overlay) |
834 |
(viper-move-overlay |
(viper-move-overlay |
849 |
(defsubst viper-is-in-minibuffer () |
(defsubst viper-is-in-minibuffer () |
850 |
(save-match-data |
(save-match-data |
851 |
(string-match "\*Minibuf-" (buffer-name)))) |
(string-match "\*Minibuf-" (buffer-name)))) |
852 |
|
|
853 |
|
|
854 |
|
|
855 |
;;; XEmacs compatibility |
;;; XEmacs compatibility |
861 |
;; emacs |
;; emacs |
862 |
(abbreviate-file-name file) |
(abbreviate-file-name file) |
863 |
)) |
)) |
864 |
|
|
865 |
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg |
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg |
866 |
;; in sit-for, so this function smoothes out the differences. |
;; in sit-for, so this function smoothes out the differences. |
867 |
(defsubst viper-sit-for-short (val &optional nodisp) |
(defsubst viper-sit-for-short (val &optional nodisp) |
868 |
(if viper-xemacs-p |
(if viper-xemacs-p |
883 |
(save-excursion |
(save-excursion |
884 |
(set-buffer buf) |
(set-buffer buf) |
885 |
(and (<= pos (point-max)) (<= (point-min) pos)))))) |
(and (<= pos (point-max)) (<= (point-min) pos)))))) |
886 |
|
|
887 |
(defsubst viper-mark-marker () |
(defsubst viper-mark-marker () |
888 |
(viper-cond-compile-for-xemacs-or-emacs |
(viper-cond-compile-for-xemacs-or-emacs |
889 |
(mark-marker t) ; xemacs |
(mark-marker t) ; xemacs |
896 |
(setq mark-ring (delete (viper-mark-marker) mark-ring)) |
(setq mark-ring (delete (viper-mark-marker) mark-ring)) |
897 |
(set-mark-command nil) |
(set-mark-command nil) |
898 |
(setq viper-saved-mark (point))) |
(setq viper-saved-mark (point))) |
899 |
|
|
900 |
;; In transient mark mode (zmacs mode), it is annoying when regions become |
;; In transient mark mode (zmacs mode), it is annoying when regions become |
901 |
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless |
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless |
902 |
;; the user explicitly wants highlighting, e.g., by hitting '' or `` |
;; the user explicitly wants highlighting, e.g., by hitting '' or `` |
927 |
(and (<= ?A reg) (<= reg ?Z))) |
(and (<= ?A reg) (<= reg ?Z))) |
928 |
)) |
)) |
929 |
|
|
930 |
|
|
931 |
|
|
932 |
;; it is suggested that an event must be copied before it is assigned to |
;; it is suggested that an event must be copied before it is assigned to |
933 |
;; last-command-event in XEmacs |
;; last-command-event in XEmacs |
934 |
(defun viper-copy-event (event) |
(defun viper-copy-event (event) |
936 |
(copy-event event) ; xemacs |
(copy-event event) ; xemacs |
937 |
event ; emacs |
event ; emacs |
938 |
)) |
)) |
939 |
|
|
940 |
;; Uses different timeouts for ESC-sequences and others |
;; Uses different timeouts for ESC-sequences and others |
941 |
(defsubst viper-fast-keysequence-p () |
(defsubst viper-fast-keysequence-p () |
942 |
(not (viper-sit-for-short |
(not (viper-sit-for-short |
943 |
(if (viper-ESC-event-p last-input-event) |
(if (viper-ESC-event-p last-input-event) |
944 |
viper-ESC-keyseq-timeout |
viper-ESC-keyseq-timeout |
945 |
viper-fast-keyseq-timeout) |
viper-fast-keyseq-timeout) |
946 |
t))) |
t))) |
947 |
|
|
948 |
;; like read-event, but in XEmacs also try to convert to char, if possible |
;; like read-event, but in XEmacs also try to convert to char, if possible |
949 |
(defun viper-read-event-convert-to-char () |
(defun viper-read-event-convert-to-char () |
950 |
(let (event) |
(let (event) |
978 |
;; keysequence. Otherwise, viper-fast-keysequence-p will be |
;; keysequence. Otherwise, viper-fast-keysequence-p will be |
979 |
;; always t -- whether there is anything after ESC or not |
;; always t -- whether there is anything after ESC or not |
980 |
(viper-set-unread-command-events keyseq) |
(viper-set-unread-command-events keyseq) |
981 |
(setq keyseq (read-key-sequence nil))) |
(setq keyseq (read-key-sequence nil))) |
982 |
(viper-set-unread-command-events keyseq) |
(viper-set-unread-command-events keyseq) |
983 |
(setq keyseq (read-key-sequence nil))))) |
(setq keyseq (read-key-sequence nil))))) |
984 |
keyseq)) |
keyseq)) |
989 |
;; macros, since it enables certain macros to be shared between X and TTY modes |
;; macros, since it enables certain macros to be shared between X and TTY modes |
990 |
;; by correctly mapping key sequences for Left/Right/... (one an ascii |
;; by correctly mapping key sequences for Left/Right/... (one an ascii |
991 |
;; terminal) into logical keys left, right, etc. |
;; terminal) into logical keys left, right, etc. |
992 |
(defun viper-read-key () |
(defun viper-read-key () |
993 |
(let ((overriding-local-map viper-overriding-map) |
(let ((overriding-local-map viper-overriding-map) |
994 |
(inhibit-quit t) |
(inhibit-quit t) |
995 |
help-char key) |
help-char key) |
996 |
(use-global-map viper-overriding-map) |
(use-global-map viper-overriding-map) |
997 |
(unwind-protect |
(unwind-protect |
998 |
(setq key (elt (viper-read-key-sequence nil) 0)) |
(setq key (elt (viper-read-key-sequence nil) 0)) |
999 |
(use-global-map global-map)) |
(use-global-map global-map)) |
1000 |
key)) |
key)) |
1001 |
|
|
1019 |
(event-key event)) |
(event-key event)) |
1020 |
((button-event-p event) |
((button-event-p event) |
1021 |
(concat "mouse-" (prin1-to-string (event-button event)))) |
(concat "mouse-" (prin1-to-string (event-button event)))) |
1022 |
(t |
(t |
1023 |
(error "viper-event-key: Unknown event, %S" event))) |
(error "viper-event-key: Unknown event, %S" event))) |
1024 |
;; Emacs doesn't handle capital letters correctly, since |
;; Emacs doesn't handle capital letters correctly, since |
1025 |
;; \S-a isn't considered the same as A (it behaves as |
;; \S-a isn't considered the same as A (it behaves as |
1053 |
(if mod |
(if mod |
1054 |
(append mod (list basis)) |
(append mod (list basis)) |
1055 |
basis)))) |
basis)))) |
1056 |
|
|
1057 |
(defun viper-key-to-emacs-key (key) |
(defun viper-key-to-emacs-key (key) |
1058 |
(let (key-name char-p modifiers mod-char-list base-key base-key-name) |
(let (key-name char-p modifiers mod-char-list base-key base-key-name) |
1059 |
(cond (viper-xemacs-p key) |
(cond (viper-xemacs-p key) |
1109 |
"viper-eventify-list-xemacs: can't convert to event, %S" |
"viper-eventify-list-xemacs: can't convert to event, %S" |
1110 |
elt)))) |
elt)))) |
1111 |
lis)) |
lis)) |
1112 |
|
|
1113 |
|
|
1114 |
;; Smoothes out the difference between Emacs' unread-command-events |
;; Smoothes out the difference between Emacs' unread-command-events |
1115 |
;; and XEmacs unread-command-event. Arg is a character, an event, a list of |
;; and XEmacs unread-command-event. Arg is a character, an event, a list of |
1154 |
(and (vectorp vec) |
(and (vectorp vec) |
1155 |
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) |
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) |
1156 |
|
|
1157 |
|
|
1158 |
;; check if vec is a vector of character symbols |
;; check if vec is a vector of character symbols |
1159 |
(defun viper-char-symbol-sequence-p (vec) |
(defun viper-char-symbol-sequence-p (vec) |
1160 |
(and |
(and |
1164 |
(mapcar (lambda (elt) |
(mapcar (lambda (elt) |
1165 |
(and (symbolp elt) (= (length (symbol-name elt)) 1))) |
(and (symbolp elt) (= (length (symbol-name elt)) 1))) |
1166 |
vec))))) |
vec))))) |
1167 |
|
|
1168 |
|
|
1169 |
(defun viper-char-array-p (array) |
(defun viper-char-array-p (array) |
1170 |
(eval (cons 'and (mapcar 'viper-characterp array)))) |
(eval (cons 'and (mapcar 'viper-characterp array)))) |
1171 |
|
|
1188 |
(t (prin1-to-string (vconcat temp))))) |
(t (prin1-to-string (vconcat temp))))) |
1189 |
((viper-char-symbol-sequence-p event-seq) |
((viper-char-symbol-sequence-p event-seq) |
1190 |
(mapconcat 'symbol-name event-seq "")) |
(mapconcat 'symbol-name event-seq "")) |
1191 |
((and (vectorp event-seq) |
((and (vectorp event-seq) |
1192 |
(viper-char-array-p |
(viper-char-array-p |
1193 |
(setq temp (mapcar 'viper-key-to-character event-seq)))) |
(setq temp (mapcar 'viper-key-to-character event-seq)))) |
1194 |
(mapconcat 'char-to-string temp "")) |
(mapconcat 'char-to-string temp "")) |
1201 |
) |
) |
1202 |
events |
events |
1203 |
"")) |
"")) |
1204 |
|
|
1205 |
|
|
1206 |
(defun viper-read-char-exclusive () |
(defun viper-read-char-exclusive () |
1207 |
(let (char |
(let (char |
1208 |
(echo-keystrokes 1)) |
(echo-keystrokes 1)) |
1230 |
(= 1 (length (symbol-name (nth 1 key))))) |
(= 1 (length (symbol-name (nth 1 key))))) |
1231 |
(read (format "?\\C-%s" (symbol-name (nth 1 key))))) |
(read (format "?\\C-%s" (symbol-name (nth 1 key))))) |
1232 |
(t key))) |
(t key))) |
1233 |
|
|
1234 |
|
|
1235 |
(defun viper-setup-master-buffer (&rest other-files-or-buffers) |
(defun viper-setup-master-buffer (&rest other-files-or-buffers) |
1236 |
"Set up the current buffer as a master buffer. |
"Set up the current buffer as a master buffer. |
1237 |
Arguments become related buffers. This function should normally be used in |
Arguments become related buffers. This function should normally be used in |
1238 |
the `Local variables' section of a file." |
the `Local variables' section of a file." |
1239 |
(setq viper-related-files-and-buffers-ring |
(setq viper-related-files-and-buffers-ring |
1240 |
(make-ring (1+ (length other-files-or-buffers)))) |
(make-ring (1+ (length other-files-or-buffers)))) |
1241 |
(mapcar '(lambda (elt) |
(mapcar '(lambda (elt) |
1242 |
(viper-ring-insert viper-related-files-and-buffers-ring elt)) |
(viper-ring-insert viper-related-files-and-buffers-ring elt)) |
1277 |
|
|
1278 |
|
|
1279 |
;; Set Viper syntax classes and related variables according to |
;; Set Viper syntax classes and related variables according to |
1280 |
;; `viper-syntax-preference'. |
;; `viper-syntax-preference'. |
1281 |
(defun viper-update-syntax-classes (&optional set-default) |
(defun viper-update-syntax-classes (&optional set-default) |
1282 |
(let ((preference (cond ((eq viper-syntax-preference 'emacs) |
(let ((preference (cond ((eq viper-syntax-preference 'emacs) |
1283 |
"w") ; Viper words have only Emacs word chars |
"w") ; Viper words have only Emacs word chars |
1338 |
`emacs' means Viper words are the same as Emacs words as specified by Emacs |
`emacs' means Viper words are the same as Emacs words as specified by Emacs |
1339 |
syntax tables. |
syntax tables. |
1340 |
This option is appropriate if you like Emacs-style words." |
This option is appropriate if you like Emacs-style words." |
1341 |
:type '(radio (const strict-vi) (const reformed-vi) |
:type '(radio (const strict-vi) (const reformed-vi) |
1342 |
(const extended) (const emacs)) |
(const extended) (const emacs)) |
1343 |
:set 'viper-set-syntax-preference |
:set 'viper-set-syntax-preference |
1344 |
:group 'viper) |
:group 'viper) |
1382 |
(defun viper-skip-alpha-forward (&optional addl-chars) |
(defun viper-skip-alpha-forward (&optional addl-chars) |
1383 |
(or (stringp addl-chars) (setq addl-chars "")) |
(or (stringp addl-chars) (setq addl-chars "")) |
1384 |
(viper-skip-syntax |
(viper-skip-syntax |
1385 |
'forward |
'forward |
1386 |
(cond ((eq viper-syntax-preference 'strict-vi) |
(cond ((eq viper-syntax-preference 'strict-vi) |
1387 |
"") |
"") |
1388 |
(t viper-ALPHA-char-class)) |
(t viper-ALPHA-char-class)) |
1393 |
(defun viper-skip-alpha-backward (&optional addl-chars) |
(defun viper-skip-alpha-backward (&optional addl-chars) |
1394 |
(or (stringp addl-chars) (setq addl-chars "")) |
(or (stringp addl-chars) (setq addl-chars "")) |
1395 |
(viper-skip-syntax |
(viper-skip-syntax |
1396 |
'backward |
'backward |
1397 |
(cond ((eq viper-syntax-preference 'strict-vi) |
(cond ((eq viper-syntax-preference 'strict-vi) |
1398 |
"") |
"") |
1399 |
(t viper-ALPHA-char-class)) |
(t viper-ALPHA-char-class)) |
1404 |
;; weird syntax tables may confuse strict-vi style |
;; weird syntax tables may confuse strict-vi style |
1405 |
(defsubst viper-skip-all-separators-forward (&optional within-line) |
(defsubst viper-skip-all-separators-forward (&optional within-line) |
1406 |
(if (eq viper-syntax-preference 'strict-vi) |
(if (eq viper-syntax-preference 'strict-vi) |
1407 |
(if within-line |
(if within-line |
1408 |
(skip-chars-forward viper-strict-SEP-chars-sans-newline) |
(skip-chars-forward viper-strict-SEP-chars-sans-newline) |
1409 |
(skip-chars-forward viper-strict-SEP-chars)) |
(skip-chars-forward viper-strict-SEP-chars)) |
1410 |
(viper-skip-syntax 'forward |
(viper-skip-syntax 'forward |
1413 |
(if within-line (viper-line-pos 'end))))) |
(if within-line (viper-line-pos 'end))))) |
1414 |
(defsubst viper-skip-all-separators-backward (&optional within-line) |
(defsubst viper-skip-all-separators-backward (&optional within-line) |
1415 |
(if (eq viper-syntax-preference 'strict-vi) |
(if (eq viper-syntax-preference 'strict-vi) |
1416 |
(if within-line |
(if within-line |
1417 |
(skip-chars-backward viper-strict-SEP-chars-sans-newline) |
(skip-chars-backward viper-strict-SEP-chars-sans-newline) |
1418 |
(skip-chars-backward viper-strict-SEP-chars)) |
(skip-chars-backward viper-strict-SEP-chars)) |
1419 |
(viper-skip-syntax 'backward |
(viper-skip-syntax 'backward |
1437 |
'forward |
'forward |
1438 |
(concat "^" viper-ALPHA-char-class viper-SEP-char-class) |
(concat "^" viper-ALPHA-char-class viper-SEP-char-class) |
1439 |
;; Emacs may consider some of these as words, but we don't want them |
;; Emacs may consider some of these as words, but we don't want them |
1440 |
viper-non-word-characters |
viper-non-word-characters |
1441 |
(viper-line-pos 'end)))) |
(viper-line-pos 'end)))) |
1442 |
(defun viper-skip-nonalphasep-backward () |
(defun viper-skip-nonalphasep-backward () |
1443 |
(if (eq viper-syntax-preference 'strict-vi) |
(if (eq viper-syntax-preference 'strict-vi) |
1475 |
(t nil))) |
(t nil))) |
1476 |
(if (memq ?^ syntax) (setq negated-syntax t)) |
(if (memq ?^ syntax) (setq negated-syntax t)) |
1477 |
|
|
1478 |
(while (and (not (= local 0)) |
(while (and (not (= local 0)) |
1479 |
(cond ((eq direction 'forward) |
(cond ((eq direction 'forward) |
1480 |
(not (eobp))) |
(not (eobp))) |
1481 |
(t (not (bobp))))) |
(t (not (bobp))))) |
1482 |
(setq char-looked-at (viper-char-at-pos direction) |
(setq char-looked-at (viper-char-at-pos direction) |
1507 |
(setq total (+ total local))) |
(setq total (+ total local))) |
1508 |
total |
total |
1509 |
)) |
)) |
|
|
|
1510 |
|
|
1511 |
|
|
1512 |
|
|
1513 |
(provide 'viper-util) |
(provide 'viper-util) |
1514 |
|
|
1515 |
|
|
1516 |
;;; Local Variables: |
;;; Local Variables: |
1517 |
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) |
;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) |