Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
1f2a6224
Commit
1f2a6224
authored
Jul 07, 2009
by
Dmitry Dzhus
Browse files
Removed fadr.el.
parent
28d67a53
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
2 additions
and
162 deletions
+2
-162
lisp/ChangeLog
lisp/ChangeLog
+2
-0
lisp/fadr.el
lisp/fadr.el
+0
-162
No files found.
lisp/ChangeLog
View file @
1f2a6224
2009-07-07 Dmitry Dzhus <dima@sphinx.net.ru>
* fadr.el: Removed.
* progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el
(gdb-memory-address): New variable which holds top address of
memory page shown in memory buffer
...
...
lisp/fadr.el
deleted
100644 → 0
View file @
28d67a53
;;; fadr.el --- convenient access to recursive list structures
;; Copyright (C) 2009 Free Software Foundation, Inc.
;; Author: Dmitry Dzhus <dima@sphinx.net.ru>
;; Keywords: lisp, internal
;; 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 of the License, 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/>.
;;; Commentary:
;; This code allows accessing data stored in recursive association and
;; plain lists using a compact notation.
;;
;; Consider the following list:
;;
;; (setq basket '((apples . (((color . green) (taste . delicious)) ((color . red) (taste . disgusting))))))
;;
;; Its contents may be accessed using `fadr-member':
;;
;; (fadr-member basket ".apples[1].color")
;; red
;;
;; Associated values are selected using a dot followed by a key, while
;; lists accept an index (0-based) in square brackets.
;;
;; `fadr-q' is a one-argument shortcut fro `fadr-member', where
;; (fadr-q "res.path") results to (fadr-member res ".path"):
;;
;; (fadr-q "basket.apples[0].taste")
;; delicious
;;
;; `fadr-expand' substitutes ~PATH with results of `fadr-member' calls
;; with respective arguments:
;;
;; (fadr-expand "~.color apple is ~.taste" (fadr-member basket ".apples[0]"))
;; "green apple is delicious"
;;
;; `fadr-format' is like `fadr-expand', but it performs %-substitutions first:
;;
;; (fadr-format "%s #%d is ~.color and ~.taste" (fadr-member basket ".apples[1]") "Apple" 1)
;; "Apple #1 is red and disgusting"
;;; Code:
(
defun
fadr-get-field-value
(
field
object
)
"Get value of FIELD from OBJECT.
FIELD is a symbol."
(
cdr
(
assoc
field
object
)))
(
defsubst
bol-regexp
(
regexp
)
(
concat
"^"
regexp
))
(
defconst
fadr-field-name-regexp
"[[:alpha:]_-]+"
)
(
defconst
fadr-field-selector-regexp
(
concat
"\\.\\("
fadr-field-name-regexp
"\\)"
))
(
defconst
fadr-index-selector-regexp
"\\[\\([[:digit:]]+\\)\\]"
)
(
defconst
fadr-path-regexp
(
concat
"\\("
fadr-field-selector-regexp
"\\|"
fadr-index-selector-regexp
"\\)+"
))
(
defmacro
fadr-define-select
(
name
regexp
&optional
doc
filter
)
"Define a function NAME of one string argument which will
extract data from it using the first subgroup in REGEXP. If
FILTER is specified, it will be called with the resulting string."
`
(
defun
,
name
(
path
)
,
doc
(
let
((
string
(
if
(
string-match
,
regexp
path
)
(
match-string-no-properties
1
path
)
nil
)))
(
if
string
,
(
if
filter
`
(
funcall
,
filter
string
)
'string
)
nil
))))
(
fadr-define-select
fadr-index-select
(
bol-regexp
fadr-index-selector-regexp
)
"Extract name of the next field selected in PATH as a symbol."
'string-to-number
)
;; Bad case: (fadr-field-select ".nil")
(
fadr-define-select
fadr-field-select
(
bol-regexp
fadr-field-selector-regexp
)
"Extract value of the next list index selected in PATH as a
number."
'intern
)
;; TODO: define this function using macros to ease the adding of new
;; selector types
(
defun
fadr-member
(
object
path
)
"Access data in OBJECT using PATH.
This function is not match-safe, meaning that you may need to
wrap a call to it with `save-match-data'."
(
if
(
string=
path
""
)
object
(
let
((
index
(
fadr-index-select
path
))
(
field
(
fadr-field-select
path
)))
(
cond
(
index
(
fadr-member
(
elt
object
index
)
(
fadr-peel-path
path
)))
(
field
(
fadr-member
(
fadr-get-field-value
field
object
)
(
fadr-peel-path
path
)))
(
t
(
error
"Bad path"
))))))
(
defun
fadr-q
(
full-path
)
(
catch
'bad-path
(
if
(
string-match
fadr-path-regexp
full-path
)
(
if
(
not
(
=
(
match-beginning
0
)
0
))
(
let
((
object
(
eval
(
intern
(
substring
full-path
0
(
match-beginning
0
)))))
(
path
(
substring
full-path
(
match-beginning
0
))))
(
fadr-member
object
path
))
(
throw
'bad-path
(
error
"No object specified"
)))
(
throw
'bad-path
(
error
"Incorrect path"
)))))
(
defun
fadr-peel-path
(
path
)
"Return PATH without first selector."
(
cond
((
fadr-field-select
path
)
(
string-match
(
bol-regexp
fadr-field-selector-regexp
)
path
))
((
fadr-index-select
path
)
(
string-match
(
bol-regexp
fadr-index-selector-regexp
)
path
))
(
t
(
error
"Could not peel path"
)))
(
substring
path
(
match-end
0
)))
(
defun
fadr-expand
(
string
object
)
"Format STRING using OBJECT members.
All ~.<path> substrings within STRING are replaced with
respective values of OBJECT members."
(
replace-regexp-in-string
(
concat
"~\\("
fadr-path-regexp
"\\)"
)
#'
(
lambda
(
text
)
(
save-match-data
(
format
"%s"
(
fadr-member
object
(
substring
text
1
)))))
string
))
(
defun
fadr-format
(
string
object
&rest
objects
)
"Format STRING with OBJECTS, then `fadr-expand' the result with OBJECT."
(
let
((
new-string
(
apply
'format
(
append
(
list
string
)
objects
))))
(
fadr-expand
new-string
object
)))
(
provide
'fadr
)
;; arch-tag: 4edced02-a5c3-4516-b278-3f85a12146ea
;;; fadr.el ends here
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment