annotate lisp/emulation/viper-util.el @ 81058:b6ab0a86a34c

Add arch tagline
author Miles Bader <miles@gnu.org>
date Thu, 24 May 2007 02:09:52 +0000
parents 7a3f13e2dd57
children ac0efac52065 c3779fe5830e b8d9a391daf3 95d0cdf160ea
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
1 ;;; viper-util.el --- Utilities used by viper.el
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
2
64701
34bd8e434dd7 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64215
diff changeset
3 ;; Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003,
75346
7a3f13e2dd57 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 72516
diff changeset
4 ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
11288
d1f620273acb Add copyright.
Karl Heuer <kwzh@gnu.org>
parents: 10789
diff changeset
5
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
6 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
39215
8dccf2552307 2001-09-09 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38723
diff changeset
7
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
9
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
13 ;; any later version.
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
14
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
19
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64085
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62440
diff changeset
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62440
diff changeset
23 ;; Boston, MA 02110-1301, USA.
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
24
38414
67b464da13ec Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 36857
diff changeset
25 ;;; Commentary:
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
26
38414
67b464da13ec Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 36857
diff changeset
27 ;;; Code:
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
28
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
29 ;; Compiler pacifier
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
30 (defvar viper-overriding-map)
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
31 (defvar pm-color-alist)
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
32 (defvar zmacs-region-stays)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
33 (defvar viper-minibuffer-current-face)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
34 (defvar viper-minibuffer-insert-face)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
35 (defvar viper-minibuffer-vi-face)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
36 (defvar viper-minibuffer-emacs-face)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
37 (defvar viper-replace-overlay-face)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
38 (defvar viper-fast-keyseq-timeout)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
39 (defvar ex-unix-type-shell)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
40 (defvar ex-unix-type-shell-options)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
41 (defvar viper-ex-tmp-buf-name)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
42 (defvar viper-syntax-preference)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
43 (defvar viper-saved-mark)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
44
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
45 (require 'ring)
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
46
18172
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
47 (if noninteractive
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
48 (eval-when-compile
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
49 (let ((load-path (cons (expand-file-name ".") load-path)))
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
50 (or (featurep 'viper-init)
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
51 (load "viper-init.el" nil nil 'nosuffix))
e145ccc61a22 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18047
diff changeset
52 )))
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
53 ;; end pacifier
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
54
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
55 (require 'viper-init)
15747
a0933adcee9e (vip-ms-style-os-p, vip-vms-os-p): Moved here from viper.el.
Karl Heuer <kwzh@gnu.org>
parents: 15728
diff changeset
56
14581
4951b11970a1 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14384
diff changeset
57
19203
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
58 ;; A fix for NeXT Step
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
59 ;; Should go away, when NS people fix the design flaw, which leaves the
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
60 ;; two x-* functions undefined.
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
61 (if (and (not (fboundp 'x-display-color-p)) (fboundp 'ns-display-color-p))
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
62 (fset 'x-display-color-p (symbol-function 'ns-display-color-p)))
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
63 (if (and (not (fboundp 'x-color-defined-p)) (fboundp 'ns-color-defined-p))
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
64 (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)))
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
65
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
66
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
67 ;;; XEmacs support
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
68
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
69
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
70 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
71 (progn ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
72 (fset 'viper-overlay-p (symbol-function 'extentp))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
73 (fset 'viper-make-overlay (symbol-function 'make-extent))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
74 (fset 'viper-overlay-live-p (symbol-function 'extent-live-p))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
75 (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
76 (fset 'viper-overlay-start (symbol-function 'extent-start-position))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
77 (fset 'viper-overlay-end (symbol-function 'extent-end-position))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
78 (fset 'viper-overlay-get (symbol-function 'extent-property))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
79 (fset 'viper-overlay-put (symbol-function 'set-extent-property))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
80 (fset 'viper-read-event (symbol-function 'next-command-event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
81 (fset 'viper-characterp (symbol-function 'characterp))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
82 (fset 'viper-int-to-char (symbol-function 'int-to-char))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
83 (if (viper-window-display-p)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
84 (fset 'viper-iconify (symbol-function 'iconify-frame)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
85 (cond ((viper-has-face-support-p)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
86 (fset 'viper-get-face (symbol-function 'get-face))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
87 (fset 'viper-color-defined-p (symbol-function 'valid-color-name-p))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
88 )))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
89 (progn ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
90 (fset 'viper-overlay-p (symbol-function 'overlayp))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
91 (fset 'viper-make-overlay (symbol-function 'make-overlay))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
92 (fset 'viper-overlay-live-p (symbol-function 'overlayp))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
93 (fset 'viper-move-overlay (symbol-function 'move-overlay))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
94 (fset 'viper-overlay-start (symbol-function 'overlay-start))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
95 (fset 'viper-overlay-end (symbol-function 'overlay-end))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
96 (fset 'viper-overlay-get (symbol-function 'overlay-get))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
97 (fset 'viper-overlay-put (symbol-function 'overlay-put))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
98 (fset 'viper-read-event (symbol-function 'read-event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
99 (fset 'viper-characterp (symbol-function 'integerp))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
100 (fset 'viper-int-to-char (symbol-function 'identity))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
101 (if (viper-window-display-p)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
102 (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
103 (cond ((viper-has-face-support-p)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
104 (fset 'viper-get-face (symbol-function 'internal-get-face))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
105 (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
106 )))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
107 )
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
108
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
109
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
110
33842
f6a67d77484a * ediff-diff.el: Moved variables around to have it compile under NT.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33742
diff changeset
111 ;; CHAR is supposed to be a char or an integer (positive or negative)
f6a67d77484a * ediff-diff.el: Moved variables around to have it compile under NT.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33742
diff changeset
112 ;; LIST is a list of chars, nil, and negative numbers
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
113 ;; Check if CHAR is a member by trying to convert in characters, if necessary.
33842
f6a67d77484a * ediff-diff.el: Moved variables around to have it compile under NT.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33742
diff changeset
114 ;; Introduced for compatibility with XEmacs, where integers are not the same as
f6a67d77484a * ediff-diff.el: Moved variables around to have it compile under NT.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33742
diff changeset
115 ;; chars.
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
116 (defun viper-memq-char (char list)
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
117 (cond ((and (integerp char) (>= char 0))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
118 (memq (viper-int-to-char char) list))
33842
f6a67d77484a * ediff-diff.el: Moved variables around to have it compile under NT.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33742
diff changeset
119 ((memq char list))))
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
120
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
121 ;; Check if char-or-int and char are the same as characters
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
122 (defun viper-char-equal (char-or-int char)
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
123 (cond ((and (integerp char-or-int) (>= char-or-int 0))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
124 (= (viper-int-to-char char-or-int) char))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
125 ((eq char-or-int char))))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
126
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
127 ;; Like =, but accommodates null and also is t for eq-objects
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
128 (defun viper= (char char1)
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
129 (cond ((eq char char1) t)
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
130 ((and (viper-characterp char) (viper-characterp char1))
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
131 (= char char1))
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
132 (t nil)))
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
133
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
134 (defsubst viper-color-display-p ()
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
135 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
136 (eq (device-class (selected-device)) 'color) ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
137 (x-display-color-p) ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
138 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
139
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
140 (defun viper-get-cursor-color (&optional frame)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
141 (viper-cond-compile-for-xemacs-or-emacs
71382
4033086b16b6 2006-06-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68997
diff changeset
142 (color-instance-name
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
143 (frame-property (or frame (selected-frame)) 'cursor-color)) ; xemacs
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
144 (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
145 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
146
16136
de1340e6ddb4 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15747
diff changeset
147
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
148 ;; OS/2
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
149 (cond ((eq (viper-device-type) 'pm)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
150 (fset 'viper-color-defined-p
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
151 (lambda (color) (assoc color pm-color-alist)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
152
14233
396316e5fbe6 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14169
diff changeset
153
396316e5fbe6 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14169
diff changeset
154 ;; cursor colors
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
155 (defun viper-change-cursor-color (new-color &optional frame)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
156 (if (and (viper-window-display-p) (viper-color-display-p)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
157 (stringp new-color) (viper-color-defined-p new-color)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
158 (not (string= new-color (viper-get-cursor-color))))
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
159 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
160 (set-frame-property
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
161 (or frame (selected-frame))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
162 'cursor-color (make-color-instance new-color))
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
163 (modify-frame-parameters
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
164 (or frame (selected-frame))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
165 (list (cons 'cursor-color new-color)))
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
166 )
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
167 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
168
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
169 (defun viper-set-cursor-color-according-to-state (&optional frame)
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
170 (cond ((eq viper-current-state 'replace-state)
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
171 (viper-change-cursor-color viper-replace-state-cursor-color frame))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
172 ((and (eq viper-current-state 'emacs-state)
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
173 viper-emacs-state-cursor-color)
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
174 (viper-change-cursor-color viper-emacs-state-cursor-color frame))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
175 ((eq viper-current-state 'insert-state)
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
176 (viper-change-cursor-color viper-insert-state-cursor-color frame))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
177 (t
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
178 (viper-change-cursor-color viper-vi-state-cursor-color frame))))
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
179
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
180 ;; By default, saves current frame cursor color in the
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
181 ;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
182 (defun viper-save-cursor-color (before-which-mode)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
183 (if (and (viper-window-display-p) (viper-color-display-p))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
184 (let ((color (viper-get-cursor-color)))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
185 (if (and (stringp color) (viper-color-defined-p color)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
186 (not (string= color viper-replace-overlay-cursor-color)))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
187 (modify-frame-parameters
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
188 (selected-frame)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
189 (list
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
190 (cons
68997
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
191 (cond ((eq before-which-mode 'before-replace-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
192 'viper-saved-cursor-color-in-replace-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
193 ((eq before-which-mode 'before-emacs-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
194 'viper-saved-cursor-color-in-emacs-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
195 (t
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
196 'viper-saved-cursor-color-in-insert-mode))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
197 color)))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
198 ))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
199
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
200
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
201 (defsubst viper-get-saved-cursor-color-in-replace-mode ()
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
202 (or
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
203 (funcall
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
204 (if viper-emacs-p 'frame-parameter 'frame-property)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
205 (selected-frame)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
206 'viper-saved-cursor-color-in-replace-mode)
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
207 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
68997
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
208 viper-emacs-state-cursor-color
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
209 viper-vi-state-cursor-color)))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
210
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
211 (defsubst viper-get-saved-cursor-color-in-insert-mode ()
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
212 (or
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
213 (funcall
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
214 (if viper-emacs-p 'frame-parameter 'frame-property)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
215 (selected-frame)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
216 'viper-saved-cursor-color-in-insert-mode)
72516
aba79a1f03ed 2006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 71382
diff changeset
217 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
68997
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
218 viper-emacs-state-cursor-color
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
219 viper-vi-state-cursor-color)))
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
220
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
221 (defsubst viper-get-saved-cursor-color-in-emacs-mode ()
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
222 (or
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
223 (funcall
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
224 (if viper-emacs-p 'frame-parameter 'frame-property)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
225 (selected-frame)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
226 'viper-saved-cursor-color-in-emacs-mode)
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
227 viper-vi-state-cursor-color))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
228
16766
beb94a5271e2 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16329
diff changeset
229 ;; restore cursor color from replace overlay
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
230 (defun viper-restore-cursor-color(after-which-mode)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
231 (if (viper-overlay-p viper-replace-overlay)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
232 (viper-change-cursor-color
68997
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
233 (cond ((eq after-which-mode 'after-replace-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
234 (viper-get-saved-cursor-color-in-replace-mode))
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
235 ((eq after-which-mode 'after-emacs-mode)
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
236 (viper-get-saved-cursor-color-in-emacs-mode))
6169b51037af 2006-02-19 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 68648
diff changeset
237 (t (viper-get-saved-cursor-color-in-insert-mode)))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
238 )))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
239
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
240
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
241 ;; Check the current version against the major and minor version numbers
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
242 ;; using op: cur-vers op major.minor If emacs-major-version or
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
243 ;; emacs-minor-version are not defined, we assume that the current version
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
244 ;; is hopelessly outdated. We assume that emacs-major-version and
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
245 ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
246 ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
247 ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
248 ;; incorrect. However, this gives correct result in our cases, since we are
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
249 ;; testing for sufficiently high Emacs versions.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
250 (defun viper-check-version (op major minor &optional type-of-emacs)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
251 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
252 (and (cond ((eq type-of-emacs 'xemacs) viper-xemacs-p)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
253 ((eq type-of-emacs 'emacs) viper-emacs-p)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
254 (t t))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
255 (cond ((eq op '=) (and (= emacs-minor-version minor)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
256 (= emacs-major-version major)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
257 ((memq op '(> >= < <=))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
258 (and (or (funcall op emacs-major-version major)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
259 (= emacs-major-version major))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
260 (if (= emacs-major-version major)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
261 (funcall op emacs-minor-version minor)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
262 t)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
263 (t
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
264 (error "%S: Invalid op in viper-check-version" op))))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
265 (cond ((memq op '(= > >=)) nil)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
266 ((memq op '(< <=)) t))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
267
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
268
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
269 (defun viper-get-visible-buffer-window (wind)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
270 (if viper-xemacs-p
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
271 (get-buffer-window wind t)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
272 (get-buffer-window wind 'visible)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
273
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
274
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
275 ;; Return line position.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
276 ;; If pos is 'start then returns position of line start.
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
277 ;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
278 ;; Pos = 'indent returns beginning of indentation.
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
279 ;; Otherwise, returns point. Current point is not moved in any case."
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
280 (defun viper-line-pos (pos)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
281 (let ((cur-pos (point))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
282 (result))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
283 (cond
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
284 ((equal pos 'start)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
285 (beginning-of-line))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
286 ((equal pos 'end)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
287 (end-of-line))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
288 ((equal pos 'mid)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
289 (goto-char (+ (viper-line-pos 'start) (viper-line-pos 'end) 2)))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
290 ((equal pos 'indent)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
291 (back-to-indentation))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
292 (t nil))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
293 (setq result (point))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
294 (goto-char cur-pos)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
295 result))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
296
47520
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
297 ;; Emacs used to count each multibyte character as several positions in the buffer,
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
298 ;; so we had to use Emacs' chars-in-region to count characters. Since 20.3,
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
299 ;; Emacs counts multibyte characters as 1 position. XEmacs has always been
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
300 ;; counting each char as just one pos. So, now we can simply subtract beg from
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
301 ;; end to determine the number of characters in a region.
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
302 (defun viper-chars-in-region (beg end &optional preserve-sign)
47520
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
303 ;;(let ((count (abs (if (fboundp 'chars-in-region)
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
304 ;; (chars-in-region beg end)
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
305 ;; (- end beg)))))
a37b476e1aec 2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 43220
diff changeset
306 (let ((count (abs (- end beg))))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
307 (if (and (< end beg) preserve-sign)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
308 (- count)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
309 count)))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
310
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
311 ;; Test if POS is between BEG and END
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
312 (defsubst viper-pos-within-region (pos beg end)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
313 (and (>= pos (min beg end)) (>= (max beg end) pos)))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
314
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
315
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
316 ;; Like move-marker but creates a virgin marker if arg isn't already a marker.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
317 ;; The first argument must eval to a variable name.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
318 ;; Arguments: (var-name position &optional buffer).
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
319 ;;
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
320 ;; This is useful for moving markers that are supposed to be local.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
321 ;; For this, VAR-NAME should be made buffer-local with nil as a default.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
322 ;; Then, each time this var is used in `viper-move-marker-locally' in a new
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
323 ;; buffer, a new marker will be created.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
324 (defun viper-move-marker-locally (var pos &optional buffer)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
325 (if (markerp (eval var))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
326 ()
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
327 (set var (make-marker)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
328 (move-marker (eval var) pos buffer))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
329
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
330
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
331 ;; Print CONDITIONS as a message.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
332 (defun viper-message-conditions (conditions)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
333 (let ((case (car conditions)) (msg (cdr conditions)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
334 (if (null msg)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
335 (message "%s" case)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
336 (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
337 (beep 1)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
338
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
339
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
340
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
341 ;;; List/alist utilities
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
342
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
343 ;; Convert LIST to an alist
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
344 (defun viper-list-to-alist (lst)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
345 (let ((alist))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
346 (while lst
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
347 (setq alist (cons (list (car lst)) alist))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
348 (setq lst (cdr lst)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
349 alist))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
350
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
351 ;; Convert ALIST to a list.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
352 (defun viper-alist-to-list (alst)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
353 (let ((lst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
354 (while alst
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
355 (setq lst (cons (car (car alst)) lst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
356 (setq alst (cdr alst)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
357 lst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
358
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
359 ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
360 (defun viper-filter-alist (regexp alst)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
361 (interactive "s x")
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
362 (let ((outalst) (inalst alst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
363 (while (car inalst)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
364 (if (string-match regexp (car (car inalst)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
365 (setq outalst (cons (car inalst) outalst)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
366 (setq inalst (cdr inalst)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
367 outalst))
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
368
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
369 ;; Filter LIST using REGEXP. Return list whose elements match the regexp.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
370 (defun viper-filter-list (regexp lst)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
371 (interactive "s x")
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
372 (let ((outlst) (inlst lst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
373 (while (car inlst)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
374 (if (string-match regexp (car inlst))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
375 (setq outlst (cons (car inlst) outlst)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
376 (setq inlst (cdr inlst)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
377 outlst))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
378
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
379
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
380 ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
381 ;; LIS2 is modified by filtering it: deleting its members of the form
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
382 ;; \(car elt\) such that (car elt') is in LIS1.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
383 (defun viper-append-filter-alist (lis1 lis2)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
384 (let ((temp lis1)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
385 elt)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
386 ;;filter-append the second list
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
387 (while temp
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
388 ;; delete all occurrences
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
389 (while (setq elt (assoc (car (car temp)) lis2))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
390 (setq lis2 (delq elt lis2)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
391 (setq temp (cdr temp)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
392
64750
fbdb9482b6fc 2005-08-06 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64701
diff changeset
393 (append lis1 lis2)))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
394
36857
f6386773ce30 2001-03-17 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 33842
diff changeset
395
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
396
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
397 ;;; Support for :e, :r, :w file globbing
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
398
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
399 ;; Glob the file spec.
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
400 ;; This function is designed to work under Unix. It might also work under VMS.
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
401 (defun viper-glob-unix-files (filespec)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
402 (let ((gshell
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
403 (cond (ex-unix-type-shell shell-file-name)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
404 ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
405 (t "sh"))) ; probably Unix anyway
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
406 (gshell-options
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
407 ;; using cond in anticipation of further additions
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
408 (cond (ex-unix-type-shell-options)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
409 ))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
410 (command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
16136
de1340e6ddb4 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15747
diff changeset
411 (t (format "ls -1 -d %s" filespec))))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
412 status)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
413 (save-excursion
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
414 (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
415 (erase-buffer)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
416 (setq status
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
417 (if gshell-options
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
418 (call-process gshell nil t nil
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
419 gshell-options
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
420 "-c"
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
421 command)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
422 (call-process gshell nil t nil
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
423 "-c"
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
424 command)))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
425 (goto-char (point-min))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
426 ;; Issue an error, if no match.
53477
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
427 (unless (eq 0 status)
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
428 (save-excursion
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
429 (skip-chars-forward " \t\n\j")
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
430 (if (looking-at "ls:")
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
431 (viper-forward-Word 1))
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
432 (error "%s: %s"
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
433 (if (stringp gshell)
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
434 gshell
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
435 "shell")
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
436 (buffer-substring (point) (viper-line-pos 'end)))
79093b308520 * progmodes/idlwave.el (idlwave-make-tags):
Eli Zaretskii <eliz@is.elta.co.il>
parents: 52401
diff changeset
437 ))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
438 (goto-char (point-min))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
439 (viper-get-filenames-from-buffer 'one-per-line))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
440 ))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
441
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
442
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
443 ;; Interpret the stuff in the buffer as a list of file names
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
444 ;; return a list of file names listed in the buffer beginning at point
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
445 ;; If optional arg is supplied, assume each filename is listed on a separate
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
446 ;; line
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
447 (defun viper-get-filenames-from-buffer (&optional one-per-line)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
448 (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
449 result fname delim)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
450 (skip-chars-forward skip-chars)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
451 (while (not (eobp))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
452 (if (cond ((looking-at "\"")
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
453 (setq delim ?\")
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
454 (re-search-forward "[^\"]+" nil t)) ; noerror
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
455 ((looking-at "'")
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
456 (setq delim ?')
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
457 (re-search-forward "[^']+" nil t)) ; noerror
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
458 (t
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
459 (re-search-forward
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
460 (concat "[^" skip-chars "]+") nil t))) ;noerror
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
461 (setq fname
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
462 (buffer-substring (match-beginning 0) (match-end 0))))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
463 (if delim
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
464 (forward-char 1))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
465 (skip-chars-forward " \t\n")
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
466 (setq result (cons fname result)))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
467 result))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
468
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
469 ;; convert MS-DOS wildcards to regexp
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
470 (defun viper-wildcard-to-regexp (wcard)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
471 (save-excursion
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
472 (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
473 (erase-buffer)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
474 (insert wcard)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
475 (goto-char (point-min))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
476 (while (not (eobp))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
477 (skip-chars-forward "^*?.\\\\")
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
478 (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
479 ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
480 ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
481 ((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
482 )
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
483 (buffer-string)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
484 ))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
485
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
486
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
487 ;; glob windows files
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
488 ;; LIST is expected to be in reverse order
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
489 (defun viper-glob-mswindows-files (filespec)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
490 (let ((case-fold-search t)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
491 tmp tmp2)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
492 (save-excursion
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
493 (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
494 (erase-buffer)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
495 (insert filespec)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
496 (goto-char (point-min))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
497 (setq tmp (viper-get-filenames-from-buffer))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
498 (while tmp
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
499 (setq tmp2 (cons (directory-files
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
500 ;; the directory part
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
501 (or (file-name-directory (car tmp))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
502 "")
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
503 t ; return full names
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
504 ;; the regexp part: globs the file names
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
505 (concat "^"
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
506 (viper-wildcard-to-regexp
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
507 (file-name-nondirectory (car tmp)))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
508 "$"))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
509 tmp2))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
510 (setq tmp (cdr tmp)))
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
511 (reverse (apply 'append tmp2)))))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
512
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
513
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
514 ;;; Insertion ring
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
515
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
516 ;; Rotate RING's index. DIRection can be positive or negative.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
517 (defun viper-ring-rotate1 (ring dir)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
518 (if (and (ring-p ring) (> (ring-length ring) 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
519 (progn
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
520 (setcar ring (cond ((> dir 0)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
521 (ring-plus1 (car ring) (ring-length ring)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
522 ((< dir 0)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
523 (ring-minus1 (car ring) (ring-length ring)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
524 ;; don't rotate if dir = 0
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
525 (t (car ring))))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
526 (viper-current-ring-item ring)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
527 )))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
528
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
529 (defun viper-special-ring-rotate1 (ring dir)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
530 (if (memq viper-intermediate-command
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
531 '(repeating-display-destructive-command
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
532 repeating-insertion-from-ring))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
533 (viper-ring-rotate1 ring dir)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
534 ;; don't rotate otherwise
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
535 (viper-ring-rotate1 ring 0)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
536
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
537 ;; current ring item; if N is given, then so many items back from the
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
538 ;; current
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
539 (defun viper-current-ring-item (ring &optional n)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
540 (setq n (or n 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
541 (if (and (ring-p ring) (> (ring-length ring) 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
542 (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
543
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
544 ;; Push item onto ring. The second argument is a ring-variable, not value.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
545 (defun viper-push-onto-ring (item ring-var)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
546 (or (ring-p (eval ring-var))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
547 (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
548 (or (null item) ; don't push nil
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
549 (and (stringp item) (string= item "")) ; or empty strings
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
550 (equal item (viper-current-ring-item (eval ring-var))) ; or old stuff
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
551 ;; Since viper-set-destructive-command checks if we are inside
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
552 ;; viper-repeat, we don't check whether this-command-keys is a `.'. The
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
553 ;; cmd viper-repeat makes a call to the current function only if `.' is
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
554 ;; executing a command from the command history. It doesn't call the
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
555 ;; push-onto-ring function if `.' is simply repeating the last
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
556 ;; destructive command. We only check for ESC (which happens when we do
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
557 ;; insert with a prefix argument, or if this-command-keys doesn't give
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
558 ;; anything meaningful (in that case we don't know what to show to the
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
559 ;; user).
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
560 (and (eq ring-var 'viper-command-ring)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
561 (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
562 (viper-array-to-string (this-command-keys))))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
563 (viper-ring-insert (eval ring-var) item))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
564 )
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
565
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
566
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
567 ;; removing elts from ring seems to break it
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
568 (defun viper-cleanup-ring (ring)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
569 (or (< (ring-length ring) 2)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
570 (null (viper-current-ring-item ring))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
571 ;; last and previous equal
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
572 (if (equal (viper-current-ring-item ring)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
573 (viper-current-ring-item ring 1))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
574 (viper-ring-pop ring))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
575
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
576 ;; ring-remove seems to be buggy, so we concocted this for our purposes.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
577 (defun viper-ring-pop (ring)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
578 (let* ((ln (ring-length ring))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
579 (vec (cdr (cdr ring)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
580 (veclen (length vec))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
581 (hd (car ring))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
582 (idx (max 0 (ring-minus1 hd ln)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
583 (top-elt (aref vec idx)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
584
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
585 ;; shift elements
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
586 (while (< (1+ idx) veclen)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
587 (aset vec idx (aref vec (1+ idx)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
588 (setq idx (1+ idx)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
589 (aset vec idx nil)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
590
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
591 (setq hd (max 0 (ring-minus1 hd ln)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
592 (if (= hd (1- ln)) (setq hd 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
593 (setcar ring hd) ; move head
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
594 (setcar (cdr ring) (max 0 (1- ln))) ; adjust length
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
595 top-elt
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
596 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
597
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
598 (defun viper-ring-insert (ring item)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
599 (let* ((ln (ring-length ring))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
600 (vec (cdr (cdr ring)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
601 (veclen (length vec))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
602 (hd (car ring))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
603 (vecpos-after-hd (if (= hd 0) ln hd))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
604 (idx ln))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
605
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
606 (if (= ln veclen)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
607 (progn
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
608 (aset vec hd item) ; hd is always 1+ the actual head index in vec
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
609 (setcar ring (ring-plus1 hd ln)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
610 (setcar (cdr ring) (1+ ln))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
611 (setcar ring (ring-plus1 vecpos-after-hd (1+ ln)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
612 (while (and (>= idx vecpos-after-hd) (> ln 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
613 (aset vec idx (aref vec (1- idx)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
614 (setq idx (1- idx)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
615 (aset vec vecpos-after-hd item))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
616 item))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
617
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
618
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
619 ;;; String utilities
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
620
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
621 ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
622 ;; PRE-STRING is a string to prepend to the abbrev string.
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
623 ;; POST-STRING is a string to append to the abbrev string.
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
624 ;; ABBREV_SIGN is a string to be inserted before POST-STRING
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
625 ;; if the orig string was truncated.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
626 (defun viper-abbreviate-string (string max-len
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
627 pre-string post-string abbrev-sign)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
628 (let (truncated-str)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
629 (setq truncated-str
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
630 (if (stringp string)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
631 (substring string 0 (min max-len (length string)))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
632 (cond ((null truncated-str) "")
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
633 ((> (length string) max-len)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
634 (format "%s%s%s%s"
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
635 pre-string truncated-str abbrev-sign post-string))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
636 (t (format "%s%s%s" pre-string truncated-str post-string)))))
12204
a7bd91d4af97 (vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents: 12139
diff changeset
637
a7bd91d4af97 (vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents: 12139
diff changeset
638 ;; tells if we are over a whitespace-only line
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
639 (defsubst viper-over-whitespace-line ()
12204
a7bd91d4af97 (vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents: 12139
diff changeset
640 (save-excursion
a7bd91d4af97 (vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents: 12139
diff changeset
641 (beginning-of-line)
a7bd91d4af97 (vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents: 12139
diff changeset
642 (looking-at "^[ \t]*$")))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
643
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
644
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
645 ;;; Saving settings in custom file
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
646
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
647 ;; Save the current setting of VAR in CUSTOM-FILE.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
648 ;; If given, MESSAGE is a message to be displayed after that.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
649 ;; This message is erased after 2 secs, if erase-msg is non-nil.
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
650 ;; Arguments: var message custom-file &optional erase-message
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
651 (defun viper-save-setting (var message custom-file &optional erase-msg)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
652 (let* ((var-name (symbol-name var))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
653 (var-val (if (boundp var) (eval var)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
654 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
655 (buf (find-file-noselect (substitute-in-file-name custom-file)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
656 )
14384
854325337547 Moved code around to minimize compiler warnings.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14336
diff changeset
657 (message message)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
658 (save-excursion
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
659 (set-buffer buf)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
660 (goto-char (point-min))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
661 (if (re-search-forward regexp nil t)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
662 (let ((reg-end (1- (match-end 0))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
663 (search-backward var-name)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
664 (delete-region (match-beginning 0) reg-end)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
665 (goto-char (match-beginning 0))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
666 (insert (format "%s '%S" var-name var-val)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
667 (goto-char (point-max))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
668 (if (not (bolp)) (insert "\n"))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
669 (insert (format "(setq %s '%S)\n" var-name var-val)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
670 (save-buffer))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
671 (kill-buffer buf)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
672 (if erase-msg
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
673 (progn
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
674 (sit-for 2)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
675 (message "")))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
676 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
677
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
678 ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
679 ;; match this pattern.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
680 (defun viper-save-string-in-file (string custom-file &optional pattern)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
681 (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
682 (save-excursion
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
683 (set-buffer buf)
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
684 (let (buffer-read-only)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
685 (goto-char (point-min))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
686 (if pattern (delete-matching-lines pattern))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
687 (goto-char (point-max))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
688 (if string (insert string))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
689 (save-buffer)))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
690 (kill-buffer buf)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
691 ))
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
692
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
693
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
694 ;; define remote file test
60168
d96e54250eea * viper-cmd.el (viper-prefix-commands): make into a defconst.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 53477
diff changeset
695 (defun viper-file-remote-p (file-name)
d96e54250eea * viper-cmd.el (viper-prefix-commands): make into a defconst.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 53477
diff changeset
696 (file-remote-p file-name))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
697
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
698
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
699 ;; This is a simple-minded check for whether a file is under version control.
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
700 ;; If file,v exists but file doesn't, this file is considered to be not checked
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
701 ;; in and not checked out for the purpose of patching (since patch won't be
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
702 ;; able to read such a file anyway).
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
703 ;; FILE is a string representing file name
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
704 ;;(defun viper-file-under-version-control (file)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
705 ;; (let* ((filedir (file-name-directory file))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
706 ;; (file-nondir (file-name-nondirectory file))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
707 ;; (trial (concat file-nondir ",v"))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
708 ;; (full-trial (concat filedir trial))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
709 ;; (full-rcs-trial (concat filedir "RCS/" trial)))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
710 ;; (and (stringp file)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
711 ;; (file-exists-p file)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
712 ;; (or
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
713 ;; (and
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
714 ;; (file-exists-p full-trial)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
715 ;; ;; in FAT FS, `file,v' and `file' may turn out to be the same!
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
716 ;; ;; don't be fooled by this!
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
717 ;; (not (equal (file-attributes file)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
718 ;; (file-attributes full-trial))))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
719 ;; ;; check if a version is in RCS/ directory
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
720 ;; (file-exists-p full-rcs-trial)))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
721 ;; ))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
722
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
723
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
724 (defsubst viper-file-checked-in-p (file)
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
725 (and (featurep 'vc-hooks)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
726 ;; CVS files are considered not checked in
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
727 (not (memq (vc-backend file) '(nil CVS)))
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
728 (if (fboundp 'vc-state)
38723
3a1c2213b3d2 (viper-file-checked-in-p): Use `and'
Gerd Moellmann <gerd@gnu.org>
parents: 38514
diff changeset
729 (and
38514
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
730 (not (memq (vc-state file) '(edited needs-merge)))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
731 (not (stringp (vc-state file))))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
732 ;; XEmacs has no vc-state
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
733 (not (vc-locking-user file)))
10482dd382e7 * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 38414
diff changeset
734 ))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
735
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
736 ;; checkout if visited file is checked in
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
737 (defun viper-maybe-checkout (buf)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
738 (let ((file (expand-file-name (buffer-file-name buf)))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
739 (checkout-function (key-binding "\C-x\C-q")))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
740 (if (and (viper-file-checked-in-p file)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
741 (or (beep 1) t)
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
742 (y-or-n-p
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
743 (format
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
744 "File %s is checked in. Check it out? "
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
745 (viper-abbreviate-file-name file))))
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
746 (with-current-buffer buf
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
747 (command-execute checkout-function)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
748
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
749
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
750
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
751
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
752 ;;; Overlays
28510
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
753 (defun viper-put-on-search-overlay (beg end)
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
754 (if (viper-overlay-p viper-search-overlay)
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
755 (viper-move-overlay viper-search-overlay beg end)
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
756 (setq viper-search-overlay (viper-make-overlay beg end (current-buffer)))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
757 (viper-overlay-put
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
758 viper-search-overlay 'priority viper-search-overlay-priority))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
759 (viper-overlay-put viper-search-overlay 'face viper-search-face))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
760
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
761 ;; Search
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
762
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
763 (defun viper-flash-search-pattern ()
28510
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
764 (if (not (viper-has-face-support-p))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
765 nil
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
766 (viper-put-on-search-overlay (match-beginning 0) (match-end 0))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
767 (sit-for 2)
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
768 (viper-overlay-put viper-search-overlay 'face nil)))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
769
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
770 (defun viper-hide-search-overlay ()
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
771 (if (not (viper-overlay-p viper-search-overlay))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
772 (progn
28510
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
773 (setq viper-search-overlay
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
774 (viper-make-overlay (point-min) (point-min) (current-buffer)))
28510
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
775 (viper-overlay-put
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
776 viper-search-overlay 'priority viper-search-overlay-priority)))
6fb7a3864791 2000-04-07 Mikio Nakajima <minakaji@osaka.email.ne.jp>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 27899
diff changeset
777 (viper-overlay-put viper-search-overlay 'face nil))
16136
de1340e6ddb4 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15747
diff changeset
778
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
779 ;; Replace state
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
780
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
781 (defsubst viper-move-replace-overlay (beg end)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
782 (viper-move-overlay viper-replace-overlay beg end))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
783
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
784 (defun viper-set-replace-overlay (beg end)
27899
42f9a58e0fc4 * viper-cmd.el (viper-envelop-ESC-key): added the option to
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 26263
diff changeset
785 (if (viper-overlay-live-p viper-replace-overlay)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
786 (viper-move-replace-overlay beg end)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
787 (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer)))
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
788 ;; never detach
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
789 (viper-overlay-put
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
790 viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
791 (viper-overlay-put
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
792 viper-replace-overlay 'priority viper-replace-overlay-priority)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
793 ;; If Emacs will start supporting overlay maps, as it currently supports
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
794 ;; text-property maps, we could do away with viper-replace-minor-mode and
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
795 ;; just have keymap attached to replace overlay.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
796 ;;(viper-overlay-put
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
797 ;; viper-replace-overlay
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
798 ;; (if viper-xemacs-p 'keymap 'local-map)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
799 ;; viper-replace-map)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
800 )
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
801 (if (viper-has-face-support-p)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
802 (viper-overlay-put
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
803 viper-replace-overlay 'face viper-replace-overlay-face))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
804 (viper-save-cursor-color 'before-replace-mode)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
805 (viper-change-cursor-color viper-replace-overlay-cursor-color)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
806 )
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
807
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
808
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
809 (defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
27899
42f9a58e0fc4 * viper-cmd.el (viper-envelop-ESC-key): added the option to
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 26263
diff changeset
810 (or (viper-overlay-live-p viper-replace-overlay)
42f9a58e0fc4 * viper-cmd.el (viper-envelop-ESC-key): added the option to
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 26263
diff changeset
811 (viper-set-replace-overlay (point-min) (point-min)))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
812 (if (or (not (viper-has-face-support-p))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
813 viper-use-replace-region-delimiters)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
814 (let ((before-name (if viper-xemacs-p 'begin-glyph 'before-string))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
815 (after-name (if viper-xemacs-p 'end-glyph 'after-string)))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
816 (viper-overlay-put viper-replace-overlay before-name before-glyph)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
817 (viper-overlay-put viper-replace-overlay after-name after-glyph))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
818
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
819 (defun viper-hide-replace-overlay ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
820 (viper-set-replace-overlay-glyphs nil nil)
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
821 (viper-restore-cursor-color 'after-replace-mode)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
822 (viper-restore-cursor-color 'after-insert-mode)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
823 (if (viper-has-face-support-p)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
824 (viper-overlay-put viper-replace-overlay 'face nil)))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
825
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
826
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
827 (defsubst viper-replace-start ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
828 (viper-overlay-start viper-replace-overlay))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
829 (defsubst viper-replace-end ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
830 (viper-overlay-end viper-replace-overlay))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
831
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
832
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
833 ;; Minibuffer
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
834
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
835 (defun viper-set-minibuffer-overlay ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
836 (viper-check-minibuffer-overlay)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
837 (if (viper-has-face-support-p)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
838 (progn
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
839 (viper-overlay-put
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
840 viper-minibuffer-overlay 'face viper-minibuffer-current-face)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
841 (viper-overlay-put
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
842 viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
843 ;; never detach
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
844 (viper-overlay-put
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
845 viper-minibuffer-overlay
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
846 (if viper-emacs-p 'evaporate 'detachable)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
847 nil)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
848 ;; make viper-minibuffer-overlay open-ended
14233
396316e5fbe6 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14169
diff changeset
849 ;; In emacs, it is made open ended at creation time
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
850 (if viper-xemacs-p
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
851 (progn
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
852 (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
853 (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
14233
396316e5fbe6 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14169
diff changeset
854 )))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
855
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
856 (defun viper-check-minibuffer-overlay ()
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
857 (if (viper-overlay-live-p viper-minibuffer-overlay)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
858 (viper-move-overlay
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
859 viper-minibuffer-overlay
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
860 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
861 (1+ (buffer-size)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
862 (setq viper-minibuffer-overlay
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
863 (if viper-xemacs-p
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
864 (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
865 ;; make overlay open-ended
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
866 (viper-make-overlay
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
867 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
868 (1+ (buffer-size))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
869 (current-buffer) nil 'rear-advance)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
870 ))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
871
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
872
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
873 (defsubst viper-is-in-minibuffer ()
21940
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
874 (save-match-data
f7e788ea680b new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19462
diff changeset
875 (string-match "\*Minibuf-" (buffer-name))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
876
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
877
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
878
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
879 ;;; XEmacs compatibility
14581
4951b11970a1 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14384
diff changeset
880
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
881 (defun viper-abbreviate-file-name (file)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
882 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
883 ;; XEmacs requires addl argument
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
884 (abbreviate-file-name file t)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
885 ;; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
886 (abbreviate-file-name file)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
887 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
888
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
889 ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
890 ;; in sit-for, so this function smoothes out the differences.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
891 (defsubst viper-sit-for-short (val &optional nodisp)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
892 (if viper-xemacs-p
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
893 (sit-for (/ val 1000.0) nodisp)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
894 (sit-for 0 val nodisp)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
895
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
896 ;; EVENT may be a single event of a sequence of events
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
897 (defsubst viper-ESC-event-p (event)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
898 (let ((ESC-keys '(?\e (control \[) escape))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
899 (key (viper-event-key event)))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
900 (member key ESC-keys)))
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
901
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
902 ;; checks if object is a marker, has a buffer, and points to within that buffer
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
903 (defun viper-valid-marker (marker)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
904 (if (and (markerp marker) (marker-buffer marker))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
905 (let ((buf (marker-buffer marker))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
906 (pos (marker-position marker)))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
907 (save-excursion
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
908 (set-buffer buf)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
909 (and (<= pos (point-max)) (<= (point-min) pos))))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
910
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
911 (defsubst viper-mark-marker ()
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
912 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
913 (mark-marker t) ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
914 (mark-marker) ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
915 ))
14909
7ff1df13b124 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14588
diff changeset
916
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
917 ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
918 ;; is the same as (mark t).
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
919 (defsubst viper-set-mark-if-necessary ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
920 (setq mark-ring (delete (viper-mark-marker) mark-ring))
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
921 (set-mark-command nil)
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
922 (setq viper-saved-mark (point)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
923
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
924 ;; In transient mark mode (zmacs mode), it is annoying when regions become
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
925 ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
926 ;; the user explicitly wants highlighting, e.g., by hitting '' or ``
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
927 (defun viper-deactivate-mark ()
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
928 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
929 (zmacs-deactivate-region)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
930 (deactivate-mark)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
931 ))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
932
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
933 (defsubst viper-leave-region-active ()
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
934 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
935 (setq zmacs-region-stays t)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
936 nil
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
937 ))
12899
e0dfd3c3837e (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12693
diff changeset
938
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
939 ;; Check if arg is a valid character for register
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
940 ;; TYPE is a list that can contain `letter', `Letter', and `digit'.
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
941 ;; Letter means lowercase letters, Letter means uppercase letters, and
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
942 ;; digit means digits from 1 to 9.
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
943 ;; If TYPE is nil, then down/uppercase letters and digits are allowed.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
944 (defun viper-valid-register (reg &optional type)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
945 (or type (setq type '(letter Letter digit)))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
946 (or (if (memq 'letter type)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
947 (and (<= ?a reg) (<= reg ?z)))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
948 (if (memq 'digit type)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
949 (and (<= ?1 reg) (<= reg ?9)))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
950 (if (memq 'Letter type)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
951 (and (<= ?A reg) (<= reg ?Z)))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
952 ))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
953
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
954
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
955
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
956 ;; it is suggested that an event must be copied before it is assigned to
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
957 ;; last-command-event in XEmacs
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
958 (defun viper-copy-event (event)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
959 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
960 (copy-event event) ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
961 event ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
962 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
963
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
964 ;; Uses different timeouts for ESC-sequences and others
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
965 (defsubst viper-fast-keysequence-p ()
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
966 (not (viper-sit-for-short
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
967 (if (viper-ESC-event-p last-input-event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
968 viper-ESC-keyseq-timeout
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
969 viper-fast-keyseq-timeout)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
970 t)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
971
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
972 ;; like read-event, but in XEmacs also try to convert to char, if possible
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
973 (defun viper-read-event-convert-to-char ()
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
974 (let (event)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
975 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
976 (progn
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
977 (setq event (next-command-event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
978 (or (event-to-character event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
979 event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
980 (read-event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
981 )
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
982 ))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
983
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
984 ;; Viperized read-key-sequence
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
985 (defun viper-read-key-sequence (prompt &optional continue-echo)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
986 (let (inhibit-quit event keyseq)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
987 (setq keyseq (read-key-sequence prompt continue-echo))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
988 (setq event (if viper-xemacs-p
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
989 (elt keyseq 0) ; XEmacs returns vector of events
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
990 (elt (listify-key-sequence keyseq) 0)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
991 (if (viper-ESC-event-p event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
992 (let (unread-command-events)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
993 (if (viper-fast-keysequence-p)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
994 (let ((viper-vi-global-user-minor-mode nil)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
995 (viper-vi-local-user-minor-mode nil)
43220
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
996 (viper-vi-intercept-minor-mode nil)
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
997 (viper-insert-intercept-minor-mode nil)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
998 (viper-replace-minor-mode nil) ; actually unnecessary
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
999 (viper-insert-global-user-minor-mode nil)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1000 (viper-insert-local-user-minor-mode nil))
43220
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1001 ;; Note: set unread-command-events only after testing for fast
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1002 ;; keysequence. Otherwise, viper-fast-keysequence-p will be
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1003 ;; always t -- whether there is anything after ESC or not
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1004 (viper-set-unread-command-events keyseq)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1005 (setq keyseq (read-key-sequence nil)))
43220
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1006 (viper-set-unread-command-events keyseq)
69c91aaa067a 2002-02-10 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 42602
diff changeset
1007 (setq keyseq (read-key-sequence nil)))))
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1008 keyseq))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1009
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1010
12693
321b2ad48a9c (vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12212
diff changeset
1011 ;; This function lets function-key-map convert key sequences into logical
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1012 ;; keys. This does a better job than viper-read-event when it comes to kbd
15578
fadc581e380e (vip-read-key): inhibit quit added.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15480
diff changeset
1013 ;; macros, since it enables certain macros to be shared between X and TTY modes
fadc581e380e (vip-read-key): inhibit quit added.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15480
diff changeset
1014 ;; by correctly mapping key sequences for Left/Right/... (one an ascii
fadc581e380e (vip-read-key): inhibit quit added.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15480
diff changeset
1015 ;; terminal) into logical keys left, right, etc.
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1016 (defun viper-read-key ()
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1017 (let ((overriding-local-map viper-overriding-map)
15578
fadc581e380e (vip-read-key): inhibit quit added.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15480
diff changeset
1018 (inhibit-quit t)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1019 help-char key)
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1020 (use-global-map viper-overriding-map)
19203
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
1021 (unwind-protect
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1022 (setq key (elt (viper-read-key-sequence nil) 0))
19203
58c50205001d new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19079
diff changeset
1023 (use-global-map global-map))
15578
fadc581e380e (vip-read-key): inhibit quit added.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 15480
diff changeset
1024 key))
12693
321b2ad48a9c (vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12212
diff changeset
1025
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1026
12139
e16c06646396 (vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents: 11288
diff changeset
1027 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
14584
6674e3119d9e (vip-event-key): ignore consp events.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14581
diff changeset
1028 ;; instead of nil, if '(nil) was previously inadvertently assigned to
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1029 ;; unread-command-events
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1030 (defun viper-event-key (event)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1031 (or (and event (eventp event))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1032 (error "viper-event-key: Wrong type argument, eventp, %S" event))
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1033 (when (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1034 (or (key-press-event-p event) (mouse-event-p event)) ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1035 t ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1036 )
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1037 (let ((mod (event-modifiers event))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1038 basis)
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1039 (setq basis
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1040 (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1041 ;; XEmacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1042 (cond ((key-press-event-p event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1043 (event-key event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1044 ((button-event-p event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1045 (concat "mouse-" (prin1-to-string (event-button event))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1046 (t
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1047 (error "viper-event-key: Unknown event, %S" event)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1048 ;; Emacs doesn't handle capital letters correctly, since
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1049 ;; \S-a isn't considered the same as A (it behaves as
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1050 ;; plain `a' instead). So we take care of this here
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1051 (cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1052 (setq mod nil
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1053 event event))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1054 ;; Emacs has the oddity whereby characters 128+char
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1055 ;; represent M-char *if* this appears inside a string.
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1056 ;; So, we convert them manually to (meta char).
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1057 ((and (viper-characterp event)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1058 (< ?\C-? event) (<= event 255))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1059 (setq mod '(meta)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1060 event (- event ?\C-? 1)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1061 ((and (null mod) (eq event 'return))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1062 (setq event ?\C-m))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1063 ((and (null mod) (eq event 'space))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1064 (setq event ?\ ))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1065 ((and (null mod) (eq event 'delete))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1066 (setq event ?\C-?))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1067 ((and (null mod) (eq event 'backspace))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1068 (setq event ?\C-h))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1069 (t (event-basic-type event)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1070 ) ; viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1071 )
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1072 (if (viper-characterp basis)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1073 (setq basis
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1074 (if (viper= basis ?\C-?)
18047
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1075 (list 'control '\?) ; taking care of an emacs bug
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1076 (intern (char-to-string basis)))))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1077 (if mod
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1078 (append mod (list basis))
1b06411ccc04 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 16766
diff changeset
1079 basis))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1080
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1081 (defun viper-key-to-emacs-key (key)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1082 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1083 (cond (viper-xemacs-p key)
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1084
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1085 ((symbolp key)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1086 (setq key-name (symbol-name key))
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1087 (cond ((= (length key-name) 1) ; character event
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1088 (string-to-char key-name))
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1089 ;; Emacs doesn't recognize `return' and `escape' as events on
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1090 ;; dumb terminals, so we translate them into characters
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1091 ((and viper-emacs-p (not (viper-window-display-p))
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1092 (string= key-name "return"))
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1093 ?\C-m)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1094 ((and viper-emacs-p (not (viper-window-display-p))
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1095 (string= key-name "escape"))
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1096 ?\e)
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1097 ;; pass symbol-event as is
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1098 (t key)))
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1099
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1100 ((listp key)
64215
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1101 (setq modifiers (viper-subseq key 0 (1- (length key)))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1102 base-key (viper-seq-last-elt key)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1103 base-key-name (symbol-name base-key)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1104 char-p (= (length base-key-name) 1))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1105 (setq mod-char-list
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1106 (mapcar
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1107 '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1108 modifiers))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1109 (if char-p
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1110 (setq key-name
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1111 (car (read-from-string
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1112 (concat
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1113 "?\\"
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1114 (mapconcat 'identity mod-char-list "-\\")
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1115 "-"
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1116 base-key-name))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1117 (setq key-name
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1118 (intern
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1119 (concat
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1120 (mapconcat 'identity mod-char-list "-")
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1121 "-"
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1122 base-key-name))))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1123 ))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1124
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1125
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1126 ;; LIS is assumed to be a list of events of characters
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1127 (defun viper-eventify-list-xemacs (lis)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1128 (mapcar
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1129 (lambda (elt)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1130 (cond ((viper-characterp elt) (character-to-event elt))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1131 ((eventp elt) elt)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1132 (t (error
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1133 "viper-eventify-list-xemacs: can't convert to event, %S"
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1134 elt))))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1135 lis))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1136
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1137
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1138 ;; Smoothes out the difference between Emacs' unread-command-events
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1139 ;; and XEmacs unread-command-event. Arg is a character, an event, a list of
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1140 ;; events or a sequence of keys.
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1141 ;;
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1142 ;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1143 ;; symbol in unread-command-events list may cause Emacs to turn this symbol
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1144 ;; into an event. Below, we delete nil from event lists, since nil is the most
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1145 ;; common symbol that might appear in this wrong context.
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1146 (defun viper-set-unread-command-events (arg)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1147 (if viper-emacs-p
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1148 (setq
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1149 unread-command-events
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1150 (let ((new-events
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1151 (cond ((eventp arg) (list arg))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1152 ((listp arg) arg)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1153 ((sequencep arg)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1154 (listify-key-sequence arg))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1155 (t (error
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1156 "viper-set-unread-command-events: Invalid argument, %S"
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1157 arg)))))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1158 (if (not (eventp nil))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1159 (setq new-events (delq nil new-events)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1160 (append new-events unread-command-events)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1161 ;; XEmacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1162 (setq
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1163 unread-command-events
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1164 (append
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1165 (cond ((viper-characterp arg) (list (character-to-event arg)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1166 ((eventp arg) (list arg))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1167 ((stringp arg) (mapcar 'character-to-event arg))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1168 ((vectorp arg) (append arg nil)) ; turn into list
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1169 ((listp arg) (viper-eventify-list-xemacs arg))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1170 (t (error
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1171 "viper-set-unread-command-events: Invalid argument, %S" arg)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1172 unread-command-events))))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1173
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1174
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1175 ;; Check if vec is a vector of key-press events representing characters
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1176 ;; XEmacs only
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1177 (defun viper-event-vector-p (vec)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1178 (and (vectorp vec)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1179 (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1180
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1181
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1182 ;; check if vec is a vector of character symbols
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1183 (defun viper-char-symbol-sequence-p (vec)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1184 (and
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1185 (sequencep vec)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1186 (eval
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1187 (cons 'and
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1188 (mapcar (lambda (elt)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1189 (and (symbolp elt) (= (length (symbol-name elt)) 1)))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1190 vec)))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1191
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1192
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1193 (defun viper-char-array-p (array)
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1194 (eval (cons 'and (mapcar 'viper-characterp array))))
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1195
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1196
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1197 ;; Args can be a sequence of events, a string, or a Viper macro. Will try to
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1198 ;; convert events to keys and, if all keys are regular printable
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1199 ;; characters, will return a string. Otherwise, will return a string
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1200 ;; representing a vector of converted events. If the input was a Viper macro,
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1201 ;; will return a string that represents this macro as a vector.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1202 (defun viper-array-to-string (event-seq)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1203 (let (temp temp2)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1204 (cond ((stringp event-seq) event-seq)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1205 ((viper-event-vector-p event-seq)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1206 (setq temp (mapcar 'viper-event-key event-seq))
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1207 (cond ((viper-char-symbol-sequence-p temp)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1208 (mapconcat 'symbol-name temp ""))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1209 ((and (viper-char-array-p
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1210 (setq temp2 (mapcar 'viper-key-to-character temp))))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1211 (mapconcat 'char-to-string temp2 ""))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1212 (t (prin1-to-string (vconcat temp)))))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1213 ((viper-char-symbol-sequence-p event-seq)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1214 (mapconcat 'symbol-name event-seq ""))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1215 ((and (vectorp event-seq)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1216 (viper-char-array-p
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1217 (setq temp (mapcar 'viper-key-to-character event-seq))))
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1218 (mapconcat 'char-to-string temp ""))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1219 (t (prin1-to-string event-seq)))))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1220
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1221 (defun viper-key-press-events-to-chars (events)
42602
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1222 (mapconcat (viper-cond-compile-for-xemacs-or-emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1223 (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1224 'char-to-string ; emacs
633233bf2bbf 2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 39215
diff changeset
1225 )
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1226 events
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1227 ""))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1228
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1229
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1230 (defun viper-read-char-exclusive ()
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1231 (let (char
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1232 (echo-keystrokes 1))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1233 (while (null char)
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1234 (condition-case nil
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1235 (setq char (read-char))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1236 (error
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1237 ;; skip event if not char
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1238 (viper-read-event))))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1239 char))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1240
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1241 ;; key is supposed to be in viper's representation, e.g., (control l), a
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1242 ;; character, etc.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1243 (defun viper-key-to-character (key)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1244 (cond ((eq key 'space) ?\ )
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1245 ((eq key 'delete) ?\C-?)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1246 ((eq key 'return) ?\C-m)
15480
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1247 ((eq key 'backspace) ?\C-h)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1248 ((and (symbolp key)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1249 (= 1 (length (symbol-name key))))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1250 (string-to-char (symbol-name key)))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1251 ((and (listp key)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1252 (eq (car key) 'control)
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1253 (symbol-name (nth 1 key))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1254 (= 1 (length (symbol-name (nth 1 key)))))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1255 (read (format "?\\C-%s" (symbol-name (nth 1 key)))))
43a3308fcf61 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 14909
diff changeset
1256 (t key)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1257
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1258
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1259 (defun viper-setup-master-buffer (&rest other-files-or-buffers)
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1260 "Set up the current buffer as a master buffer.
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1261 Arguments become related buffers. This function should normally be used in
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1262 the `Local variables' section of a file."
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1263 (setq viper-related-files-and-buffers-ring
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1264 (make-ring (1+ (length other-files-or-buffers))))
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1265 (mapcar '(lambda (elt)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1266 (viper-ring-insert viper-related-files-and-buffers-ring elt))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1267 other-files-or-buffers)
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1268 (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name))
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1269 )
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1270
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1271 ;;; Movement utilities
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1272
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1273 ;; Characters that should not be considered as part of the word, in reformed-vi
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1274 ;; syntax mode.
66893
7c76da84383b 2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 65627
diff changeset
1275 ;; Note: \\ (quoted \) must appear before `-' because this string is listified
7c76da84383b 2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 65627
diff changeset
1276 ;; into characters at some point and then put back to string. The result is
7c76da84383b 2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 65627
diff changeset
1277 ;; used in skip-chars-forward, which treats - specially. Here we achieve the
7c76da84383b 2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 65627
diff changeset
1278 ;; effect of quoting - and preventing it from being special.
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1279 (defconst viper-non-word-characters-reformed-vi
66893
7c76da84383b 2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 65627
diff changeset
1280 "!@#$%^&*()\\-+=|\\~`{}[];:'\",<.>/?")
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1281 ;; These are characters that are not to be considered as parts of a word in
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1282 ;; Viper.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1283 ;; Set each time state changes and at loading time
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1284 (viper-deflocalvar viper-non-word-characters nil)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1285
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1286 ;; must be buffer-local
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1287 (viper-deflocalvar viper-ALPHA-char-class "w"
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1288 "String of syntax classes characterizing Viper's alphanumeric symbols.
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1289 In addition, the symbol `_' may be considered alphanumeric if
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1290 `viper-syntax-preference' is `strict-vi' or `reformed-vi'.")
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1291
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1292 (defconst viper-strict-ALPHA-chars "a-zA-Z0-9_"
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1293 "Regexp matching the set of alphanumeric characters acceptable to strict
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1294 Vi.")
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1295 (defconst viper-strict-SEP-chars " \t\n"
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1296 "Regexp matching the set of alphanumeric characters acceptable to strict
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1297 Vi.")
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1298 (defconst viper-strict-SEP-chars-sans-newline " \t"
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1299 "Regexp matching the set of alphanumeric characters acceptable to strict
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1300 Vi.")
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1301
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1302 (defconst viper-SEP-char-class " -"
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1303 "String of syntax classes for Vi separators.
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1304 Usually contains ` ', linefeed, TAB or formfeed.")
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1305
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1306
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1307 ;; Set Viper syntax classes and related variables according to
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1308 ;; `viper-syntax-preference'.
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1309 (defun viper-update-syntax-classes (&optional set-default)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1310 (let ((preference (cond ((eq viper-syntax-preference 'emacs)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1311 "w") ; Viper words have only Emacs word chars
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1312 ((eq viper-syntax-preference 'extended)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1313 "w_") ; Viper words have Emacs word & symbol chars
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1314 (t "w"))) ; Viper words are Emacs words plus `_'
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1315 (non-word-chars (cond ((eq viper-syntax-preference 'reformed-vi)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1316 (viper-string-to-list
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1317 viper-non-word-characters-reformed-vi))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1318 (t nil))))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1319 (if set-default
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1320 (setq-default viper-ALPHA-char-class preference
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1321 viper-non-word-characters non-word-chars)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1322 (setq viper-ALPHA-char-class preference
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1323 viper-non-word-characters non-word-chars))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1324 ))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1325
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1326 ;; SYMBOL is used because customize requires it, but it is ignored, unless it
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1327 ;; is `nil'. If nil, use setq.
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1328 (defun viper-set-syntax-preference (&optional symbol value)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1329 "Set Viper syntax preference.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1330 If called interactively or if SYMBOL is nil, sets syntax preference in current
26263
4f315ca65976 *** empty log message ***
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 22284
diff changeset
1331 buffer. If called non-interactively, preferably via the customization widget,
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1332 sets the default value."
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1333 (interactive)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1334 (or value
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1335 (setq value
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1336 (completing-read
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1337 "Viper syntax preference: "
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1338 '(("strict-vi") ("reformed-vi") ("extended") ("emacs"))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1339 nil 'require-match)))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1340 (if (stringp value) (setq value (intern value)))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1341 (or (memq value '(strict-vi reformed-vi extended emacs))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1342 (error "Invalid Viper syntax preference, %S" value))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1343 (if symbol
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1344 (setq-default viper-syntax-preference value)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1345 (setq viper-syntax-preference value))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1346 (viper-update-syntax-classes))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1347
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1348 (defcustom viper-syntax-preference 'reformed-vi
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1349 "*Syntax type characterizing Viper's alphanumeric symbols.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1350 Affects movement and change commands that deal with Vi-style words.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1351 Works best when set in the hooks to various major modes.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1352
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1353 `strict-vi' means Viper words are (hopefully) exactly as in Vi.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1354
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1355 `reformed-vi' means Viper words are like Emacs words \(as determined using
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1356 Emacs syntax tables, which are different for different major modes\) with two
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1357 exceptions: the symbol `_' is always part of a word and typical Vi non-word
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1358 symbols, such as `,',:,\",),{, etc., are excluded.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1359 This behaves very close to `strict-vi', but also works well with non-ASCII
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1360 characters from various alphabets.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1361
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1362 `extended' means Viper word constituents are symbols that are marked as being
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1363 parts of words OR symbols in Emacs syntax tables.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1364 This is most appropriate for major modes intended for editing programs.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1365
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1366 `emacs' means Viper words are the same as Emacs words as specified by Emacs
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1367 syntax tables.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1368 This option is appropriate if you like Emacs-style words."
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1369 :type '(radio (const strict-vi) (const reformed-vi)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1370 (const extended) (const emacs))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1371 :set 'viper-set-syntax-preference
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1372 :group 'viper)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1373 (make-variable-buffer-local 'viper-syntax-preference)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1374
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1375
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1376 ;; addl-chars are characters to be temporarily considered as alphanumerical
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1377 (defun viper-looking-at-alpha (&optional addl-chars)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1378 (or (stringp addl-chars) (setq addl-chars ""))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1379 (if (eq viper-syntax-preference 'reformed-vi)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1380 (setq addl-chars (concat addl-chars "_")))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1381 (let ((char (char-after (point))))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1382 (if char
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1383 (if (eq viper-syntax-preference 'strict-vi)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1384 (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1385 (or
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1386 ;; or one of the additional chars being asked to include
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1387 (viper-memq-char char (viper-string-to-list addl-chars))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1388 (and
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1389 ;; not one of the excluded word chars (note:
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1390 ;; viper-non-word-characters is a list)
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1391 (not (viper-memq-char char viper-non-word-characters))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1392 ;; char of the Viper-word syntax class
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1393 (viper-memq-char (char-syntax char)
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1394 (viper-string-to-list viper-ALPHA-char-class))))))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1395 ))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1396
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1397 (defun viper-looking-at-separator ()
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1398 (let ((char (char-after (point))))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1399 (if char
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1400 (if (eq viper-syntax-preference 'strict-vi)
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1401 (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1402 (or (eq char ?\n) ; RET is always a separator in Vi
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1403 (viper-memq-char (char-syntax char)
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1404 (viper-string-to-list viper-SEP-char-class)))))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1405 ))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1406
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1407 (defsubst viper-looking-at-alphasep (&optional addl-chars)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1408 (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1409
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1410 (defun viper-skip-alpha-forward (&optional addl-chars)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1411 (or (stringp addl-chars) (setq addl-chars ""))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1412 (viper-skip-syntax
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1413 'forward
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1414 (cond ((eq viper-syntax-preference 'strict-vi)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1415 "")
19241
eb1cef5fa337 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19203
diff changeset
1416 (t viper-ALPHA-char-class))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1417 (cond ((eq viper-syntax-preference 'strict-vi)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1418 (concat viper-strict-ALPHA-chars addl-chars))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1419 (t addl-chars))))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1420
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1421 (defun viper-skip-alpha-backward (&optional addl-chars)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1422 (or (stringp addl-chars) (setq addl-chars ""))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1423 (viper-skip-syntax
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1424 'backward
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1425 (cond ((eq viper-syntax-preference 'strict-vi)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1426 "")
19241
eb1cef5fa337 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19203
diff changeset
1427 (t viper-ALPHA-char-class))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1428 (cond ((eq viper-syntax-preference 'strict-vi)
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1429 (concat viper-strict-ALPHA-chars addl-chars))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1430 (t addl-chars))))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1431
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1432 ;; weird syntax tables may confuse strict-vi style
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1433 (defsubst viper-skip-all-separators-forward (&optional within-line)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1434 (if (eq viper-syntax-preference 'strict-vi)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1435 (if within-line
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1436 (skip-chars-forward viper-strict-SEP-chars-sans-newline)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1437 (skip-chars-forward viper-strict-SEP-chars))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1438 (viper-skip-syntax 'forward
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1439 viper-SEP-char-class
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1440 (or within-line "\n")
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1441 (if within-line (viper-line-pos 'end)))))
65627
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1442
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1443 (defsubst viper-skip-all-separators-backward (&optional within-line)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1444 (if (eq viper-syntax-preference 'strict-vi)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1445 (if within-line
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1446 (skip-chars-backward viper-strict-SEP-chars-sans-newline)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1447 (skip-chars-backward viper-strict-SEP-chars))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1448 (viper-skip-syntax 'backward
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1449 viper-SEP-char-class
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1450 (or within-line "\n")
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1451 (if within-line (viper-line-pos 'start)))))
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1452 (defun viper-skip-nonseparators (direction)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1453 (viper-skip-syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1454 direction
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1455 (concat "^" viper-SEP-char-class)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1456 nil
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1457 (viper-line-pos (if (eq direction 'forward) 'end 'start))))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1458
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1459
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1460 ;; skip over non-word constituents and non-separators
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1461 (defun viper-skip-nonalphasep-forward ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1462 (if (eq viper-syntax-preference 'strict-vi)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1463 (skip-chars-forward
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1464 (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1465 (viper-skip-syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1466 'forward
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1467 (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1468 ;; Emacs may consider some of these as words, but we don't want them
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1469 viper-non-word-characters
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1470 (viper-line-pos 'end))))
65627
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1471
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1472 (defun viper-skip-nonalphasep-backward ()
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1473 (if (eq viper-syntax-preference 'strict-vi)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1474 (skip-chars-backward
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1475 (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1476 (viper-skip-syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1477 'backward
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1478 (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1479 ;; Emacs may consider some of these as words, but we don't want them
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1480 viper-non-word-characters
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1481 (viper-line-pos 'start))))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1482
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1483 ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1484 ;; Return the number of chars traveled.
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1485 ;; Both SYNTAX or ADDL-CHARS can be strings or lists of characters.
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1486 ;; When SYNTAX is "w", then viper-non-word-characters are not considered to be
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1487 ;; words, even if Emacs syntax table says they are.
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1488 (defun viper-skip-syntax (direction syntax addl-chars &optional limit)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1489 (let ((total 0)
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1490 (local 1)
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1491 (skip-chars-func
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1492 (if (eq direction 'forward)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1493 'skip-chars-forward 'skip-chars-backward))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1494 (skip-syntax-func
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1495 (if (eq direction 'forward)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1496 'viper-forward-char-carefully 'viper-backward-char-carefully))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1497 char-looked-at syntax-of-char-looked-at negated-syntax)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1498 (setq addl-chars
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1499 (cond ((listp addl-chars) (viper-charlist-to-string addl-chars))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1500 ((stringp addl-chars) addl-chars)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1501 (t "")))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1502 (setq syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1503 (cond ((listp syntax) syntax)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1504 ((stringp syntax) (viper-string-to-list syntax))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1505 (t nil)))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1506 (if (memq ?^ syntax) (setq negated-syntax t))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1507
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1508 (while (and (not (= local 0))
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1509 (cond ((eq direction 'forward)
22284
7c92be9aea04 (viper-skip-syntax): Bug fix for eob/bob cases.
Karl Heuer <kwzh@gnu.org>
parents: 21940
diff changeset
1510 (not (eobp)))
7c92be9aea04 (viper-skip-syntax): Bug fix for eob/bob cases.
Karl Heuer <kwzh@gnu.org>
parents: 21940
diff changeset
1511 (t (not (bobp)))))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1512 (setq char-looked-at (viper-char-at-pos direction)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1513 ;; if outside the range, set to nil
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1514 syntax-of-char-looked-at (if char-looked-at
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1515 (char-syntax char-looked-at)))
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1516 (setq local
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1517 (+ (if (and
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1518 (cond ((and limit (eq direction 'forward))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1519 (< (point) limit))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1520 (limit ; backward & limit
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1521 (> (point) limit))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1522 (t t)) ; no limit
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1523 ;; char under/before cursor has appropriate syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1524 (if negated-syntax
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1525 (not (memq syntax-of-char-looked-at syntax))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1526 (memq syntax-of-char-looked-at syntax))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1527 ;; if char-syntax class is "word", make sure it is not one
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1528 ;; of the excluded characters
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1529 (if (and (eq syntax-of-char-looked-at ?w)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1530 (not negated-syntax))
33019
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1531 (not (viper-memq-char
6306740f6938 2000-10-29 Michael Kifer <kifer@cs.sunysb.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 28510
diff changeset
1532 char-looked-at viper-non-word-characters))
19462
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1533 t))
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1534 (funcall skip-syntax-func 1)
a3240ad2e954 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 19241
diff changeset
1535 0)
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1536 (funcall skip-chars-func addl-chars limit)))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1537 (setq total (+ total local)))
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1538 total
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1539 ))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1540
65627
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1541 ;; tells when point is at the beginning of field
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1542 (defun viper-beginning-of-field ()
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1543 (or (bobp)
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1544 (not (eq (get-char-property (point) 'field)
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1545 (get-char-property (1- (point)) 'field)))))
511f8e9d22ca 2005-09-20 Michael Kifer <kifer@cs.stonybrook.edu>
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64750
diff changeset
1546
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1547
64215
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1548 ;; this is copied from cl-extra.el
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1549 ;; Return the subsequence of SEQ from START to END.
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1550 ;; If END is omitted, it defaults to the length of the sequence.
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1551 ;; If START or END is negative, it counts from the end.
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1552 (defun viper-subseq (seq start &optional end)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1553 (if (stringp seq) (substring seq start end)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1554 (let (len)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1555 (and end (< end 0) (setq end (+ end (setq len (length seq)))))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1556 (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1557 (cond ((listp seq)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1558 (if (> start 0) (setq seq (nthcdr start seq)))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1559 (if end
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1560 (let ((res nil))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1561 (while (>= (setq end (1- end)) start)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1562 (push (pop seq) res))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1563 (nreverse res))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1564 (copy-sequence seq)))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1565 (t
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1566 (or end (setq end (or len (length seq))))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1567 (let ((res (make-vector (max (- end start) 0) nil))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1568 (i 0))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1569 (while (< start end)
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1570 (aset res i (aref seq start))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1571 (setq i (1+ i) start (1+ start)))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1572 res))))))
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1573
a4c59075cac8 * viper-cmd.el (viper--key-maps): new variable.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 64085
diff changeset
1574
13213
68b3f6d9156f (vip-leave-region-active): new function.
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 12899
diff changeset
1575
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1576 (provide 'viper-util)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 47520
diff changeset
1577
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1578
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1579 ;;; Local Variables:
19079
dfbef8117c6a new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18839
diff changeset
1580 ;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
18839
1405083241e8 new version
Michael Kifer <kifer@cs.stonybrook.edu>
parents: 18172
diff changeset
1581 ;;; End:
10789
af7c0bb1059f Initial revision
Karl Heuer <kwzh@gnu.org>
parents:
diff changeset
1582
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
1583 ;;; arch-tag: 7f023fd5-dd9e-4378-a397-9c179553b0e3
38414
67b464da13ec Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 36857
diff changeset
1584 ;;; viper-util.el ends here