-
Notifications
You must be signed in to change notification settings - Fork 35
/
Copy pathergoemacs-mapkeymap.el
213 lines (191 loc) · 8.77 KB
/
ergoemacs-mapkeymap.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
;;; ergoemacs-mapkeymap.el --- Ergoemacs map interface -*- lexical-binding: t -*-
;; Copyright © 2013-2021 Free Software Foundation, Inc.
;; Filename: ergoemacs-mapkeymap.el
;; Description:
;; Author: Matthew L. Fidler
;; Maintainer: Matthew L. Fidler
;; Created: Sat Sep 28 20:10:56 2013 (-0500)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Function to map over a KEYMAP
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'cl-lib)
(eval-when-compile
(require 'ergoemacs-macros))
(declare-function ergoemacs-map-properties--all-sparse-p "ergoemacs-map-properties")
(declare-function ergoemacs-map-properties--composed-list "ergoemacs-map-properties")
(declare-function ergoemacs-setcdr "ergoemacs-lib")
(declare-function ergoemacs-map-properties--original "ergoemacs-map-properties")
(defun ergoemacs-map-force-full-keymap (keymap)
"Force KEYMAP to be a full keymap."
(if (ignore-errors (char-table-p (nth 1 keymap))) keymap
(ergoemacs-setcdr keymap (cons (nth 1 (make-keymap)) (cdr keymap)))
keymap))
(defun ergoemacs-map-set-char-table-range (keymap range value)
"Set the KEYMAP's char-table RANGE to VALUE.
If KEYMAP is sparse keymap, make it a full keymap."
(set-char-table-range
(nth 1 (ergoemacs-map-force-full-keymap keymap)) range value))
(defvar ergoemacs-map-keymap--load-autoloads-p t
"Determines if `ergoemacs-map-keymap' will load autoloads when mapping over a keymap.")
(defun ergoemacs-map-keymap--expose-keymap (keymap)
"Change KEYMAP into the keymap value.
This accepts symbols, functions, or autoloads.
If `ergoemacs-mode' cant determine the value, return nil."
(let (tmp)
(or (and (listp keymap) keymap)
(and (symbolp keymap) (boundp keymap) (setq tmp (symbol-value keymap))
(ergoemacs-keymapp tmp) tmp)
(and (symbolp keymap) (fboundp keymap)
(setq tmp (symbol-function keymap))
(or (and (ergoemacs-keymapp tmp) tmp)
(and (eq 'autoload (car tmp))
ergoemacs-map-keymap--load-autoloads-p
;; load required keymap.
(load (nth 1 tmp))
(or (and (boundp keymap) (setq tmp (symbol-value keymap))
(ergoemacs-keymapp tmp) tmp)
(and (fboundp keymap) (setq tmp (symbol-function keymap))
(ergoemacs-keymapp tmp) tmp))))))))
(defvar ergoemacs-map-keymap--map-submap-last-map nil)
(defun ergoemacs-map-keymap--map-submap (sub-keymap function &optional original prefix flat-keymap nil-keys)
"Expose SUB-KEYMAP, then apply `ergoemacs-map-keymap'.
The sub-keymap is exposed by
`ergoemacs-map-keymap--expose-keymap'.
The `ergoemacs-map-keymap' uses the FUNCTION, ORIGINAL PREFIX
FLAT-KEYMAP and NIL-KEYS arguments. It is missing the keymap
argument, since it is calculated from the exposed sub-keymap."
(let ((tmp (ergoemacs-map-keymap--expose-keymap sub-keymap)))
(when tmp
(unless (eq ergoemacs-map-keymap--map-submap-last-map tmp)
(setq ergoemacs-map-keymap--map-submap-last-map tmp)
(ergoemacs-map-keymap function
(cond
((eq original :setcdr)
(ergoemacs-setcdr (cdr tmp)
(cdr (ergoemacs :original tmp))))
(original
(ergoemacs :original tmp))
(t tmp))
original prefix flat-keymap nil-keys)))))
(defun ergoemacs-map-keymap (function keymap &optional original prefix flat-keymap nil-keys)
"Call FUNCTION for all keys in hash table KEYMAP.
This is different from `map-keymap' because it sends keys instead
of events, and recurses into keymaps.
If ORIGINAL is :setcdr, use `ergoemacs-setdcdr' to modify the
subkeymaps to have the original keymaps.
If ORIGINAL is non-nil, use the original keys in all submaps, but
don't modify the sub-keymaps.
If ORIGINAL is nil, use the subkeymaps as they stand.
This function is called recursively, so PREFIX represents the
prefix key that is being explored in the keymap.
When non-nil, FLAT-KEYMAP will changed a composed keymap, or a
keymap with parent to a un-composed keymap without any parent keymaps.
NIL-KEYS is a list of keys that are defined as nil. This allows
them to be masked when mapping over the keymap."
(let ((flat-keymap (or flat-keymap
(if (ergoemacs-map-properties--all-sparse-p keymap)
(make-sparse-keymap)
(make-keymap))))
composed-list
parent
;; calc-parent-p
prefix-map
tmp)
(when (not prefix)
(setq ergoemacs-map-keymap--map-submap-last-map nil))
(when (ergoemacs-keymapp keymap)
(map-keymap
(lambda(event item)
(let ((key (or (and (consp event)
(cons (vconcat prefix (vector (car event)))
(vconcat prefix (vector (cdr event)))))
(vconcat prefix (or (and (stringp event) event)
(vector event))))))
(cond
((and (not (consp event));; Defined as nil.
(member key nil-keys)))
((and (not (consp event))
(setq tmp (lookup-key flat-keymap key))
(not (integerp tmp)))
;; Already defined; don't define again.
)
((and (consp event) (ergoemacs-keymapp item))
;; Unclear what to do here...
)
((ergoemacs-keymapp item)
(when function
(funcall function key 'ergoemacs-prefix))
(ergoemacs-map-keymap--map-submap item function original key flat-keymap nil-keys)
;; (unless calc-parent-p
(setq composed-list (ergoemacs :composed-list keymap)
parent (keymap-parent keymap)) ;;)
(if composed-list
(dolist (map composed-list)
(when (and (ergoemacs-keymapp map)
(setq prefix-map (lookup-key map key))
(ergoemacs-keymapp prefix-map))
(ergoemacs-map-keymap--map-submap prefix-map function original key flat-keymap nil-keys)))
(unwind-protect
(progn
(when parent
(set-keymap-parent keymap nil))
(when (and (ergoemacs-keymapp prefix-map)
(setq prefix-map (lookup-key keymap key))
(ergoemacs-keymapp prefix-map))
(ergoemacs-map-keymap--map-submap prefix-map function original key flat-keymap nil-keys)))
(when parent
(set-keymap-parent keymap parent))))
(when parent
(when (and (ergoemacs-keymapp parent)
(setq prefix-map (lookup-key parent key))
(ergoemacs-keymapp prefix-map))
(ergoemacs-map-keymap--map-submap prefix-map function original key flat-keymap nil-keys))))
(t
(when function
(funcall function key item))
(cond
((consp event)
(ergoemacs-map-set-char-table-range
(or (and prefix
(let ((prefix-lookup (lookup-key flat-keymap prefix)))
(if (listp prefix-lookup) prefix-lookup)))
flat-keymap) event item))
(t
(define-key flat-keymap key item)
(unless item
(push key nil-keys))))))))
keymap))
flat-keymap))
(provide 'ergoemacs-mapkeymap)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ergoemacs-mapkeymap.el ends here
;; Local Variables:
;; coding: utf-8-emacs
;; End: