lisp/cedet/srecode/find.el

   1 ;;;; srecode/find.el --- Tools for finding templates in the database.
   2
   3 ;; Copyright (C) 2007, 2008, 2009, 2010, 2011 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 ;; Various routines that search through various template tables
  25 ;; in search of the right template.
  26
  27 (require 'srecode/ctxt)
  28 (require 'srecode/table)
  29 (require 'srecode/map)
  30
  31 (declare-function srecode-compile-file "srecode/compile")
  32
  33 ;;; Code:
  34
  35 (defun srecode-table (&optional mode)
  36   "Return the currently active Semantic Recoder table for this buffer.
  37 Optional argument MODE specifies the mode table to use."
  38   (let* ((modeq (or mode major-mode))
  39          (table (srecode-get-mode-table modeq)))
  40
  41     ;; If there isn't one, keep searching backwards for a table.
  42     (while (and (not table) (setq modeq (get-mode-local-parent modeq)))
  43       (setq table (srecode-get-mode-table modeq)))
  44
  45     ;; Last ditch effort.
  46     (when (not table)
  47       (setq table (srecode-get-mode-table 'default)))
  48
  49     table))
  50
  51 ;;; TRACKER
  52 ;;
  53 ;; Template file tracker for between sessions.
  54 ;;
  55 (defun srecode-load-tables-for-mode (mmode &optional appname)
  56   "Load all the template files for MMODE.
  57 Templates are found in the SRecode Template Map.
  58 See `srecode-get-maps' for more.
  59 APPNAME is the name of an application.  In this case,
  60 all template files for that application will be loaded."
  61   (require 'srecode/compile)
  62   (let ((files
  63          (if appname
  64              (apply 'append
  65                     (mapcar
  66                      (lambda (map)
  67                        (srecode-map-entries-for-app-and-mode map appname mmode))
  68                      (srecode-get-maps)))
  69            (apply 'append
  70                   (mapcar
  71                    (lambda (map)
  72                      (srecode-map-entries-for-mode map mmode))
  73                    (srecode-get-maps)))))
  74         )
  75     ;; Don't recurse if we are already the 'default state.
  76     (when (not (eq mmode 'default))
  77       ;; Are we a derived mode?  If so, get the parent mode's
  78       ;; templates loaded too.
  79       (if (get-mode-local-parent mmode)
  80           (srecode-load-tables-for-mode (get-mode-local-parent mmode)
  81                                         appname)
  82         ;; No parent mode, all templates depend on the defaults being
  83         ;; loaded in, so get that in instead.
  84         (srecode-load-tables-for-mode 'default appname)))
  85
  86     ;; Load in templates for our major mode.
  87     (dolist (f files)
  88       (let ((mt (srecode-get-mode-table mmode))
  89             )
  90           (when (or (not mt) (not (srecode-mode-table-find mt (car f))))
  91             (srecode-compile-file (car f)))
  92         ))
  93     ))
  94
  95 ;;; PROJECT
  96 ;;
  97 ;; Find if a template table has a project set, and if so, is the
  98 ;; current buffer in that project.
  99 (defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
 100   "Return non-nil if the table TAB can be used in the current project.
 101 If TAB has a :project set, check that the directories match.
 102 If TAB is nil, then always return t."
 103   (let ((proj (oref tab :project)))
 104     ;; Return t if the project wasn't set.
 105     (if (not proj) t
 106       ;; If the project directory was set, lets check it.
 107       (let ((dd (expand-file-name default-directory))
 108             (projexp (regexp-quote (directory-file-name proj))))
 109         (if (string-match (concat "^" projexp) dd)
 110             t nil)))))
 111
 112 ;;; SEARCH
 113 ;;
 114 ;; Find a given template based on name, and features of the current
 115 ;; buffer.
 116 (defmethod srecode-template-get-table ((tab srecode-template-table)
 117                                        template-name &optional
 118                                        context application)
 119   "Find in the template in table TAB, the template with TEMPLATE-NAME.
 120 Optional argument CONTEXT specifies that the template should part
 121 of a particular context.
 122 The APPLICATION argument is unused."
 123   (when (srecode-template-table-in-project-p tab)
 124     (if context
 125         ;; If a context is specified, then look it up there.
 126         (let ((ctxth (gethash context (oref tab contexthash))))
 127           (when ctxth
 128             (gethash template-name ctxth)))
 129       ;; No context, perhaps a merged name?
 130       (gethash template-name (oref tab namehash)))))
 131
 132 (defmethod srecode-template-get-table ((tab srecode-mode-table)
 133                                        template-name &optional
 134                                        context application)
 135   "Find in the template in mode table TAB, the template with TEMPLATE-NAME.
 136 Optional argument CONTEXT specifies a context a particular template
 137 would belong to.
 138 Optional argument APPLICATION restricts searches to only template tables
 139 belonging to a specific application.  If APPLICATION is nil, then only
 140 tables that do not belong to an application will be searched."
 141   (let* ((mt tab)
 142          (tabs (oref mt :tables))
 143          (ans nil))
 144     (while (and (not ans) tabs)
 145       (let ((app (oref (car tabs) :application)))
 146         (when (or (and (not application) (null app))
 147                   (and application (eq app application)))
 148           (setq ans (srecode-template-get-table (car tabs) template-name
 149                                                 context)))
 150         (setq tabs (cdr tabs))))
 151     (or ans
 152         ;; Recurse to the default.
 153         (when (not (equal (oref tab :major-mode) 'default))
 154           (srecode-template-get-table (srecode-get-mode-table 'default)
 155                                       template-name context application)))))
 156
 157 ;;
 158 ;; Find a given template based on a key binding.
 159 ;;
 160 (defmethod srecode-template-get-table-for-binding
 161   ((tab srecode-template-table) binding &optional context)
 162   "Find in the template name in table TAB, the template with BINDING.
 163 Optional argument CONTEXT specifies that the template should part
 164 of a particular context."
 165   (when (srecode-template-table-in-project-p tab)
 166     (let* ((keyout nil)
 167            (hashfcn (lambda (key value)
 168                       (when (and (slot-boundp value 'binding)
 169                                  (oref value binding)
 170                                  (= (aref (oref value binding) 0) binding))
 171                         (setq keyout key))))
 172            (contextstr (cond ((listp context)
 173                               (car-safe context))
 174                              ((stringp context)
 175                               context)
 176                              (t nil)))
 177            )
 178       (if context
 179           (let ((ctxth (gethash contextstr (oref tab contexthash))))
 180             (when ctxth
 181               ;; If a context is specified, then look it up there.
 182               (maphash hashfcn ctxth)
 183               ;; Context hashes EXCLUDE the context prefix which
 184               ;; we need to include, so concat it here
 185               (when keyout
 186                 (setq keyout (concat contextstr ":" keyout)))
 187               )))
 188       (when (not keyout)
 189         ;; No context, or binding in context.  Try full hash.
 190         (maphash hashfcn (oref tab namehash)))
 191       keyout)))
 192
 193 (defmethod srecode-template-get-table-for-binding
 194   ((tab srecode-mode-table) binding &optional context application)
 195   "Find in the template name in mode table TAB, the template with BINDING.
 196 Optional argument CONTEXT specifies a context a particular template
 197 would belong to.
 198 Optional argument APPLICATION restricts searches to only template tables
 199 belonging to a specific application.  If APPLICATION is nil, then only
 200 tables that do not belong to an application will be searched."
 201   (let* ((mt tab)
 202          (tabs (oref mt :tables))
 203          (ans nil))
 204     (while (and (not ans) tabs)
 205       (let ((app (oref (car tabs) :application)))
 206         (when (or (and (not application) (null app))
 207                   (and application (eq app application)))
 208           (setq ans (srecode-template-get-table-for-binding
 209                      (car tabs) binding context)))
 210         (setq tabs (cdr tabs))))
 211     (or ans
 212         ;; Recurse to the default.
 213         (when (not (equal (oref tab :major-mode) 'default))
 214           (srecode-template-get-table-for-binding
 215            (srecode-get-mode-table 'default) binding context)))))
 216 ;;; Interactive
 217 ;;
 218 ;; Interactive queries into the template data.
 219 ;;
 220 (defvar srecode-read-template-name-history nil
 221   "History for completing reads for template names.")
 222
 223 (defun srecode-all-template-hash (&optional mode hash)
 224   "Create a hash table of all the currently available templates.
 225 Optional argument MODE is the major mode to look for.
 226 Optional argument HASH is the hash table to fill in."
 227   (let* ((mhash (or hash (make-hash-table :test 'equal)))
 228          (mmode (or mode major-mode))
 229          (mp (get-mode-local-parent mmode))
 230          )
 231     ;; Get the parent hash table filled into our current hash.
 232     (when (not (eq mode 'default))
 233       (if mp
 234           (srecode-all-template-hash mp mhash)
 235         (srecode-all-template-hash 'default mhash)))
 236     ;; Load up the hash table for our current mode.
 237     (let* ((mt (srecode-get-mode-table mmode))
 238            (tabs (when mt (oref mt :tables)))
 239            )
 240       (while tabs
 241         ;; Exclude templates for a perticular application.
 242         (when (and (not (oref (car tabs) :application))
 243                    (srecode-template-table-in-project-p (car tabs)))
 244           (maphash (lambda (key temp)
 245                      (puthash key temp mhash)
 246                      )
 247                    (oref (car tabs) namehash)))
 248         (setq tabs (cdr tabs)))
 249       mhash)))
 250
 251 (defun srecode-calculate-default-template-string (hash)
 252   "Calculate the name of the template to use as a DEFAULT.
 253 Templates are read from HASH.
 254 Context into which the template is inserted is calculated
 255 with `srecode-calculate-context'."
 256   (let* ((ctxt (srecode-calculate-context))
 257          (ans (concat (nth 0 ctxt) ":" (nth 1 ctxt))))
 258     (if (gethash ans hash)
 259         ans
 260       ;; No hash at the specifics, at least offer
 261       ;; the prefix for the completing read
 262       (concat (nth 0 ctxt) ":"))))
 263
 264 (defun srecode-read-template-name (prompt &optional initial hist default)
 265   "Completing read for Semantic Recoder template names.
 266 PROMPT is used to query for the name of the template desired.
 267 INITIAL is the initial string to use.
 268 HIST is a history variable to use.
 269 DEFAULT is what to use if the user presses RET."
 270   (srecode-load-tables-for-mode major-mode)
 271   (let* ((hash (srecode-all-template-hash))
 272          (def (or initial
 273                   (srecode-calculate-default-template-string hash))))
 274     (completing-read prompt hash
 275                      nil t def
 276                      (or hist
 277                          'srecode-read-template-name-history))))
 278
 279 (provide 'srecode/find)
 280
 281 ;; arch-tag: 49d18e58-45a0-48f5-92e1-4a1dcd4e36a6
 282 ;;; srecode/find.el ends here