diff options
| author | Dmitry Dzhus | 2009-07-07 17:08:20 +0000 |
|---|---|---|
| committer | Dmitry Dzhus | 2009-07-07 17:08:20 +0000 |
| commit | 1f2a62248ca7d165f54a5307f280cd569d8273c3 (patch) | |
| tree | 43f948396f48d809ca32ece8907212f2db0d7a35 | |
| parent | 28d67a53c593aedadae730262b84366c4bb76b56 (diff) | |
| download | emacs-1f2a62248ca7d165f54a5307f280cd569d8273c3.tar.gz emacs-1f2a62248ca7d165f54a5307f280cd569d8273c3.zip | |
Removed fadr.el.
| -rw-r--r-- | lisp/ChangeLog | 2 | ||||
| -rw-r--r-- | lisp/fadr.el | 162 |
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 @@ | |||
| 1 | 2009-07-07 Dmitry Dzhus <dima@sphinx.net.ru> | 1 | 2009-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 | |||
| 60 | FIELD 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 | ||
| 78 | extract data from it using the first subgroup in REGEXP. If | ||
| 79 | FILTER 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 | |||
| 108 | This function is not match-safe, meaning that you may need to | ||
| 109 | wrap 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 | |||
| 144 | All ~.<path> substrings within STRING are replaced with | ||
| 145 | respective 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 | ||