From 7e410a21d54ad810ce49e88d84f15f1e5e5481be Mon Sep 17 00:00:00 2001 From: grischka Date: Mon, 24 Mar 2008 17:50:29 +0100 Subject: [PATCH] eproject-0.1 --- eproject-config.el | 838 ++++++++++++++++++++++++++++++++++++++++ eproject.cfg | 44 +++ eproject.el | 1076 ++++++++++++++++++++++++++++++++++++++++++++++++++++ eproject.txt | 165 ++++++++ 4 files changed, 2123 insertions(+) create mode 100644 eproject-config.el create mode 100644 eproject.cfg create mode 100644 eproject.el create mode 100644 eproject.txt diff --git a/eproject-config.el b/eproject-config.el new file mode 100644 index 0000000..23f79a3 --- /dev/null +++ b/eproject-config.el @@ -0,0 +1,838 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; eproject-config.el --- project workspaces for emacs --- UI part +;; +;; Copyright (C) 2008 grischka +;; +;; Author: grischka -- grischka@users.sourceforge.net +;; Created: 24 Jan 2008 +;; Version: 0.1 +;; +;; This program is free software, released under the GNU General +;; Public License (GPL, version 2). For details see: +;; +;; http://www.fsf.org/licenses/gpl.html +;; +;; This program 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. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; buffer +(defvar prj-buffer nil) +;; keymap +(defvar prj-browse-map nil) +;; overlays +(defvar prj-hilight-bar nil) +(defvar prj-hilight-bar-2 nil) +;; flag +(defvar prj-edit-mode nil) + +;; tabs +(defvar prj-groups) +(defvar prj-active-group nil) +(defvar prj-group-top nil) +(defvar prj-group-left nil) +(defvar prj-group-tab nil) + +;; tab menus +(defvar prj-links) + +;; quick search +(defvar prj-qs-face nil) +(defvar prj-qs-str nil) +(defvar prj-qs-len nil) +(defvar prj-qs-pos nil) + +;; from eproject.el +(defvar prj-list) +(defvar prj-current) +(defvar prj-files) +(defvar prj-curfile) +(defvar prj-config) +(defvar prj-tools) +;; also +(declare-function prj-setconfig "eproject") +(declare-function prj-getconfig "eproject") +(declare-function prj-setup-all "eproject") +(declare-function prj-remove-file "eproject") +(declare-function caddr "eproject") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro p-get (e) + `(plist-get ,(car e) ',(cdr e)) + ) +(defmacro p-set (e v) + `(plist-put ,(car e) ',(cdr e) ,v) + ) +(defmacro p-call (e &rest args) + `(funcall (plist-get ,(car e) ',(cdr e)) ,@args) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Show/Hide the *eproject* buffer + +(defun eproject-setup () + "Show the configuration buffer." + (interactive) + (let ((map (make-keymap))) + + (substitute-key-definition + 'self-insert-command + 'prj-qsearch + map + global-map + ) + + (dolist (k '( + ("\t" . prj-next-button) + ([tab] . prj-next-button) + ("\e\t" . prj-prev-button) + ([S-tab] . prj-prev-button) + ([backtab] . prj-prev-button) + + ([left] . prj-move-left) + ([right] . prj-move-right) + ([backspace] . prj-qsearch) + ([delete] . prj-qsearch) + ([127] . prj-qsearch) + ([return] . prj-enter) + + ([32] . eproject-edit) + ([escape] . eproject-setup-quit) + + ([down-mouse-1] . prj-mouse) + ([down-mouse-2] . prj-mouse) + ([mouse-1] . prj-mouse) + ([mouse-2] . prj-mouse) + ([mouse-3] . ignore) + ([drag-mouse-1] . ignore) + )) + (define-key map (car k) (cdr k)) + ) + + (cond ((buffer-live-p prj-buffer) + (switch-to-buffer prj-buffer) + ) + (t + (unless prj-buffer + (add-hook 'post-command-hook 'prj-post-command-hook) + ) + (prj-config-init) + (setq prj-buffer (get-buffer-create "*eproject*")) + (switch-to-buffer prj-buffer) + )) + + (setq prj-browse-map map) + (prj-qs-clear) + (unless prj-edit-mode + (use-local-map map) + (prj-config-print) + ) + )) + +(defun eproject-setup-quit () + "Kill the configuration buffer." + (interactive) + (let ((alive (buffer-live-p prj-buffer))) + (cond ((and alive prj-edit-mode) + (bury-buffer prj-buffer) + ) + (t + (when alive + (kill-buffer prj-buffer) + ) + (remove-hook 'post-command-hook 'prj-post-command-hook) + (setq prj-buffer nil) + )))) + +(defun eproject-setup-toggle () + "Show/hide the project configuration browser." + (interactive) + (if (prj-config-active) + (eproject-setup-quit) + (eproject-setup) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Edit mode + +(defun eproject-edit () + (interactive) + (if (eq 'u (car prj-active-group)) (emacs-lisp-mode)) + (let ((map (make-sparse-keymap))) + (define-key map [escape] 'eproject-edit-quit) + (setq prj-edit-mode t) + (prj-qs-clear) + (use-local-map map) + (prj-config-print) + )) + +(defun eproject-edit-quit () + (interactive) + (if (eq 'u (car prj-active-group)) (fundamental-mode)) + (prj-config-parse) + (use-local-map prj-browse-map) + (setq prj-edit-mode nil) + (setq cursor-type nil) + (prj-set-hilite-bar) + (prj-setup-all) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prj-config-active () + (eq (current-buffer) prj-buffer) + ) + +(defun prj-save-window-pos () + (p-set (prj-active-group . :pos) + (list + (window-start (selected-window)) + (- (line-number-at-pos) prj-group-top) + ))) + +(defun prj-config-reset () + (dolist (s prj-groups) + (p-set (s . :pos) (list 1 0)) + ) + (setq prj-active-group (car prj-groups)) + ) + +(defun prj-config-init () + (dolist (v '( + prj-buffer + prj-browse-map + prj-hilight-bar + prj-hilight-bar-2 + prj-edit-mode + )) + (set v nil) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Read back the configuration after edits + +(defun prj-scan-group () + (when (and (prj-config-active) prj-edit-mode) + (with-current-buffer prj-buffer + (save-excursion + (let (l r e s) + (goto-line prj-group-top) + + (if (eq 'u (car prj-active-group)) + (read (concat "((" + (buffer-substring-no-properties (point) (point-max)) + "))")) + + (while (< (point) (point-max)) + (setq e (line-end-position)) + (setq r + + (cond ((re-search-forward + "^ *\\[[-+]\\] +\\([^ ]\\(.+[^ ]\\)?\\) *$" + e t) + (list ">" (match-string-no-properties 1)) + ) + ((re-search-forward + "^ *==+ *$" + e t) + (list "<") + ) + ((re-search-forward + "^ *\\([^ ()]\\([^()]*[^ ()]\\)?\\) *\\((.+)\\)? *:\\( +\\(.*[^ ]\\)\\)? *$" + e t) + (setq s (match-string-no-properties 3)) + (cons (match-string-no-properties 1) + (cons (or (match-string-no-properties 5) "") + (and s (list (substring s 1 -1))) + ))) + ((re-search-forward + "^ *\\([^ ]\\(.*[^ ]\\)?\\) *$" + e t) + (list (match-string-no-properties 1)) + ))) + + (when r + (setq l (cons r l)) + ) + (forward-line 1) + ) + (list (nreverse l)) + )))))) + +(defun prj-config-parse () + (let ((s (prj-scan-group))) + (if s (p-call (prj-active-group . :parse) (car s))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The project config window + +;; (makunbound 'prj-groups) (makunbound 'prj-links) + +(defvar prj-groups `( + + (p nil + :title "Projects" + :comment "All projects on a list" + :pos (1 0) + :list prj-list + :exec eproject-open + :print ,(lambda (a p) + (prj-link (car a) nil a) + (prj-link-2 nil p (cadr a)) + ) + :parse ,(lambda (s) + (dolist (a s) + (unless (cadr a) + (error "Error: Project directory empty.") + )) + (setq prj-list s) + (let ((a (rassoc (cdr prj-current) s))) + (when a + (setq prj-current a) + (prj-setconfig "project-name" (car a)) + ))) + :menu (add remove open close) + ) + + (f nil + :title "Files" + :comment "The files that belong to the project" + :pos (1 0) + :list prj-files + :exec eproject-visitfile + :print ,(lambda (a p) + (prj-link (car a) nil a) + ) + :parse ,(lambda (s) + (let (b) + (dolist (l s) + (setcdr l (cdr (assoc (car l) prj-files))) + ) + (dolist (a prj-files) + (if (setq b (assoc (car a) s)) + (if (eq a prj-curfile) (setq prj-curfile b)) + (prj-remove-file a) + )) + (setq prj-files s) + )) + :menu (add-file remove-file visit-file) + ) + + (t nil + :title "Tools" + :comment "Configurable tools and keyboard shortcuts" + :pos (1 0) + :list prj-tools + :exec prj-run-tool + :print ,(lambda (a p) + (prj-link (car a) nil a) + (when (caddr a) + (unless prj-edit-mode + (insert-char 32 (- (- prj-group-tab 10) (- (point) p))) + ) + (insert " (" (caddr a) ")") + ) + (when (cadr a) + (prj-link-2 nil p (cadr a)) + )) + :parse ,(lambda (s) + (setq prj-tools s) + ) + :menu () + ) + + (s nil + :title "Settings" + :comment "Project options" + :pos (1 0) + :list prj-config + :exec eproject-edit + :print ,(lambda (a p) + (prj-link-2 (car a) p (or (cdr a) "")) + ) + :parse ,(lambda (s) + (dolist (l s) (setcdr l (cadr l))) + (let ((prj-config s) n) + (setq n (prj-getconfig "project-name")) + (unless (> (length n) 0) + (error "Error: Project name empty.") + ) + (when prj-current + (setcar prj-current n) + )) + (setq prj-config s) + ) + :menu () + ) + +;;; (u nil +;;; :title "Functions" +;;; :comment "ELisP Utitlities" +;;; :pos (1 0) +;;; :list prj-functions +;;; :exec eproject-edit +;;; :print ,(lambda (a p) +;;; (pp a (current-buffer)) +;;; ) +;;; :parse ,(lambda (s) +;;; (prj-set-functions s) +;;; ) +;;; :menu () +;;; ) + )) + + +(defvar prj-links '( + + ;; projects + (add "Add" "Add new or existing project to the list" + eproject-add + ) + (remove "Remove" "Remove a project from the the list" + eproject-remove + ) + (open "Open" "Open a Project" + eproject-open + ) + (close "Close" "Close the current project" + eproject-close + ) + + ;; files + (add-file "Add" "Add a file to the project" + eproject-addfile + ) + (remove-file "Remove" "Remove file from project" + eproject-removefile + ) + (dired "Dired" "Browse project directory - Use 'a' in dired to add file(s) to the project" + eproject-dired + ) + (visit-file "Visit" "Visit this file" + eproject-visitfile + ) + + ;; edit mode + (edit "Edit" "Edit this list (spacebar)" + eproject-edit + ) + (quit-edit "Quit" "Quit edit mode (escape)" + eproject-edit-quit + ) + (revert "Revert" "Revert all configuration to last saved state" + eproject-revert + ) + (save "Save" "Save the configuration now" + eproject-save + ) + + ;; other + (help "Help" "View the 'eproject' documentation." + eproject-help + ) + (quit "Quit" "Quit configuration area" + eproject-setup-quit + ) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Print the config + +(defun prj-config-print () + (when (prj-config-active) + (let (x f a n title l p (inhibit-read-only t) active) + + (setq buffer-read-only nil) + (buffer-disable-undo) + (erase-buffer) + + (setq prj-group-left (if prj-edit-mode 0 1)) + (setq prj-group-tab (+ 24 prj-group-left)) + (setq active + (or prj-active-group + (setq prj-active-group (car prj-groups)) + )) + (insert "\n") + (setq n 1) + (dolist (s prj-groups) + (setq f (eq s active)) + (when (or f (and prj-current (null prj-edit-mode))) + (setq title (p-get (s . :title))) + (insert-char 32 n) + (cond (f + (setq p (point)) + (insert title) + (prj-make-hilite-bar 'prj-hilight-bar-2 p (point)) + ) + (t + (prj-link title (p-get (s . :comment)) s t) + )) + (setq n 2) + )) + + (dolist (s prj-links) + (prj-define-shortcut nil (cadr s) 'ignore) + ) + (dolist (s prj-groups) + (prj-define-shortcut nil (symbol-name (car s)) 'prj-key-set-group) + ) + (insert " -") + (dolist (id (if prj-edit-mode '(revert save quit-edit) '(edit help quit))) + (insert " ") + (prj-link-3 id nil) + ) + (insert "\n\n -") + (when prj-current + (insert " " (car prj-current) " ") + ) + (insert "-") + (unless prj-edit-mode + (dolist (id (p-get (active . :menu))) + (insert " ") + (prj-link-3 id nil) + ) + ) + (insert "\n\n") + + (when prj-edit-mode + (add-text-properties (point-min) (point) + '(read-only t intangible t front-sticky t rear-nonsticky t)) + ) + + (setq prj-group-top (line-number-at-pos)) + + (prj-print-items + (p-get (active . :print)) + (eval (p-get (active . :list))) + prj-group-left + ) + + (setq p (p-get (active . :pos))) + (set-window-start (get-buffer-window prj-buffer) (car p)) + (goto-line (+ prj-group-top (cadr p))) + (unless (eobp) + (forward-char prj-group-left) + ) + (unless (pos-visible-in-window-p) + (recenter (/ (window-height) 5)) + ) + (set-buffer-modified-p nil) + (cond (prj-edit-mode + (buffer-enable-undo) + (setq cursor-type 'box) + ) + (t + (prj-set-hilite-bar) + (setq buffer-read-only t) + (setq cursor-type nil) + )) + t + ))) + +(defun prj-print-items (fn items tab) + (dolist (a items) + (when (stringp (car a)) + (unless (and (string-match "^ *#" (car a)) (null prj-edit-mode)) + (insert-char 32 tab) + )) + (funcall fn a (- (point) tab)) + (insert "\n") + )) + +(defun prj-link (text help &optional fn top) + (if (and prj-edit-mode (null help)) + (insert text) + (let ((p (point)) (f (if top 'link))) + (insert-text-button + text + 'help-echo help + 'action 'prj-action + 'class (or fn 'link) + 'follow-link t + 'face f + 'mouse-face 'link + ) + (when (or f help) + (add-text-properties p (1+ p) '(face (:foreground "blue" :underline t))) + ) + ))) + +(defun prj-link-2 (a p b) + (if a (insert a)) + (insert-char 32 (- prj-group-tab 1 (- (point) p))) + (insert " : " b) + ) + +(defun prj-link-3 (id f) + (let ((a (assq id prj-links))) + (when a + (prj-link (cadr a) (caddr a) a f) + (prj-define-shortcut nil (cadr a) (nth 3 a)) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Project selection and configuration + +(defun prj-action (b) + (let ((a (button-get b 'class))) + (cond ((memq a prj-links) + (command-execute (nth 3 a)) + ) + ((memq a prj-groups) + (setq prj-active-group a) + (prj-config-print) + ) + (t + (p-call (prj-active-group . :exec) a) + )))) + +(defun prj-key-set-group () + (interactive) + (let ((c (intern (char-to-string (logand last-input-event 255)))) s) + (when (setq s (assoc c prj-groups)) + (setq prj-active-group s) + (prj-config-print) + ))) + +(defun prj-define-shortcut (map s fn) + (let ((c (logior (aref s 0) 32))) + (define-key + (or map (current-local-map)) + (read (format "\"\\M-%c\"" c)) + fn + ))) + +(defun prj-config-get-result (id) + (and (prj-config-active) + (eq id (car prj-active-group)) + (nth (cadr (p-get (prj-active-group . :pos))) + (eval (p-get (prj-active-group . :list))) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tab between buttons and move files up/down + +(defun prj-next-button () + (interactive) + (if prj-qs-pos + (prj-qs-next 1) + )) + +(defun prj-prev-button () + (interactive) + (if prj-qs-pos + (prj-qs-next -1) + )) + +(defun prj-move-left () + (interactive) + (prj-move-to -1) + ) + +(defun prj-move-right () + (interactive) + (prj-move-to 1) + ) + +(defun prj-move-to (d &optional cycle) + (let ((n 0) (x 0)) + (dolist (s prj-groups) + (if (eq s prj-active-group) + (setq x n)) + (setq n (1+ n)) + ) + (setq x (+ x d)) + (unless prj-current (setq n 1)) + (if cycle + (if (< x 0) (setq x (1- n)) (if (>= x n) (setq x 0))) + (setq x (max 0 (min (1- n) x))) + ) + (setq prj-active-group (nth x prj-groups)) + (prj-config-print) + )) + +(defun prj-enter () + (interactive) + (let (a b) + (and (setq b (button-at (point))) + (setq a (button-get b 'action)) + (funcall a b) + ))) + +(defun prj-mouse () + (interactive) + ;;(message "LC: %s" (prin1-to-string last-input-event)) + (let ((i last-input-event) p b a x y tp) + (when (consp i) + (select-window (car (cadr i))) + (setq p (nth 5 (cadr i))) + (setq tp (nth 6 (cadr i))) + (setq y (1+ (cdr tp))) + (setq x (1+ (car tp))) + (if (>= y prj-group-top) + (goto-line y) + ) + (and (memq (car i) '(mouse-1 mouse-2)) + (setq b (button-at p)) + (setq a (button-get b 'action)) + (funcall a b) + )))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; A hook to maintain the selection bar + +(defun prj-post-command-hook () + (and + (prj-config-active) + (prj-set-hilite-bar) + )) + +(defun prj-set-hilite-bar () + (unless prj-edit-mode + ;;(message "LC: %s" (prin1-to-string (cons this-command last-input-event))) + (let (n m a c e p) + (setq m (length (eval (p-get (prj-active-group . :list))))) + (setq p (line-number-at-pos)) + (setq n (max prj-group-top + (min (line-number-at-pos) + (1- (+ prj-group-top m)) + ))) + (goto-line n) + (if (< p n) + (set-window-start nil (point-min)) + ) + (unless (eobp) + (setq a (point)) + (forward-char prj-group-left) + (setq e (line-end-position)) + (and (< (setq c (+ a prj-group-tab)) e) + (= (char-after c) ?:) + (setq e c) + ) + (while (= (char-after) 32) + (forward-char 1) + ) + (prj-make-hilite-bar 'prj-hilight-bar (point) e) + (prj-save-window-pos) + )))) + +(defun prj-make-hilite-bar (s a e) + (let (b) + (if (and (boundp s) (setq b (eval s))) + (move-overlay b a e) + (overlay-put + (set s (make-overlay a e)) + 'face '(:background "grey90" :foreground "blue") + )) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Quick Search + +(defun prj-qsearch () + (interactive) + (setq prj-qs-str + (cond ((member last-command-char '(backspace 127)) + (substring prj-qs-str 0 (max 0 (1- (length prj-qs-str)))) + ) + ((eq last-command-char 'delete) + "" + ) + (t + (concat prj-qs-str (char-to-string last-command-char)) + ))) + (prj-qs-next 0) + ) + +(defun prj-qs-clear () + (when prj-qs-face + (delete-overlay prj-qs-face) + ) + (setq prj-qs-face nil) + (setq prj-qs-pos nil) + (setq prj-qs-str "") + (setq prj-qs-len 0) + ) + +(defun prj-qs-find (s f p) + (save-excursion + (let (r beg end start limit) + (setq s (concat + "^[[:space:]]*\\([^[:space:]]*[/\\]\\)?\\(" + (regexp-quote s) + "\\)[^/\\[:space:]]*\\([[:space:]]\\|$\\)" + )) + + (goto-line prj-group-top) + (setq beg (point)) + (setq end (point-max)) + (goto-char (max p beg)) + + (if (>= f 0) + (setq fn 're-search-forward + start beg + limit end + ) + (setq fn 're-search-backward + start end + limit beg + )) + + (catch 'loop + (while t + (beginning-of-line (max 1 (1+ f))) + (cond ((funcall fn s limit t) + (throw 'loop (match-beginning 2)) + ) + (r + (throw 'loop nil) + ) + ((setq r t) + (goto-char start) + ))))))) + +(defun prj-qs-next (f) + (let (k l p a e n s) + (setq p prj-qs-pos) + (setq l prj-qs-len) + (setq s prj-qs-str) + (prj-qs-clear) + + (setq k (length s)) + (if (= k 0) + (setq l k) + (progn + (if (setq n (prj-qs-find s f (or p (point)))) + (setq p n l k) + (setq s (substring s 0 l)) + ) + (message "Quick search: %s" s) + )) + + (when p + (goto-char (+ p l)) + (prj-set-hilite-bar) + (when (> l 0) + (setq prj-qs-face (make-overlay p (+ p l))) + (overlay-put prj-qs-face 'face '(:background "white" :box "black")) + + (setq prj-qs-pos p) + (setq prj-qs-len l) + (setq prj-qs-str s) + + (when (setq e (read-key-sequence nil)) + (setq e (listify-key-sequence e)) + (setq unread-command-events (nconc e unread-command-events)) + (unless (lookup-key prj-browse-map (vconcat e) t) + (prj-qs-clear) + )))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; eproject-config.el ends here diff --git a/eproject.cfg b/eproject.cfg new file mode 100644 index 0000000..913a74c --- /dev/null +++ b/eproject.cfg @@ -0,0 +1,44 @@ +;; -*- mode: Lisp; -*- + +(setq prj-config + '(("project-name" . "eproject-0.1"))) + +(setq prj-tools + '(("Previous File" "-e eproject-prevfile" "M-left") + ("Next File" "-e eproject-nextfile" "M-right") + ("---") + ("Hello World" "echo \"Hello World!\"" "f1") + ("World Search" "-e (world-search-forward)" "f2") + )) + +(setq prj-files + '(("eproject.txt" 1 1) + ("eproject.el" 1 1) + ("eproject-config.el" 1 1) + )) + +(setq prj-functions + '( + (defun world-search-forward nil + (info "(emacs)word search") + (switch-to-buffer + (generate-new-buffer "*World Search*")) + (insert-buffer "*info*") + (save-excursion + (while + (re-search-forward "word" nil t) + (replace-match "world")))) + )) + +(unless prj-list + (setq prj-list + (list (list (prj-getconfig "project-name") + eproject-directory + ))) + + (run-with-idle-timer + 1.0 nil + '(lambda () (message " *** Welcome to eproject ***")) + ) + ) + diff --git a/eproject.el b/eproject.el new file mode 100644 index 0000000..2e8334e --- /dev/null +++ b/eproject.el @@ -0,0 +1,1076 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; eproject.el --- project workspaces for emacs +;; +;; Copyright (C) 2008 grischka +;; +;; Author: grischka -- grischka@users.sourceforge.net +;; Created: 24 Jan 2008 +;; Version: 0.1 +;; +;; This program is free software, released under the GNU General +;; Public License (GPL, version 2). For details see: +;; +;; http://www.fsf.org/licenses/gpl.html +;; +;; This program 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. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; There is a global file +(defun prj-globalfile () + (expand-file-name (concat user-emacs-directory "eproject.lst")) + ) + +;; with the list of all projects +(defvar prj-list) + +;; and the project that was open in the last session (if any) +(defvar prj-last-open nil) + +;; and the frame coords from last session +(defvar prj-frame-pos nil) + +;; eproject version that created the config file +(defvar prj-version nil) + +;; Here is a function to reset these +(defun prj-init () + (setq prj-version nil) + (setq prj-list nil) + (setq prj-last-open nil) + (setq prj-frame-pos nil) +) + +;; Each project has a directory +(defvar prj-directory) + +;; with a configuration files in it +(defun prj-localfile () + (expand-file-name "eproject.cfg" prj-directory) + ) + +;; This file defines: + +;; the list of files +(defvar prj-files) + +;; the current file +(defvar prj-curfile) + +;; an alist of settings +(defvar prj-config) + +;; a list of tools +(defvar prj-tools) + +;; a list of utility functions (feature incomplete) +(defvar prj-functions nil) + +;; Here are some default tools for new projects, +;; (which you might want to adjust to your needs) + +(defun prj-default-config () + (setq prj-tools (copy-tree '( + ("Make" "make" "f9") + ("Clean" "make clean" "C-f9") + ("Run" "echo run what" "f8") + ("Stop" "-e eproject-killtool" "C-f8") + ("---") ;; menu separator + ("Configure" "./configure") + ))) + ) + +;; This defines the current project +(defvar prj-current) + +;; There is an internal list with generated functions +;; for each tool +(defvar prj-tools-fns) + +;; and a list with files removed from the project +(defvar prj-removed-files) + +;; Here is a function to reset/close the project +(defun prj-reset () + (setq prj-version nil) + (setq prj-current nil) + (setq prj-directory nil) + (setq prj-files nil) + (setq prj-removed-files nil) + (setq prj-curfile nil) + (setq prj-config nil) + (setq prj-tools nil) + (setq prj-tools-fns nil) + (prj-reset-functions) + (prj-default-config) + ) + +(defun prj-reset-functions () + (dolist (l prj-functions) + (if (eq (car l) 'setq) + (makunbound (cadr l)) + (fmakunbound (cadr l)) + )) + (setq prj-functions nil) + ) + +(defun prj-set-functions (s) + (prj-reset-functions) + (setq prj-functions s) + (dolist (l s) (eval l)) + ) + +;; Some more variables + +;; the frame that exists on startup +(defvar prj-initial-frame nil) + +;; this is put into minor-mode-alist +(defvar eproject-mode t) + +;; where this file is in +(defvar eproject-directory) + +;; eproject version that created the files +(defvar eproject-version "0.1") + +;; Configuration UI +(eval-and-compile + (defun eproject-setup-toggle () (interactive)) + (defun eproject-setup-quit () (interactive)) + (defun prj-config-get-result (s)) + (defun prj-config-reset ()) + (defun prj-config-print ()) + (defun prj-config-parse ()) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Small functions + +(defun prj-del-list (l e) + (let ((a (assoc (car e) l))) + (if a + (delq a l) + l))) + +(defun prj-add-list (l e) + (nconc (prj-del-list l e) (list e)) + ) + +(defun prj-next-file (l e) + (let ((a (assoc (car e) l))) + (when a + (setq l (memq a l)) + (if (cdr l) (cadr l) a) + ))) + +(defun prj-prev-file (l e) + (let ((a (assoc (car e) l)) (p l)) + (when a + (while (and l (null (eq (car l) a))) + (setq p l l (cdr l)) + ) + (car p) + ))) + +;; replace a closed file, either by the previous or the next. +(defun prj-otherfile (l f) + (let ((n (prj-prev-file l f))) + (when (equal f n) + (setq n (prj-next-file l f)) + (when (equal f n) + (setq n nil) + )) + n)) + +(defun caddr (l) (car (cddr l))) + +;; make relative path, but only up to the second level of .. +(defun prj-relative-path (f) + (let ((r (file-relative-name f prj-directory))) + (if (string-match "^\\.\\.[/\\]\\.\\.[/\\]\\.\\.[/\\]" r) + f + r + ))) + +;; friendly truncate filename +(defun prj-shortname (s) + (let ((l (length s)) (x 30) n) + (cond ((>= x l) s) + ((progn + (setq x (- x 3)) + (setq n (length (file-name-nondirectory s))) + (if (< n l) (setq n (1+ n))) + (>= x n) + ) + (concat (substring s 0 (- x n)) "..." (substring s (- n))) + ) + ((= n l) + (concat (substring s 0 x) "...") + ) + (t + (concat "..." (substring s (- n) (- (- x 3) n)) "...") + )))) + +(defun prj-settitle () + (modify-frame-parameters + nil + (list (cons 'title + (and prj-current + (format "emacs - %s" (car prj-current)) + ))))) + +(defun eproject-addon (f) + (concat eproject-directory f) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Write configuration to file + +(defun prj-print-list (s fp) + (let ((v (eval s))) + (setq v (list 'setq s + (if (and (atom v) (null (and (symbolp v) v))) + v + (list 'quote v) + ))) + ;;(print v fp) + (pp v fp) (princ "\n" fp) + )) + +(defun prj-create-file (filename) + (let ((fp (generate-new-buffer filename))) + (princ ";; -*- mode: Lisp; -*-\n\n" fp) + fp)) + +(defun prj-close-file (fp) + (with-current-buffer fp + (condition-case nil + (write-region 1 (point-max) (buffer-name fp) nil 0) + (error nil) + )) + (kill-buffer fp) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Load/Save global project list and initial frame sizes + +(defun prj-loadlist () + (prj-init) + (load (prj-globalfile) t t) + (setq prj-version eproject-version) +) + +(defun prj-get-frame-pos (f) + (and f + (mapcar + (lambda (parm) (cons parm (frame-parameter f parm))) + '(top left width height) + ))) + +(defun prj-savelist () + (let ((g (prj-globalfile)) + fp + ) + (unless (file-exists-p g) + (make-directory (file-name-directory g) t) + ) + (setq prj-last-open (car prj-current)) + (when (frame-live-p prj-initial-frame) + (setq prj-frame-pos (prj-get-frame-pos prj-initial-frame)) + ) + (setq fp (prj-create-file g)) + (when fp + (prj-print-list 'prj-version fp) + (prj-print-list 'prj-list fp) + (prj-print-list 'prj-last-open fp) + (prj-print-list 'prj-frame-pos fp) + (prj-close-file fp) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Load/Save local per-project configuration file + +(defun prj-loadconfig (a) + (let (lf e) + (prj-reset) + (setq prj-current a) + (setq prj-directory + (file-name-as-directory + (expand-file-name (cadr a)) + )) + + (when (file-exists-p (setq lf (prj-localfile))) + (load lf nil t) + (setq prj-curfile + (or (assoc prj-curfile prj-files) + (car prj-files) + )) + ) + (if (setq e (prj-getconfig "project-name")) + (setcar a e) + (prj-setconfig "project-name" (car a)) + ) + (prj-set-functions prj-functions) + (setq prj-version eproject-version) + )) + +(defun prj-saveconfig () + (when prj-current + (let (w c b path files) + (prj-removehooks) + (setq w (selected-window)) + (setq c (window-buffer w)) + (dolist (f prj-files) + (setq path (expand-file-name (car f) prj-directory)) + (cond ((setq b (get-file-buffer path)) + (set-window-buffer w b t) + (push (list (car f) + (line-number-at-pos (window-start w)) + (line-number-at-pos (window-point w)) + ) files) + ) + ((consp (cdr f)) + (push f files) + ))) + + (set-window-buffer w c t) + (prj-addhooks) + (let ((fp (prj-create-file (prj-localfile))) + (prj-curfile (car prj-curfile)) + (prj-files (nreverse files)) + ) + (when fp + (prj-print-list 'prj-version fp) + (prj-print-list 'prj-config fp) + (prj-print-list 'prj-tools fp) + (prj-print-list 'prj-files fp) + (prj-print-list 'prj-curfile fp) + (prj-print-list 'prj-functions fp) + (prj-close-file fp) + )) + ))) + +(defun prj-saveall () + (prj-saveconfig) + (prj-savelist) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The core functions: Open / Close / Add / Remove Project + +(defun eproject-open (a) + "Open another project." + (interactive + (list + (or (prj-config-get-result 'p) + (completing-read "Open Project: " (mapcar 'car prj-list)) + ))) + (unless (consp a) + (let ((b (assoc a prj-list))) + (unless b + (error "No such project: %s" a) + ) + (setq a b) + )) + (setq a (or (car (member a prj-list)) a)) + (unless (eq a prj-current) + (unless (file-directory-p (cadr a)) + (error "Error: No such directory: %s" (cadr a)) + ) + (setq prj-list (cons a (delq a prj-list))) + (eproject-close) + (prj-loadconfig a) + ) + (prj-addhooks) + (prj-setup-all) + (cd prj-directory) + (unless (prj-edit-file prj-curfile) + (eproject-dired) + )) + +(defun eproject-close () + "Close the current project." + (interactive) + (when prj-current + (prj-saveconfig) + (prj-removehooks) + (let (f) + (unwind-protect + (progn + (save-some-buffers nil) + (eproject-killbuffers t) + (setq f t) + ) + (or f (prj-addhooks)) + )) + (prj-reset) + (prj-config-reset) + (prj-setup-all) + )) + +(defun eproject-killbuffers (&optional from-project) + "If called interactively kills all buffers that +do not belong to project files" + (interactive) + (let (a b) + (dolist (f prj-files) + (setq b (get-file-buffer (expand-file-name (car f) prj-directory))) + (if b (setq a (cons (list b) a))) + ) + (dolist (b (buffer-list)) + (when (eq (consp (assoc b a)) from-project) + (kill-buffer b) + )))) + +(defun eproject-add (d) + "Add a new or existing project to the list." + (interactive + (list + (read-directory-name "Add project in directory: " prj-directory nil t) + )) + (when d + (setq d (directory-file-name d)) + ) + (when (= 0 (length d)) + (error "Error: Empty directory name.") + ) + (let (n a) + (setq n (file-name-nondirectory d)) + (setq a (list n d)) + (push a prj-list) + (prj-setup-all) + )) + +(defun eproject-remove (a) + "Remove a project from the list." + (interactive + (list + (or (prj-config-get-result 'p) + (completing-read "Remove project: " (mapcar 'car prj-list)) + ))) + (unless (consp a) + (let ((b (assoc a prj-list))) + (unless b + (error "No such project: %s" a) + ) + (setq a b) + )) + (when (progn + (beep) + (prog1 (y-or-n-p (format "Remove \"%s\"? " (car a))) + (message "") + )) + (setq prj-list (prj-del-list prj-list a)) + (prj-setup-all) + )) + +(defun eproject-save () + "Save the project configuration to file." + (interactive) + (prj-config-parse) + (prj-config-print) + (prj-saveall) + ) + +(defun eproject-revert () + "Reload the project configuration from file." + (interactive) + (prj-loadlist) + (if prj-current + (prj-loadconfig prj-current) + ) + (prj-setup-all) + ) + +(defun eproject-addfile (f) + "Add a file to the current project." + (interactive + (and prj-current + (list + (read-file-name "Add file to project: " nil nil t nil) + ))) + (unless prj-current (error "No project open")) + (let ((a (prj-insert-file f (prj-config-get-result 'f)))) + (unless (cdr a) + (message "Added to project: %s" (car a)) + )) + (prj-config-print) + (prj-setmenu) + ) + +(defun eproject-removefile (a) + "Remove a file from the current project." + (interactive (prj-get-existing-file-1 "Remove file from project: ")) + (setq a (prj-get-existing-file-2 a)) + (prj-remove-file a) + ) + +(defun eproject-visitfile (a) + "Visit a file from the current project." + (interactive (prj-get-existing-file-1 "Visit file: ")) + (setq a (prj-get-existing-file-2 a)) + (prj-edit-file a) + ) + +(defun prj-get-existing-file-1 (msg) + (and prj-current + (list + (or (prj-config-get-result 'f) + (completing-read msg (mapcar 'car prj-files)) + )))) + +(defun prj-get-existing-file-2 (a) + (unless prj-current (error "No project open")) + (if (consp a) + a + (let ((b (assoc (prj-relative-path a) prj-files))) + (unless b (error "No such file in project: %s" a)) + b + ))) + +(defun eproject-help () + "Show the eproject README." + (interactive) + (view-file (eproject-addon "eproject.txt")) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hook functions to track opening/closing files from emacs + +(defun prj-addhooks () + (add-hook 'kill-buffer-hook 'prj-kill-buffer-hook) + (add-hook 'find-file-hook 'prj-find-file-hook) + (add-hook 'window-configuration-change-hook 'prj-wcc-hook) + ) + +(defun prj-removehooks () + (remove-hook 'window-configuration-change-hook 'prj-wcc-hook) + (remove-hook 'find-file-hook 'prj-find-file-hook) + (remove-hook 'kill-buffer-hook 'prj-kill-buffer-hook) + ) + +(defun prj-wcc-hook () + (let* ((w (selected-window)) + (b (window-buffer w)) + ) + ;; (message "wcc-hook: %s" (prin1-to-string (list wcc-count w b n))) + (prj-register-buffer b) + )) + +(defun prj-find-file-hook () + (run-with-idle-timer + 0 nil + `(lambda () + (let* ((b ,(current-buffer)) + (a (prj-register-buffer b)) + ) + (when a + (with-current-buffer b + (rename-buffer (car a) t) + )))))) + +(defun prj-kill-buffer-hook () + (let ((b (current-buffer)) a) + (if (setq a (rassq b prj-files)) + (prj-remove-file a t) + (if (setq a (rassq b prj-removed-files)) + (setq prj-removed-files (delq a prj-removed-files)) + )))) + +(defun prj-register-buffer (b) + (let (f a i) + (setq f (buffer-file-name b)) + (when f + (setq a (rassq b prj-files)) + (unless a + (setq a (prj-insert-file f nil t)) + (when a + (unless (cdr a) + (message "Added to project: %s" (car a)) + ) + (setcdr a b) + )) + (when (and a (null (eq a prj-curfile))) + (setq prj-curfile a) + (prj-setmenu) + )) + a)) + +(defun prj-insert-file (f &optional after on-the-fly) + (let ((r (prj-relative-path f)) a m) + (setq a (assoc r prj-files)) + (unless (or a (and on-the-fly (assoc r prj-removed-files))) + (setq a (list r)) + (setq m (memq (or after prj-curfile) prj-files)) + (if m + (setcdr m (cons a (cdr m))) + (setq prj-files (prj-add-list prj-files a)) + ) + (setq prj-removed-files (prj-del-list prj-removed-files a)) + ) + a)) + +(defun prj-remove-file (a &optional on-the-fly) + (let ((n (prj-otherfile prj-files a)) b) + (setq prj-files (prj-del-list prj-files a)) + (if (eq prj-curfile a) (setq prj-curfile n)) + (unless on-the-fly + (setq prj-removed-files (prj-add-list prj-removed-files a)) + (or (prj-config-print) + (prj-edit-file prj-curfile) + ) + ) + (prj-setmenu) + (message "Removed from project: %s" (car a)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Edit another file + +(defun prj-edit-file (a) + (when a + (let* ((n (car a)) + (f (expand-file-name n prj-directory)) + (b (get-file-buffer f)) + pos + ) + (unless b + (prj-removehooks) + (setq b (find-file-noselect f)) + (prj-addhooks) + (when b + (with-current-buffer b + (rename-buffer n t) + ) + (setq pos (cdr a)) + )) + (when b + (setcdr a b) + (eproject-setup-quit) + (switch-to-buffer b) + (prj-restore-edit-pos pos (selected-window)) + (prj-setmenu) + ))) + (setq prj-curfile a) + ) + +(defun prj-restore-edit-pos (pos w) + (when (consp pos) + (let* ((b (current-buffer)) + (top (car pos)) + (line (cadr pos)) + ) + (when (and (numberp top) (numberp line)) + (goto-line top) + (set-window-start w (point)) + (goto-line line) + )))) + +(defun prj-select-window (w) + (let (focus-follows-mouse) + (select-window w) + (select-frame-set-input-focus (window-frame w)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; choose next/previous file + +(defun eproject-nextfile () + "Switch to the next file that belongs to the current project." + (interactive) + (prj-switch-file 'prj-next-file 'next-buffer) + ) + +(defun eproject-prevfile () + "Switch to the previous file that belongs to the current project." + (interactive) + (prj-switch-file 'prj-prev-file 'previous-buffer) + ) + +(defun prj-switch-file (fn1 fn2) + (let* ((a (rassoc (current-buffer) prj-files))) + (cond (a + (prj-edit-file (funcall fn1 prj-files a)) + ) + (prj-curfile + (prj-edit-file prj-curfile) + ) + (t + (funcall fn2) + )))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Set key shortcuts + +(defun prj-setkeys () + (let ((f (consp prj-current)) + (a (assoc 'eproject-mode minor-mode-map-alist)) + (map (make-sparse-keymap)) + ) + (if a + (setcdr a map) + (push (cons 'eproject-mode map) minor-mode-map-alist) + ) + (when f + (define-key map [M-right] 'eproject-nextfile) + (define-key map [M-left] 'eproject-prevfile) + (define-key map [C-f5] 'eproject-dired) + (let ((n 0) fn s) + (dolist (a prj-tools) + (unless (setq fn (nth n prj-tools-fns)) + (setq fn (list 'lambda)) + (setq prj-tools-fns (nconc prj-tools-fns (list fn))) + ) + (setcdr fn `(() (interactive) (prj-run-tool ',a))) + (setq n (1+ n)) + (when (setq s (caddr a)) + (define-key map (prj-parse-key s) (and f fn)) + )))) + (define-key map [f5] 'eproject-setup-toggle) + )) + +(defun prj-parse-key (s) + (read + (if (string-match "[a-z][a-z0-9]+$" s) + (concat "[" s "]") + (concat "\"\\" s "\"")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Set menus + +(defun prj-setmenu () + (let ((f (consp prj-current)) m1 m2 m3) + (setq m1 + (list + `("Open" open + ,@(prj-menulist-maker prj-list prj-current 'prj-menu-open) + ("--") + ("Add ..." "Add new or existing project to the list" . eproject-add) + ("Remove ..." "Remove project from the list" . eproject-remove) + ,@(and f '(("Close" "Close current project" . eproject-close))) + ) + '("Setup" "Enter the project setup area." . eproject-setup-toggle) + )) + (when f + (nconc m1 (cons '("--") (prj-menulist-maker prj-tools nil prj-tools-fns))) + (setq m2 + `(("Dired" "Browse project directory in Dired - Use 'a' to add file(s) to the project" . eproject-dired) + ("--") + ,@(prj-menulist-maker prj-files prj-curfile 'prj-menu-edit) + ))) + + (prj-menu-maker + global-map + `((buffer "Project" project ,@m1) + (file "List" list ,@m2) + ) + '(menu-bar) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prj-menu-edit () + (interactive) + (let ((a (nth last-command-event prj-files))) + (if a (prj-edit-file a)) + )) + +(defun prj-menu-open () + (interactive) + (let ((a (nth last-command-event prj-list))) + (if a (eproject-open (car a))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prj-menu-maker (map l v) + (let ((e (list nil))) + (setq v (append v e)) + (dolist (k (reverse l)) + (let (s a) + (when (symbolp (car k)) + (setq a (pop k)) + ) + (cond + ((numberp (car k)) + (setcar e (pop k)) + ) + ((and (consp (cdr k)) (symbolp (cadr k))) + (setcar e (cadr k)) + (setq s (cddr k)) + (setq k (and s (cons (car k) (make-sparse-keymap (car k))))) + ) + (t + (setcar e (intern (downcase (car k)))) + )) + (if a + (define-key-after map (vconcat v) k a) + (define-key map (vconcat v) k) + ) + (if s (prj-menu-maker map s v)) + )))) + +(defun prj-menulist-maker (l act fns) + (let (r n m e f s x y z (w 36)) + (cond + ((< (length l) w) + (prj-menulist-maker-1 (list l fns 0) act) + ) + (t + ;; menu too long; split into submenus + (setq l (append l nil) n 0 m 0) + (while l + (setq z w) + (setq e (cdr (setq s (nthcdr (1- z) l)))) + (if s (setcdr s nil)) + (while (and e (string-match "^--" (caar e))) + (setq e (cdr e) z (1+ z)) + ) + (push (cons (concat (prj-shortname (caar l)) " ...") + (cons (intern (format "m_%d" (setq m (1+ m)))) + (prj-menulist-maker-1 (list l fns n) act) + )) r) + (setq l e) + (if (consp fns) (setq fns (nthcdr z fns))) + (setq n (+ n z)) + ) + (nreverse r) + )))) + +(defun prj-menulist-maker-1 (l act) + (let (r e f s i n a) + (while (car l) + (setq a (caar l)) + (setcar l (cdar l)) + (setq n (caddr l)) + (setcar (cddr l) (1+ n)) + (setq f (if (consp (cadr l)) + (prog1 (car (cadr l)) (setcar (cdr l) (cdr (cadr l)))) + (cadr l))) + + (setq i (car a)) + (unless (string-match "^ *#" i) + (setq s (if (and (consp (cdr a)) (stringp (cadr a))) (cadr a) i)) + (cond ((equal ">" i) + (setq e (cons s (cons (intern s) (prj-menulist-maker-1 l act)))) + (setq r (cons e r)) + ) + ((equal "<" i) + (setq l nil) + ) + (t + (setq i (prj-shortname i)) + (setq e (cons n (if (eq a act) + `(menu-item ,i ,f :button (:toggle . t) :help ,s) + (cons i (cons s f))))) + (setq r (cons e r)) + ))) + ) + (nreverse r) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Run make and other commands + +(defun prj-setup-tool-window () + (let ((bn "*compilation*") w h b c f) + (unless (get-buffer-window bn t) + (setq b (get-buffer-create bn)) + (setq f (frame-list)) + (cond ((cdr f) + (setq w (frame-first-window (car f))) + (delete-other-windows w) + ) + (t + (setq h (/ (* 70 (frame-height)) 100)) + (delete-other-windows w) + (setq w (split-window w h)) + )) + (set-window-buffer w b) + ))) + +(defun prj-run (cmd) + (let (dir) + (when (string-match "^-in +\\([^[:space:]]+\\) +" cmd) + (setq dir (match-string-no-properties 1 cmd)) + (setq cmd (substring cmd (match-end 0))) + ) + (when prj-directory + (setq dir (expand-file-name (or dir ".") prj-directory)) + ) + (cond ((string-match "^-e +" cmd) + (setq cmd (read (substring cmd (match-end 0)))) + (unless (commandp cmd) + (setq cmd `(lambda () (interactive) ,cmd)) + ) + (if dir (cd dir)) + (command-execute cmd) + ) + (t + (prj-setup-tool-window) + (if dir (cd dir)) + (compile cmd) + )))) + +(defun prj-run-tool (a) + (unless (string-match "^--+$" (car a)) + (prj-run (or (cadr a) (car a))) + )) + +(defun eproject-killtool () + (interactive) + (let ((bn "*compilation*") w0 w1) + (when (setq w1 (get-buffer-window bn t)) + (when (fboundp 'kill-compilation) + (setq w0 (selected-window)) + (select-window w1) + (kill-compilation) + (select-window w0) + )))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; run grep on project files + +(require 'grep) + +(defun eproject-grep (command-args) + "Run the grep command on all the project files." + (interactive + (progn + (grep-compute-defaults) + (let ((default (grep-default-command))) + (list (read-from-minibuffer + "Run grep on project files: " + (if current-prefix-arg default grep-command) + nil + nil + 'grep-history + (if current-prefix-arg nil default) + ))))) + (let ((default-directory prj-directory)) + (dolist (f (mapcar 'car prj-files)) + (setq command-args (concat command-args " " f)) + ) + (grep command-args) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; add files to the project with dired + +(require 'dired) + +(defun prj-dired-addfiles () + (interactive) + (when prj-current + (let ((n 0) a) + (dolist (f (dired-get-marked-files)) + (setq a (prj-insert-file f)) + (unless (cdr a) + (setq n (1+ n)) + (setq prj-curfile a) + )) + (message "Added to project: %d file(s)" n) + (prj-setmenu) + ))) + +(defun eproject-dired () + "Start a dired window with the project directory." + (interactive) + (when prj-directory + (eproject-setup-quit) + ;;(message "Use 'a' to add marked or single files to the project.") + (dired prj-directory) + (let ((map dired-mode-map)) + (define-key map [mouse-2] 'dired-find-file) + (define-key map "a" 'prj-dired-addfiles) + (define-key map [menu-bar operate command] '("Add to Project" + "Add current or marked file(s) to project" . prj-dired-addfiles)) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun prj-setup-all () + (prj-setkeys) + (prj-setmenu) + (prj-settitle) + (prj-config-print) +) + +(defun prj-getconfig (n) + (let ((a (cdr (assoc n prj-config)))) + (and (stringp a) a) + )) + +(defun prj-setconfig (n v) + (let ((a (assoc n prj-config))) + (unless a + (setq a (list n)) + (setq prj-config (nconc prj-config (list a))) + ) + (setcdr a v) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Initialize + +(defun prj-startup-delayed () + ;; where is this file + (setq eproject-directory + (file-name-directory (symbol-file 'eproject-startup))) + + ;; load UI support + (load (eproject-addon "eproject-config")) + + ;; When no projects are specified yet, load the eproject project itself. + (unless prj-list + (load (eproject-addon "eproject.cfg")) + ) + + ;; no project so far + (prj-reset) + (prj-setup-all) + (add-hook 'kill-emacs-hook 'prj-saveall) + + ;; inhibit open last project when a file was on the commandline + (unless (buffer-file-name (window-buffer)) + (when prj-last-open + + ;; open last project + (eproject-open prj-last-open) + + ;; restore frame position + (when prj-frame-pos + (modify-frame-parameters prj-initial-frame prj-frame-pos) + ;; emacs bug: when it's too busy it doesn't set frames correctly. + (sit-for 0.2) + )))) + +(defun prj-command-line-switch (option) + (setq prj-last-open (pop argv)) + (setq inhibit-startup-screen t) + ) + +(defun eproject-startup () + (if (boundp 'prj-list) + (progn + (load (eproject-addon "eproject-config")) + (prj-setup-all)) + (progn + (prj-loadlist) + (when prj-last-open (setq inhibit-startup-screen t)) + (setq prj-initial-frame (selected-frame)) + (push '("project" . prj-command-line-switch) command-switch-alist) + (run-with-idle-timer 0.1 nil 'prj-startup-delayed) + ))) + +;;;###autoload(require 'eproject) +(provide 'eproject) +(eproject-startup) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;u;;;;;;;;;;;;;;;;;;;;;;;;;; +;; eproject.el ends here diff --git a/eproject.txt b/eproject.txt new file mode 100644 index 0000000..8b2418d --- /dev/null +++ b/eproject.txt @@ -0,0 +1,165 @@ + + eproject + ======== + + -- project workspaces for emacs -- + + A project in this sense is: + * A set of files that you wish to operate with, and + * A set of commands bound to key shorcuts and menu entries + + In particular eproject lets you switch between projects as easily as + between files. + + + + Keys + ==== + + Global: + + F5 : Toggle project setup + Ctrl-F5 : Browse project directory in dired + Alt-Left : Previous file + Alt-Right : Next file + + In the project setup: + + Arrow keys : Navigate + Return : Open project, file, tool + : Quick search + Alt- : Activate link + Spacebar : Enter edit mode + Escape : Quit edit mode + + In dired: + + a : Add file(s) to the project + + + + Setup + ===== + + Projects: + --------- + + This is the global project list. You can open and close projects, + and add new or already existing ones to the list. + + + Files: + ------ + + Files are added to the project simply when they are first + visited. Similar they are removed then they get killed. New files + are inserted after the one that was last viewed. + + + Tools: + ------ + + Here you can enter some shell command lines with tools that you wish + to have at hand, and optionally bind them to key shortcuts. The + tools will show up in the menu also. + + There are two options that can be put in front of commands: + + -e run lisp command or sexp + -in ... run command in specified directory. + (Relative paths refer to the project directory) + + A new project is initialized with default tool commands. If you wish + to have a different default set, please edit 'prj-default-config' in + 'eproject.el' near the top. + + + Settings: + --------- + + Currently there is only 'project-name'. If you add a new project, + the name is initialized to the directory name, but you can change it + to whatever you want. + + + Edit Mode: + ---------- + + In the project setup, hit the the spacebar to enter edit mode. You + can edit pretty much everything except it has little effect to + change the name of a project other than the current one. + + Hit escape to quit the edit mode. Any changes to the configuration + are saved automatically when the project is closed. + + + + Usage + ===== + + To load eproject, add this line to your ~/.emacs: + + (load "/path/to/eproject.el") + + eproject will automatically start up with the last recently used + project. It will also restore the frame size and position. You can + start emacs with a specific project from the command line using: + + 'emacs -project '. + + + eproject commands: + ------------------ + + projects: + + eproject-add + eproject-remove + eproject-open + eproject-close + eproject-save + eproject-revert + eproject-help + + files: + + eproject-addfile + eproject-removefile + eproject-visitfile + eproject-prevfile (M-left) + eproject-nextfile (M-right) + + setup: + + eproject-setup + eproject-setup-toggle (f5) + eproject-setup-quit + eproject-edit + eproject-edit-quit + + other: + + eproject-grep : run grep on the project files) + eproject-dired (C-F5) : dired project (add files with 'a') + eproject-killtool : kill compiler etc. + eproject-killbuffers : kill all buffers except project files + + + + License + ======= + + eproject 0.1 + Copyright (C) 2008 grischka@users.sourceforge.net + + This program is free software, released under the GNU General Public + License (GPL), Version 2. For details see: + + http://www.fsf.org/licenses/gpl.html + + This program 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. + + Jan 17, 2008 -- grischka -- 2.11.4.GIT