lisp/cedet/srecode/ctxt.el

   1 ;;; srecode/ctxt.el --- Derive a context from the source buffer.
   2
   3 ;; Copyright (C) 2007-2014 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 ;; Manage context calculations for Semantic Recoder.
  25 ;;
  26 ;; SRecode templates are always bound to a context.  By calculating
  27 ;; the current context, we can narrow down the selection of possible
  28 ;; templates to something reasonable.
  29 ;;
  30 ;; Alternately, code here will find a context for templates that
  31 ;; require different pieces of code placed in multiple areas.
  32
  33 (require 'semantic)
  34 (require 'semantic/tag-ls)
  35
  36 (declare-function srecode-dictionary-show-section "srecode/dictionary")
  37 (declare-function srecode-dictionary-set-value "srecode/dictionary")
  38
  39 ;;; Code:
  40
  41 (define-overload srecode-calculate-context ()
  42   "Calculate the context at the current point.
  43 The returned context is a list, with the top-most context first.
  44 Each returned context is a string that would show up in a `context'
  45 statement in an `.srt' file.
  46
  47 Some useful context values used by the provided srecode templates are:
  48   \"file\" - Templates that for a file (such as an empty file.)
  49      \"empty\" - The file is empty
  50   \"declaration\" - Top-level declarations in a file.
  51      \"include\" - In or near include statements
  52      \"package\" - In or near provide statements
  53      \"function\" - In or near function statements
  54          \"NAME\" - Near functions within NAME namespace or class
  55      \"variable\" - In or near variable statements.
  56      \"type\"     - In or near type declarations.
  57      \"comment\"  - In a comment
  58   \"classdecl\" - Declarations within a class/struct/etc.
  59      \"variable\" - In or near class fields
  60      \"function\" - In or near methods/functions
  61         \"virtual\" - Nearby items are virtual
  62            \"pure\" - and those virtual items are pure virtual
  63      \"type\"     - In or near type declarations.
  64      \"comment\"  - In a comment in a block of code
  65      -- these items show up at the end of the context list. --
  66      \"public\", \"protected\", \"private\" -
  67                   In or near a section of public/protected/private entries.
  68   \"code\" - In a block of code.
  69      \"string\" - In a string in a block of code
  70      \"comment\"  - In a comment in a block of code
  71
  72     ... More later."
  73   )
  74
  75 (defun srecode-calculate-nearby-things ()
  76   ;; NOTE: May need to add bounds to this FCN
  77   "Calculate the CONTEXT type items nearby the current point.
  78 Assume that what we want to insert next is based on what is just
  79 before point.  If there is nothing, then assume it is whatever is
  80 after point."
  81   ;; @todo - ADD BOUNDS TO THE PREV/NEXT TAG SEARCH
  82   ;;         thus classdecl "near" stuff cannot be
  83   ;;         outside the bounds of the type in question.
  84   (let ((near (semantic-find-tag-by-overlay-prev))
  85         (prot nil)
  86         (ans nil))
  87     (if (not near)
  88         (setq near (semantic-find-tag-by-overlay-next)))
  89     (when near
  90       ;; Calculate the type of thing we are near.
  91       (if (not (semantic-tag-of-class-p near 'function))
  92           (setq ans (cons (symbol-name (semantic-tag-class near)) ans))
  93         ;; if the symbol NEAR has a parent,
  94         (let ((p (semantic-tag-function-parent near)))
  95           (setq ans (cons (symbol-name (semantic-tag-class near)) ans))
  96           (cond ((semantic-tag-p p)
  97                  (setq ans (cons (semantic-tag-name p) ans)))
  98                 ((stringp p)
  99                  (setq ans (cons p ans)))
 100                 (t nil)))
 101         ;; Was it virtual?
 102         (when (semantic-tag-get-attribute near :virtual)
 103           (setq ans (cons "virtual" ans)))
 104         ;; Was it pure?
 105         (when (semantic-tag-get-attribute near :pure-virtual-flag)
 106           (setq ans (cons "pure" ans)))
 107       )
 108       ;; Calculate the protection
 109       (setq prot (semantic-tag-protection near))
 110       (when (and prot (not (eq prot 'unknown)))
 111         (setq ans (cons (symbol-name prot) ans)))
 112       )
 113     (nreverse ans)))
 114
 115 (defun srecode-calculate-context-font-lock ()
 116   "Calculate an srecode context by using font-lock."
 117   (let ((face (get-text-property (point) 'face))
 118         )
 119     (cond ((member face '(font-lock-string-face
 120                           font-lock-doc-face))
 121            (list "string"))
 122           ((member face '(font-lock-comment-face
 123                           font-lock-comment-delimiter-face))
 124            (list "comment"))
 125           )
 126     ))
 127
 128 (defun srecode-calculate-context-default ()
 129   "Generic method for calculating a context for srecode."
 130   (if (= (point-min) (point-max))
 131       (list "file" "empty")
 132
 133     (semantic-fetch-tags)
 134     (let ((ct (semantic-find-tag-by-overlay))
 135           )
 136       (cond ((or (not ct)
 137                  ;; Ok, below is a bit C specific.
 138                  (and (eq (semantic-tag-class (car ct)) 'type)
 139                       (string= (semantic-tag-type (car ct)) "namespace")))
 140              (cons "declaration"
 141                    (or (srecode-calculate-context-font-lock)
 142                        (srecode-calculate-nearby-things)
 143                        ))
 144              )
 145             ((eq (semantic-tag-class (car ct)) 'function)
 146              (cons "code" (srecode-calculate-context-font-lock))
 147              )
 148             ((eq (semantic-tag-class (car ct)) 'type) ; We know not namespace
 149              (cons "classdecl"
 150                    (or (srecode-calculate-context-font-lock)
 151                        (srecode-calculate-nearby-things)))
 152              )
 153             ((and (car (cdr ct))
 154                   (eq (semantic-tag-class (car (cdr ct))) 'type))
 155              (list "classdecl"
 156                    (symbol-name (semantic-tag-class (car ct))))
 157              )
 158             )
 159       )))
 160
 161 \f
 162 ;;; HANDLERS
 163 ;;
 164 ;; The calculated context is one thing, but more info is often available.
 165 ;; The context handlers can add info into the active dictionary that is
 166 ;; based on the context, such as a method parent name, protection scheme,
 167 ;; or other feature.
 168
 169 (defun srecode-semantic-handle-:ctxt (dict &optional template)
 170   "Add macros into the dictionary DICT based on the current Emacs Lisp file.
 171 Argument TEMPLATE is the template object adding context dictionary
 172 entries.
 173 This might add the following:
 174    VIRTUAL - show a section if a function is virtual
 175    PURE - show a section if a function is pure virtual.
 176    PARENT - The name of a parent type for functions.
 177    PROTECTION - Show a protection section, and what the protection is."
 178   (require 'srecode/dictionary)
 179   (when template
 180
 181     (let ((name (oref template object-name))
 182           (cc (if (boundp 'srecode-insertion-start-context)
 183                   srecode-insertion-start-context))
 184           ;(context (oref template context))
 185           )
 186
 187 ;      (when (and cc
 188 ;                (null (string= (car cc) context))
 189 ;                )
 190 ;       ;; No current context, or the base is different, then
 191 ;       ;; this is the section where we need to recalculate
 192 ;       ;; the context based on user choice, if possible.
 193 ;       ;;
 194 ;       ;; The recalculation is complex, as there are many possibilities
 195 ;       ;; that need to be divined.  Set "cc" to the new context
 196 ;       ;; at the end.
 197 ;       ;;
 198 ;       ;; @todo -
 199 ;
 200 ;       )
 201
 202       ;; The various context all have different features.
 203       (let ((ct (nth 0 cc))
 204             (it (nth 1 cc))
 205             (last (last cc))
 206             (parent nil)
 207             )
 208         (cond ((string= it "function")
 209                (setq parent (nth 2 cc))
 210                (when parent
 211                  (cond ((string= parent "virtual")
 212                         (srecode-dictionary-show-section dict "VIRTUAL")
 213                         (when (nth 3 cc)
 214                           (srecode-dictionary-show-section dict "PURE"))
 215                         )
 216                        (t
 217                         (srecode-dictionary-set-value dict "PARENT" parent))))
 218                )
 219               ((and (string= it "type")
 220                     (or (string= name "function") (string= name "method")))
 221                ;; If we have a type, but we insert a fcn, then use that type
 222                ;; as the function parent.
 223                (let ((near (semantic-find-tag-by-overlay-prev)))
 224                  (when (and near (semantic-tag-of-class-p near 'type))
 225                    (srecode-dictionary-set-value
 226                     dict "PARENT" (semantic-tag-name near))))
 227                )
 228               ((string= ct "code")
 229                ;;(let ((analyzer (semantic-analyze-current-context)))
 230                ;; @todo - Use the analyze to setup things like local
 231                ;;         variables we might use or something.
 232                nil
 233                ;;)
 234                )
 235               (t
 236                nil))
 237         (when (member last '("public" "private" "protected"))
 238           ;; Hey, fancy that, we can do both.
 239           (srecode-dictionary-set-value dict "PROTECTION" parent)
 240           (srecode-dictionary-show-section dict "PROTECTION"))
 241         ))
 242     ))
 243
 244
 245 (provide 'srecode/ctxt)
 246
 247 ;;; srecode/ctxt.el ends here