diff options
Diffstat (limited to '.emacs.d/elisp/ide-skel.el')
| -rw-r--r-- | .emacs.d/elisp/ide-skel.el | 4016 |
1 files changed, 0 insertions, 4016 deletions
diff --git a/.emacs.d/elisp/ide-skel.el b/.emacs.d/elisp/ide-skel.el deleted file mode 100644 index 90be871..0000000 --- a/.emacs.d/elisp/ide-skel.el +++ /dev/null @@ -1,4016 +0,0 @@ -;; ide-skel.el --- IDE skeleton for Emacs Lisp hackers - -;; Copyright (C) 2008 Peter Karpiuk, Scott Tiger S.A. - -;; Author: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com> -;; Maintainer: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com> -;; 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\", -\",piy76<aaaa\", -\">u-===*#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\", -\"<tasdfgh>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\\)$") - -(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'" 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) - |