aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDmitry Dzhus2009-07-07 17:08:20 +0000
committerDmitry Dzhus2009-07-07 17:08:20 +0000
commit1f2a62248ca7d165f54a5307f280cd569d8273c3 (patch)
tree43f948396f48d809ca32ece8907212f2db0d7a35
parent28d67a53c593aedadae730262b84366c4bb76b56 (diff)
downloademacs-1f2a62248ca7d165f54a5307f280cd569d8273c3.tar.gz
emacs-1f2a62248ca7d165f54a5307f280cd569d8273c3.zip
Removed fadr.el.
-rw-r--r--lisp/ChangeLog2
-rw-r--r--lisp/fadr.el162
2 files changed, 2 insertions, 162 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 60dd6ac29a6..1e4d263a351 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
12009-07-07 Dmitry Dzhus <dima@sphinx.net.ru> 12009-07-07 Dmitry Dzhus <dima@sphinx.net.ru>
2 2
3 * fadr.el: Removed.
4
3 * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el 5 * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el
4 (gdb-memory-address): New variable which holds top address of 6 (gdb-memory-address): New variable which holds top address of
5 memory page shown in memory buffer 7 memory page shown in memory buffer
diff --git a/lisp/fadr.el b/lisp/fadr.el
deleted file mode 100644
index 0ffbef43ec1..00000000000
--- a/lisp/fadr.el
+++ /dev/null
@@ -1,162 +0,0 @@
1;;; fadr.el --- convenient access to recursive list structures
2
3;; Copyright (C) 2009 Free Software Foundation, Inc.
4
5;; Author: Dmitry Dzhus <dima@sphinx.net.ru>
6;; Keywords: lisp, internal
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;; This code allows accessing data stored in recursive association and
24;; plain lists using a compact notation.
25;;
26;; Consider the following list:
27;;
28;; (setq basket '((apples . (((color . green) (taste . delicious)) ((color . red) (taste . disgusting))))))
29;;
30;; Its contents may be accessed using `fadr-member':
31;;
32;; (fadr-member basket ".apples[1].color")
33;; red
34;;
35;; Associated values are selected using a dot followed by a key, while
36;; lists accept an index (0-based) in square brackets.
37;;
38;; `fadr-q' is a one-argument shortcut fro `fadr-member', where
39;; (fadr-q "res.path") results to (fadr-member res ".path"):
40;;
41;; (fadr-q "basket.apples[0].taste")
42;; delicious
43;;
44;; `fadr-expand' substitutes ~PATH with results of `fadr-member' calls
45;; with respective arguments:
46;;
47;; (fadr-expand "~.color apple is ~.taste" (fadr-member basket ".apples[0]"))
48;; "green apple is delicious"
49;;
50;; `fadr-format' is like `fadr-expand', but it performs %-substitutions first:
51;;
52;; (fadr-format "%s #%d is ~.color and ~.taste" (fadr-member basket ".apples[1]") "Apple" 1)
53;; "Apple #1 is red and disgusting"
54
55;;; Code:
56
57(defun fadr-get-field-value (field object)
58 "Get value of FIELD from OBJECT.
59
60FIELD is a symbol."
61 (cdr (assoc field object)))
62
63(defsubst bol-regexp (regexp)
64 (concat "^" regexp))
65(defconst fadr-field-name-regexp
66 "[[:alpha:]_-]+")
67(defconst fadr-field-selector-regexp
68 (concat "\\.\\(" fadr-field-name-regexp "\\)"))
69(defconst fadr-index-selector-regexp
70 "\\[\\([[:digit:]]+\\)\\]")
71(defconst fadr-path-regexp
72 (concat "\\(" fadr-field-selector-regexp "\\|"
73 fadr-index-selector-regexp
74 "\\)+"))
75
76(defmacro fadr-define-select (name regexp &optional doc filter)
77 "Define a function NAME of one string argument which will
78extract data from it using the first subgroup in REGEXP. If
79FILTER is specified, it will be called with the resulting string."
80 `(defun ,name (path)
81 ,doc
82 (let ((string (if (string-match ,regexp path)
83 (match-string-no-properties 1 path)
84 nil)))
85 (if string
86 ,(if filter
87 `(funcall ,filter string)
88 'string)
89 nil))))
90
91(fadr-define-select fadr-index-select
92 (bol-regexp fadr-index-selector-regexp)
93 "Extract name of the next field selected in PATH as a symbol."
94 'string-to-number)
95
96;; Bad case: (fadr-field-select ".nil")
97(fadr-define-select fadr-field-select
98 (bol-regexp fadr-field-selector-regexp)
99 "Extract value of the next list index selected in PATH as a
100 number."
101 'intern)
102
103;; TODO: define this function using macros to ease the adding of new
104;; selector types
105(defun fadr-member (object path)
106 "Access data in OBJECT using PATH.
107
108This function is not match-safe, meaning that you may need to
109wrap a call to it with `save-match-data'."
110 (if (string= path "")
111 object
112 (let ((index (fadr-index-select path))
113 (field (fadr-field-select path)))
114 (cond (index
115 (fadr-member (elt object index)
116 (fadr-peel-path path)))
117 (field
118 (fadr-member (fadr-get-field-value field object)
119 (fadr-peel-path path)))
120 (t (error "Bad path"))))))
121
122(defun fadr-q (full-path)
123 (catch 'bad-path
124 (if (string-match fadr-path-regexp full-path)
125 (if (not (= (match-beginning 0) 0))
126 (let ((object (eval (intern (substring full-path 0 (match-beginning 0)))))
127 (path (substring full-path (match-beginning 0))))
128 (fadr-member object path))
129 (throw 'bad-path (error "No object specified")))
130 (throw 'bad-path (error "Incorrect path")))))
131
132(defun fadr-peel-path (path)
133 "Return PATH without first selector."
134 (cond ((fadr-field-select path)
135 (string-match (bol-regexp fadr-field-selector-regexp) path))
136 ((fadr-index-select path)
137 (string-match (bol-regexp fadr-index-selector-regexp) path))
138 (t (error "Could not peel path")))
139 (substring path (match-end 0)))
140
141(defun fadr-expand (string object)
142 "Format STRING using OBJECT members.
143
144All ~.<path> substrings within STRING are replaced with
145respective values of OBJECT members."
146 (replace-regexp-in-string
147 (concat "~\\(" fadr-path-regexp "\\)")
148 #'(lambda (text)
149 (save-match-data
150 (format "%s"
151 (fadr-member object (substring text 1)))))
152 string))
153
154(defun fadr-format (string object &rest objects)
155 "Format STRING with OBJECTS, then `fadr-expand' the result with OBJECT."
156 (let ((new-string (apply 'format (append (list string) objects))))
157 (fadr-expand new-string object)))
158
159(provide 'fadr)
160
161;; arch-tag: 4edced02-a5c3-4516-b278-3f85a12146ea
162;;; fadr.el ends here