245 lines
8.4 KiB
EmacsLisp
245 lines
8.4 KiB
EmacsLisp
;;; srecode/ctxt.el --- Derive a context from the source buffer. -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
|
||
|
||
;; Author: Eric M. Ludlam <zappo@gnu.org>
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs 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.
|
||
|
||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; Manage context calculations for Semantic Recoder.
|
||
;;
|
||
;; SRecode templates are always bound to a context. By calculating
|
||
;; the current context, we can narrow down the selection of possible
|
||
;; templates to something reasonable.
|
||
;;
|
||
;; Alternately, code here will find a context for templates that
|
||
;; require different pieces of code placed in multiple areas.
|
||
|
||
(require 'semantic)
|
||
(require 'semantic/tag-ls)
|
||
(require 'srecode/dictionary)
|
||
|
||
;;; Code:
|
||
|
||
(define-overloadable-function srecode-calculate-context ()
|
||
"Calculate the context at the current point.
|
||
The returned context is a list, with the top-most context first.
|
||
Each returned context is a string that would show up in a `context'
|
||
statement in an `.srt' file.
|
||
|
||
Some useful context values used by the provided srecode templates are:
|
||
\"file\" - Templates that for a file (such as an empty file.)
|
||
\"empty\" - The file is empty
|
||
\"declaration\" - Top-level declarations in a file.
|
||
\"include\" - In or near include statements
|
||
\"package\" - In or near provide statements
|
||
\"function\" - In or near function statements
|
||
\"NAME\" - Near functions within NAME namespace or class
|
||
\"variable\" - In or near variable statements.
|
||
\"type\" - In or near type declarations.
|
||
\"comment\" - In a comment
|
||
\"classdecl\" - Declarations within a class/struct/etc.
|
||
\"variable\" - In or near class fields
|
||
\"function\" - In or near methods/functions
|
||
\"virtual\" - Nearby items are virtual
|
||
\"pure\" - and those virtual items are pure virtual
|
||
\"type\" - In or near type declarations.
|
||
\"comment\" - In a comment in a block of code
|
||
-- these items show up at the end of the context list. --
|
||
\"public\", \"protected\", \"private\" -
|
||
In or near a section of public/protected/private entries.
|
||
\"code\" - In a block of code.
|
||
\"string\" - In a string in a block of code
|
||
\"comment\" - In a comment in a block of code
|
||
|
||
... More later."
|
||
)
|
||
|
||
(defun srecode-calculate-nearby-things ()
|
||
;; NOTE: May need to add bounds to this FCN
|
||
"Calculate the CONTEXT type items nearby the current point.
|
||
Assume that what we want to insert next is based on what is just
|
||
before point. If there is nothing, then assume it is whatever is
|
||
after point."
|
||
;; @todo - ADD BOUNDS TO THE PREV/NEXT TAG SEARCH
|
||
;; thus classdecl "near" stuff cannot be
|
||
;; outside the bounds of the type in question.
|
||
(let ((near (semantic-find-tag-by-overlay-prev))
|
||
(prot nil)
|
||
(ans nil))
|
||
(if (not near)
|
||
(setq near (semantic-find-tag-by-overlay-next)))
|
||
(when near
|
||
;; Calculate the type of thing we are near.
|
||
(if (not (semantic-tag-of-class-p near 'function))
|
||
(setq ans (cons (symbol-name (semantic-tag-class near)) ans))
|
||
;; if the symbol NEAR has a parent,
|
||
(let ((p (semantic-tag-function-parent near)))
|
||
(setq ans (cons (symbol-name (semantic-tag-class near)) ans))
|
||
(cond ((semantic-tag-p p)
|
||
(setq ans (cons (semantic-tag-name p) ans)))
|
||
((stringp p)
|
||
(setq ans (cons p ans)))
|
||
(t nil)))
|
||
;; Was it virtual?
|
||
(when (semantic-tag-get-attribute near :virtual)
|
||
(setq ans (cons "virtual" ans)))
|
||
;; Was it pure?
|
||
(when (semantic-tag-get-attribute near :pure-virtual-flag)
|
||
(setq ans (cons "pure" ans)))
|
||
)
|
||
;; Calculate the protection
|
||
(setq prot (semantic-tag-protection near))
|
||
(when (and prot (not (eq prot 'unknown)))
|
||
(setq ans (cons (symbol-name prot) ans)))
|
||
)
|
||
(nreverse ans)))
|
||
|
||
(defun srecode-calculate-context-font-lock ()
|
||
"Calculate an srecode context by using font-lock."
|
||
(let ((face (get-text-property (point) 'face))
|
||
)
|
||
(cond ((member face '(font-lock-string-face
|
||
font-lock-doc-face))
|
||
(list "string"))
|
||
((member face '(font-lock-comment-face
|
||
font-lock-comment-delimiter-face))
|
||
(list "comment"))
|
||
)
|
||
))
|
||
|
||
(defun srecode-calculate-context-default ()
|
||
"Generic method for calculating a context for srecode."
|
||
(if (= (point-min) (point-max))
|
||
(list "file" "empty")
|
||
|
||
(semantic-fetch-tags)
|
||
(let ((ct (semantic-find-tag-by-overlay))
|
||
)
|
||
(cond ((or (not ct)
|
||
;; Ok, below is a bit C specific.
|
||
(and (eq (semantic-tag-class (car ct)) 'type)
|
||
(string= (semantic-tag-type (car ct)) "namespace")))
|
||
(cons "declaration"
|
||
(or (srecode-calculate-context-font-lock)
|
||
(srecode-calculate-nearby-things)
|
||
))
|
||
)
|
||
((eq (semantic-tag-class (car ct)) 'function)
|
||
(cons "code" (srecode-calculate-context-font-lock))
|
||
)
|
||
((eq (semantic-tag-class (car ct)) 'type) ; We know not namespace
|
||
(cons "classdecl"
|
||
(or (srecode-calculate-context-font-lock)
|
||
(srecode-calculate-nearby-things)))
|
||
)
|
||
((and (car (cdr ct))
|
||
(eq (semantic-tag-class (car (cdr ct))) 'type))
|
||
(list "classdecl"
|
||
(symbol-name (semantic-tag-class (car ct))))
|
||
)
|
||
)
|
||
)))
|
||
|
||
|
||
;;; HANDLERS
|
||
;;
|
||
;; The calculated context is one thing, but more info is often available.
|
||
;; The context handlers can add info into the active dictionary that is
|
||
;; based on the context, such as a method parent name, protection scheme,
|
||
;; or other feature.
|
||
|
||
(defun srecode-semantic-handle-:ctxt (dict &optional template)
|
||
"Add macros into the dictionary DICT based on the current Emacs Lisp file.
|
||
Argument TEMPLATE is the template object adding context dictionary
|
||
entries.
|
||
This might add the following:
|
||
VIRTUAL - show a section if a function is virtual
|
||
PURE - show a section if a function is pure virtual.
|
||
PARENT - The name of a parent type for functions.
|
||
PROTECTION - Show a protection section, and what the protection is."
|
||
(when template
|
||
|
||
(let ((name (oref template object-name))
|
||
(cc (if (boundp 'srecode-insertion-start-context)
|
||
srecode-insertion-start-context))
|
||
;(context (oref template context))
|
||
)
|
||
|
||
; (when (and cc
|
||
; (null (string= (car cc) context))
|
||
; )
|
||
; ;; No current context, or the base is different, then
|
||
; ;; this is the section where we need to recalculate
|
||
; ;; the context based on user choice, if possible.
|
||
; ;;
|
||
; ;; The recalculation is complex, as there are many possibilities
|
||
; ;; that need to be divined. Set "cc" to the new context
|
||
; ;; at the end.
|
||
; ;;
|
||
; ;; @todo -
|
||
;
|
||
; )
|
||
|
||
;; The various context all have different features.
|
||
(let ((ct (nth 0 cc))
|
||
(it (nth 1 cc))
|
||
(last (last cc))
|
||
(parent nil)
|
||
)
|
||
(cond ((string= it "function")
|
||
(setq parent (nth 2 cc))
|
||
(when parent
|
||
(cond ((string= parent "virtual")
|
||
(srecode-dictionary-show-section dict "VIRTUAL")
|
||
(when (nth 3 cc)
|
||
(srecode-dictionary-show-section dict "PURE"))
|
||
)
|
||
(t
|
||
(srecode-dictionary-set-value dict "PARENT" parent))))
|
||
)
|
||
((and (string= it "type")
|
||
(or (string= name "function") (string= name "method")))
|
||
;; If we have a type, but we insert a fcn, then use that type
|
||
;; as the function parent.
|
||
(let ((near (semantic-find-tag-by-overlay-prev)))
|
||
(when (and near (semantic-tag-of-class-p near 'type))
|
||
(srecode-dictionary-set-value
|
||
dict "PARENT" (semantic-tag-name near))))
|
||
)
|
||
((string= ct "code")
|
||
;;(let ((analyzer (semantic-analyze-current-context)))
|
||
;; @todo - Use the analyze to setup things like local
|
||
;; variables we might use or something.
|
||
nil
|
||
;;)
|
||
)
|
||
(t
|
||
nil))
|
||
(when (member last '("public" "private" "protected"))
|
||
;; Hey, fancy that, we can do both.
|
||
(srecode-dictionary-set-value dict "PROTECTION" parent)
|
||
(srecode-dictionary-show-section dict "PROTECTION"))
|
||
))
|
||
))
|
||
|
||
|
||
(provide 'srecode/ctxt)
|
||
|
||
;;; srecode/ctxt.el ends here
|