lisp/cedet/srecode/extract.el

   1 ;;; srecode/extract.el --- Extract content from previously inserted macro.
   2
   3 ;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Extract content from a previously inserted macro.
  25 ;;
  26 ;; The extraction routines can be handy if you want to extract users
  27 ;; added text from the middle of a template inserted block of text.
  28 ;; This code will not work for all templates.  It will only work for
  29 ;; templates with unique static text between all the different insert
  30 ;; macros.
  31 ;;
  32 ;; That said, it will handle include and section templates, so complex
  33 ;; or deep template calls can be extracted.
  34 ;;
  35 ;; This code was specifically written for srecode-document, which
  36 ;; wants to extract user written text, and re-use it in a reformatted
  37 ;; comment.
  38
  39 (require 'srecode)
  40 (require 'srecode/compile)
  41 (require 'srecode/insert)
  42
  43 ;;; Code:
  44
  45 (defclass srecode-extract-state ()
  46   ((anchor :initform nil
  47            :documentation
  48            "The last known plain-text end location.")
  49    (lastinserter :initform nil
  50                  :documentation
  51                  "The last inserter with 'later extraction type.")
  52    (lastdict :initform nil
  53              :documentation
  54              "The dictionary associated with lastinserter.")
  55    )
  56   "The current extraction state.")
  57
  58 (cl-defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
  59   "Set onto the extract state ST a new inserter INS and dictionary DICT."
  60   (oset st lastinserter ins)
  61   (oset st lastdict dict))
  62
  63 (cl-defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
  64   "Reset the anchor point on extract state ST."
  65   (oset st anchor (point)))
  66
  67 (cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
  68                                           endpoint)
  69   "Perform an extraction on the extract state ST with ENDPOINT.
  70 If there was no waiting inserter, do nothing."
  71   (when (oref st lastinserter)
  72     (save-match-data
  73       (srecode-inserter-extract (oref st lastinserter)
  74                                 (oref st anchor)
  75                                 endpoint
  76                                 (oref st lastdict)
  77                                 st))
  78     ;; Clear state.
  79     (srecode-extract-state-set st nil nil)))
  80
  81 ;;; Extraction
  82 ;l
  83 (defun srecode-extract (template start end)
  84   "Extract TEMPLATE from between START and END in the current buffer.
  85 Uses TEMPLATE's constant strings to break up the text and guess what
  86 the dictionary entries were for that block of text."
  87   (save-excursion
  88     (save-restriction
  89       (narrow-to-region start end)
  90       (let ((dict (srecode-create-dictionary t))
  91             (state (srecode-extract-state "state"))
  92             )
  93         (goto-char start)
  94         (srecode-extract-method template dict state)
  95         dict))))
  96
  97 (cl-defmethod srecode-extract-method ((st srecode-template) dictionary
  98                                    state)
  99   "Extract template ST and store extracted text in DICTIONARY.
 100 Optional STARTRETURN is a symbol in which the start of the first
 101 plain-text match occurred."
 102   (srecode-extract-code-stream (oref st code) dictionary state))
 103
 104 (defun srecode-extract-code-stream (code dictionary state)
 105   "Extract CODE from buffer text into DICTIONARY.
 106 Uses string constants in CODE to split up the buffer.
 107 Uses STATE to maintain the current extraction state."
 108   (while code
 109     (cond
 110
 111      ;; constant strings need mark the end of old inserters that
 112      ;; need to extract values, or are just there.
 113      ((stringp (car code))
 114       (srecode-extract-state-set-anchor state)
 115       ;; When we have a string, find it in the collection, then extract
 116       ;; that start point as the end point of the inserter
 117       (unless (re-search-forward (regexp-quote (car code))
 118                                  (point-max) t)
 119         (error "Unable to extract all dictionary entries"))
 120
 121       (srecode-extract-state-extract state (match-beginning 0))
 122       (goto-char (match-end 0))
 123       )
 124
 125      ;; Some inserters are simple, and need to be extracted after
 126      ;; we find our next block of static text.
 127      ((eq (srecode-inserter-do-extract-p (car code)) 'later)
 128       (srecode-extract-state-set state (car code) dictionary)
 129       )
 130
 131      ;; Some inserter want to start extraction now, such as sections.
 132      ;; We can't predict the end point till we parse out the middle.
 133      ((eq (srecode-inserter-do-extract-p (car code)) 'now)
 134       (srecode-extract-state-set-anchor state)
 135       (srecode-inserter-extract (car code) (point) nil dictionary state))
 136      )
 137     (setq code (cdr code))
 138     ))
 139
 140 ;;; Inserter Base Extractors
 141 ;;
 142 (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
 143   "Return non-nil if this inserter can extract values."
 144   nil)
 145
 146 (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
 147                                      start end dict state)
 148   "Extract text from START/END and store in DICT.
 149 Return nil as this inserter will extract nothing."
 150   nil)
 151
 152 ;;; Variable extractor is simple and can extract later.
 153 ;;
 154 (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
 155   "Return non-nil if this inserter can extract values."
 156   'later)
 157
 158 (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
 159                                      start end vdict state)
 160   "Extract text from START/END and store in VDICT.
 161 Return t if something was extracted.
 162 Return nil if this inserter doesn't need to extract anything."
 163   (srecode-dictionary-set-value vdict
 164                                 (oref ins :object-name)
 165                                 (buffer-substring-no-properties
 166                                  start end)
 167                                 )
 168   t)
 169
 170 ;;; Section Inserter
 171 ;;
 172 (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
 173   "Return non-nil if this inserter can extract values."
 174   'now)
 175
 176 (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
 177                                      start end indict state)
 178   "Extract text from START/END and store in INDICT.
 179 Return the starting location of the first plain-text match.
 180 Return nil if nothing was extracted."
 181   (let ((name (oref ins :object-name))
 182         (subdict (srecode-create-dictionary indict))
 183         (allsubdict nil)
 184         )
 185
 186     ;; Keep extracting till we can extract no more.
 187     (while (condition-case nil
 188                (progn
 189                  (srecode-extract-method
 190                   (oref ins template) subdict state)
 191                  t)
 192              (error nil))
 193
 194       ;; Success means keep this subdict, and also make a new one for
 195       ;; the next iteration.
 196       (setq allsubdict (cons subdict allsubdict))
 197       (setq subdict (srecode-create-dictionary indict))
 198       )
 199
 200     (srecode-dictionary-set-value indict name (nreverse allsubdict))
 201
 202     nil))
 203
 204 ;;; Include Extractor must extract now.
 205 ;;
 206 (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
 207   "Return non-nil if this inserter can extract values."
 208   'now)
 209
 210 (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
 211                                      start end dict state)
 212   "Extract text from START/END and store in DICT.
 213 Return the starting location of the first plain-text match.
 214 Return nil if nothing was extracted."
 215   (goto-char start)
 216   (srecode-insert-include-lookup ins dict)
 217   ;; There are two modes for includes.  One is with no dict,
 218   ;; so it is inserted straight.  If the dict has a name, then
 219   ;; we need to run once per dictionary occurrence.
 220   (if (not (string= (oref ins :object-name) ""))
 221       ;; With a name, do the insertion.
 222       (let ((subdict (srecode-dictionary-add-section-dictionary
 223                       dict (oref ins :object-name))))
 224         (error "Need to implement include w/ name extractor")
 225         ;; Recurse into the new template while no errors.
 226         (while (condition-case nil
 227                    (progn
 228                      (srecode-extract-method
 229                       (oref ins includedtemplate) subdict
 230                       state)
 231                      t)
 232                  (error nil))))
 233
 234     ;; No stream, do the extraction into the current dictionary.
 235     (srecode-extract-method (oref ins includedtemplate) dict
 236                             state))
 237   )
 238
 239
 240 (provide 'srecode/extract)
 241
 242 ;;; srecode/extract.el ends here