annotate lisp/cedet/ede/linux.el @ 105799:3fe6da4a95a9

* cedet/srecode/srt-mode.el (semantic-analyze-possible-completions): * cedet/semantic/symref/list.el (semantic-symref-rb-toggle-expand-tag): * cedet/semantic/symref/grep.el (semantic-symref-perform-search): * cedet/semantic/bovine/gcc.el (semantic-gcc-query): * cedet/semantic/bovine/c.el (semantic-c-parse-lexical-token): * cedet/semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons) (semantic-analyzer-debug-global-symbol) (semantic-analyzer-debug-missing-innertype) (semantic-analyzer-debug-insert-include-summary): * cedet/semantic/util.el (semantic-file-tag-table): (semantic-describe-buffer-var-helper, semantic-something-to-tag-table) (semantic-recursive-find-nonterminal-by-name): * cedet/semantic/tag-ls.el (semantic-tag-calculate-parent-default): * cedet/semantic/tag-file.el (semantic-prototype-file): * cedet/semantic/symref.el (semantic-symref-parse-tool-output): * cedet/semantic/sb.el (semantic-sb-fetch-tag-table): * cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): * cedet/semantic/idle.el (semantic-idle-work-for-one-buffer): (semantic-idle-summary-maybe-highlight): * cedet/semantic/ia-sb.el (semantic-ia-speedbar) (semantic-ia-sb-tag-info): * cedet/semantic/grammar.el (semantic-analyze-possible-completions): * cedet/semantic/find.el (semantic-brute-find-tag-by-position): * cedet/semantic/ede-grammar.el (project-compile-target): (ede-proj-makefile-insert-variables): * cedet/semantic/debug.el (semantic-debug-set-parser-location): (semantic-debug-set-source-location, semantic-debug-interface-layout) (semantic-debug-mode, semantic-debug): * cedet/semantic/db.el (semanticdb-needs-refresh-p): * cedet/semantic/db-typecache.el (semanticdb-typecache-refresh-for-buffer): * cedet/semantic/db-javascript.el (semanticdb-equivalent-mode): * cedet/semantic/db-find.el (semanticdb-find-log-new-search) (semanticdb-find-translate-path-includes--internal) (semanticdb-reset-log, semanticdb-find-log-activity): * cedet/semantic/db-file.el (object-write): * cedet/semantic/db-el.el (semanticdb-equivalent-mode): * cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-C-file-p) (semanticdb-create-ebrowse-database): * cedet/semantic/db-debug.el (semanticdb-table-sanity-check): * cedet/semantic/complete.el (semantic-displayor-focus-request) (semantic-collector-calculate-completions-raw) (semantic-complete-read-tag-analyzer): * cedet/semantic/analyze.el (semantic-analyze-pulse): * cedet/ede/util.el (ede-update-version-in-source): * cedet/ede/proj.el (project-delete-target): * cedet/ede/proj-elisp.el (ede-update-version-in-source) (ede-proj-flush-autoconf): * cedet/ede/pconf.el (ede-proj-configure-synchronize) (ede-proj-configure-synchronize): * cedet/ede/locate.el (ede-locate-file-in-project-impl): * cedet/ede/linux.el (ede-linux-version): * cedet/ede/emacs.el (ede-emacs-version): * cedet/ede/dired.el (ede-dired-add-to-target): * cedet/ede.el (ede-buffer-header-file, ede-find-target) (ede-buffer-documentation-files, ede-project-buffers, ede-set) (ede-target-buffers, ede-buffers, ede-make-project-local-variable): * cedet/cedet-idutils.el (cedet-idutils-fnid-call): (cedet-idutils-lid-call, cedet-idutils-expand-filename) (cedet-idutils-version-check): * cedet/cedet-global.el (cedet-gnu-global-call): (cedet-gnu-global-expand-filename, cedet-gnu-global-root) (cedet-gnu-global-version-check, cedet-gnu-global-scan-hits): * cedet/cedet-cscope.el (cedet-cscope-call) (cedet-cscope-expand-filename, cedet-cscope-version-check): Use with-current-buffer. * cedet/ede.el (ede-make-project-local-variable) (ede-set-project-variables, ede-set): Use dolist.

;;; ede/linux.el --- Special project for Linux

;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <[e-mail]>

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Provide a special project type just for Linux, cause Linux is special.
;;
;; Identifies a Linux project automatically.
;; Speedy ede-expand-filename based on extension.
;; Pre-populates the preprocessor map from lisp.h
;;
;; ToDo :
;; * Add "build" options.
;; * Add texinfo lookup options.
;; * Add website

(require 'ede)
(declare-function semanticdb-file-table-object "semantic/db")
(declare-function semanticdb-needs-refresh-p "semantic/db")
(declare-function semanticdb-refresh-table "semantic/db")

;;; Code:
(defvar ede-linux-project-list nil
  "List of projects created by option `ede-linux-project'.")

(defun ede-linux-file-existing (dir)
  "Find a Linux project in the list of Linux projects.
DIR is the directory to search from."
  (let ((projs ede-linux-project-list)
	(ans nil))
    (while (and projs (not ans))
      (let ((root (ede-project-root-directory (car projs))))
	(when (string-match (concat "^" (regexp-quote root)) dir)
	  (setq ans (car projs))))
      (setq projs (cdr projs)))
    ans))

;;;###autoload
(defun ede-linux-project-root (&optional dir)
  "Get the root directory for DIR."
  (when (not dir) (setq dir default-directory))
  (let ((case-fold-search t)
	(proj (ede-linux-file-existing dir)))
    (if proj
	(ede-up-directory (file-name-directory
			   (oref proj :file)))
      ;; No pre-existing project.  Lets take a wild-guess if we have
      ;; an Linux project here.
      (when (string-match "linux[^/]*" dir)
	(let ((base (substring dir 0 (match-end 0))))
	  (when (file-exists-p (expand-file-name "scripts/ver_linux" base))
	      base))))))

(defun ede-linux-version (dir)
  "Find the Linux version for the Linux src in DIR."
  (let ((buff (get-buffer-create " *linux-query*")))
    (with-current-buffer buff
      (erase-buffer)
      (setq default-directory (file-name-as-directory dir))
      (insert-file-contents "Makefile" nil 0 512)
      (goto-char (point-min))
      (let (major minor sub)
	(re-search-forward "^VERSION *= *\\([0-9.]+\\)")
	(setq major (match-string 1))
	(re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)")
	(setq minor (match-string 1))
	(re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)")
	(setq sub (match-string 1))
	(prog1
	    (concat major "." minor "." sub)
	  (kill-buffer buff)
	  )))))

(defclass ede-linux-project (ede-project eieio-instance-tracker)
  ((tracking-symbol :initform 'ede-linux-project-list)
   )
  "Project Type for the Linux source code."
  :method-invocation-order :depth-first)

(defun ede-linux-load (dir &optional rootproj)
  "Return an Linux Project object if there is a match.
Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
  (or (ede-linux-file-existing dir)
      ;; Doesn't already exist, so lets make one.
      (ede-linux-project "Linux"
			 :name "Linux"
			 :version (ede-linux-version dir)
			 :directory (file-name-as-directory dir)
			 :file (expand-file-name "scripts/ver_linux"
						 dir))
      (ede-add-project-to-global-list this)
      )
  )

(defclass ede-linux-target-c (ede-target)
  ()
  "EDE Linux Project target for C code.
All directories need at least one target.")

(defclass ede-linux-target-misc (ede-target)
  ()
  "EDE Linux Project target for Misc files.
All directories need at least one target.")

(defmethod initialize-instance ((this ede-linux-project)
				&rest fields)
  "Make sure the :file is fully expanded."
  (call-next-method)
  (unless (slot-boundp this 'targets)
    (oset this :targets nil)))

;;; File Stuff
;;
(defmethod ede-project-root-directory ((this ede-linux-project)
				       &optional file)
  "Return the root for THIS Linux project with file."
  (ede-up-directory (file-name-directory (oref this file))))

(defmethod ede-project-root ((this ede-linux-project))
  "Return my root."
  this)

(defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
					      dir)
  "Return PROJ, for handling all subdirs below DIR."
  proj)

;;; TARGET MANAGEMENT
;;
(defun ede-linux-find-matching-target (class dir targets)
  "Find a target that is a CLASS and is in DIR in the list of TARGETS."
  (let ((match nil))
    (dolist (T targets)
      (when (and (object-of-class-p T class)
		 (string= (oref T :path) dir))
	(setq match T)
      ))
    match))

(defmethod ede-find-target ((proj ede-linux-project) buffer)
  "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
  (let* ((ext (file-name-extension (buffer-file-name buffer)))
	 (cls (cond ((not ext)
		     'ede-linux-target-misc)
		    ((string-match "c\\|h" ext)
		     'ede-linux-target-c)
		    (t 'ede-linux-target-misc)))
	 (targets (oref proj targets))
	 (dir default-directory)
	 (ans (ede-linux-find-matching-target cls dir targets))
	 )
    (when (not ans)
      (setq ans (make-instance
		 cls
		 :name (file-name-nondirectory
			(directory-file-name dir))
		 :path dir
		 :source nil))
      (object-add-to-list proj :targets ans)
      )
    ans))

;;; UTILITIES SUPPORT.
;;
(defmethod ede-preprocessor-map ((this ede-linux-target-c))
  "Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!"
  (require 'semantic/db)
  (let* ((proj (ede-target-parent this))
	 (root (ede-project-root proj))
	 (versionfile (ede-expand-filename root "include/linux/version.h"))
	 (table (when (and versionfile (file-exists-p versionfile))
		  (semanticdb-file-table-object versionfile)))
	 (filemap '( ("__KERNEL__" . "")
		     ))
	 )
    (when table
      (when (semanticdb-needs-refresh-p table)
	(semanticdb-refresh-table table))
      (setq filemap (append filemap (oref table lexical-table)))
      )
    filemap
    ))

(defun ede-linux-file-exists-name (name root subdir)
  "Return a file name if NAME exists under ROOT with SUBDIR in between."
  (let ((F (expand-file-name name (expand-file-name subdir root))))
    (when (file-exists-p F) F)))

(defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
  "Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
  (let* ((ext (file-name-extension name))
	 (root (ede-project-root proj))
	 (dir (ede-project-root-directory root))
	 (F (cond
	     ((not ext) nil)
	     ((string-match "h" ext)
	      (or (ede-linux-file-exists-name name dir "")
		  (ede-linux-file-exists-name name dir "include"))
	      )
	     ((string-match "txt" ext)
	      (ede-linux-file-exists-name name dir "Documentation"))
	     (t nil)))
	 )
    (or F (call-next-method))))

(provide 'ede/linux)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-feature: ede/loaddefs
;; generated-autoload-load-name: "ede/linux"
;; End:

;; arch-tag: 41f310c8-b169-4259-8a2d-0ff4bd0a736d
;;; ede/linux.el ends here