+++ /dev/null
-;;; 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
projects / emacs.git / commitdiff