Function: vhdl-save-cache

vhdl-save-cache is a byte-compiled function defined in vhdl-mode.el.gz.

Signature

(vhdl-save-cache KEY)

Documentation

Save current hierarchy cache to file.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/vhdl-mode.el.gz
(defun vhdl-save-cache (key)
  "Save current hierarchy cache to file."
  (let* ((orig-buffer (current-buffer))
	 (vhdl-project key)
	 (project (vhdl-project-p))
	 (default-directory key)
	 (directory (abbreviate-file-name (vhdl-default-directory)))
	 (file-name (vhdl-resolve-env-variable
		     (vhdl-replace-string
		      (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
		      (concat
		       (subst-char-in-string ?  ?_ (or project "dir"))
		       " " (user-login-name)))))
	 (file-dir-name (expand-file-name file-name directory))
	 (cache-key (or project directory))
	 (key (if project "project" "directory")))
    (unless (file-exists-p (file-name-directory file-dir-name))
      (make-directory (file-name-directory file-dir-name) t))
    (if (not (file-writable-p file-dir-name))
	(progn (vhdl-warning (format "File not writable: \"%s\""
				     (abbreviate-file-name file-dir-name)))
	       (sit-for 2))
      (message "Saving cache: \"%s\"" file-dir-name)
      (set-buffer (find-file-noselect file-dir-name t t))
      (erase-buffer)
      (insert ";; -*- Emacs-Lisp -*-\n\n"
	      ";;; " (file-name-nondirectory file-name)
	      " - design hierarchy cache file for Emacs VHDL Mode "
	      vhdl-version "\n")
      (insert "\n;; " (if project "Project  " "Directory") " : ")
      (if project (insert project) (prin1 directory (current-buffer)))
      (insert "\n;; Saved     : " (format-time-string "%Y-%m-%d %T ")
	      (user-login-name) "\n\n"
	      "\n;; version number\n"
	      "(setq vhdl-cache-version \"" vhdl-version "\")\n"
	      "\n;; " (if project "project" "directory") " name"
	      "\n(setq " key " ")
      (prin1 (or project directory) (current-buffer))
      (insert ")\n")
      (when (member 'hierarchy vhdl-speedbar-save-cache)
	(insert "\n;; entity and architecture cache\n"
		"(vhdl-aput 'vhdl-entity-alist " key " '")
	(print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
	(insert ")\n\n;; configuration cache\n"
		"(vhdl-aput 'vhdl-config-alist " key " '")
	(print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
	(insert ")\n\n;; package cache\n"
		"(vhdl-aput 'vhdl-package-alist " key " '")
	(print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
	(insert ")\n\n;; instantiated entities cache\n"
		"(vhdl-aput 'vhdl-ent-inst-alist " key " '")
	(print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
	(insert ")\n\n;; design units per file cache\n"
		"(vhdl-aput 'vhdl-file-alist " key " '")
	(print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
	(when project
	  (insert ")\n\n;; source directories in project cache\n"
		  "(vhdl-aput 'vhdl-directory-alist " key " '")
	  (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
	(insert ")\n"))
      (when (member 'display vhdl-speedbar-save-cache)
	(insert "\n;; shown design units cache\n"
		"(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
	(print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
	       (current-buffer))
	(insert ")\n"))
      (setq vhdl-updated-project-list
	    (delete cache-key vhdl-updated-project-list))
      (save-buffer)
      (kill-buffer (current-buffer))
      (set-buffer orig-buffer))))