;; ide-skel.el --- IDE skeleton for Emacs Lisp hackers ;; Copyright (C) 2008 Peter Karpiuk, Scott Tiger S.A. ;; Author: Peter Karpiuk ;; Maintainer: Peter Karpiuk ;; Created: 24 Apr 2008 ;; Version 0.6.0 ;; Keywords: ide speedbar ;; 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 2, 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; see the file COPYING. If not, write to the ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Ide-skel is a skeleton (or framework) of IDE for Emacs users. ;; Like Eclipse, it can be used as is with some predefined plugins ;; on board, but is designed to extend by Emacs Lisp programmers to ;; suite their own needs. Emacs 22 only, tested under Linux only ;; (under Windows ide-skel.el will rather not work, sorry). ;; ;; ** Configuration in .emacs ;; ;; (require 'ide-skel) ;; ;; ;; optional, but useful - see Emacs Manual ;; (partial-completion-mode) ;; (icomplete-mode) ;; ;; ;; for convenience ;; (global-set-key [f4] 'ide-skel-proj-find-files-by-regexp) ;; (global-set-key [f5] 'ide-skel-proj-grep-files-by-regexp) ;; (global-set-key [f10] 'ide-skel-toggle-left-view-window) ;; (global-set-key [f11] 'ide-skel-toggle-bottom-view-window) ;; (global-set-key [f12] 'ide-skel-toggle-right-view-window) ;; (global-set-key [C-next] 'tabbar-backward) ;; (global-set-key [C-prior] 'tabbar-forward) ;; ;; ** Side view windows ;; ;; Left and right view windows are "speedbars" - they are embedded ;; inside main Emacs frame and can be open/closed independently. ;; Right view window summarizes information related to the current ;; editor buffer - it can present content of such buffer in another ;; way (eg. Imenu tree), or show an extra panel for buffer major ;; mode operations (see SQL*Plus mode plugin example). Left view ;; window contains buffers such like buffer list (yet another, ;; popular way for switching buffers), filesystem/project browser ;; for easy navigation, or Info documentation browser, ;; or... whatever you wish. ;; ;; Side view windows are special - they cannot take focus and we can ;; operate on it only with mouse (!). Some window operations like ;; delete-other-windows (C-x 1) are slighty modified to treat side ;; view windows specially. ;; ;; ** Bottom view window ;; ;; Let auxiliary buffers (*shell*, *Messages*, *Help*, *Compilation* ;; and another buffers with '*' in name) pop up/show in bottom ;; window only. BUT, if you want, you can open any buffer in any ;; window (except side windows) as usual - that's only nice ;; heuristic, not pressure. ;; ;; Bottom view window remembers last selected buffer within it, so ;; if you close this window and open later, it will show you buffer ;; which you expect. ;; ;; ** Tabbars ;; ;; Ide-skel uses (great) tabbar.el package with some modifications: ;; ;; - there is no division into major mode groups (like in ;; Eclipse), ;; ;; - side view windows, bottom view window and editor windows have ;; different tabsets, ;; ;; - you can scroll tabs with mouse wheel, ;; ;; - the Home button in window left corner acts as window menu ;; (you can add your items to it in your plugin), ;; ;; - mouse-3 click on tab kills its buffer ;; ;; * Project ;; ;; Here, "project" means a directory tree checked out from CVS or ;; SVN. One project can contain source files of many types. When ;; we edit any project file, Emacs can easily find the project root ;; directory simply by looking at filesystem. ;; ;; So, we can execute many commands (grep, find, replace) on all ;; project source files or on all project source files of the same ;; type as file edited now (see Project menu). Ide-skel package ;; also automatically configures partial-completion-mode for project ;; edited now. ;; ;; There is no configuration for concrete projects needed (and ;; that's great advantage in my opinion). ;; If you find this package useful, send me a postcard to address: ;; ;; Peter Karpiuk ;; Scott Tiger S.A. ;; ul. Gawinskiego 8 ;; 01-645 Warsaw ;; Poland ;; * Notes for Emacs Lisp hackers ;; ;; Each side window buffer should have: ;; ;; - name that begins with space, ;; ;; - tab label (string) - buffer local IDE-SKEL-TABBAR-TAB-LABEL ;; variable, ;; ;; - keep condition function (IDE-SKEL-KEEP-CONDITION-FUNCTION), ;; ;; - menu (IDE-SKEL-TABBAR-MENU-FUNCTION) - optional. ;; ;; Side window buffer is enabled (can be choosed by mouse click on ;; his tab) if it has buffer local variable IDE-SKEL-TABBAR-ENABLED ;; set to non-nil. There may be many live side window buffers, but ;; unavailable in current context ("context" means buffer edited in ;; editor window) if they have IDE-SKEL-TABBAR-ENABLED set to nil. ;; ;; Hiding side window operation disables all window buffers. "Show ;; side window" event handler should enable (and maybe create) side ;; window buffers based on current context. When you switch to ;; other buffer in editor window (switching the context), all side ;; window buffers for which keep condition function returns nil are ;; disabled. Handlers for EDITOR-BUFFER-CHANGED event should enable ;; (and maybe create) additional buffers based on current context. ;; ;; ** Side window events ;; ;; Event handlers should be implemented as an abnormal hook: ;; ;; ide-skel-side-view-window-functions ;; ;; It should be function with parameters ;; ;; - side: symbol LEFT or RIGHT ;; ;; - event-type: symbol for event: ;; SHOW/EDITOR-BUFFER-CHANGED/TAB-CHANGE/HIDE ;; ;; - list (optional): event parameters specific for event type. ;; ;; Events are send only for opened (existing and visible) windows. ;; ;; Hook functions are called in order until one of them returns ;; non-nil. ;; ;; *** Show ;; ;; After side window open. Event handler should enable (and maybe ;; create) buffers appropriate for current context. After event ;; handle, if no side window buffer is selected, there will be ;; selected one of them. No parameters. ;; ;; *** Editor Buffer Changed ;; ;; After editor buffer changed (aka context switch). ;; ;; Before event, buffers for which keep condition function returns ;; nil, are disabled. Event handler should enable (and maybe ;; create) buffers appropriate for new context. ;; ;; Parameters: before-buffer current-buffer. ;; ;; *** Tab Change ;; ;; Before side window buffer change (as result of mouse click on tab ;; or ide-skel-side-window-switch-to-buffer function call). ;; Parameters: current-buffer new-buffer ;; ;; *** Hide ;; ;; Before side window hiding. After event handling, all side window ;; buffers are disabled. ;; ;; *** Functions & vars ;; ;; In plugins, you can use variables with self-descriptive names: ;; ;; ide-skel-selected-frame ;; ide-skel-current-editor-window ;; ide-skel-current-editor-buffer ;; ide-skel-current-left-view-window ;; ide-skel-current-right-view-window ;; ;; Moreover, when user selects another buffer to edit, the ;; ;; ide-skel-editor-buffer-changed-hook ;; ;; hook is run. It is similar to "editor buffer changed" event, but ;; has no parameters and is run even when all side windows are ;; closed. ;; ;; **** Functions ;; ;; ide-skel-side-window-switch-to-buffer (side-window buffer) ;; Switch buffer in side window (please use only this function for ;; this operation). ;; ;; ide-skel-get-side-view-buffer-create (name side-sym tab-label ;; help-string keep-condition-function) ;; Create new buffer for side view window. NAME should begin with ;; space, side sym should be LEFT or RIGHT. ;; ;; **** Local variables in side window buffers ;; ;; ide-skel-tabbar-tab-label ;; ide-skel-tabbar-tab-help-string ;; ide-skel-tabbar-menu-function ;; ide-skel-tabbar-enabled ;; ide-skel-keep-condition-function (require 'cl) (require 'complete) (require 'tree-widget) (require 'tabbar) (require 'recentf) (defgroup ide-skel nil "Ide Skeleton" :group 'tools :version 21) (defcustom ide-skel-tabbar-hidden-buffer-names-regexp-list '("^TAGS" "^diary$") "Buffer name that matches any of this regexps, will have no tab." :group 'ide-skel :tag "Hidden Buffer Names Regexp List" :type '(repeat regexp) :initialize 'custom-initialize-default :set (lambda (symbol value) (when tabbar-mode (tabbar-init-tabsets-store)) (set-default symbol value))) (defcustom ide-skel-bottom-view-buffer-names-regexps '("\\*.*\\*") "Buffers with names matched by one of this regexps will be shown in bottom view." :group 'ide-skel :tag "Bottom View Buffer Names Regexps" :type '(repeat regexp) :initialize 'custom-initialize-default :set (lambda (symbol value) (when tabbar-mode (tabbar-init-tabsets-store)) (set-default symbol value)) ) (defcustom ide-skel-bottom-view-buffer-names-disallowed-regexps '("\\*info\\*" "\\*Backtrace\\*") "Buffers with names matched by one of this regexps will NOT be shown in bottom view." :group 'ide-skel :tag "Bottom View Buffer Names Disallowed Regexps" :type '(repeat regexp) :initialize 'custom-initialize-default :set (lambda (symbol value) (when tabbar-mode (tabbar-init-tabsets-store)) (set-default symbol value)) ) (defconst ide-skel-left-view-window-tabset-name "LeftView") (defconst ide-skel-right-view-window-tabset-name "RightView") (defconst ide-skel-bottom-view-window-tabset-name "BottomView") (defconst ide-skel-editor-window-tabset-name "Editor") (defun ide-skel-shine-color (color percent) (when (equal color "unspecified-bg") (setq color (if (< percent 0) "white" "black"))) (apply 'format "#%02x%02x%02x" (mapcar (lambda (value) (min 65535 (max 0 (* (+ (/ value 650) percent) 650)))) (color-values color)))) (defun ide-skel-color-percentage (color) (truncate (* (/ (/ (reduce '+ (color-values color)) 3.0) 65535.0) 100.0))) (defun ide-skel-shine-face-background (face-sym percent) (when (>= (ide-skel-color-percentage (face-background 'default)) 50) (setq percent (- percent))) (set-face-attribute face-sym nil :background (ide-skel-shine-color (face-background 'default) percent))) (defun ide-skel-shine-face-foreground (face-sym percent) (when (>= (ide-skel-color-percentage (face-foreground 'default)) 50) (setq percent (- percent))) (set-face-attribute face-sym nil :foreground (ide-skel-shine-color (face-foreground 'default) percent))) (defvar ide-skel-tabbar-tab-label-max-width 25 "Max width for tab label. Nil means no limit. If label width is too big, it will be shortened with ... inside.") (defvar ide-skel-tabbar-tab-label nil "Tab name. Local for buffer in side view window.") (make-variable-buffer-local 'ide-skel-tabbar-tab-label) (defvar ide-skel-tabbar-tab-help-string nil "Tooltip text for tab in side view window. Buffer local.") (make-variable-buffer-local 'ide-skel-tabbar-tab-help-string) (defvar ide-skel-tabset-name nil) (make-variable-buffer-local 'ide-skel-tabset-name) (defvar ide-skel-tabbar-menu-function nil) (make-variable-buffer-local 'ide-skel-tabbar-menu-function) (defvar ide-skel-tabbar-enabled nil) (make-variable-buffer-local 'ide-skel-tabbar-enabled) (defvar ide-skel-keep-condition-function nil) (make-variable-buffer-local 'ide-skel-keep-condition-function) (defvar ide-skel-current-left-view-window nil) (defvar ide-skel-current-right-view-window nil) (defvar ide-skel-current-editor-window nil) (defvar ide-skel-current-editor-buffer nil) (defvar ide-skel-selected-frame nil) (defconst ide-skel-left-view-window-xpm "\ /* XPM */ static char * left_view_xpm[] = { \"24 24 145 2\", \" c None\", \". c #000000\", \"+ c #FBFED6\", \"@ c #F3F6CE\", \"# c #EBEEC7\", \"$ c #E3E7BF\", \"% c #DCE0B9\", \"& c #D5D9B2\", \"* c #FFFFFF\", \"= c #FDFDFD\", \"- c #F9F9F9\", \"; c #F4F4F4\", \"> c #DDDDDD\", \", c #F2F5CD\", \"' c #E4E8C0\", \") c #DDE1BA\", \"! c #D7DAB4\", \"~ c #D1D4AE\", \"{ c #FEFEFE\", \"] c #FBFBFB\", \"^ c #F8F8F8\", \"/ c #F5F5F5\", \"( c #F2F2F2\", \"_ c #DBDBDB\", \": c #E9EDC5\", \"< c #D8DBB5\", \"[ c #D2D5AF\", \"} c #CDD0AA\", \"| c #FCFCFC\", \"1 c #F6F6F6\", \"2 c #F3F3F3\", \"3 c #F0F0F0\", \"4 c #DADADA\", \"5 c #E1E5BD\", \"6 c #CDD0AB\", \"7 c #C8CCA6\", \"8 c #FAFAFA\", \"9 c #F7F7F7\", \"0 c #EFEFEF\", \"a c #D9D9D9\", \"b c #DADDB6\", \"c c #C4C7A2\", \"d c #EDEDED\", \"e c #D7D7D7\", \"f c #D3D6B0\", \"g c #CFD3AD\", \"h c #CBCFA9\", \"i c #C8CBA6\", \"j c #C0C39F\", \"k c #F1F1F1\", \"l c #EEEEEE\", \"m c #ECECEC\", \"n c #D6D6D6\", \"o c #C9CDA7\", \"p c #C6C9A4\", \"q c #C3C6A1\", \"r c #BFC39E\", \"s c #BCBF9B\", \"t c #EAEAEA\", \"u c #D4D4D4\", \"v c #C7CAA5\", \"w c #C1C5A0\", \"x c #BEC29D\", \"y c #BBBF9B\", \"z c #B9BC98\", \"A c #EBEBEB\", \"B c #E8E8E8\", \"C c #D3D3D3\", \"D c #C2C5A0\", \"E c #BDC09C\", \"F c #BABE99\", \"G c #B8BB97\", \"H c #B5B895\", \"I c #E9E9E9\", \"J c #E7E7E7\", \"K c #D1D1D1\", \"L c #BBBE9A\", \"M c #B7BA96\", \"N c #B4B794\", \"O c #B2B592\", \"P c #E5E5E5\", \"Q c #D0D0D0\", \"R c #B3B693\", \"S c #B1B491\", \"T c #AFB28F\", \"U c #E3E3E3\", \"V c #CECECE\", \"W c #B4B793\", \"X c #B0B390\", \"Y c #AEB18F\", \"Z c #ACAF8D\", \"` c #E6E6E6\", \" . c #E4E4E4\", \".. c #E2E2E2\", \"+. c #CDCDCD\", \"@. c #ADB08E\", \"#. c #ABAE8C\", \"$. c #AAAD8B\", \"%. c #E0E0E0\", \"&. c #CBCBCB\", \"*. c #A9AC8A\", \"=. c #A7AA89\", \"-. c #DEDEDE\", \";. c #CACACA\", \">. c #ABAE8B\", \",. c #A8AB89\", \"'. c #A6A988\", \"). c #A5A887\", \"!. c #C8C8C8\", \"~. c #A7AA88\", \"{. c #A6A987\", \"]. c #A4A786\", \"^. c #A3A685\", \"/. c #DFDFDF\", \"(. c #C7C7C7\", \"_. c #A5A886\", \":. c #A2A584\", \"<. c #A1A483\", \"[. c #C6C6C6\", \"}. c #A4A785\", \"|. c #A0A382\", \"1. c #9FA282\", \"2. c #D8D8D8\", \"3. c #C4C4C4\", \"4. c #A3A684\", \"5. c #A2A484\", \"6. c #A0A383\", \"7. c #9EA181\", \"8. c #9DA080\", \"9. c #C3C3C3\", \"0. c #8D8F72\", \"a. c #8C8E72\", \"b. c #8B8D71\", \"c. c #8A8C70\", \"d. c #898B6F\", \"e. c #888A6F\", \"f. c #C5C5C5\", \"g. c #C2C2C2\", \"h. c #C1C1C1\", \"i. c #C0C0C0\", \"j. c #BEBEBE\", \"k. c #BDBDBD\", \"l. c #BBBBBB\", \"m. c #BABABA\", \"n. c #ABABAB\", \" \", \" . . . . . . . . . . . . . . . . . . . . . . \", \". + @ # $ % & . * * * * * * * * * * = - ; ; > . \", \". , # ' ) ! ~ . * * * * * * * * * { ] ^ / ( _ . \", \". : $ ) < [ } . * * * * * * * * * | - 1 2 3 4 . \", \". 5 % ! [ 6 7 . * * * * * * * * = 8 9 ; 3 0 a . \", \". b & ~ } 7 c . * * * * * * * { ] ^ / ( 0 d e . \", \". f g h i c j . * * * * * * * | - 1 2 k l m n . \", \". } o p q r s . * * * * * * = 8 9 ; 3 0 m t u . \", \". v c w x y z . * * * * * = 8 9 / ( 0 d A B C . \", \". D r E F G H . * * * * { ] ^ / 2 3 l A I J K . \", \". E L z M N O . * * * { ] ^ 1 2 3 l m I J P Q . \", \". z M H R S T . * * { ] ^ 1 2 k l m t B P U V . \", \". H W O X Y Z . * = ] ^ 1 2 k 0 m t B ` ...+.. \", \". O X T @.#.$.. = 8 ^ 1 2 k 0 m t B ` ...%.&.. \", \". T @.Z $.*.=.. 8 9 / 2 k 0 m t B ` ...%.-.;.. \", \". Z >.*.,.'.).. 9 / 2 3 l m t B ` ...%.-.> !.. \", \". *.,.~.{.].^.. ; ( 3 l m t B ` ...%./.> _ (.. \", \". ~.{._.^.:.<.. k 0 l m t B ` ...%./.> _ a [.. \", \". _.}.:.<.|.1.. 0 d A I B ` ...%./.> _ a 2.3.. \", \". 4.5.6.1.7.8.. m A I J P ...%.-.> _ a 2.n 9.. \", \". 0.a.b.c.d.e.. +.&.;.!.(.f.3.g.h.i.j.k.l.m.n.. \", \" . . . . . . . . . . . . . . . . . . . . . . \", \" \"}; " "XPM format image used as left view window icon") (defconst ide-skel-left-view-window-image (create-image ide-skel-left-view-window-xpm 'xpm t)) (defconst ide-skel-right-view-window-xpm "\ /* XPM */ static char * right_view_xpm[] = { \"24 24 125 2\", \" c None\", \". c #000000\", \"+ c #FFFFFF\", \"@ c #A8AB89\", \"# c #A6A987\", \"$ c #A4A785\", \"% c #A2A484\", \"& c #A0A282\", \"* c #919376\", \"= c #A7AA88\", \"- c #A5A886\", \"; c #A2A584\", \"> c #A0A383\", \", c #9FA181\", \"' c #909275\", \") c #A3A685\", \"! c #A1A483\", \"~ c #9FA282\", \"{ c #9DA080\", \"] c #8F9174\", \"^ c #A4A786\", \"/ c #A0A382\", \"( c #9EA181\", \"_ c #9C9F7F\", \": c #8E9073\", \"< c #FEFEFE\", \"[ c #9B9E7F\", \"} c #8D8F73\", \"| c #FCFCFC\", \"1 c #A1A484\", \"2 c #9EA180\", \"3 c #9A9D7E\", \"4 c #8C8E72\", \"5 c #FDFDFD\", \"6 c #FAFAFA\", \"7 c #9B9E7E\", \"8 c #999C7D\", \"9 c #8B8D71\", \"0 c #F7F7F7\", \"a c #9FA281\", \"b c #9A9C7D\", \"c c #989B7C\", \"d c #8A8C70\", \"e c #FBFBFB\", \"f c #F8F8F8\", \"g c #F5F5F5\", \"h c #9C9E7F\", \"i c #9A9D7D\", \"j c #979A7B\", \"k c #898B70\", \"l c #F6F6F6\", \"m c #F3F3F3\", \"n c #999C7C\", \"o c #96997A\", \"p c #888A6F\", \"q c #F1F1F1\", \"r c #9B9D7E\", \"s c #989A7B\", \"t c #959779\", \"u c #87896E\", \"v c #EFEFEF\", \"w c #959879\", \"x c #949678\", \"y c #86886D\", \"z c #ECECEC\", \"A c #97997B\", \"B c #949778\", \"C c #939577\", \"D c #85876C\", \"E c #EAEAEA\", \"F c #95987A\", \"G c #919476\", \"H c #84876C\", \"I c #F9F9F9\", \"J c #F0F0F0\", \"K c #EEEEEE\", \"L c #E8E8E8\", \"M c #949779\", \"N c #939578\", \"O c #929476\", \"P c #909375\", \"Q c #83866B\", \"R c #F4F4F4\", \"S c #F2F2F2\", \"T c #E6E6E6\", \"U c #939678\", \"V c #929477\", \"W c #909376\", \"X c #8F9275\", \"Y c #82856A\", \"Z c #E4E4E4\", \"` c #8E9174\", \" . c #818469\", \".. c #EDEDED\", \"+. c #EBEBEB\", \"@. c #E9E9E9\", \"#. c #E2E2E2\", \"$. c #8D9073\", \"%. c #808368\", \"&. c #E7E7E7\", \"*. c #E5E5E5\", \"=. c #E0E0E0\", \"-. c #8C8F72\", \";. c #7F8268\", \">. c #D6D6D6\", \",. c #D5D5D5\", \"'. c #D4D4D4\", \"). c #D2D2D2\", \"!. c #D1D1D1\", \"~. c #D0D0D0\", \"{. c #CECECE\", \"]. c #CDCDCD\", \"^. c #CBCBCB\", \"/. c #CACACA\", \"(. c #C8C8C8\", \"_. c #C7C7C7\", \":. c #C5C5C5\", \"<. c #C4C4C4\", \"[. c #C2C2C2\", \"}. c #7D8066\", \"|. c #7C7F65\", \"1. c #7B7E64\", \"2. c #7B7D64\", \"3. c #7A7C63\", \"4. c #70725B\", \" \", \" . . . . . . . . . . . . . . . . . . . . . . \", \". + + + + + + + + + + + + + + + . @ # $ % & * . \", \". + + + + + + + + + + + + + + + . = - ; > , ' . \", \". + + + + + + + + + + + + + + + . # ) ! ~ { ] . \", \". + + + + + + + + + + + + + + + . ^ ; / ( _ : . \", \". + + + + + + + + + + + + + + < . ) ! ~ { [ } . \", \". + + + + + + + + + + + + + + | . 1 & 2 _ 3 4 . \", \". + + + + + + + + + + + + + 5 6 . > ( _ 7 8 9 . \", \". + + + + + + + + + + + + 5 6 0 . a { 7 b c d . \", \". + + + + + + + + + + + < e f g . { h i c j k . \", \". + + + + + + + + + + < e f l m . _ 3 n j o p . \", \". + + + + + + + + + < e f l m q . r 8 s o t u . \", \". + + + + + + + + 5 e f l m q v . 8 c o w x y . \", \". + + + + + + + 5 6 f l m q v z . c A w B C D . \", \". + + + + + < | 6 0 g m q v z E . A F B C G H . \", \". + + + + 5 e I 0 g m J K z E L . F M N O P Q . \", \". + + < | 6 f l R S J K z E L T . M U V W X Y . \", \". < 5 e I 0 g m q v K z E L T Z . U V * X ` .. \", \". e I f l R S q v ..+.@.L T Z #.. V * X ` $.%.. \", \". f l g m q J K z +.@.&.*.Z #.=.. W X ` $.-.;.. \", \". >.,.'.).!.~.{.].^./.(._.:.<.[.. }.|.1.2.3.4.. \", \" . . . . . . . . . . . . . . . . . . . . . . \", \" \"}; " "XPM format image used as right view window icon") (defconst ide-skel-right-view-window-image (create-image ide-skel-right-view-window-xpm 'xpm t)) (defconst ide-skel-bottom-view-window-xpm "\ /* XPM */ static char * bottom_view_xpm[] = { \"24 24 130 2\", \" c None\", \". c #000000\", \"+ c #FFFFFF\", \"@ c #FDFDFD\", \"# c #F9F9F9\", \"$ c #F6F6F6\", \"% c #F4F4F4\", \"& c #DDDDDD\", \"* c #FEFEFE\", \"= c #FBFBFB\", \"- c #F8F8F8\", \"; c #F5F5F5\", \"> c #F2F2F2\", \", c #DBDBDB\", \"' c #FCFCFC\", \") c #F3F3F3\", \"! c #F0F0F0\", \"~ c #DADADA\", \"{ c #FAFAFA\", \"] c #F7F7F7\", \"^ c #F1F1F1\", \"/ c #EFEFEF\", \"( c #D9D9D9\", \"_ c #EDEDED\", \": c #D7D7D7\", \"< c #EEEEEE\", \"[ c #ECECEC\", \"} c #D6D6D6\", \"| c #EAEAEA\", \"1 c #D4D4D4\", \"2 c #EBEBEB\", \"3 c #E8E8E8\", \"4 c #D3D3D3\", \"5 c #E9E9E9\", \"6 c #E7E7E7\", \"7 c #D1D1D1\", \"8 c #E5E5E5\", \"9 c #D0D0D0\", \"0 c #E3E3E3\", \"a c #CECECE\", \"b c #E6E6E6\", \"c c #E4E4E4\", \"d c #E2E2E2\", \"e c #CDCDCD\", \"f c #E0E0E0\", \"g c #CBCBCB\", \"h c #CCCFAB\", \"i c #CACDAA\", \"j c #C8CBA8\", \"k c #C7CAA7\", \"l c #C5C8A5\", \"m c #C3C6A4\", \"n c #C2C5A3\", \"o c #C0C3A1\", \"p c #BEC1A0\", \"q c #BDBF9E\", \"r c #BBBE9D\", \"s c #B9BC9B\", \"t c #B8BA9A\", \"u c #B6B999\", \"v c #B4B797\", \"w c #B3B596\", \"x c #B1B495\", \"y c #B0B293\", \"z c #AEB192\", \"A c #ADAF91\", \"B c #ABAE8F\", \"C c #9C9E82\", \"D c #C9CCA8\", \"E c #C6C9A6\", \"F c #C4C7A5\", \"G c #C1C4A2\", \"H c #BFC2A1\", \"I c #BEC19F\", \"J c #BCBF9E\", \"K c #BABD9C\", \"L c #B7BA9A\", \"M c #B6B998\", \"N c #ABAE90\", \"O c #AAAD8E\", \"P c #9A9D81\", \"Q c #C2C4A2\", \"R c #BFC1A0\", \"S c #BDC09F\", \"T c #BCBE9D\", \"U c #B9BB9B\", \"V c #B7BA99\", \"W c #B6B898\", \"X c #B1B494\", \"Y c #A9AB8D\", \"Z c #999C80\", \"` c #C1C3A2\", \" . c #BFC2A0\", \".. c #B9BC9C\", \"+. c #B8BB9A\", \"@. c #B7B999\", \"#. c #B5B898\", \"$. c #B4B697\", \"%. c #B2B596\", \"&. c #AAAD8F\", \"*. c #A7AA8C\", \"=. c #989B80\", \"-. c #BDC09E\", \";. c #B3B696\", \">. c #B2B595\", \",. c #B1B394\", \"'. c #AFB293\", \"). c #A6A98B\", \"!. c #97997F\", \"~. c #A7A98C\", \"{. c #A6A88B\", \"]. c #A4A78A\", \"^. c #A3A689\", \"/. c #A2A588\", \"(. c #A1A487\", \"_. c #A0A286\", \":. c #9FA185\", \"<. c #9EA084\", \"[. c #9D9F83\", \"}. c #9B9E82\", \"|. c #999B80\", \"1. c #989A7F\", \"2. c #97997E\", \"3. c #96987D\", \"4. c #95977D\", \"5. c #94967C\", \"6. c #92957B\", \"7. c #91947A\", \"8. c #909279\", \"9. c #85876F\", \" \", \" . . . . . . . . . . . . . . . . . . . . . . \", \". + + + + + + + + + + + + + + + + + @ # $ % & . \", \". + + + + + + + + + + + + + + + + * = - ; > , . \", \". + + + + + + + + + + + + + + + + ' # $ ) ! ~ . \", \". + + + + + + + + + + + + + + + @ { ] % ^ / ( . \", \". + + + + + + + + + + + + + + * = - ; > ! _ : . \", \". + + + + + + + + + + + + + + ' # $ ) / < [ } . \", \". + + + + + + + + + + + + + @ { ] % ^ < [ | 1 . \", \". + + + + + + + + + + + + @ { ] ; > / _ 2 3 4 . \", \". + + + + + + + + + + + * = - ; > ! < 2 5 6 7 . \", \". + + + + + + + + + + * = - $ ) ! < [ 5 6 8 9 . \", \". + + + + + + + + + * = - $ ) ^ < [ | 3 8 0 a . \", \". + + + + + + + + @ = - $ ) ^ / [ | 3 b c d e . \", \". + + + + + + + @ { - $ ) ^ / [ | 3 b c d f g . \", \". . . . . . . . . . . . . . . . . . . . . . . . \", \". h i j k l m n o p q r s t u v w x y z A B C . \", \". D k E F n G H I J K s L M v w x y z A N O P . \", \". E F m Q o R S T K U V W v w X y z A N O Y Z . \", \". m n ` .I J r ..+.@.#.$.%.X y z A N &.Y *.=.. \", \". G H p -.T K s t u #.;.>.,.'.z A N O Y *.).!.. \", \". ~.{.].^./.(._.:.<.[.}.P |.1.2.3.4.5.6.7.8.9.. \", \" . . . . . . . . . . . . . . . . . . . . . . \", \" \"}; " "XPM format image used as bottom view window icon") (defconst ide-skel-bottom-view-window-image (create-image ide-skel-bottom-view-window-xpm 'xpm t)) (defvar ide-skel-win--win2-switch t) (defvar ide-skel-win--minibuffer-selected-p nil) ;; (copy-win-node w) ;; (win-node-corner-pos w) ;; (make-win-node :corner-pos 0 :buffer b :horiz-scroll 0 :point 0 :mark nil :divisions nil) ;; (win-node-p w) (defstruct win-node "Window configuration tree node." (corner-pos nil) ; pair - original position of left top window corner (buf-corner-pos 1) ; position within the buffer at the upper left of the window buffer ; the buffer window displays (horiz-scroll 0) ; amount of horizontal scrolling, in columns (point 1) ; point (mark nil) ; the mark (edges nil) ; (window-edges) (cursor-priority nil) (fixed-size nil) (divisions nil)) ; children (list of division) (defstruct division "Podzial okienka" win-node ; winnode for window after division horizontal-p ; division horizontal or vertical percent) ; 0.0-1.0: width/height of parent after division (defvar sel-window nil) (defvar sel-priority nil) (defvar ide-skel-ommited-windows nil) (defvar ide-skel--fixed-size-windows nil) ;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer... (defvar ide-skel-side-view-window-functions nil) (defvar ide-skel-editor-buffer-changed-hook nil) (defvar ide-skel-last-buffer-change-event nil) (defvar ide-skel-last-selected-window-or-buffer nil) (defcustom ide-skel-bottom-view-window-size 0.35 "Default bottom view window height in characters (int >= 5) or percent of Emacs frame height (0.0 - 1.0)" :group 'ide-skel :tag "Default Bottom View Window Height" :type (list 'restricted-sexp :match-alternatives (list (lambda (value) (or (and (floatp value) (> value 0.0) (< value 1.0)) (and (integerp value) (>= value 5))))))) (defcustom ide-skel-bottom-view-on-left-view t "Non-nil if bottom view lies partially on left view." :group 'ide-skel :tag "Bottom View on Left View" :type '(boolean) :initialize 'custom-initialize-default :set (lambda (symbol value) (let ((is-bottom-view-window (ide-skel-get-bottom-view-window))) (when is-bottom-view-window (ide-skel-hide-bottom-view-window)) (unwind-protect (set-default symbol value) (when is-bottom-view-window (ide-skel-show-bottom-view-window)))))) (defcustom ide-skel-bottom-view-on-right-view t "Non-nil if bottom view lies partially on right view." :group 'ide-skel :tag "Bottom View on Right View" :type '(boolean) :initialize 'custom-initialize-default :set (lambda (symbol value) (let ((is-bottom-view-window (ide-skel-get-bottom-view-window))) (when is-bottom-view-window (ide-skel-hide-bottom-view-window)) (unwind-protect (set-default symbol value) (when is-bottom-view-window (ide-skel-show-bottom-view-window)))))) (defconst ide-skel-unexpected-bottom-view-window-buffer-names '("*Completions*" "*Compile-Log*")) (defvar ide-skel--last-bottom-view-buffer-name nil) (defvar ide-skel-was-scratch nil) (defvar ide-skel-bottom-view-window-oper-in-progress nil) (defvar ide-skel--current-side-windows (cons nil nil)) (defcustom ide-skel-left-view-window-width 25 "Default width of left view window." :group 'ide-skel :tag "Default Left View Window Width" :type '(integer) :initialize 'custom-initialize-default :set (lambda (symbol value) (let ((is-left-view-window (ide-skel-get-left-view-window))) (when is-left-view-window (ide-skel-hide-left-view-window)) (unwind-protect (set-default symbol value) (when is-left-view-window (ide-skel-show-left-view-window)))))) (defcustom ide-skel-right-view-window-width 30 "Default width of right view window." :group 'ide-skel :tag "Default Right View Window Width" :type '(integer) :initialize 'custom-initialize-default :set (lambda (symbol value) (let ((is-right-view-window (ide-skel-get-right-view-window))) (when is-right-view-window (ide-skel-hide-right-view-window)) (unwind-protect (set-default symbol value) (when is-right-view-window (ide-skel-show-right-view-window)))))) (defcustom ide-skel-side-view-display-cursor nil "Non-nil if cursor should be displayed in side view windows" :group 'ide-skel :tag "Side View Display Cursor" :type 'boolean) (defvar ide-skel-highlight-face 'ide-skel-highlight-face) (defface ide-skel-highlight-face (list (list '((background light)) (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) -70) :foreground (face-background 'default)) (when (>= emacs-major-version 22) '(:box (:style released-button))))) (list '((background dark)) (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) +70) :foreground (face-background 'default)) (when (>= emacs-major-version 22) '(:box (:style released-button))))) '(t (:inherit default))) "Face for selection in side views." :group 'ide-skel) ;;; buffer -> alist ;;; :imenu-buffer ;;; :default-left-tab-label, :default-right-tab-label (defvar ide-skel-context-properties (make-hash-table :test 'eq)) (defvar ide-skel-last-left-view-window-tab-label nil) (defvar ide-skel-last-right-view-window-tab-label nil) (defvar ide-skel-buffer-list-buffer nil) (defvar ide-skel-buffer-list nil) (defvar ide-skel-buffer-list-tick nil) (defconst ide-skel-tree-widget-open-xpm "\ /* XPM */ static char *open[] = { /* columns rows colors chars-per-pixel */ \"11 15 49 1\", \" c #4D084D080B7B\", \". c #5A705A700DBB\", \"X c #7B647B6404B5\", \"o c #7818781810F1\", \"O c #7E1E7E1E16D4\", \"+ c #5EB75D2D6FCF\", \"@ c #5FD85D2D6FCF\", \"# c #60415D2D6FCF\", \"$ c #88BD88BD068F\", \"% c #8A5D8A5D0969\", \"& c #82F782F71033\", \"* c #841B841B1157\", \"= c #87BC87BC1125\", \"- c #878787871696\", \"; c #87D587BE172E\", \": c #87C187C11812\", \"> c #895A895A1B9C\", \", c #8A0A8A0A1C10\", \"< c #8E5B8DF21DE7\", \"1 c #95DF95DF1A5F\", \"2 c #95CC95CC1B5B\", \"3 c #98D498D41EE5\", \"4 c #9BBB9BBB2414\", \"5 c #9BBB9BBB2622\", \"6 c #9CDF9CDF2696\", \"7 c #984C984C281C\", \"8 c #9EA19EA129C1\", \"9 c #A060A0602B4B\", \"0 c #A3BAA3BA3148\", \"q c #A78AA78A36FD\", \"w c #A7BBA7BB38D9\", \"e c #A7B7A7B73B03\", \"r c #AB1AAB1A3B03\", \"t c #ABD7ABD73C6C\", \"y c #AFC5AFC54435\", \"u c #B5D2B5D24A67\", \"i c #B659B6594AEE\", \"p c #B959B9595378\", \"a c #BBCEBBCE5267\", \"s c #BE64BE645A53\", \"d c #C2D2C2D26078\", \"f c #C43BC43B60D8\", \"g c #C42EC42E60EE\", \"h c #C44FC44F60EC\", \"j c #C73BC73B66E7\", \"k c #C65DC65D697B\", \"l c #CECECECE7676\", \"z c #D02CD02C7B7B\", \"x c None\", /* pixels */ \"xxxxxxxxxxx\", \"xxxxxxxxxxx\", \"xxxxxxxxxxx\", \"xxxxxxxxxxx\", \"x,> xxxxxxx\", \"6zlpw07xxxx\", \"5k32211=oxx\", \"49ryuasfexx\", \"$8yuasgdOxx\", \"%qiashjtxxx\", \"X&*<;-:.xxx\", \"xxx@xxxxxxx\", \"xxx#xxxxxxx\", \"xxx+xxxxxxx\", \"xxx+xxxxxxx\" }; ") (defconst ide-skel-tree-widget-open-image (create-image ide-skel-tree-widget-open-xpm 'xpm t)) (defconst ide-skel-tree-widget-no-handle-xpm "\ /* XPM */ static char *no_handle[] = { /* columns rows colors chars-per-pixel */ \"7 15 1 1\", \" c None\", /* pixels */ \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \" }; ") (defconst ide-skel-tree-widget-no-handle-image (create-image ide-skel-tree-widget-no-handle-xpm 'xpm t)) (defconst ide-skel-tree-widget-no-guide-xpm "\ /* XPM */ static char *no_guide[] = { /* columns rows colors chars-per-pixel */ \"4 15 1 1\", \" c None\", /* pixels */ \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \", \" \" }; ") (defconst ide-skel-tree-widget-no-guide-image (create-image ide-skel-tree-widget-no-guide-xpm 'xpm t)) (defconst ide-skel-tree-widget-leaf-xpm "\ /* XPM */ static char *leaf[] = { /* columns rows colors chars-per-pixel */ \"11 15 42 1\", \" c #224222422242\", \". c #254525452545\", \"X c #272727272727\", \"o c #31DA31DA31DA\", \"O c #4CAC4CAC4CAC\", \"+ c #4F064F064F06\", \"@ c #506050605060\", \"# c #511651165116\", \"$ c #57D657D657D6\", \"% c #59A559A559A5\", \"& c #5AAC5AAC5AAC\", \"* c #5D5A5D5A5D5A\", \"= c #5F025F025F02\", \"- c #60C660C660C6\", \"; c #617D617D617D\", \": c #63D363D363D3\", \"> c #8B908B908B90\", \", c #8E3C8E3C8E3C\", \"< c #8F588F588F58\", \"1 c #93FC93FC93FC\", \"2 c #949194919491\", \"3 c #96AD96AD96AD\", \"4 c #991899189918\", \"5 c #99EA99EA99EA\", \"6 c #9B619B619B61\", \"7 c #9CD69CD69CD6\", \"8 c #9E769E769E76\", \"9 c #9FA59FA59FA5\", \"0 c #A0C3A0C3A0C3\", \"q c #A293A293A293\", \"w c #A32EA32EA32E\", \"e c #A480A480A480\", \"r c #A5A5A5A5A5A5\", \"t c #A755A755A755\", \"y c #AA39AA39AA39\", \"u c #AC77AC77AC77\", \"i c #B1B7B1B7B1B7\", \"p c #B283B283B283\", \"a c #B7B7B7B7B7B7\", \"s c #BD02BD02BD02\", \"d c gray74\", \"f c None\", /* pixels */ \"fffffffffff\", \"fffffffffff\", \"fffffffffff\", \"XXXXfffffff\", \"%,25#offfff\", \"*6qr$&.ffff\", \"=1<3>wOffff\", \";6648a@ffff\", \";wweys#ffff\", \":970ed#ffff\", \"-tuipp+ffff\", \"XXXXXX ffff\", \"fffffffffff\", \"fffffffffff\", \"fffffffffff\" }; ") (defconst ide-skel-tree-widget-leaf-image (create-image ide-skel-tree-widget-leaf-xpm 'xpm t)) (defconst ide-skel-tree-widget-handle-xpm "\ /* XPM */ static char *handle[] = { /* columns rows colors chars-per-pixel */ \"7 15 2 1\", \" c #56D752D36363\", \". c None\", /* pixels */ \".......\", \".......\", \".......\", \".......\", \".......\", \".......\", \".......\", \" \", \".......\", \".......\", \".......\", \".......\", \".......\", \".......\", \".......\" }; ") (defconst ide-skel-tree-widget-handle-image (create-image ide-skel-tree-widget-handle-xpm 'xpm t)) (defconst ide-skel-tree-widget-guide-xpm "\ /* XPM */ static char *guide[] = { /* columns rows colors chars-per-pixel */ \"4 15 2 1\", \" c #73C96E6E8484\", \". c None\", /* pixels */ \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \" }; ") (defconst ide-skel-tree-widget-guide-image (create-image ide-skel-tree-widget-guide-xpm 'xpm t)) (defconst ide-skel-tree-widget-end-guide-xpm "\ /* XPM */ static char *end_guide[] = { /* columns rows colors chars-per-pixel */ \"4 15 2 1\", \" c #73C96E6E8484\", \". c None\", /* pixels */ \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"... \", \"....\", \"....\", \"....\", \"....\", \"....\", \"....\", \"....\" }; ") (defconst ide-skel-tree-widget-end-guide-image (create-image ide-skel-tree-widget-end-guide-xpm 'xpm t)) (defconst ide-skel-tree-widget-empty-xpm "\ /* XPM */ static char *empty[] = { /* columns rows colors chars-per-pixel */ \"11 15 39 1\", \" c #2BCF2BCF2BCF\", \". c #31F831F831F8\", \"X c #3F283F283F28\", \"o c #41B141B141B1\", \"O c #467946794679\", \"+ c #476747674767\", \"@ c #484648464846\", \"# c #498749874987\", \"$ c #4B684B684B68\", \"% c #524F524F524F\", \"& c #52D352D352D3\", \"* c #554155415541\", \"= c #561C561C561C\", \"- c #598659865986\", \"; c #5D775D775D77\", \": c #5E7E5E7E5E7E\", \"> c #60CE60CE60CE\", \", c #615161516151\", \"< c #61F361F361F3\", \"1 c #642464246424\", \"2 c #654865486548\", \"3 c #678767876787\", \"4 c #68D868D868D8\", \"5 c #699569956995\", \"6 c #6D556D556D55\", \"7 c #6FB56FB56FB5\", \"8 c #72CF72CF72CF\", \"9 c #731073107310\", \"0 c #757775777577\", \"q c #7B747B747B74\", \"w c #809080908090\", \"e c #81F281F281F2\", \"r c #820D820D820D\", \"t c #84F984F984F9\", \"y c #858285828582\", \"u c #95E295E295E2\", \"i c #9FFF9FFF9FFF\", \"p c #A5A5A5A5A5A5\", \"a c None\", /* pixels */ \"aaaaaaaaaaa\", \"aaaaaaaaaaa\", \"aaaaaaaaaaa\", \"aaaaaaaaaaa\", \"a&% aaaaaaa\", \",piy76u-===*#oaa\", \":14690qe3aa\", \"+;680qewOaa\", \"@290qrt5aaa\", \"XO+@#$$.aaa\", \"aaaaaaaaaaa\", \"aaaaaaaaaaa\", \"aaaaaaaaaaa\", \"aaaaaaaaaaa\" }; ") (defconst ide-skel-tree-widget-empty-image (create-image ide-skel-tree-widget-empty-xpm 'xpm t)) (defconst ide-skel-tree-widget-close-xpm "\ /* XPM */ static char *close[] = { /* columns rows colors chars-per-pixel */ \"11 15 45 1\", \" c #4EA14EA10DFA\", \". c #5AA05AA00C52\", \"X c #75297529068F\", \"o c #7B647B6404B5\", \"O c #8B888B880B91\", \"+ c #8EDE8EDE0F5F\", \"@ c #82F782F71033\", \"# c #83A683A61157\", \"$ c #84AD84AD13BC\", \"% c #857985791489\", \"& c #868086801590\", \"* c #8A8A8A8A1697\", \"= c #878787871812\", \"- c #885388531936\", \"; c #8BAB8BAB17B8\", \": c #8CCC8CCC1A7D\", \"> c #8DB68DB61BC4\", \", c #90EC90EC11D0\", \"< c #9161916114B5\", \"1 c #92A292A2163F\", \"2 c #8E8B8E8B2150\", \"3 c #8F0F8F0F2274\", \"4 c #9AF79AF72386\", \"5 c #9D289D282655\", \"6 c #9ED19ED1286E\", \"7 c #9F599F592912\", \"8 c #A31DA31D2D82\", \"9 c #A3DDA3DD2DA2\", \"0 c #A144A1442ED2\", \"q c #A828A82833B4\", \"w c #AB38AB383AEB\", \"e c #AD21AD213DC2\", \"r c #AD6DAD6D3E56\", \"t c #AFFCAFFC4481\", \"y c #B0AAB0AA429F\", \"u c #B1B1B1B144E8\", \"i c #B51DB51D4A5F\", \"p c #B535B5354A8A\", \"a c #B56FB56F4AEE\", \"s c #B7B0B7B0525B\", \"d c #BD14BD1459B1\", \"f c #BFACBFAC5C55\", \"g c #C5D9C5D965F7\", \"h c #C85FC85F6D04\", \"j c None\", /* pixels */ \"jjjjjjjjjjj\", \"jjjjjjjjjjj\", \"jjjjjjjjjjj\", \"jjjjjjjjjjj\", \"j32 jjjjjjj\", \"1uy84570.jj\", \"O69wtpsd*jj\", \"+qrtpsdf;jj\", \",etisdfg:jj\", \"jj\", \"o@#$%&=-Xjj\", \"jjjjjjjjjjj\", \"jjjjjjjjjjj\", \"jjjjjjjjjjj\", \"jjjjjjjjjjj\" }; ") (defconst ide-skel-tree-widget-close-image (create-image ide-skel-tree-widget-close-xpm 'xpm t)) (define-widget 'ide-skel-imenu-internal-node-widget 'tree-widget "Internal node widget.") (define-widget 'ide-skel-imenu-leaf-widget 'push-button "Leaf widget." :format "%[%t%]\n" :button-face 'variable-pitch ) (defvar ide-skel-imenu-sorted nil) (make-variable-buffer-local 'ide-skel-imenu-sorted) (defvar ide-skel-imenu-editor-buffer nil) (make-variable-buffer-local 'ide-skel-imenu-editor-buffer) (defvar ide-skel-imenu-open-paths nil) (make-variable-buffer-local 'ide-skel-imenu-open-paths) (defface imenu-side-view-face '((t :inherit variable-pitch :height 0.8)) "Default face used in right view for imenu" :group 'ide-skel) (define-widget 'ide-skel-info-tree-dir-widget 'tree-widget "Directory Tree widget." :expander 'ide-skel-info-tree-expand-dir :notify 'ide-skel-info-open :indent 0) (define-widget 'ide-skel-info-tree-file-widget 'push-button "File widget." :format "%[%t%]%d\n" :button-face 'variable-pitch :notify 'ide-skel-info-file-open) (defvar ide-skel-info-open-paths nil) (make-variable-buffer-local 'ide-skel-info-open-paths) (defvar ide-skel-info-root-node nil) (make-variable-buffer-local 'ide-skel-info-root-node) (defvar ide-skel-info-buffer nil) (define-widget 'ide-skel-dir-tree-dir-widget 'tree-widget "Directory Tree widget." :expander 'ide-skel-dir-tree-expand-dir :notify 'ide-skel-dir-open :indent 0) (define-widget 'ide-skel-dir-tree-file-widget 'push-button "File widget." :format "%[%t%]%d\n" :button-face 'variable-pitch :notify 'ide-skel-file-open) (defvar ide-skel-dir-open-paths nil) (make-variable-buffer-local 'ide-skel-dir-open-paths) (defvar ide-skel-dir-root-dir "/") (make-variable-buffer-local 'ide-skel-dir-root-dir) (defvar ide-skel-dir-buffer nil) (defconst ide-skel-cvs-dir-regexp "\\(\\.svn\\|CVS\\|\\.git\\)$") (defstruct ide-skel-project root-path include-file-path ; for PC-include-file-path variable ) (defvar ide-skel-projects nil) (defvar ide-skel-proj-find-results-buffer-name "*Proj find*") (defvar ide-skel-project-menu '("Project" :filter ide-skel-project-menu) "Menu for CVS/SVN projects") (defvar ide-skel-proj-find-project-files-history nil) (defvar ide-skel-proj-grep-project-files-history nil) (defvar ide-skel-proj-ignored-extensions '("semantic.cache")) (defvar ide-skel-all-text-files-flag nil) (defvar ide-skel-proj-grep-header nil) (defvar ide-skel-proj-old-compilation-exit-message-function nil) (make-variable-buffer-local 'ide-skel-proj-old-compilation-exit-message-function) (defvar ide-skel-proj-grep-mode-map nil) (defvar ide-skel-proj-grep-replace-history nil) ;;; (copy-face 'mode-line 'mode-line-inactive) (define-key tree-widget-button-keymap [drag-mouse-1] 'ignore) (defun ide-skel-tabbar-tab-label (tab) "Return a label for TAB. That is, a string used to represent it on the tab bar." (let* ((object (tabbar-tab-value tab)) (tabset (tabbar-tab-tabset tab)) (label (format " %s " (or (and (bufferp object) (with-current-buffer object ide-skel-tabbar-tab-label)) ; local in buffer object)))) (when (and (not (memq tabset (list (tabbar-get-tabset ide-skel-left-view-window-tabset-name) (tabbar-get-tabset ide-skel-right-view-window-tabset-name)))) (numberp ide-skel-tabbar-tab-label-max-width) (> ide-skel-tabbar-tab-label-max-width 0)) (setq label (tabbar-shorten label ide-skel-tabbar-tab-label-max-width))) label)) (defun ide-skel-tabbar-help-on-tab (tab) "Return the help string shown when mouse is onto TAB." (let ((tabset (tabbar-tab-tabset tab)) (object (tabbar-tab-value tab))) (or (when (bufferp object) (with-current-buffer object (or ide-skel-tabbar-tab-help-string ; local in buffer (buffer-file-name)))) "mouse-1: switch to buffer\nmouse-2: delete other windows\nmouse-3: kill buffer"))) (defun ide-skel-tabbar-buffer-groups () "Return the list of group names the current buffer belongs to." (if (and (ide-skel-side-view-buffer-p (current-buffer)) (or (not ide-skel-tabbar-tab-label) (not ide-skel-tabbar-enabled))) nil (let ((result (list (or ide-skel-tabset-name ; local in current buffer (when (ide-skel-bottom-view-buffer-p (current-buffer)) ide-skel-bottom-view-window-tabset-name) ide-skel-editor-window-tabset-name)))) (dolist (window (copy-list (window-list nil 1))) (when (eq (window-buffer window) (current-buffer)) (let ((tabset-name (ide-skel-get-tabset-name-for-window window))) (unless (member tabset-name result) (push tabset-name result))))) result))) (defun ide-skel-tabbar-buffer-tabs () "Return the buffers to display on the tab bar, in a tab set." ;; (message "ide-skel-tabbar-buffer-tabs %S" (current-buffer)) (tabbar-buffer-update-groups) (let* ((window (selected-window)) (tabset (tabbar-get-tabset (ide-skel-get-tabset-name-for-window window)))) (when (not (tabbar-get-tab (current-buffer) tabset)) (tabbar-add-tab tabset (current-buffer) t)) (tabbar-select-tab-value (current-buffer) tabset) tabset)) (defun ide-skel-tabbar-buffer-list () "Return the list of buffers to show in tabs. The current buffer is always included." (ide-skel-tabbar-faces-adapt) (delq t (mapcar #'(lambda (b) (let ((buffer-name (buffer-name b))) (cond ((and (ide-skel-side-view-buffer-p b) (with-current-buffer b (or (not ide-skel-tabbar-tab-label) (not ide-skel-tabbar-enabled)))) t) ;; Always include the current buffer. ((eq (current-buffer) b) b) ;; accept if buffer has tabset name ((with-current-buffer b ide-skel-tabset-name) b) ;; remove if matches any regexp from ide-skel-tabbar-hidden-buffer-names-regexp-list ((not (null (some (lambda (regexp) (string-match regexp buffer-name)) ide-skel-tabbar-hidden-buffer-names-regexp-list))) t) ;; accept if buffer has filename ((buffer-file-name b) b) ;; remove if name starts with space ((and (char-equal ?\ (aref (buffer-name b) 0)) (not (ide-skel-side-view-buffer-p b))) t) ;; accept otherwise (b)))) (buffer-list (selected-frame))))) (defun ide-skel-get-tabset-name-for-window (window) (cond ((eq (ide-skel-get-left-view-window) window) ide-skel-left-view-window-tabset-name) ((eq (ide-skel-get-right-view-window) window) ide-skel-right-view-window-tabset-name) ((eq (ide-skel-get-bottom-view-window) window) ide-skel-bottom-view-window-tabset-name) (t ide-skel-editor-window-tabset-name))) (defun ide-skel-tabbar-select-tab (event tab) "On mouse EVENT, select TAB." (let* ((mouse-button (event-basic-type event)) (buffer (tabbar-tab-value tab)) (tabset-name (and (buffer-live-p buffer) (with-current-buffer buffer ide-skel-tabset-name))) (left-tabset (equal tabset-name ide-skel-left-view-window-tabset-name)) (right-tabset (equal tabset-name ide-skel-right-view-window-tabset-name))) (cond ((eq mouse-button 'mouse-1) (cond (left-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window buffer)) (right-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window buffer)) (t (switch-to-buffer buffer)))) ((and (eq mouse-button 'mouse-2) (not left-tabset) (not right-tabset)) (switch-to-buffer buffer) (delete-other-windows)) ((and (eq mouse-button 'mouse-3) (not left-tabset) (not right-tabset)) (kill-buffer buffer))) ;; Disable group mode. (set 'tabbar-buffer-group-mode nil))) (defun ide-skel-tabbar-buffer-kill-buffer-hook () "Hook run just before actually killing a buffer. In Tabbar mode, try to switch to a buffer in the current tab bar, after the current buffer has been killed. Try first the buffer in tab after the current one, then the buffer in tab before. On success, put the sibling buffer in front of the buffer list, so it will be selected first." (let ((buffer-to-kill (current-buffer))) (save-selected-window (save-current-buffer ;; cannot kill buffer from any side view window (when (and (eq header-line-format tabbar-header-line-format) (not (ide-skel-side-view-buffer-p (current-buffer)))) (dolist (window (copy-list (window-list nil 1))) (when (eq buffer-to-kill (window-buffer window)) (select-window window) (let ((bl (tabbar-tab-values (funcall tabbar-current-tabset-function))) found sibling) (while (and bl (not found)) (if (equal buffer-to-kill (car bl)) (setq found t) (setq sibling (car bl))) (setq bl (cdr bl))) (setq sibling (or sibling (car bl))) (if (and sibling (not (eq sibling buffer-to-kill)) (buffer-live-p sibling)) ;; Move sibling buffer in front of the buffer list. (switch-to-buffer sibling) (let ((next-buffer (ide-skel--find-buffer-for-bottom-view-window))) (when (eq next-buffer buffer-to-kill) (setq next-buffer (some (lambda (buf) (if (or (eq buf buffer-to-kill) (ide-skel-side-view-buffer-p buf) (ide-skel-hidden-buffer-name-p (buffer-name buf))) nil buf)) (buffer-list (selected-frame))))) (when next-buffer (switch-to-buffer next-buffer) (tabbar-current-tabset t)))))))))))) (defun ide-skel-tabbar-inhibit-function () "Inhibit display of the tab bar in specified windows, that is in `checkdoc' status windows and in windows with its own header line." (let ((result (tabbar-default-inhibit-function)) (sw (selected-window))) (when (and result (ide-skel-side-view-window-p sw)) (setq result nil)) (when (not (eq header-line-format tabbar-header-line-format)) (setq result t)) result)) (defun ide-skel-tabbar-home-function (event) (let* ((window (posn-window (event-start event))) (is-view-window (ide-skel-side-view-window-p window)) (buffer (window-buffer window)) extra-commands (normal-window-counter 0)) (dolist (win (copy-list (window-list nil 1))) (unless (ide-skel-side-view-window-p win) (incf normal-window-counter))) (with-selected-window window (when (and is-view-window ide-skel-tabbar-menu-function) (setq extra-commands (funcall ide-skel-tabbar-menu-function))) (let ((close-p (when (or is-view-window (> normal-window-counter 1)) (list '(close "Close" t)))) (maximize-p (when (and (not is-view-window) (> normal-window-counter 1)) (list '(maximize "Maximize" t))))) (when (or close-p maximize-p) (let ((user-selection (car (x-popup-menu event (append (list 'keymap) close-p maximize-p extra-commands))))) (cond ((eq user-selection 'close) (call-interactively 'delete-window)) ((eq user-selection 'maximize) (delete-other-windows window)) ((eq user-selection nil)) (t (funcall user-selection))))))))) (defun ide-skel-tabbar-mwheel-scroll-forward (event) (interactive "@e") (tabbar-press-scroll-left)) (defun ide-skel-tabbar-mwheel-scroll-backward (event) (interactive "@e") (tabbar-press-scroll-right)) (defun ide-skel-tabbar-mwheel-scroll (event) "Select the next or previous group of tabs according to EVENT." (interactive "@e") (if (tabbar--mwheel-up-p event) (ide-skel-tabbar-mwheel-scroll-forward event) (ide-skel-tabbar-mwheel-scroll-backward event))) (defun ide-skel-tabbar-mwhell-mode-hook () (setq tabbar-mwheel-mode-map (let ((km (make-sparse-keymap))) (if (get 'mouse-wheel 'event-symbol-elements) ;; Use one generic mouse wheel event (define-key km [A-mouse-wheel] 'ide-skel-tabbar-mwheel-scroll) ;; Use separate up/down mouse wheel events (let ((up (tabbar--mwheel-key tabbar--mwheel-up-event)) (down (tabbar--mwheel-key tabbar--mwheel-down-event))) (define-key km `[header-line ,down] 'ide-skel-tabbar-mwheel-scroll-backward) (define-key km `[header-line ,up] 'ide-skel-tabbar-mwheel-scroll-forward) )) km)) (setcdr (assoc 'tabbar-mwheel-mode minor-mode-map-alist) tabbar-mwheel-mode-map)) (defun ide-skel-tabbar-mode-hook () (setq tabbar-prefix-map (let ((km (make-sparse-keymap))) (define-key km [(control home)] 'tabbar-press-home) (define-key km [(control left)] 'tabbar-backward) (define-key km [(control right)] 'tabbar-forward) (define-key km [(control prior)] 'tabbar-press-scroll-left) (define-key km [(control next)] 'tabbar-press-scroll-right) km)) (setq tabbar-mode-map (let ((km (make-sparse-keymap))) (define-key km tabbar-prefix-key tabbar-prefix-map) km)) (setcdr (assoc 'tabbar-mode minor-mode-map-alist) tabbar-mode-map)) (defun ide-skel-tabbar-init-hook () (setq tabbar-cycle-scope 'tabs tabbar-auto-scroll-flag nil) (setq tabbar-tab-label-function 'ide-skel-tabbar-tab-label tabbar-help-on-tab-function 'ide-skel-tabbar-help-on-tab tabbar-buffer-groups-function 'ide-skel-tabbar-buffer-groups tabbar-buffer-list-function 'ide-skel-tabbar-buffer-list tabbar-current-tabset-function 'ide-skel-tabbar-buffer-tabs tabbar-select-tab-function 'ide-skel-tabbar-select-tab tabbar-inhibit-functions (append '(ide-skel-tabbar-inhibit-function) (delq 'tabbar-default-inhibit-function tabbar-inhibit-functions)) tabbar-home-function 'ide-skel-tabbar-home-function tabbar-home-help-function (lambda () "Window menu")) (add-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook)) (defun ide-skel-tabbar-quit-hook () (setq tabbar-current-tabset-function nil tabbar-tab-label-function nil tabbar-select-tab-function nil tabbar-help-on-tab-function nil tabbar-home-function nil tabbar-home-help-function nil tabbar-buffer-groups-function nil tabbar-buffer-list-function nil) (remove-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook)) (defun ide-skel-tabbar-load-hook () (add-hook 'tabbar-mode-hook 'ide-skel-tabbar-mode-hook) (add-hook 'tabbar-mwheel-mode-hook 'ide-skel-tabbar-mwhell-mode-hook) (add-hook 'tabbar-init-hook 'ide-skel-tabbar-init-hook t) (add-hook 'tabbar-quit-hook 'ide-skel-tabbar-quit-hook t) (custom-set-faces '(tabbar-default ((t (:inherit variable-pitch :background "gray82" :foreground "gray50" :height 0.8)))) '(tabbar-selected ((t (:inherit tabbar-default :background "white" :foreground "blue" :box (:line-width 1 :color "black"))))) '(tabbar-separator ((t (:inherit tabbar-default :height 0.2)))) '(tabbar-highlight ((t ()))) '(tabbar-button-highlight ((t (:inherit tabbar-button)))) '(tabbar-unselected ((t (:inherit tabbar-default :background "gray72" :foreground "black" :box (:line-width 1 :color "black")))))) (ide-skel-tabbar-faces-adapt)) (defun ide-skel-tabbar-faces-adapt () (ide-skel-shine-face-background 'tabbar-default +18) (set-face-attribute 'tabbar-selected nil :background (face-background 'default)) (set-face-attribute 'tabbar-selected nil :foreground (face-foreground 'font-lock-function-name-face)) (set-face-attribute 'tabbar-selected nil :box (list :line-width 1 :color (face-foreground 'default))) (ide-skel-shine-face-background 'tabbar-unselected +30) (set-face-attribute 'tabbar-unselected nil :foreground (face-foreground 'default)) (set-face-attribute 'tabbar-unselected nil :box (list :line-width 1 :color (face-foreground 'default))) (ide-skel-shine-face-background 'tabbar-button +18) (ide-skel-shine-face-foreground 'tabbar-button +20)) (defun ide-skel-paradox-settings () ;; hide scroll buttons (setq tabbar-scroll-left-button (cons (cons "" nil) (cons "" nil)) tabbar-scroll-right-button (cons (cons "" nil) (cons "" nil)))) (ide-skel-paradox-settings) ;;; Views (defun ide-skel-window-list () (delq nil (mapcar (lambda (win) (unless (memq win ide-skel-ommited-windows) win)) (copy-list (window-list nil 1))))) (defun ide-skel-next-window (&optional window minibuf all-frames) (let ((nw (next-window window minibuf all-frames))) (if (memq nw ide-skel-ommited-windows) (ide-skel-next-window nw minibuf all-frames) nw))) (defun ide-skel-previous-window (window minibuf all-frames) (let ((pw (previous-window window minibuf all-frames))) (if (memq pw ide-skel-ommited-windows) window pw))) (defun ide-skel-win--absorb-win-node (dest-win-node src-win-node) (dotimes (index (length src-win-node)) (setf (elt dest-win-node index) (elt src-win-node index)))) (defun ide-skel-win--create-win-node (object) (cond ((win-node-p object) (copy-win-node object)) ((windowp object) (make-win-node :corner-pos (ide-skel-win-corner object) :buf-corner-pos (window-start object) :buffer (window-buffer object) :horiz-scroll (window-hscroll object) :point (window-point object) :mark nil :edges (window-edges object) :fixed-size (cdr (assoc (ide-skel-win-corner object) ide-skel--fixed-size-windows)) :divisions nil)) (t (error "Argument is not win-not nor window: %S" object)))) (defun ide-skel-win--get-corner-pos (object) (cond ((windowp object) (ide-skel-win-corner object)) ((win-node-p object) (win-node-corner-pos object)) ((consp object) object) (t (error "Invalid arg: %S" object)))) (defun ide-skel-win--corner-pos-equal (win-node1 win-node2) (let ((corner-pos1 (ide-skel-win--get-corner-pos win-node1)) (corner-pos2 (ide-skel-win--get-corner-pos win-node2))) (equal corner-pos1 corner-pos2))) (defun ide-skel-win--add-division (win-node division &optional at-end-p) (setf (win-node-divisions win-node) (if at-end-p (reverse (cons division (reverse (win-node-divisions win-node)))) (cons division (win-node-divisions win-node))))) (defun ide-skel-win--remove-division (win-node &optional from-end-p) (let (result) (if from-end-p (let ((divs (reverse (win-node-divisions win-node)))) (setq result (car divs)) (setf (win-node-divisions win-node) (reverse (cdr divs)))) (setq result (car (win-node-divisions win-node))) (setf (win-node-divisions win-node) (cdr (win-node-divisions win-node)))) result)) (defun ide-skel-win--find-node (root predicate) "Return node for which predicate returns non-nil." (when root (if (funcall predicate root) root (some (lambda (division) (ide-skel-win--find-node (division-win-node division) predicate)) (win-node-divisions root))))) (defun ide-skel-win--find-node-by-corner-pos (root corner-pos) "Return struct for window with specified corner coordinates." (setq corner-pos (cond ((windowp corner-pos) (ide-skel-win-corner corner-pos)) ((consp corner-pos) corner-pos) (t (error "arg corner-pos %S is not a pair/window" corner-pos)))) (ide-skel-win--find-node root (lambda (win-node) (equal corner-pos (win-node-corner-pos win-node))))) (defun ide-skel-win--get-window-list () (let* ((start-win (selected-window)) (cur-win (ide-skel-next-window start-win 1 1)) (win-list (list start-win))) (while (not (eq cur-win start-win)) (setq win-list (cons cur-win win-list)) (setq cur-win (ide-skel-next-window cur-win 1 1))) (reverse win-list))) (defun ide-skel-win--analysis (&optional window-proc) ;; (message "ide-skel-win--analysis BEGIN %S" (get-internal-run-time)) (let ((window-size-fixed nil)) (setq ide-skel--fixed-size-windows nil) (dolist (window (copy-list (window-list nil 1))) (with-selected-window window (cond ((eq window-size-fixed 'width) (push (cons (ide-skel-win-corner window) (cons (window-width window) nil)) ide-skel--fixed-size-windows)) ((eq window-size-fixed 'height) (push (cons (ide-skel-win-corner window) (cons nil (window-height window))) ide-skel--fixed-size-windows)) ((not window-size-fixed) nil) (t (push (cons (ide-skel-win-corner window) (cons (window-width window) (window-height window))) ide-skel--fixed-size-windows))))) (dolist (window (ide-skel-window-list)) (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window nil))) (setq ide-skel-win--minibuffer-selected-p (eq (selected-window) (minibuffer-window))) (when ide-skel-win--minibuffer-selected-p (select-window (ide-skel-get-editor-window))) (when (memq (selected-window) ide-skel-ommited-windows) (select-window (ide-skel-next-window (selected-window) 1 1))) (let* (leaf-win (counter 0) (cursor-alist (mapcar (lambda (win) (prog1 (cons win counter) (incf counter))) (ide-skel-win--get-window-list))) win-node-set) (select-window (ide-skel-win-get-upper-left-window)) (while (setq leaf-win (get-window-with-predicate (lambda (win) (if ide-skel-win--win2-switch (ide-skel-win--is-leaf2 win) (ide-skel-win--is-leaf win))) 1 1)) (let* ((parent-win (ide-skel-previous-window leaf-win 1 1)) (parent-node (car (member* (ide-skel-win-corner parent-win) win-node-set :test 'ide-skel-win--corner-pos-equal))) (leaf-node (car (member* (ide-skel-win-corner leaf-win) win-node-set :test 'ide-skel-win--corner-pos-equal)))) (unless leaf-node (setq leaf-node (ide-skel-win--create-win-node leaf-win)) (setf (win-node-cursor-priority leaf-node) (cdr (assq leaf-win cursor-alist))) (setq win-node-set (adjoin leaf-node win-node-set :test 'ide-skel-win--corner-pos-equal))) (unless parent-node (setq parent-node (ide-skel-win--create-win-node parent-win)) (setf (win-node-cursor-priority parent-node) (cdr (assq parent-win cursor-alist))) (setq win-node-set (adjoin parent-node win-node-set :test 'ide-skel-win--corner-pos-equal))) (let* ((is-horizontal (ide-skel-win--is-adjacent parent-win 'right leaf-win)) (size (if is-horizontal (window-width parent-win) (window-height parent-win))) percent) (setf (win-node-edges leaf-node) (window-edges leaf-win)) (when window-proc (funcall window-proc parent-win)) (when window-proc (funcall window-proc leaf-win)) (delete-window leaf-win) (when window-proc (funcall window-proc parent-win)) (setq percent (/ (float size) (if is-horizontal (window-width parent-win) (window-height parent-win)))) (ide-skel-win--add-division parent-node (make-division :win-node leaf-node :horizontal-p is-horizontal :percent percent))))) ;; if there was only one window (unless win-node-set (when window-proc (funcall window-proc (selected-window))) (let ((node (ide-skel-win--create-win-node (selected-window)))) (setq win-node-set (adjoin node win-node-set :test 'ide-skel-win--corner-pos-equal)))) ;; return root node (let ((root-node (car (member* (ide-skel-win-corner (selected-window)) win-node-set :test 'ide-skel-win--corner-pos-equal)))) (setf (win-node-edges root-node) (window-edges (selected-window))) ;; (message "ide-skel-win--analysis END %S" (get-internal-run-time)) root-node)))) (defun ide-skel-win-get-upper-left-window () "Return window in left upper corner" (let (best-window) (dolist (win (ide-skel-window-list)) (if (null best-window) (setq best-window win) (let* ((best-window-coords (window-edges best-window)) (best-window-weight (+ (car best-window-coords) (cadr best-window-coords))) (win-coords (window-edges win)) (win-weight (+ (car win-coords) (cadr win-coords)))) (when (< win-weight best-window-weight) (setq best-window win))))) best-window)) (defun ide--is-right-window (window) (let ((bounds (window-edges window)) (result t)) (dolist (win (ide-skel-window-list)) (let ((left-edge-pos (car (window-edges win)))) (when (>= left-edge-pos (nth 2 bounds)) (setq result nil)))) result)) (defun ide-skel-get-win-width-delta (window) (if window-system (let ((bounds (window-edges window))) (+ (- (- (nth 2 bounds) (nth 0 bounds)) (window-width window)) (if (and (not scroll-bar-mode) (ide--is-right-window window)) 1 0))) 1)) (defun ide-skel-win--split (window horizontal-p percentage) "Split window and return children." (let* ((delta (ide-skel-get-win-width-delta window)) (weight percentage) (new-size (cond ((integerp weight) (if (< weight 0) (if horizontal-p (+ (window-width window) weight) (+ (window-height window) weight)) (if horizontal-p (+ delta weight) weight))) (t ; float (when (< weight 0.0) (setq weight (+ 1.0 weight))) (if horizontal-p (round (+ delta (* (window-width window) weight))) (round (* (window-height window) weight))))))) (split-window window new-size horizontal-p))) (defun ide-skel-win--process-win-node (win win-node &optional window-proc) (let ((win2 win)) (set-window-buffer win (win-node-buffer win-node)) ; (set-window-start win (win-node-buf-corner-pos win-node)) (set-window-hscroll win (win-node-horiz-scroll win-node)) (set-window-point win (win-node-point win-node)) (when window-proc (setq win (funcall window-proc win))) (dolist (division (win-node-divisions win-node)) (when (not (null (division-win-node division))) (let ((child-window (ide-skel-win--split win (division-horizontal-p division) (division-percent division)))) (when window-proc (setq win (funcall window-proc win))) (ide-skel-win--process-win-node child-window (division-win-node division) window-proc)))) (with-selected-window win2 (let ((fixed-size (win-node-fixed-size win-node)) (window-size-fixed nil)) (when fixed-size (when (car fixed-size) (enlarge-window (- (car fixed-size) (window-width win2)) t)) (when (cdr fixed-size) (enlarge-window (- (cdr fixed-size) (window-height win2)) nil))))) (when (win-node-cursor-priority win-node) (unless sel-window (setq sel-window win sel-priority (win-node-cursor-priority win-node))) (when (< (win-node-cursor-priority win-node) sel-priority) (setq sel-window win sel-priority (win-node-cursor-priority win-node)))))) (defun ide-skel-win--synthesis (window win-node &optional window-proc) (let ((window-size-fixed nil) sel-window sel-priority) (ide-skel-win--process-win-node window win-node window-proc) (when sel-window (select-window sel-window)) (when ide-skel-win--minibuffer-selected-p (select-window (minibuffer-window))) (setq ide-skel-win--minibuffer-selected-p nil) (dolist (window (ide-skel-window-list)) (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window t))))) (defun ide-skel-win--remove-child (win-node child-win-node) (if (eq win-node child-win-node) (let* ((division (ide-skel-win--remove-division win-node t)) (divisions (win-node-divisions win-node))) (when division (ide-skel-win--absorb-win-node win-node (division-win-node division))) (setf (win-node-divisions win-node) (append divisions (win-node-divisions win-node)))) (dolist (division (win-node-divisions win-node)) (if (and (eq (division-win-node division) child-win-node) (null (win-node-divisions (division-win-node division)))) (setf (division-win-node division) nil) (ide-skel-win--remove-child (division-win-node division) child-win-node))))) (defun ide-skel-win-remove-window (window) "Remove window with coordinates WINDOW." (let* ((window-corner-pos (ide-skel-win-corner window)) (root-win-node (ide-skel-win--analysis)) (child-win-node (ide-skel-win--find-node-by-corner-pos root-win-node window-corner-pos))) (ide-skel-win--remove-child root-win-node child-win-node) (ide-skel-win--synthesis (selected-window) root-win-node))) (defun ide-skel-win-add-window (buffer parent-window-edges edge-symbol size) "Split PARENT-WINDOW-EDGES window along specified edge. In new window with width/height SIZE show buffer BUFFER. SIZE can be integer (character count) or float 0.0 - 1.0." (when (windowp parent-window-edges) (setq parent-window-edges (window-edges parent-window-edges))) (let ((horizontal-p (or (eq edge-symbol 'left) (eq edge-symbol 'right))) (replace-parent-p (or (eq edge-symbol 'top) (eq edge-symbol 'left))) (percentage (if (or (eq edge-symbol 'bottom) (eq edge-symbol 'right)) (- size) size))) (ide-skel-win--add-window buffer parent-window-edges horizontal-p percentage replace-parent-p))) (defun ide-skel-win--add-window (buffer parent-window-edges horizontal-p percentage replace-parent-p) (let* ((root-win-node (ide-skel-win--analysis)) (new-win-node (make-win-node :buffer buffer))) (ide-skel-win--synthesis (selected-window) root-win-node (lambda (window) (if (equal (window-edges window) parent-window-edges) (let ((child-window (ide-skel-win--split window horizontal-p percentage))) (set-window-buffer (if replace-parent-p window child-window) buffer) (if replace-parent-p child-window window)) window))))) (defun ide-skel-win--get-bounds (object) (cond ((windowp object) (window-edges object)) ((and (listp object) (= (length object) 4)) object) (t (error "Invalid object param: %S" object)))) (defun ide-skel-win--win-area (window) (let ((win-bounds (ide-skel-win--get-bounds window))) (* (- (nth 2 win-bounds) (nth 0 win-bounds)) (- (nth 3 win-bounds) (nth 1 win-bounds))))) (defun ide-skel-win--is-adjacent(window1 edge-symbol window2) "Non-nil if WINDOW1 sticks to WINDOW2 along specified edge." (let ((bounds1 (ide-skel-win--get-bounds window1)) (bounds2 (ide-skel-win--get-bounds window2)) result) (if (or (equal edge-symbol 'top) (equal edge-symbol 'bottom)) (setq result (and (equal (nth 0 bounds1) (nth 0 bounds2)) ; bounds.LEFT = bounds2.LEFT (equal (nth 2 bounds1) (nth 2 bounds2)))) ; bounds.RIGHT = bounds2.RIGHT (setq result (and (equal (nth 1 bounds1) (nth 1 bounds2)) ; bounds.TOP = bounds2.TOP (equal (nth 3 bounds1) (nth 3 bounds2))))) ; bounds.BOTTOM = bounds2.BOTTOM (when result (setq result (cond ((equal edge-symbol 'top) (equal (nth 1 bounds1) (nth 3 bounds2))) ; bounds.TOP = bounds2.BOTTOM ((equal edge-symbol 'bottom) (equal (nth 3 bounds1) (nth 1 bounds2))) ; bounds.BOTTOM = bounds2.TOP ((equal edge-symbol 'left) (equal (nth 0 bounds1) (nth 2 bounds2))) ; bounds.LEFT = bounds2.RIGHT (t (equal (nth 2 bounds1) (nth 0 bounds2)))))) result)) (defun ide-skel-win--is-leaf (&optional window) "Non-nil if WINDOW is a leaf." (unless window (setq window (selected-window))) ;; no window can stick from right or bottom (when (and (not (get-window-with-predicate (lambda (win) (ide-skel-win--is-adjacent window 'right win)) 1 1)) (not (get-window-with-predicate (lambda (win) (ide-skel-win--is-adjacent window 'bottom win)) 1 1))) (let ((parent (ide-skel-previous-window window 1 1))) ;; parent must exist and come from left or up (when (and parent (or (ide-skel-win--is-adjacent window 'top parent) (ide-skel-win--is-adjacent window 'left parent))) window)))) (defun ide-skel-win--is-leaf2 (&optional win2) "Non-nil if WIN2 is leaf." (unless win2 (setq win2 (selected-window))) ;; no window can stick from right or bottom (when (and (not (get-window-with-predicate (lambda (win) (ide-skel-win--is-adjacent win2 'right win)))) (not (get-window-with-predicate (lambda (win) (ide-skel-win--is-adjacent win2 'bottom win))))) (let ((parent (ide-skel-previous-window win2 1 1))) ;; parent must exist and come from left or up (when (and parent (or (ide-skel-win--is-adjacent win2 'top parent) (ide-skel-win--is-adjacent win2 'left parent))) win2)))) (defun ide-skel-win-corner (window) (let ((coords (window-edges window))) (cons (car coords) (cadr coords)))) (defun ide-skel-window-size-changed (frame) (let* ((editor-window (ide-skel-get-editor-window)) (left-view-window (car ide-skel--current-side-windows)) (right-view-window (cdr ide-skel--current-side-windows)) (bottom-view-window (ide-skel-get-bottom-view-window))) (ide-skel-recalculate-view-cache) (when bottom-view-window (ide-skel-remember-bottom-view-window)) (when left-view-window (setq ide-skel-left-view-window-width (window-width left-view-window))) (when right-view-window (setq ide-skel-right-view-window-width (window-width right-view-window))))) (add-hook 'window-size-change-functions 'ide-skel-window-size-changed) (setq special-display-regexps ide-skel-bottom-view-buffer-names-regexps) (defun ide-skel-recalculate-view-cache () (setq ide-skel-selected-frame (selected-frame) ide-skel-current-editor-window (ide-skel-get-editor-window)) (setq ide-skel-current-editor-buffer (window-buffer ide-skel-current-editor-window) ide-skel-current-left-view-window (car ide-skel--current-side-windows) ide-skel-current-right-view-window (cdr ide-skel--current-side-windows))) (defun ide-skel-get-last-selected-window () (and ide-skel-last-selected-window-or-buffer (or (and (window-live-p (car ide-skel-last-selected-window-or-buffer)) (car ide-skel-last-selected-window-or-buffer)) (and (buffer-live-p (cdr ide-skel-last-selected-window-or-buffer)) (get-buffer-window (cdr ide-skel-last-selected-window-or-buffer)))))) (require 'mwheel) (defvar ide-skel-mouse-wheel-events (list mouse-wheel-up-event mouse-wheel-down-event)) (run-with-idle-timer 0 t (lambda () ;; (when ide-skel-current-left-view-window ;; (with-selected-window ide-skel-current-left-view-window ;; (beginning-of-line))) ;; (when ide-skel-current-right-view-window ;; (with-selected-window ide-skel-current-right-view-window ;; (beginning-of-line))) (unless (or (active-minibuffer-window) (memq 'down (event-modifiers last-input-event)) (memq (event-basic-type last-input-event) ide-skel-mouse-wheel-events) (mouse-movement-p last-input-event)) ;; selected frame changed? (unless (eq (selected-frame) ide-skel-selected-frame) (ide-skel-recalculate-view-cache)) ;; side view windows cannot have cursor (while (memq (selected-window) (list ide-skel-current-left-view-window ide-skel-current-right-view-window)) (let ((win (ide-skel-get-last-selected-window))) (if (and win (not (eq (selected-window) win))) (select-window win) (other-window 1)))) (setq ide-skel-last-selected-window-or-buffer (cons (selected-window) (window-buffer (selected-window)))) ;; current buffer changed? (let ((editor-buffer (window-buffer ide-skel-current-editor-window))) (when (not (eq ide-skel-last-buffer-change-event editor-buffer)) (ide-skel-send-event nil 'editor-buffer-changed ide-skel-last-buffer-change-event editor-buffer)))))) (setq special-display-function (lambda (buffer &optional data) (let ((bottom-view-window (ide-skel-get-bottom-view-window))) (if (and bottom-view-window (eq bottom-view-window (selected-window)) (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names)) (progn (show-buffer (ide-skel-get-editor-window) buffer) (ide-skel-get-editor-window)) (unless (ide-skel-get-bottom-view-window) (ide-skel-show-bottom-view-window)) (set-window-buffer (ide-skel-get-bottom-view-window) buffer) ;; (select-window (ide-skel-get-bottom-view-window)) (ide-skel-get-bottom-view-window))))) ;;; Bottom view (defun ide-skel-hidden-buffer-name-p (buffer-name) (equal (elt buffer-name 0) 32)) (defun ide-skel-bottom-view-buffer-p (buffer) "Non-nil if buffer should be shown in bottom view." (let ((name (buffer-name buffer))) (or (with-current-buffer buffer (and ide-skel-tabset-name (string= ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name))) (and (not (ide-skel-hidden-buffer-name-p name)) (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-regexps) (not (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-disallowed-regexps)))))) (defun ide-skel-remember-bottom-view-window () (let ((bottom-view-window (ide-skel-get-bottom-view-window))) (when bottom-view-window (setq ide-skel--last-bottom-view-buffer-name (buffer-name (window-buffer bottom-view-window)) ide-skel-bottom-view-window-size (max 5 (window-height bottom-view-window)))))) (defun ide-skel--find-buffer-for-bottom-view-window () "Returns first buffer to display in bottom view window (always returns a buffer)." (let ((best-buffers (list (car (buffer-list (selected-frame)))))) (some (lambda (buffer) (when (ide-skel-bottom-view-buffer-p buffer) (if (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names) (setq best-buffers (append best-buffers (list buffer))) (setq best-buffers (cons buffer best-buffers))) nil)) (buffer-list (selected-frame))) (if (and (not ide-skel-was-scratch) (get-buffer "*scratch*")) (progn (setq ide-skel-was-scratch t) (get-buffer "*scratch*")) (car best-buffers)))) (defun ide-skel--is-full-width-window (window &rest except-windows) (let ((bounds (window-edges window)) (result t)) (dolist (win (ide-skel-window-list)) (unless (memq win except-windows) (let ((left-edge-pos (car (window-edges win)))) (when (or (< left-edge-pos (car bounds)) (>= left-edge-pos (nth 2 bounds))) (setq result nil))))) result)) (defun ide-skel-get-bottom-view-window () (let* ((editor-window (ide-skel-get-editor-window)) best-window) ;; get lowest window (dolist (win (copy-list (window-list nil 1))) (when (with-current-buffer (window-buffer win) (and (or (not ide-skel-tabset-name) (equal ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name)) (not (eq win editor-window)))) (if (null best-window) (setq best-window win) (when (> (cadr (window-edges win)) (cadr (window-edges best-window))) (setq best-window win))))) (when (and best-window (not (ide-skel--is-full-width-window best-window (ide-skel-get-left-view-window) (ide-skel-get-right-view-window)))) (setq best-window nil)) best-window)) (defun ide-skel-show-bottom-view-window (&optional buffer) (interactive) (unless ide-skel-bottom-view-window-oper-in-progress (let ((saved-window (cons (selected-window) (window-buffer (selected-window))))) (unwind-protect (unless (ide-skel-get-bottom-view-window) ;; if not open yet (setq ide-skel-bottom-view-window-oper-in-progress t) (unless buffer (setq buffer (or (and ide-skel--last-bottom-view-buffer-name (get-buffer ide-skel--last-bottom-view-buffer-name)) (ide-skel--find-buffer-for-bottom-view-window)))) (let* ((left-view-window (ide-skel-get-left-view-window)) (left-view-window-bounds (and left-view-window (window-edges left-view-window))) (right-view-window (ide-skel-get-right-view-window)) (right-view-window-bounds (and right-view-window (window-edges right-view-window))) (root-win-node (ide-skel-win--analysis)) (window-bounds (window-edges (selected-window)))) ; bounds of maximized window (after analysis) (when (and left-view-window-bounds (not ide-skel-bottom-view-on-left-view)) (setf (nth 0 window-bounds) (nth 2 left-view-window-bounds))) (when (and right-view-window-bounds (not ide-skel-bottom-view-on-right-view)) (setf (nth 2 window-bounds) (nth 0 right-view-window-bounds))) (ide-skel-win--synthesis (selected-window) root-win-node) (let ((ide-skel-win--win2-switch (and (not (null left-view-window)) ide-skel-bottom-view-on-right-view)) (old ide-skel-ommited-windows)) (when (and (not ide-skel-bottom-view-on-left-view) (not ide-skel-bottom-view-on-right-view) (ide-skel-get-left-view-window)) (push (ide-skel-get-left-view-window) ide-skel-ommited-windows)) (ide-skel-win-add-window buffer window-bounds 'bottom ide-skel-bottom-view-window-size) (setq ide-skel-ommited-windows old)))) (if (window-live-p (car saved-window)) (select-window (car saved-window)) (when (get-buffer-window (cdr saved-window)) (select-window (get-buffer-window (cdr saved-window))))) (setq ide-skel-bottom-view-window-oper-in-progress nil))))) (defun ide-skel-hide-bottom-view-window () (interactive) (unless ide-skel-bottom-view-window-oper-in-progress (setq ide-skel-bottom-view-window-oper-in-progress t) (let ((bottom-view-window (ide-skel-get-bottom-view-window))) (when bottom-view-window (let ((ide-skel-win--win2-switch nil) (select-editor (eq bottom-view-window (selected-window)))) (ide-skel-remember-bottom-view-window) (ide-skel-win-remove-window bottom-view-window) (when select-editor (select-window (ide-skel-get-editor-window)))))) (setq ide-skel-bottom-view-window-oper-in-progress nil))) (defun ide-skel-toggle-bottom-view-window () "Toggle bottom view window." (interactive) (if (ide-skel-get-bottom-view-window) (ide-skel-hide-bottom-view-window) (ide-skel-show-bottom-view-window))) ;;; Editor (defun ide-skel-get-editor-window () (let (best-window) (setq ide-skel--current-side-windows (cons nil nil)) (dolist (win (copy-list (window-list nil 1))) (when (with-current-buffer (window-buffer win) (when (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name) (setcar ide-skel--current-side-windows win)) (when (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name) (setcdr ide-skel--current-side-windows win)) (or (not ide-skel-tabset-name) (equal ide-skel-tabset-name ide-skel-editor-window-tabset-name))) (if (null best-window) (setq best-window win) (let* ((best-window-coords (window-edges best-window)) (win-coords (window-edges win))) (when (or (< (cadr win-coords) (cadr best-window-coords)) (and (= (cadr win-coords) (cadr best-window-coords)) (< (car win-coords) (car best-window-coords)))) (setq best-window win)))))) best-window)) ;;; Left view & Right view (defun ide-skel-toggle-side-view-window (name &optional run-hooks) (if (funcall (intern (format "ide-skel-get-%s-view-window" name))) (funcall (intern (format "ide-skel-hide-%s-view-window" name)) run-hooks) (funcall (intern (format "ide-skel-show-%s-view-window" name)) run-hooks))) (defun ide-skel-toggle-left-view-window () (interactive) (ide-skel-toggle-side-view-window 'left (interactive-p))) (defun ide-skel-toggle-right-view-window () (interactive) (ide-skel-toggle-side-view-window 'right (interactive-p))) (add-hook 'kill-buffer-hook (lambda () (when (eq ide-skel-current-editor-buffer (current-buffer)) (let* ((context (gethash ide-skel-current-editor-buffer ide-skel-context-properties)) (imenu-buffer (cdr (assq :imenu-buffer context))) (imenu-window (when imenu-buffer (get-buffer-window imenu-buffer)))) (when imenu-window (set-window-dedicated-p imenu-window nil) (set-window-buffer imenu-window ide-skel-default-right-view-buffer) (set-window-dedicated-p imenu-window t)) (remhash (current-buffer) ide-skel-context-properties) (when imenu-buffer (kill-buffer imenu-buffer)))))) (defun ide-skel-send-event (side-symbol event-type &rest params) (ide-skel-recalculate-view-cache) (cond ((eq event-type 'hide) (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'hide) (ide-skel-disable-nonactual-side-view-tabs side-symbol 'disable-all)) ((eq event-type 'show) (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'show) (ide-skel-side-window-switch-to-buffer (symbol-value (intern (format "ide-skel-current-%s-view-window" side-symbol))) nil)) ((eq event-type 'editor-buffer-changed) (run-hooks 'ide-skel-editor-buffer-changed-hook) (when ide-skel-current-left-view-window (ide-skel-disable-nonactual-side-view-tabs 'left) (run-hook-with-args-until-success 'ide-skel-side-view-window-functions 'left 'editor-buffer-changed ide-skel-last-buffer-change-event ide-skel-current-editor-buffer) (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window nil)) (when ide-skel-current-right-view-window (ide-skel-disable-nonactual-side-view-tabs 'right) (run-hook-with-args-until-success 'ide-skel-side-view-window-functions 'right 'editor-buffer-changed (car params) (cadr params)) (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window nil)) (setq ide-skel-last-buffer-change-event ide-skel-current-editor-buffer)) ((eq event-type 'tab-change) (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'tab-change (car params) (cadr params))))) (defun ide-skel-hide-side-view-window (name &optional run-hooks) (let* ((view-window (funcall (intern (format "ide-skel-get-%s-view-window" name)))) (select-editor (eq view-window (selected-window)))) (when view-window (when (active-minibuffer-window) (error "Cannot remove side window while minibuffer is active")) (let* ((bottom-view-window (ide-skel-get-bottom-view-window)) (selected-bottom-view-window (and bottom-view-window (eq bottom-view-window (selected-window)))) (buffer (window-buffer view-window)) (second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left)))))) (set (intern (format "ide-skel-last-%s-view-buffer" name)) buffer) (when run-hooks (ide-skel-send-event name 'hide)) (when bottom-view-window (ide-skel-hide-bottom-view-window)) (when second-side-window (push second-side-window ide-skel-ommited-windows)) (let ((ide-skel-win--win2-switch (eq name 'left))) (set (intern (format "ide-skel-%s-view-window-width" name)) (window-width view-window)) (ide-skel-win-remove-window view-window)) (setq ide-skel-ommited-windows nil) (when bottom-view-window (ide-skel-show-bottom-view-window) (when selected-bottom-view-window (select-window (ide-skel-get-bottom-view-window)))) (ide-skel-recalculate-view-cache) (when select-editor (select-window (ide-skel-get-editor-window))))))) (defun ide-skel-hide-left-view-window (&optional run-hooks) (interactive) (let ((right-view-window (ide-skel-get-right-view-window))) (when right-view-window (ide-skel-hide-right-view-window)) (ide-skel-hide-side-view-window 'left (or run-hooks (interactive-p))) (when right-view-window (ide-skel-show-right-view-window)))) (defun ide-skel-hide-right-view-window (&optional run-hooks) (interactive) (ide-skel-hide-side-view-window 'right (or (interactive-p) run-hooks))) (defun ide-skel-get-side-view-buffer-create (name side-sym tab-label help-string keep-condition-function) (let* ((was-buffer (get-buffer name)) (km (make-sparse-keymap)) (buffer (get-buffer-create name))) (unless was-buffer (with-current-buffer buffer (kill-all-local-variables) (remove-overlays) (define-key km [drag-mouse-1] 'ignore) (use-local-map km) (make-local-variable 'mouse-wheel-scroll-amount) (make-local-variable 'auto-hscroll-mode) (make-local-variable 'hscroll-step) (make-local-variable 'hscroll-margin) (setq ide-skel-tabset-name (if (eq side-sym 'left) ide-skel-left-view-window-tabset-name ide-skel-right-view-window-tabset-name) ide-skel-tabbar-tab-label tab-label ide-skel-tabbar-tab-help-string help-string ide-skel-keep-condition-function keep-condition-function auto-hscroll-mode nil hscroll-step 0.0 hscroll-margin 0 ;; left-fringe-width 0 ;; right-fringe-width 0 buffer-read-only t mode-line-format " " mouse-wheel-scroll-amount '(1) window-size-fixed 'width) ;; (make-variable-buffer-local 'fringe-indicator-alist) (setq fringe-indicator-alist (copy-alist default-fringe-indicator-alist)) ;; (when (>= emacs-major-version 22) ;; (set 'indicate-buffer-boundaries '((up . left) (down . left)))) (setcdr (assq 'truncation fringe-indicator-alist) nil) (set (make-local-variable 'scroll-conservatively) 1500) ; much greater than 0 (when (and window-system (not ide-skel-side-view-display-cursor)) (setq cursor-type nil)))) buffer)) (defvar ide-skel-default-left-view-buffer (let ((buffer (ide-skel-get-side-view-buffer-create " Default Left View Buffer" 'left nil nil (lambda (buf) t)))) (with-current-buffer buffer (setq header-line-format " ")) buffer)) (defvar ide-skel-last-left-view-buffer ide-skel-default-left-view-buffer) (defvar ide-skel-default-right-view-buffer (let ((buffer (ide-skel-get-side-view-buffer-create " Default Right View Buffer" 'right nil nil (lambda (buf) t)))) (with-current-buffer buffer (setq header-line-format " ")) buffer)) (defvar ide-skel-last-right-view-buffer ide-skel-default-right-view-buffer) (defun ide-skel-show-side-view-window (name &optional run-hooks) (unless (funcall (intern (format "ide-skel-get-%s-view-window" name))) (let* ((current-buffer (window-buffer (selected-window))) (bottom-view-window (ide-skel-get-bottom-view-window)) root-win-node (bottom-view-window-bounds (and (or (symbol-value (intern (format "ide-skel-bottom-view-on-%s-view" name))) (and ide-skel-bottom-view-on-left-view (not ide-skel-bottom-view-on-right-view))) bottom-view-window (window-edges bottom-view-window))) best-window-bounds) (when bottom-view-window-bounds (ide-skel-hide-bottom-view-window)) (let ((second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left)))))) (when second-side-window (push second-side-window ide-skel-ommited-windows)) (setq root-win-node (ide-skel-win--analysis)) (setq best-window-bounds (window-edges (selected-window))) ; bounds of maximized window (after analysis) (ide-skel-win--synthesis (selected-window) root-win-node) (ide-skel-win-add-window (symbol-value (intern (format (if run-hooks "ide-skel-default-%s-view-buffer" "ide-skel-last-%s-view-buffer") name))) best-window-bounds name (symbol-value (intern (format "ide-skel-%s-view-window-width" name)))) (setq ide-skel-ommited-windows nil) (when bottom-view-window-bounds (ide-skel-show-bottom-view-window)) (set-window-dedicated-p (funcall (intern (format "ide-skel-get-%s-view-window" name))) t) (when run-hooks (dolist (tab (tabbar-tabs (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name)))))) (tabbar-delete-tab tab)) (ide-skel-send-event name 'show)) (some (lambda (win) (when (eq (window-buffer win) current-buffer) (select-window win) t)) (copy-list (window-list nil 1))))))) ;; Disables from view all buffers for which keep condition function ;; returns nil. If a current buffer is there, select another enabled, ;; which implies tab-change event, then select any enabled buffer. (defun ide-skel-disable-nonactual-side-view-tabs (name &optional disable-all) (let* ((tabset (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name))))) (tabs (tabbar-tabs tabset)) (editor-buffer (window-buffer (ide-skel-get-editor-window))) selected-deleted (selected-tab (tabbar-selected-tab tabset))) (when tabs (dolist (tab tabs) (let ((buffer (tabbar-tab-value tab))) (with-current-buffer buffer (when (or disable-all (not ide-skel-keep-condition-function) (not (funcall ide-skel-keep-condition-function editor-buffer))) (setq ide-skel-tabbar-enabled nil) (when (eq tab selected-tab) (setq selected-deleted t)) (tabbar-delete-tab tab))))) (let ((selected-buffer (when (and (not selected-deleted) (tabbar-tabs tabset) (tabbar-selected-value tabset))))) (when (and (not disable-all) (or selected-deleted (not (eq (tabbar-selected-tab tabset) selected-tab)))) (unless selected-buffer (setq selected-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" name))))) (ide-skel-side-window-switch-to-buffer (symbol-value (intern (format "ide-skel-current-%s-view-window" name))) selected-buffer)))))) (defun ide-skel-show-left-view-window (&optional run-hooks) (interactive) (let ((right-view-window (ide-skel-get-right-view-window))) (when right-view-window (ide-skel-hide-right-view-window)) (ide-skel-show-side-view-window 'left (or run-hooks (interactive-p))) (when right-view-window (ide-skel-show-right-view-window)))) (defun ide-skel-show-right-view-window (&optional run-hooks) (interactive) (ide-skel-show-side-view-window 'right (or run-hooks (interactive-p)))) (defun ide-skel-get-side-view-window (name) (let ((tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name))))) (some (lambda (win) (when (with-current-buffer (window-buffer win) (equal ide-skel-tabset-name tabset-name)) win)) (copy-list (window-list nil 1))))) (defun ide-skel-get-left-view-window () (ide-skel-get-side-view-window 'left)) (defun ide-skel-get-right-view-window () (ide-skel-get-side-view-window 'right)) (defun ide-skel-get-side-view-windows () (let (result (left-view-win (ide-skel-get-left-view-window)) (right-view-win (ide-skel-get-right-view-window))) (when left-view-win (push left-view-win result)) (when right-view-win (push right-view-win result)) result)) (defun ide-skel-side-view-window-p (window) (ide-skel-side-view-buffer-p (window-buffer window))) (defun ide-skel-side-view-buffer-p (buffer) (with-current-buffer buffer (or (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name) (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name)))) (defadvice delete-window (around delete-window-around-advice (&optional window)) (let* ((target-window (if window window (selected-window))) (editor-window (and (interactive-p) (ide-skel-get-editor-window))) ; for ide-skel--current-side-windows (side-effects) (hide-view-windows (and (interactive-p) (not (eq (car ide-skel--current-side-windows) target-window)) (not (eq (cdr ide-skel--current-side-windows) target-window)))) (hide-left-view-window (and hide-view-windows (car ide-skel--current-side-windows))) (hide-right-view-window (and hide-view-windows (cdr ide-skel--current-side-windows))) result) (when (interactive-p) (if (eq (car ide-skel--current-side-windows) target-window) (ide-skel-send-event 'left 'hide) (when (eq (cdr ide-skel--current-side-windows) target-window) (ide-skel-send-event 'right 'hide)))) (let* ((edges (window-inside-edges window)) (buf (window-buffer window)) win (center-position (cons (/ (+ (car edges) (caddr edges)) 2) (/ (+ (cadr edges) (cadddr edges)) 2)))) (when hide-left-view-window (ide-skel-hide-left-view-window)) (when hide-right-view-window (ide-skel-hide-right-view-window)) (setq win (window-at (car center-position) (cdr center-position))) (when (eq (window-buffer win) buf) (setq window (window-at (car center-position) (cdr center-position))))) (unwind-protect (setq result (progn ad-do-it)) (when hide-left-view-window (ide-skel-show-left-view-window)) (when hide-right-view-window (ide-skel-show-right-view-window))) result)) (ad-activate 'delete-window) (defadvice delete-other-windows (around delete-other-windows-around-advice (&optional window)) (ide-skel-assert-not-in-side-view-window) (let* ((editor-window (ide-skel-get-editor-window)) (dont-revert-after (and (interactive-p) (listp current-prefix-arg) (car current-prefix-arg))) ; C-u (hide-left-view-window (and (interactive-p) (car ide-skel--current-side-windows))) (hide-right-view-window (and (interactive-p) (cdr ide-skel--current-side-windows))) result) (when hide-left-view-window (ide-skel-hide-left-view-window dont-revert-after)) (when hide-right-view-window (ide-skel-hide-right-view-window dont-revert-after)) (unwind-protect (setq result (progn ad-do-it)) (when (not dont-revert-after) (when hide-left-view-window (ide-skel-show-left-view-window)) (when hide-right-view-window (ide-skel-show-right-view-window)))) result)) (ad-activate 'delete-other-windows) (defun ide-skel-assert-not-in-side-view-window () (when (and (interactive-p) (ide-skel-side-view-window-p (selected-window))) (error "Cannot do it"))) (defadvice kill-buffer (before kill-buffer-before-advice (buffer)) (ide-skel-assert-not-in-side-view-window)) (ad-activate 'kill-buffer) (defadvice split-window-vertically (before split-window-vertically-before-advice (&optional size)) (ide-skel-assert-not-in-side-view-window)) (ad-activate 'split-window-vertically) (defadvice split-window-horizontally (before split-window-horizontally-before-advice (&optional size)) (ide-skel-assert-not-in-side-view-window)) (ad-activate 'split-window-horizontally) (defadvice mouse-drag-vertical-line (around mouse-drag-vertical-line-around-advice (start-event)) (let* ((editor-window (ide-skel-get-editor-window)) (left-view-window (car ide-skel--current-side-windows)) (right-view-window (cdr ide-skel--current-side-windows))) (when left-view-window (with-selected-window left-view-window (setq window-size-fixed nil))) (when right-view-window (with-selected-window right-view-window (setq window-size-fixed nil))) (unwind-protect (progn ad-do-it) (when left-view-window (with-selected-window left-view-window (setq window-size-fixed 'width))) (when right-view-window (with-selected-window right-view-window (setq window-size-fixed 'width)))))) (ad-activate 'mouse-drag-vertical-line) (defadvice other-window (after other-window-after-advice (arg &optional all-frames)) (if (memq (selected-window) (list ide-skel-current-left-view-window ide-skel-current-right-view-window)) (other-window arg all-frames) ad-return-value)) (ad-activate 'other-window) ;; Buffer list buffer (left side view) (define-derived-mode fundmental-mode fundamental-mode "Fundmental") (setq default-major-mode 'fundmental-mode) (defun ide-skel-recentf-closed-files-list () "Lista ostatnio otwieranych, ale aktualnie zamknietych plikow" (let* ((open-file-paths (delq nil (mapcar (lambda (buffer) (buffer-file-name buffer)) (buffer-list))))) (if (featurep 'recentf) (sort (reverse (set-difference recentf-list open-file-paths :test 'string=)) (lambda (path1 path2) (string< (file-name-nondirectory path1) (file-name-nondirectory path2)))) nil))) (defun ide-skel-select-buffer (buffer-or-path &optional line-no) (let* ((window (ide-skel-get-last-selected-window)) (buffer (or (and (bufferp buffer-or-path) buffer-or-path) (find-file-noselect buffer-or-path))) (is-bottom-view-buffer (ide-skel-bottom-view-buffer-p buffer))) (when (not (buffer-live-p buffer)) (error "Buffer %s is dead" buffer)) (unless (get-buffer-window buffer) ;; (message "%S %S" window (ide-skel-get-bottom-view-window)) (if (and window (not (eq window (ide-skel-get-bottom-view-window))) (not is-bottom-view-buffer)) (set-window-buffer window buffer) (let ((editor-window (ide-skel-get-editor-window))) (select-window editor-window) (if is-bottom-view-buffer (switch-to-buffer-other-window buffer) (set-window-buffer editor-window buffer))))) (setq ide-skel-last-selected-window-or-buffer (cons (get-buffer-window buffer) buffer)) (select-window (car ide-skel-last-selected-window-or-buffer)) (when line-no (with-current-buffer buffer (goto-line line-no))))) (defun ide-skel-select-buffer-handler (event) (interactive "@e") ;; (message "EVENT: %S" event) (with-selected-window (posn-window (event-start event)) (let* ((object (get-text-property (posn-point (event-start event)) 'object-to-display))) (beginning-of-line) (ide-skel-select-buffer object)))) (defun ide-skel-buffers-view-insert-buffer-list (label buffer-list) (setq label (propertize label 'face 'bold)) (insert (format "%s\n" label)) (dolist (object buffer-list) (let* ((label (format " % -100s" (if (bufferp object) (buffer-name object) (file-name-nondirectory object)))) (km (make-sparse-keymap))) (define-key km [mouse-1] 'ide-skel-select-buffer-handler) (setq label (propertize label 'mouse-face 'ide-skel-highlight-face 'local-map km 'face 'variable-pitch 'pointer 'hand 'object-to-display object 'help-echo (if (bufferp object) (buffer-file-name object) object))) (insert label) (insert "\n")))) (defun ide-skel-buffers-view-fill () (when ide-skel-current-left-view-window (with-current-buffer ide-skel-buffer-list-buffer (let ((point (point)) (window-start (when (eq (window-buffer ide-skel-current-left-view-window) ide-skel-buffer-list-buffer) (save-excursion (goto-char (window-start ide-skel-current-left-view-window)) (cons (line-number-at-pos) (current-column)))))) ;; (message "%S" window-start) (let (asterisk-buffers (inhibit-read-only t) normal-buffers) (erase-buffer) (dolist (buffer (sort (buffer-list) (lambda (buf1 buf2) (string< (buffer-name buf1) (buffer-name buf2))))) (let* ((name (buffer-name buffer)) (first-char (aref (buffer-name buffer) 0))) (unless (char-equal ?\ first-char) (if (char-equal ?* first-char) (push buffer asterisk-buffers) (push buffer normal-buffers))))) (ide-skel-buffers-view-insert-buffer-list "Normal Buffers:" normal-buffers) (ide-skel-buffers-view-insert-buffer-list "Scratch Buffers:" asterisk-buffers) (ide-skel-buffers-view-insert-buffer-list "Recent Files:" (ide-skel-recentf-closed-files-list))) (if window-start (let ((pos (save-excursion (goto-line (car window-start)) (beginning-of-line) (forward-char (cdr window-start)) (point)))) (set-window-start ide-skel-current-left-view-window pos)) (goto-char point) (beginning-of-line)))))) (defun ide-skel-some-view-window-buffer (side-symbol predicate) (some (lambda (buffer) (and (buffer-live-p buffer) (with-current-buffer buffer (and (equal ide-skel-tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" side-symbol)))) ide-skel-tabbar-enabled (funcall predicate buffer) buffer)))) (buffer-list))) (defun ide-skel-side-window-switch-to-buffer (side-window buffer) "If BUFFER is nil, then select any non-default buffer. The TAB-CHANGE event is send only if selected buffer changed." (unwind-protect (let* ((side-symbol (cond ((eq side-window ide-skel-current-left-view-window) 'left) ((eq side-window ide-skel-current-right-view-window) 'right) (t nil))) (context (gethash ide-skel-current-editor-buffer ide-skel-context-properties)) (context-default-tab-label-symbol (intern (format "default-%s-tab-label" side-symbol)))) (when side-symbol (unless buffer (let* ((default-empty-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" side-symbol)))) (context-default-tab-label (cdr (assq context-default-tab-label-symbol context))) (last-view-window-tab-label (symbol-value (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol))))) ;; first non-nil: ;; - selected before in this context ;; - selected in previous context ;; - current if other than default-empty ;; - first non default-empty ;; - default-empty (setq buffer (or (and context-default-tab-label (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) (equal ide-skel-tabbar-tab-label context-default-tab-label)))) (and last-view-window-tab-label (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) (equal ide-skel-tabbar-tab-label last-view-window-tab-label)))) (and (not (eq (window-buffer side-window) default-empty-buffer)) (window-buffer side-window)) (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) ide-skel-tabbar-tab-label)) default-empty-buffer)))) (unless (eq (window-buffer side-window) buffer) (set (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol)) (with-current-buffer buffer ide-skel-tabbar-tab-label)) (setq context (assq-delete-all context-default-tab-label-symbol context)) (puthash ide-skel-current-editor-buffer (cons (cons context-default-tab-label-symbol (with-current-buffer buffer ide-skel-tabbar-tab-label)) context) ide-skel-context-properties) (ide-skel-send-event side-symbol 'tab-change (window-buffer side-window) buffer))) (set-window-dedicated-p side-window nil) (set-window-buffer side-window buffer)) (set-window-dedicated-p side-window t))) ;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer... (defun ide-skel-default-side-view-window-function (side event &rest list) ;; (message "SIDE: %S, event: %S, rest: %S %S" side event list ide-skel-current-left-view-window) (when (and (eq side 'left) ide-skel-current-left-view-window) (cond ((eq event 'show) (unless ide-skel-buffer-list-buffer (setq ide-skel-buffer-list-buffer (ide-skel-get-side-view-buffer-create " Ide-Skel Buffer List Buffer" 'left "Bufs" "List of opened and recent files" (lambda (buf) t))) (with-current-buffer ide-skel-buffer-list-buffer (setq ide-skel-tabbar-enabled t))) (ide-skel-buffers-view-fill) (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window ide-skel-buffer-list-buffer)))) nil) ;; (message "SIDE: %S, event: %S, rest: %S" side event list) (add-hook 'change-major-mode-hook (lambda () (setq ide-skel-buffer-list-tick t))) (add-hook 'kill-buffer-hook (lambda () (setq ide-skel-buffer-list-tick t))) (run-with-idle-timer 0.1 t (lambda () (when ide-skel-buffer-list-tick (setq ide-skel-buffer-list-tick nil) (ide-skel-buffers-view-fill)))) (add-hook 'ide-skel-side-view-window-functions 'ide-skel-default-side-view-window-function) (define-key-after global-map [tool-bar ide-skel-toggle-left-view-window] (list 'menu-item "Left View Window" 'ide-skel-toggle-left-view-window :image ide-skel-left-view-window-image)) (define-key-after global-map [tool-bar ide-skel-toggle-bottom-view-window] (list 'menu-item "Bottom View Window" 'ide-skel-toggle-bottom-view-window :image ide-skel-bottom-view-window-image)) (define-key-after global-map [tool-bar ide-skel-toggle-right-view-window] (list 'menu-item "Right View Window" 'ide-skel-toggle-right-view-window :image ide-skel-right-view-window-image)) (eval-after-load "tabbar" '(ide-skel-tabbar-load-hook)) ;;; Tree Widget (defadvice tree-widget-lookup-image (around tree-widget-lookup-image-around-advice (name)) (if (equal (tree-widget-theme-name) "small-folder") (setq ad-return-value (apply 'create-image (symbol-value (intern (format "ide-skel-tree-widget-%s-xpm" name))) 'xpm t (tree-widget-image-properties name))) ad-do-it)) (ad-activate 'tree-widget-lookup-image) ;;; Imenu (require 'imenu) (defun ide-skel-imenu-refresh () (interactive) (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t)) (defun ide-skel-imenu-sort-change () (interactive) (with-current-buffer (window-buffer ide-skel-current-right-view-window) (setq ide-skel-imenu-sorted (not ide-skel-imenu-sorted))) (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t)) (defun ide-skel-imenu-get-buffer-create (editor-buffer &optional dont-create) (let* ((context (gethash editor-buffer ide-skel-context-properties)) (buffer (cdr (assq :imenu-buffer context)))) (when (and (not buffer) (not dont-create)) (setq buffer (ide-skel-get-side-view-buffer-create (concat " " (buffer-name editor-buffer) " Ide Skel Imenu") 'right "Imenu" nil (lambda (editor-buffer) (eq ide-skel-imenu-editor-buffer ide-skel-current-editor-buffer)))) (with-current-buffer buffer (setq ide-skel-tabbar-menu-function (lambda () (let ((is-outline-mode (with-current-buffer (window-buffer ide-skel-current-right-view-window) (with-current-buffer ide-skel-imenu-editor-buffer (or (eq major-mode 'outline-mode) (and (boundp 'outline-minor-mode) (symbol-value 'outline-minor-mode))))))) (append (list (list 'ide-skel-imenu-refresh "Refresh" t) (unless is-outline-mode (list 'ide-skel-imenu-sort-change (if (with-current-buffer (window-buffer ide-skel-current-right-view-window) ide-skel-imenu-sorted) "Natural order" "Sorted order") t)))))) ide-skel-imenu-editor-buffer editor-buffer ide-skel-imenu-open-paths (make-hash-table :test 'equal)) (add-hook 'tree-widget-after-toggle-functions (lambda (widget) (let ((path (widget-get widget :path))) (when path (if (widget-get widget :open) (puthash path t ide-skel-imenu-open-paths) (remhash path ide-skel-imenu-open-paths))))) nil t)) (puthash editor-buffer (cons (cons :imenu-buffer buffer) context) ide-skel-context-properties)) buffer)) (defun ide-skel-tree-node-notify (widget &rest rest) (let ((index-name (widget-get widget :index-name)) (index-position (widget-get widget :index-position)) (function (widget-get widget :function)) (arguments (widget-get widget :arguments))) (select-window (ide-skel-get-editor-window)) (if function (apply function index-name index-position arguments) (goto-char index-position)))) ;; building hash (defun ide-skel-imenu-analyze (hash prefix element) (when element (if (and (consp (cdr element)) (listp (cadr element))) (dolist (elem (cdr element)) (ide-skel-imenu-analyze hash (concat prefix "/" (car element)) elem)) (puthash (concat prefix "/" (car element)) (list (cons :element element)) hash)))) ;; logical linking, internal nodes creation (defun ide-skel-imenu-analyze2 (hash prefix element) (when element (if (and (consp (cdr element)) (listp (cadr element))) (dolist (elem (cdr element)) (ide-skel-imenu-analyze2 hash (concat prefix "/" (car element)) elem)) (let* ((index-name (car element)) (path (concat prefix "/" index-name)) (node (gethash path hash)) (reverse-separators (let ((index 0) result) (while (string-match "[*#:.]+" index-name index) (push (cons (match-beginning 0) (match-end 0)) result) (setq index (match-end 0))) result)) found) (some (lambda (separator-pair) (let* ((begin (car separator-pair)) (end (cdr separator-pair)) (before-name (substring index-name 0 begin)) (after-name (substring index-name end)) (parent-path (concat prefix "/" before-name)) (parent-node (gethash parent-path hash))) (when parent-node (push (cons :parent parent-path) node) (unless (assq :name node) (push (cons :name after-name) node)) (puthash path node hash) (unless (assq :widget parent-node) (let* ((parent-element (cdr (assq :element parent-node))) (parent-index-name (car parent-element)) (parent-index-position (if (consp (cdr parent-element)) (cadr parent-element) (cdr parent-element))) (parent-function (when (consp (cdr parent-element)) (caddr parent-element))) (open-status (gethash parent-path ide-skel-imenu-open-paths)) (parent-arguments (when (consp (cdr parent-element)) (cdddr parent-element)))) (push (cons :widget ;; internal node (list 'ide-skel-imenu-internal-node-widget :open open-status :indent 0 :path parent-path :notify 'ide-skel-tree-node-notify :index-name parent-index-name :index-position parent-index-position :function parent-function :arguments parent-arguments :node (list 'push-button :format "%[%t%]\n" :button-face 'variable-pitch :tag (or (cdr (assq :name parent-node)) before-name) ;; :tag (cadr (assq :element parent-node)) ))) parent-node) (puthash parent-path parent-node hash))) t))) reverse-separators))))) ;; widget linking, leafs creation (defun ide-skel-imenu-analyze3 (hash prefix element) (when element (if (and (consp (cdr element)) (listp (cadr element))) (dolist (elem (cdr element)) (ide-skel-imenu-analyze3 hash (concat prefix "/" (car element)) elem)) (let* ((index-name (car element)) (index-position (if (consp (cdr element)) (cadr element) (cdr element))) (function (when (consp (cdr element)) (caddr element))) (arguments (when (consp (cdr element)) (cdddr element))) (path (concat prefix "/" index-name)) (node (gethash path hash)) (widget (cdr (assq :widget node))) (parent-path (cdr (assq :parent node))) (parent-node (when parent-path (gethash parent-path hash))) (parent-widget (when parent-node (cdr (assq :widget parent-node))))) ;; create leaf if not exists (unless widget ;; leaf node (push (cons :widget (list 'ide-skel-imenu-leaf-widget :notify 'ide-skel-tree-node-notify :index-name index-name :index-position index-position :function function :arguments arguments :tag (or (cdr (assq :name node)) index-name))) node) (puthash path node hash) (setq widget (cdr (assq :widget node)))) ;; add to parent (when parent-widget (setcdr (last parent-widget) (cons widget nil))))))) (defun ide-skel-imenu-create-tree (hash prefix element) (when element (if (and (consp (cdr element)) (listp (cadr element))) (let* ((menu-title (car element)) (sub-alist (cdr element)) (path (concat prefix "/" menu-title)) (open-status (gethash path ide-skel-imenu-open-paths))) (append (list 'ide-skel-imenu-internal-node-widget :open open-status :indent 0 :path path :node (list 'push-button :format "%[%t%]\n" :button-face 'variable-pitch :tag menu-title)) (delq nil (mapcar (lambda (elem) (ide-skel-imenu-create-tree hash path elem)) sub-alist)))) (let* ((index-name (car element)) (index-position (if (consp (cdr element)) (cadr element) (cdr element))) (function (when (consp (cdr element)) (caddr element))) (arguments (when (consp (cdr element)) (cdddr element))) (path (concat prefix "/" index-name)) (node (gethash path hash)) (parent-path (cdr (assq :parent node))) (widget (cdr (assq :widget node)))) (unless parent-path widget))))) (defun ide-skel-imenu-compare (e1 e2) (let ((ce1 (and (consp (cdr e1)) (listp (cadr e1)))) (ce2 (and (consp (cdr e2)) (listp (cadr e2))))) (when ce1 (setcdr e1 (sort (cdr e1) 'ide-skel-imenu-compare))) (when ce2 (setcdr e2 (sort (cdr e2) 'ide-skel-imenu-compare))) (if (or (and ce1 ce2) (and (not ce1) (not ce2))) (string< (car e1) (car e2)) (and ce1 (not ce2))))) (defun ide-skel-outline-tree-create (index-alist) (let (stack node-list (current-depth 0)) (dolist (element index-alist) (let ((index-name (car element)) (index-position (if (consp (cdr element)) (cadr element) (cdr element))) (function (when (consp (cdr element)) (caddr element))) (arguments (when (consp (cdr element)) (cdddr element)))) ;; (message "index-name: %S" index-name) (string-match "^\\([*]+\\)[ ]*\\(.*\\)$" index-name) (let* ((depth (length (match-string 1 index-name))) (name (match-string 2 index-name)) parent-node node) (while (and stack (>= (caar stack) depth)) (setq stack (cdr stack))) (when stack (setq parent-node (cdar stack)) (when (eq (car parent-node) 'ide-skel-imenu-leaf-widget) (let ((path (plist-get (cdr parent-node) :path))) (setcar parent-node 'ide-skel-imenu-internal-node-widget) (setcdr parent-node (list :open (gethash path ide-skel-imenu-open-paths) :indent 0 :notify 'ide-skel-tree-node-notify :index-name (plist-get (cdr parent-node) :index-name) :index-position (plist-get (cdr parent-node) :index-position) :function (plist-get (cdr parent-node) :function) :arguments (plist-get (cdr parent-node) :arguments) :path path :node (list 'push-button :format "%[%t%]\n" :button-face 'variable-pitch :tag (plist-get (cdr parent-node) :tag))))))) (setq node (list 'ide-skel-imenu-leaf-widget :notify 'ide-skel-tree-node-notify :index-name index-name :index-position index-position :function function :path (concat (plist-get (cdr parent-node) :path) "/" index-name) :arguments arguments :tag name)) (push (cons depth node) stack) (if parent-node (setcdr (last parent-node) (cons node nil)) (push node node-list))))) (append (list 'ide-skel-imenu-internal-node-widget :open t :indent 0 :path "" :tag "") (reverse node-list)))) (defun ide-skel-imenu-side-view-draw-tree (imenu-buffer &optional refresh) (with-current-buffer imenu-buffer (let ((index-alist (with-current-buffer ide-skel-imenu-editor-buffer (when refresh (imenu--cleanup) (setq imenu--index-alist nil)) (cons "" (progn (unless imenu--index-alist (font-lock-default-fontify-buffer) (condition-case err (imenu--make-index-alist t) (error nil))) imenu--index-alist)))) (is-outline-mode (with-current-buffer ide-skel-imenu-editor-buffer (or (eq major-mode 'outline-mode) (and (boundp 'outline-minor-mode) (symbol-value 'outline-minor-mode))))) (inhibit-read-only t) (hash (make-hash-table :test 'equal)) (start-line (save-excursion (goto-char (window-start ide-skel-current-right-view-window)) (line-number-at-pos)))) (unless is-outline-mode (when ide-skel-imenu-sorted (setq index-alist (cons "" (sort (copy-tree (cdr index-alist)) 'ide-skel-imenu-compare)))) (ide-skel-imenu-analyze hash "/" index-alist) (ide-skel-imenu-analyze2 hash "/" index-alist) (ide-skel-imenu-analyze3 hash "/" index-alist)) (let ((tree (if is-outline-mode (ide-skel-outline-tree-create (cdr index-alist)) (ide-skel-imenu-create-tree hash "/" index-alist)))) (plist-put (cdr tree) :open t) (plist-put (cdr tree) :indent 0) (erase-buffer) (tree-widget-set-theme "small-folder") (widget-create tree) (set-keymap-parent (current-local-map) tree-widget-button-keymap) (widget-setup) (goto-line start-line) (beginning-of-line) (set-window-start ide-skel-current-right-view-window (point)))))) (defun ide-skel-imenu-side-view-window-function (side event &rest list) ;; (message "%S %S %S" side event list) (when (and (eq side 'right) ide-skel-current-right-view-window) (let ((imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer t))) (when (memq event '(show editor-buffer-changed)) (when (ide-skel-has-imenu ide-skel-current-editor-buffer) (unless imenu-buffer (setq imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer))) (with-current-buffer imenu-buffer (setq ide-skel-tabbar-enabled t)))) (when (and imenu-buffer (eq event 'tab-change) (eq (cadr list) imenu-buffer)) (with-current-buffer imenu-buffer (when (= (buffer-size) 0) (ide-skel-imenu-side-view-draw-tree imenu-buffer)))))) nil) (add-hook 'ide-skel-side-view-window-functions 'ide-skel-imenu-side-view-window-function) ;;; Info (require 'info) (defun ide-skel-info-get-buffer-create () (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Info" 'left "Info" "Info browser" (lambda (editor-buffer) t)))) (with-current-buffer buffer (setq ide-skel-tabbar-menu-function (lambda () (append (list (list 'ide-skel-info-refresh "Refresh" t)))) ide-skel-info-open-paths (make-hash-table :test 'equal) ide-skel-info-root-node (cons "Top" "(dir)top")) (add-hook 'tree-widget-after-toggle-functions (lambda (widget) (let ((path (widget-get widget :path))) (when path (if (widget-get widget :open) (puthash path t ide-skel-info-open-paths) (remhash path ide-skel-info-open-paths))))) nil t)) buffer)) (defun ide-skel-info-file-open (widget &rest rest) (let ((path (widget-get widget :path))) (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" path)) (error "Invalid node %s" path) (let ((filename (match-string 1 path)) (nodename (match-string 2 path)) (buffer (get-buffer "*info*")) buffer-win) (unless buffer (with-selected-window (ide-skel-get-last-selected-window) (info) (setq buffer (window-buffer (selected-window))) (setq buffer-win (selected-window)))) (unless buffer-win (setq buffer-win (get-buffer-window buffer)) (unless buffer-win (with-selected-window (ide-skel-get-last-selected-window) (switch-to-buffer buffer) (setq buffer-win (selected-window))))) (select-window buffer-win) (Info-find-node filename nodename))))) (defun ide-skel-info-tree-expand-dir (tree) (let ((path (widget-get tree :path))) (condition-case err (mapcar 'ide-skel-info-tree-widget (Info-speedbar-fetch-file-nodes path)) (error (message "%s" (error-message-string err)) nil)))) (defun ide-skel-info-tree-widget (e) (let ((name (car e)) (path (cdr e))) (if (condition-case err (Info-speedbar-fetch-file-nodes path) (error nil)) (list 'ide-skel-info-tree-dir-widget :path path :help-echo name :open (gethash path ide-skel-info-open-paths) :node (list 'push-button :tag name :format "%[%t%]\n" :notify 'ide-skel-info-file-open :path path :button-face 'variable-pitch :help-echo name :keymap tree-widget-button-keymap )) (list 'ide-skel-info-tree-file-widget :path path :help-echo name :keymap tree-widget-button-keymap :tag name)))) (defun ide-skel-info-refresh (&optional show-top) (interactive) (with-current-buffer ide-skel-info-buffer (let ((inhibit-read-only t) (start-line (save-excursion (goto-char (window-start ide-skel-current-left-view-window)) (line-number-at-pos)))) (erase-buffer) (tree-widget-set-theme "small-folder") (let ((tree (ide-skel-info-tree-widget ide-skel-info-root-node))) (plist-put (cdr tree) :open t) (widget-create tree)) (set-keymap-parent (current-local-map) tree-widget-button-keymap) (widget-setup) (if show-top (goto-char (point-min)) (goto-line start-line)) (beginning-of-line) (set-window-start ide-skel-current-right-view-window (point))))) (defun ide-skel-info (root-node) (with-current-buffer ide-skel-info-buffer (clrhash ide-skel-info-open-paths) (setq ide-skel-info-root-node root-node) (ide-skel-info-refresh t))) (defun ide-skel-info-side-view-window-function (side event &rest list) (when (and (eq side 'left) ide-skel-current-left-view-window) (cond ((eq event 'show) (unless ide-skel-info-buffer (setq ide-skel-info-buffer (ide-skel-info-get-buffer-create))) (with-current-buffer ide-skel-info-buffer (setq ide-skel-tabbar-enabled t))) ((and (eq event 'tab-change) (eq (cadr list) ide-skel-info-buffer) (= (buffer-size ide-skel-info-buffer) 0)) (ide-skel-info-refresh)))) nil) (add-hook 'ide-skel-side-view-window-functions 'ide-skel-info-side-view-window-function) ;;; Dir tree (defun ide-skel-dir-node-notify (widget &rest rest) (let ((path (widget-get widget :path))) (ide-skel-dir path))) (defun ide-skel-file-open (widget &rest rest) (let ((path (widget-get widget :path))) (ide-skel-select-buffer path))) (defun ide-skel-dir-tree-widget (e) "Return a widget to display file or directory E." (if (file-directory-p e) `(ide-skel-dir-tree-dir-widget :path ,e :help-echo ,e :open ,(gethash e ide-skel-dir-open-paths) :node (push-button :tag ,(file-name-as-directory (file-name-nondirectory e)) :format "%[%t%]\n" :notify ide-skel-dir-node-notify :path ,e :button-face (variable-pitch bold) :help-echo ,e :keymap ,tree-widget-button-keymap ; Emacs )) `(ide-skel-dir-tree-file-widget :path ,e :help-echo ,e :tag ,(file-name-nondirectory e)))) (defun ide-skel-dir-get-buffer-create () (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Dirs" 'left "Dirs" "Filesystem browser" (lambda (editor-buffer) t)))) (with-current-buffer buffer (setq ide-skel-tabbar-menu-function (lambda () (append (list (list 'ide-skel-dir-refresh "Refresh" t) (when (and (buffer-file-name ide-skel-current-editor-buffer) (fboundp 'ide-skel-proj-get-project-create) (funcall 'ide-skel-project-p (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer))))) (list 'ide-skel-dir-project "Show project tree" t)) (list 'ide-skel-dir-home "Home" t) (list 'ide-skel-dir-filesystem-root "/" t) ))) ide-skel-dir-open-paths (make-hash-table :test 'equal) ide-skel-dir-root-dir (file-truename (substitute-in-file-name "~"))) (add-hook 'tree-widget-after-toggle-functions (lambda (widget) (let ((path (widget-get widget :path))) (when path (if (widget-get widget :open) (puthash path t ide-skel-dir-open-paths) (remhash path ide-skel-dir-open-paths))))) nil t)) buffer)) (defun ide-skel-dir-tree-list (dir) "Return the content of the directory DIR. Return the list of components found, with sub-directories at the beginning of the list." (let (files dirs) (dolist (entry (directory-files dir 'full)) (unless (string-equal (substring entry -1) ".") (if (file-directory-p entry) (push entry dirs) (push entry files)))) (nreverse (nconc files dirs)))) (defun ide-skel-dir-tree-expand-dir (tree) "Expand the tree widget TREE. Return a list of child widgets." (let ((dir (directory-file-name (widget-get tree :path)))) (if (file-accessible-directory-p dir) (progn (message "Reading directory %s..." dir) (condition-case err (prog1 (mapcar 'ide-skel-dir-tree-widget (ide-skel-dir-tree-list dir)) (message "Reading directory %s...done" dir)) (error (message "%s" (error-message-string err)) nil))) (error "This directory is inaccessible")))) (defun ide-skel-select-dir-handler (event) (interactive "@e") (with-selected-window (posn-window (event-start event)) (let* ((path (get-text-property (posn-point (event-start event)) 'path))) (ide-skel-dir path)))) (defun ide-skel-dir-refresh (&optional show-top) (interactive) (with-current-buffer ide-skel-dir-buffer (let ((inhibit-read-only t) (start-line (save-excursion (goto-char (window-start ide-skel-current-left-view-window)) (line-number-at-pos)))) (erase-buffer) (let ((path-dirs (split-string (directory-file-name ide-skel-dir-root-dir) "[/\\]")) (km (make-sparse-keymap)) path) (setq path-dirs (reverse (cdr (reverse path-dirs)))) (define-key km [mouse-1] 'ide-skel-select-dir-handler) (while path-dirs (let ((dir (car path-dirs))) (when (and (> (current-column) 0) (>= (+ (current-column) (length dir) 1) (window-width ide-skel-current-left-view-window))) (insert "\n")) (setq path (directory-file-name (concat path (format "/%s" dir)))) (unless (equal (char-before) ?/) (insert "/")) (insert (propertize dir 'face 'bold 'local-map km 'mouse-face 'highlight 'path path))) (setq path-dirs (cdr path-dirs)))) (insert "\n\n") (tree-widget-set-theme "small-folder") (let ((default-directory ide-skel-dir-root-dir) (tree (ide-skel-dir-tree-widget (directory-file-name ide-skel-dir-root-dir)))) (plist-put (cdr tree) :open t) (widget-create tree)) (set-keymap-parent (current-local-map) tree-widget-button-keymap) (widget-setup) (if show-top (goto-char (point-min)) (goto-line start-line)) (beginning-of-line) (set-window-start ide-skel-current-right-view-window (point)) ))) (defun ide-skel-dir (root-dir) (with-current-buffer ide-skel-dir-buffer (clrhash ide-skel-dir-open-paths) (setq ide-skel-dir-root-dir (file-truename (substitute-in-file-name root-dir))) (ide-skel-dir-refresh t))) (defun ide-skel-dir-project () (interactive) (let ((root-dir (funcall 'ide-skel-project-root-path (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer)))))) (message "Root dir: %S" root-dir) (ide-skel-dir root-dir))) (defun ide-skel-dir-home () (interactive) (ide-skel-dir "~")) (defun ide-skel-dir-filesystem-root () (interactive) (ide-skel-dir "/")) (defun ide-skel-dirs-side-view-window-function (side event &rest list) (when (and (eq side 'left) ide-skel-current-left-view-window) (cond ((eq event 'show) (unless ide-skel-dir-buffer (setq ide-skel-dir-buffer (ide-skel-dir-get-buffer-create))) (with-current-buffer ide-skel-dir-buffer (setq ide-skel-tabbar-enabled t))) ((and (eq event 'tab-change) (eq (cadr list) ide-skel-dir-buffer) (= (buffer-size ide-skel-dir-buffer) 0)) (ide-skel-dir-refresh)))) nil) (add-hook 'ide-skel-side-view-window-functions 'ide-skel-dirs-side-view-window-function) (easy-menu-add-item nil nil ide-skel-project-menu t) (defun ide-skel-proj-insert-with-face (string face) (let ((point (point))) (insert string) (let ((overlay (make-overlay point (point)))) (overlay-put overlay 'face face)))) (defun ide-skel-mode-name-stringify (mode-name) (let ((name (format "%s" mode-name))) (replace-regexp-in-string "-" " " (capitalize (if (string-match "^\\(.*\\)-mode" name) (match-string 1 name) name))))) (defun ide-skel-proj-get-all-dirs (root-dir) (condition-case err (split-string (shell-command-to-string (format "find %s -type d | grep -v '/CVS\\|/\\.svn\\|/\\.git'" root-dir)) "\n" t) (error nil))) (defun ide-skel-shell () (interactive) (when (fboundp 'ide-skel-show-bottom-view-window) (funcall 'ide-skel-show-bottom-view-window) (select-window (or (funcall 'ide-skel-get-bottom-view-window) (selected-window))) (ansi-term (or (getenv "ESHELL") (getenv "SHELL"))))) (defun ide-skel-project-menu (menu) (let* ((curbuf-file (buffer-file-name (current-buffer))) (curbuf-mode-name (when (and (buffer-file-name (current-buffer)) (ide-skel-mode-file-regexp-list (list major-mode))) (ide-skel-mode-name-stringify major-mode)))) (condition-case err (append (when curbuf-mode-name (list (vector (format "Search for %s file..." curbuf-mode-name) 'ide-skel-proj-find-files-by-regexp curbuf-mode-name))) (list (vector "Search for file..." 'ide-skel-proj-find-text-files-by-regexp curbuf-mode-name)) (when curbuf-mode-name (list (vector (format "Grep %s files..." curbuf-mode-name) 'ide-skel-proj-grep-files-by-regexp curbuf-mode-name))) (list (vector "Grep files..." 'ide-skel-proj-grep-text-files-by-regexp curbuf-file)) (list (vector "Shell" 'ide-skel-shell t))) (error (message (error-message-string err)))))) ;; (ide-skel-project . relative-path) jesli path nalezy do projektu, ;; (qdir . filename) wpp (defun ide-skel-proj-get-project-create (path) (let ((path (file-truename (substitute-in-file-name path))) dir) (if (file-directory-p path) (progn (setq path (file-name-as-directory path)) (setq dir path)) (setq dir (file-name-as-directory (file-name-directory path)))) ;; path - true, qualified file name (no environment variables, ~, links) (let ((project (some (lambda (project) (let ((root-dir (ide-skel-project-root-path project))) (when (string-match (concat "^" (regexp-quote root-dir)) path) project))) ide-skel-projects))) (when project (setq dir (ide-skel-project-root-path project))) ;; there is no such project (unless project (let ((last-project-dir dir) (dir-list (split-string dir "/")) is-project) ;; there is no root dir (while (directory-files dir t (concat "^" ide-skel-cvs-dir-regexp) t) (setq is-project t last-project-dir (file-name-as-directory dir) dir (file-name-as-directory (file-name-directory (directory-file-name dir))))) (when is-project (let ((list (nthcdr (1- (length (split-string last-project-dir "/"))) dir-list))) (cond ((equal (car list) "trunk") (setq last-project-dir (concat last-project-dir "trunk/"))) ((member (car list) '("branches" "tags")) (setq last-project-dir (concat last-project-dir (car list) "/" (when (cdr list) (concat (cadr list) "/"))))) (t))) (setq project (make-ide-skel-project :root-path last-project-dir :include-file-path (ide-skel-proj-get-all-dirs last-project-dir)) dir last-project-dir) (push project ide-skel-projects)))) (list (or project dir) (file-relative-name path dir) path)))) (defun ide-skel-proj-get-root (proj-or-dir) (when proj-or-dir (directory-file-name (file-truename (substitute-in-file-name (if (ide-skel-project-p proj-or-dir) (ide-skel-project-root-path proj-or-dir) proj-or-dir)))))) (defun ide-skel-proj-find-files (dir file-predicate &optional dir-predicate) "Return list of all qualified file paths in tree dir with root DIR, for which FILE-PREDICATE returns non-nil. We will go into directory only if DIR-PREDICATE returns non-nil or DIR-PREDICATE *is* nil." (setq dir (file-name-as-directory (file-truename (substitute-in-file-name dir)))) (let (result-list) (mapcar (lambda (path) (if (file-directory-p path) (when (and (file-accessible-directory-p path) (or (null dir-predicate) (funcall dir-predicate path))) (setq result-list (append result-list (ide-skel-proj-find-files path file-predicate dir-predicate)))) (when (or (null file-predicate) (funcall file-predicate path)) (push path result-list)))) (delete (concat (file-name-as-directory dir) ".") (delete (concat (file-name-as-directory dir) "..") (directory-files dir t nil t)))) result-list)) (defun ide-skel-root-dir-for-path (path) (let (root-dir) (setq root-dir (car (ide-skel-proj-get-project-create path))) (unless (stringp root-dir) (setq root-dir (ide-skel-project-root-path root-dir))) root-dir)) (defun ide-skel-has-imenu (&optional buffer) (with-current-buffer (or buffer (current-buffer)) (or (and imenu-prev-index-position-function imenu-extract-index-name-function) imenu-generic-expression (not (eq imenu-create-index-function 'imenu-default-create-index-function))))) (defun ide-skel-mode-file-regexp-list (mode-symbol-list) (delq nil (mapcar (lambda (element) (let ((fun-name (if (listp (cdr element)) (cadr element) (cdr element)))) (when (memq fun-name mode-symbol-list) (cons (car element) fun-name)))) auto-mode-alist))) (defun ide-skel-find-project-files (root-dir mode-symbol-list predicate) (let ((obj-file-regexp-list (delq nil (mapcar (lambda (element) (let ((len (length element))) (unless (and (> len 0) (equal (elt element (1- len)) ?/)) (concat (regexp-quote element) "$")))) (append ide-skel-proj-ignored-extensions completion-ignored-extensions)))) (mode-file-regexp-list (ide-skel-mode-file-regexp-list mode-symbol-list))) ; (file-path-regexp . major-mode-function-symbol) (when (and mode-symbol-list (not mode-file-regexp-list)) (error (format "No rules for %s major modes in auto-mode-alist." (mapconcat 'identity mode-symbol-list ", ")))) (ide-skel-proj-find-files root-dir (lambda (file-name) (and (not (string-match "#" file-name)) (not (string-match "semantic.cache" file-name)) (or (and (not mode-symbol-list) (not (some (lambda (regexp) (string-match regexp file-name)) obj-file-regexp-list))) (and mode-symbol-list (some (lambda (element) (let ((freg (if (string-match "[$]" (car element)) (car element) (concat (car element) "$")))) (when (string-match freg file-name) (cdr element)))) mode-file-regexp-list))) (or (not predicate) (funcall predicate file-name)))) (lambda (dir-path) (not (string-match (concat "/" ide-skel-cvs-dir-regexp) dir-path)))))) (defun ide-skel-proj-find-text-files-by-regexp () (interactive) (unwind-protect (progn (setq ide-skel-all-text-files-flag t) (call-interactively 'ide-skel-proj-find-files-by-regexp)) (setq ide-skel-all-text-files-flag nil))) (defun ide-skel-proj-grep-text-files-by-regexp () (interactive) (unwind-protect (progn (setq ide-skel-all-text-files-flag t) (call-interactively 'ide-skel-proj-grep-files-by-regexp)) (setq ide-skel-all-text-files-flag nil))) (defun ide-skel-proj-grep-files-by-regexp (root-dir mode-symbol-list regexp) (interactive (let* ((path (buffer-file-name (current-buffer))) (all-text-files (or ide-skel-all-text-files-flag (consp current-prefix-arg))) (whatever (progn (when (and (not all-text-files) (not (ide-skel-mode-file-regexp-list (list major-mode)))) (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode)))) (unless path (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer)))))) (root-dir (when path (ide-skel-root-dir-for-path path))) (thing (let ((res (thing-at-point 'symbol))) (set-text-properties 0 (length res) nil res) res)) (chunk (let ((result (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "") (format "Search in %s files. Regexp%s: " (if all-text-files "all text" (ide-skel-mode-name-stringify major-mode)) (if thing (format " (default %s)" thing) ""))) nil ide-skel-proj-grep-project-files-history thing))) (if (and result (> (length result) 0)) result (error "Regexp cannot be null"))))) (list root-dir (unless all-text-files (list major-mode)) chunk))) (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list (lambda (path) t))) (temp-file-path (concat (file-name-as-directory temporary-file-directory) (make-temp-name "ide-")))) (unless paths (error "No files to grep")) ;; create temporary file with file paths to search (with-temp-file temp-file-path (dolist (path paths) ;; save buffer if is open (let ((buffer (get-file-buffer path))) (when (and buffer (buffer-live-p buffer)) (with-current-buffer buffer (save-buffer)))) (setq path (concat "./" (file-relative-name path (file-name-as-directory root-dir)))) (insert (concat "'" path "'\n")))) (let* ((default-directory root-dir) (grep-command (format "cat %s | xargs grep -n %s" temp-file-path regexp))) (setq ide-skel-proj-grep-header (list root-dir (if mode-symbol-list (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ") "all text") regexp)) (grep grep-command)) ;; delete file after some time, because grep is executed as external process (run-with-idle-timer 5 nil (lambda (file-path) (condition-case nil nil ; (delete-file file-path) (error nil))) temp-file-path))) (defun ide-skel-proj-find-files-by-regexp (root-dir mode-symbol-list name-regexp &optional case-sensitive) "Search directory tree with root in ROOT-DIR and returns qualified paths to files which after open in Emacs would have one of modes in MODE-SYMBOL-LIST (if list is empty, we will take all text files) and their name (without dir) matches NAME-REGEXP." (interactive (let* ((path (buffer-file-name (current-buffer))) (all-text-files (or ide-skel-all-text-files-flag (consp current-prefix-arg))) (whatever (progn (when (and (not all-text-files) (not (ide-skel-mode-file-regexp-list (list major-mode)))) (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode)))) (unless path (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer)))))) (root-dir (when path (ide-skel-root-dir-for-path path))) (chunk (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "") (if all-text-files "F" (concat (ide-skel-mode-name-stringify major-mode) " f")) (format "ile name regexp: " )) nil ide-skel-proj-find-project-files-history nil))) (list root-dir (unless all-text-files (list major-mode)) chunk))) (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list (lambda (path) (let ((case-fold-search (not case-sensitive))) (or (not name-regexp) (string-match name-regexp (file-name-nondirectory path))))))) (buffer (get-buffer-create ide-skel-proj-find-results-buffer-name)) (saved-window (cons (selected-window) (window-buffer (selected-window))))) (if (= (length paths) 1) (find-file (car paths)) (save-selected-window (save-excursion (set-buffer buffer) (setq buffer-read-only nil default-directory root-dir) (erase-buffer) (insert "Root dir: ") (ide-skel-proj-insert-with-face root-dir 'font-lock-keyword-face) (insert "; Range: ") (ide-skel-proj-insert-with-face (if mode-symbol-list (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ") "all text") 'font-lock-keyword-face) (insert " files; Regexp: ") (ide-skel-proj-insert-with-face name-regexp 'font-lock-keyword-face) (insert "; Case sensitive: ") (ide-skel-proj-insert-with-face (if case-sensitive "Yes" "No") 'font-lock-keyword-face) (insert "\n\n") (compilation-minor-mode 1) (let ((invisible-suffix ":1:1 s")) (put-text-property 0 (length invisible-suffix) 'invisible t invisible-suffix) (dolist (path paths) (let ((relative-path (file-relative-name path root-dir))) (put-text-property 0 (length relative-path) 'mouse-face 'highlight relative-path) (insert relative-path) (insert invisible-suffix) (insert "\n")))) (insert (format "\n%d files found." (length paths))) (goto-char (point-min)) (setq buffer-read-only t) (when (and paths (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t))) (switch-to-buffer-other-window buffer) (goto-line 1) (goto-line 3))) (if (window-live-p (car saved-window)) (select-window (car saved-window)) (when (get-buffer-window (cdr saved-window)) (select-window (get-buffer-window (cdr saved-window)))))))) (unless ide-skel-proj-grep-mode-map (setq ide-skel-proj-grep-mode-map (make-sparse-keymap)) (define-key ide-skel-proj-grep-mode-map "r" 'ide-skel-proj-grep-replace)) (defun ide-skel-proj-grep-replace () (interactive) (let ((replace-to (read-string "Replace to: " nil 'ide-skel-proj-grep-replace-history)) (current-pos 1) begin end buffers-to-revert replace-info) (save-excursion (while current-pos (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer))) (when (and current-pos (eq (get-text-property current-pos 'font-lock-face) 'match)) (setq begin current-pos) (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer))) (setq end current-pos) (save-excursion (goto-char begin) (beginning-of-line) (let ((begline (point))) (re-search-forward "^\\(.*\\):\\([0-9]+\\):" nil t) (let ((len (length (match-string 0))) (file-path (expand-file-name (substring-no-properties (match-string 1)) default-directory))) (when (get-file-buffer file-path) (push (get-file-buffer file-path) buffers-to-revert)) (push (list file-path (string-to-number (match-string 2)) (- begin begline len) (- end begline len)) replace-info))))))) (dolist (replacement replace-info) (let ((file-path (nth 0 replacement)) (line-no (nth 1 replacement)) (from-column-no (nth 2 replacement)) (to-column-no (nth 3 replacement))) (condition-case err (with-temp-file file-path (insert-file-contents file-path) (goto-line line-no) (forward-char from-column-no) (delete-region (point) (+ (point) (- to-column-no from-column-no))) (insert replace-to)) (error (message "%s" (error-message-string err)))))) (dolist (buffer buffers-to-revert) (when (buffer-live-p buffer) (with-current-buffer buffer (revert-buffer t t t)))) ; ignore-auto, nonconfirm, preserve-modes (message "Done."))) (define-minor-mode ide-skel-proj-grep-mode "" nil ; init value nil ; mode indicator ide-skel-proj-grep-mode-map ; keymap ;; body (unless (assq 'ide-skel-proj-grep-mode minor-mode-map-alist) (push (cons 'ide-skel-proj-grep-mode ide-skel-proj-grep-mode-map) minor-mode-map-alist))) (add-hook 'grep-setup-hook (lambda () (when ide-skel-proj-grep-header (ide-skel-proj-grep-mode 1) (unwind-protect (progn (setq buffer-read-only nil) (erase-buffer) (remove-overlays) (insert "Root dir: ") (ide-skel-proj-insert-with-face (car ide-skel-proj-grep-header) 'font-lock-keyword-face) (insert "; Range: ") (ide-skel-proj-insert-with-face (cadr ide-skel-proj-grep-header) 'font-lock-keyword-face) (insert " files; Regexp: ") (ide-skel-proj-insert-with-face (caddr ide-skel-proj-grep-header) 'font-lock-keyword-face) (insert "\n") (insert "mouse-1 toggle match; r replace matches") (insert "\n\n")) (setq buffer-read-only t ide-skel-proj-grep-header nil) (setq ide-skel-proj-old-compilation-exit-message-function (symbol-value 'compilation-exit-message-function)) (set 'compilation-exit-message-function (lambda (status code msg) (let ((result (if ide-skel-proj-old-compilation-exit-message-function (funcall ide-skel-proj-old-compilation-exit-message-function status code msg) (cons msg code)))) (save-excursion (goto-char (point-min)) (let (begin end (km (make-sparse-keymap)) (inhibit-read-only t)) (define-key km [down-mouse-1] 'ignore) (define-key km [mouse-1] 'ide-skel-proj-grep-click) (while (setq begin (next-single-property-change (point) 'font-lock-face (current-buffer) nil)) (setq end (next-single-property-change begin 'font-lock-face (current-buffer) nil)) (put-text-property begin end 'pointer 'hand) (put-text-property begin end 'local-map km) (goto-char end)))) result))))))) (defun ide-skel-proj-grep-click (event) (interactive "@e") (with-selected-window (posn-window (event-start event)) (let* ((posn-point (posn-point (event-start event))) (begin (or (and (not (get-text-property (1- posn-point) 'font-lock-face)) posn-point) (previous-single-property-change posn-point 'font-lock-face (current-buffer) nil))) (end (next-single-property-change posn-point 'font-lock-face (current-buffer) nil)) (font-lock-face (get-text-property posn-point 'font-lock-face)) (inhibit-read-only t)) (put-text-property begin end 'font-lock-face (if (eq font-lock-face 'match) 'widget-field 'match))))) (defun ide-skel-proj-change-buffer-hook-function () (let ((path (buffer-file-name))) (when path (condition-case err (let ((project-list (ide-skel-proj-get-project-create path))) (when (ide-skel-project-p (car project-list)) (setq PC-include-file-path (ide-skel-project-include-file-path (car project-list))))) (error nil))))) (add-hook 'ide-skel-editor-buffer-changed-hook 'ide-skel-proj-change-buffer-hook-function) (tabbar-mode 1) (provide 'ide-skel)