ide-skel.el 145 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020
  1. ;;; ide-skel.el --- IDE skeleton for Emacs Lisp hackers
  2. ;; Copyright (C) 2008 Peter Karpiuk, Scott Tiger S.A.
  3. ;; Author: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com>
  4. ;; Maintainer: Peter Karpiuk <piotr.karpiuk (at) gmail (dot) com>
  5. ;; Created: 24 Apr 2008
  6. ;; Version 0.6.0
  7. ;; Keywords: ide speedbar
  8. ;; GNU Emacs is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published
  10. ;; by the Free Software Foundation; either version 2, or (at your
  11. ;; option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  15. ;; General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  18. ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19. ;;; Commentary:
  20. ;; Ide-skel is a skeleton (or framework) of IDE for Emacs users.
  21. ;; Like Eclipse, it can be used as is with some predefined plugins
  22. ;; on board, but is designed to extend by Emacs Lisp programmers to
  23. ;; suite their own needs. Emacs 22 only, tested under Linux only
  24. ;; (under Windows ide-skel.el will rather not work, sorry).
  25. ;;
  26. ;; ** Configuration in .emacs
  27. ;;
  28. ;; (require 'ide-skel)
  29. ;;
  30. ;; ;; optional, but useful - see Emacs Manual
  31. ;; (partial-completion-mode)
  32. ;; (icomplete-mode)
  33. ;;
  34. ;; ;; for convenience
  35. ;; (global-set-key [f4] 'ide-skel-proj-find-files-by-regexp)
  36. ;; (global-set-key [f5] 'ide-skel-proj-grep-files-by-regexp)
  37. ;; (global-set-key [f10] 'ide-skel-toggle-left-view-window)
  38. ;; (global-set-key [f11] 'ide-skel-toggle-bottom-view-window)
  39. ;; (global-set-key [f12] 'ide-skel-toggle-right-view-window)
  40. ;; (global-set-key [C-next] 'tabbar-backward)
  41. ;; (global-set-key [C-prior] 'tabbar-forward)
  42. ;;
  43. ;; ** Side view windows
  44. ;;
  45. ;; Left and right view windows are "speedbars" - they are embedded
  46. ;; inside main Emacs frame and can be open/closed independently.
  47. ;; Right view window summarizes information related to the current
  48. ;; editor buffer - it can present content of such buffer in another
  49. ;; way (eg. Imenu tree), or show an extra panel for buffer major
  50. ;; mode operations (see SQL*Plus mode plugin example). Left view
  51. ;; window contains buffers such like buffer list (yet another,
  52. ;; popular way for switching buffers), filesystem/project browser
  53. ;; for easy navigation, or Info documentation browser,
  54. ;; or... whatever you wish.
  55. ;;
  56. ;; Side view windows are special - they cannot take focus and we can
  57. ;; operate on it only with mouse (!). Some window operations like
  58. ;; delete-other-windows (C-x 1) are slighty modified to treat side
  59. ;; view windows specially.
  60. ;;
  61. ;; ** Bottom view window
  62. ;;
  63. ;; Let auxiliary buffers (*shell*, *Messages*, *Help*, *Compilation*
  64. ;; and another buffers with '*' in name) pop up/show in bottom
  65. ;; window only. BUT, if you want, you can open any buffer in any
  66. ;; window (except side windows) as usual - that's only nice
  67. ;; heuristic, not pressure.
  68. ;;
  69. ;; Bottom view window remembers last selected buffer within it, so
  70. ;; if you close this window and open later, it will show you buffer
  71. ;; which you expect.
  72. ;;
  73. ;; ** Tabbars
  74. ;;
  75. ;; Ide-skel uses (great) tabbar.el package with some modifications:
  76. ;;
  77. ;; - there is no division into major mode groups (like in
  78. ;; Eclipse),
  79. ;;
  80. ;; - side view windows, bottom view window and editor windows have
  81. ;; different tabsets,
  82. ;;
  83. ;; - you can scroll tabs with mouse wheel,
  84. ;;
  85. ;; - the Home button in window left corner acts as window menu
  86. ;; (you can add your items to it in your plugin),
  87. ;;
  88. ;; - mouse-3 click on tab kills its buffer
  89. ;;
  90. ;; * Project
  91. ;;
  92. ;; Here, "project" means a directory tree checked out from CVS or
  93. ;; SVN. One project can contain source files of many types. When
  94. ;; we edit any project file, Emacs can easily find the project root
  95. ;; directory simply by looking at filesystem.
  96. ;;
  97. ;; So, we can execute many commands (grep, find, replace) on all
  98. ;; project source files or on all project source files of the same
  99. ;; type as file edited now (see Project menu). Ide-skel package
  100. ;; also automatically configures partial-completion-mode for project
  101. ;; edited now.
  102. ;;
  103. ;; There is no configuration for concrete projects needed (and
  104. ;; that's great advantage in my opinion).
  105. ;; If you find this package useful, send me a postcard to address:
  106. ;;
  107. ;; Peter Karpiuk
  108. ;; Scott Tiger S.A.
  109. ;; ul. Gawinskiego 8
  110. ;; 01-645 Warsaw
  111. ;; Poland
  112. ;; * Notes for Emacs Lisp hackers
  113. ;;
  114. ;; Each side window buffer should have:
  115. ;;
  116. ;; - name that begins with space,
  117. ;;
  118. ;; - tab label (string) - buffer local IDE-SKEL-TABBAR-TAB-LABEL
  119. ;; variable,
  120. ;;
  121. ;; - keep condition function (IDE-SKEL-KEEP-CONDITION-FUNCTION),
  122. ;;
  123. ;; - menu (IDE-SKEL-TABBAR-MENU-FUNCTION) - optional.
  124. ;;
  125. ;; Side window buffer is enabled (can be choosed by mouse click on
  126. ;; his tab) if it has buffer local variable IDE-SKEL-TABBAR-ENABLED
  127. ;; set to non-nil. There may be many live side window buffers, but
  128. ;; unavailable in current context ("context" means buffer edited in
  129. ;; editor window) if they have IDE-SKEL-TABBAR-ENABLED set to nil.
  130. ;;
  131. ;; Hiding side window operation disables all window buffers. "Show
  132. ;; side window" event handler should enable (and maybe create) side
  133. ;; window buffers based on current context. When you switch to
  134. ;; other buffer in editor window (switching the context), all side
  135. ;; window buffers for which keep condition function returns nil are
  136. ;; disabled. Handlers for EDITOR-BUFFER-CHANGED event should enable
  137. ;; (and maybe create) additional buffers based on current context.
  138. ;;
  139. ;; ** Side window events
  140. ;;
  141. ;; Event handlers should be implemented as an abnormal hook:
  142. ;;
  143. ;; ide-skel-side-view-window-functions
  144. ;;
  145. ;; It should be function with parameters
  146. ;;
  147. ;; - side: symbol LEFT or RIGHT
  148. ;;
  149. ;; - event-type: symbol for event:
  150. ;; SHOW/EDITOR-BUFFER-CHANGED/TAB-CHANGE/HIDE
  151. ;;
  152. ;; - list (optional): event parameters specific for event type.
  153. ;;
  154. ;; Events are send only for opened (existing and visible) windows.
  155. ;;
  156. ;; Hook functions are called in order until one of them returns
  157. ;; non-nil.
  158. ;;
  159. ;; *** Show
  160. ;;
  161. ;; After side window open. Event handler should enable (and maybe
  162. ;; create) buffers appropriate for current context. After event
  163. ;; handle, if no side window buffer is selected, there will be
  164. ;; selected one of them. No parameters.
  165. ;;
  166. ;; *** Editor Buffer Changed
  167. ;;
  168. ;; After editor buffer changed (aka context switch).
  169. ;;
  170. ;; Before event, buffers for which keep condition function returns
  171. ;; nil, are disabled. Event handler should enable (and maybe
  172. ;; create) buffers appropriate for new context.
  173. ;;
  174. ;; Parameters: before-buffer current-buffer.
  175. ;;
  176. ;; *** Tab Change
  177. ;;
  178. ;; Before side window buffer change (as result of mouse click on tab
  179. ;; or ide-skel-side-window-switch-to-buffer function call).
  180. ;; Parameters: current-buffer new-buffer
  181. ;;
  182. ;; *** Hide
  183. ;;
  184. ;; Before side window hiding. After event handling, all side window
  185. ;; buffers are disabled.
  186. ;;
  187. ;; *** Functions & vars
  188. ;;
  189. ;; In plugins, you can use variables with self-descriptive names:
  190. ;;
  191. ;; ide-skel-selected-frame
  192. ;; ide-skel-current-editor-window
  193. ;; ide-skel-current-editor-buffer
  194. ;; ide-skel-current-left-view-window
  195. ;; ide-skel-current-right-view-window
  196. ;;
  197. ;; Moreover, when user selects another buffer to edit, the
  198. ;;
  199. ;; ide-skel-editor-buffer-changed-hook
  200. ;;
  201. ;; hook is run. It is similar to "editor buffer changed" event, but
  202. ;; has no parameters and is run even when all side windows are
  203. ;; closed.
  204. ;;
  205. ;; **** Functions
  206. ;;
  207. ;; ide-skel-side-window-switch-to-buffer (side-window buffer)
  208. ;; Switch buffer in side window (please use only this function for
  209. ;; this operation).
  210. ;;
  211. ;; ide-skel-get-side-view-buffer-create (name side-sym tab-label
  212. ;; help-string keep-condition-function)
  213. ;; Create new buffer for side view window. NAME should begin with
  214. ;; space, side sym should be LEFT or RIGHT.
  215. ;;
  216. ;; **** Local variables in side window buffers
  217. ;;
  218. ;; ide-skel-tabbar-tab-label
  219. ;; ide-skel-tabbar-tab-help-string
  220. ;; ide-skel-tabbar-menu-function
  221. ;; ide-skel-tabbar-enabled
  222. ;; ide-skel-keep-condition-function
  223. (require 'cl)
  224. ;; Obsolete in emacs24
  225. ;(require 'complete)
  226. (require 'tree-widget)
  227. (require 'tabbar)
  228. (require 'recentf)
  229. (defgroup ide-skel nil
  230. "Ide Skeleton"
  231. :group 'tools
  232. :version 21)
  233. (defcustom ide-skel-tabbar-hidden-buffer-names-regexp-list '("^TAGS" "^diary$")
  234. "Buffer name that matches any of this regexps, will have no tab."
  235. :group 'ide-skel
  236. :tag "Hidden Buffer Names Regexp List"
  237. :type '(repeat regexp)
  238. :initialize 'custom-initialize-default
  239. :set (lambda (symbol value)
  240. (when tabbar-mode
  241. (tabbar-init-tabsets-store))
  242. (set-default symbol value)))
  243. (defcustom ide-skel-bottom-view-buffer-names-regexps '("\\*.*\\*")
  244. "Buffers with names matched by one of this regexps will be shown in bottom view."
  245. :group 'ide-skel
  246. :tag "Bottom View Buffer Names Regexps"
  247. :type '(repeat regexp)
  248. :initialize 'custom-initialize-default
  249. :set (lambda (symbol value)
  250. (when tabbar-mode
  251. (tabbar-init-tabsets-store))
  252. (set-default symbol value))
  253. )
  254. (defcustom ide-skel-bottom-view-buffer-names-disallowed-regexps '("\\*info\\*" "\\*Backtrace\\*")
  255. "Buffers with names matched by one of this regexps will NOT be shown in bottom view."
  256. :group 'ide-skel
  257. :tag "Bottom View Buffer Names Disallowed Regexps"
  258. :type '(repeat regexp)
  259. :initialize 'custom-initialize-default
  260. :set (lambda (symbol value)
  261. (when tabbar-mode
  262. (tabbar-init-tabsets-store))
  263. (set-default symbol value))
  264. )
  265. (defconst ide-skel-left-view-window-tabset-name "LeftView")
  266. (defconst ide-skel-right-view-window-tabset-name "RightView")
  267. (defconst ide-skel-bottom-view-window-tabset-name "BottomView")
  268. (defconst ide-skel-editor-window-tabset-name "Editor")
  269. (defun ide-skel-shine-color (color percent)
  270. (when (equal color "unspecified-bg")
  271. (setq color (if (< percent 0) "white" "black")))
  272. (apply 'format "#%02x%02x%02x"
  273. (mapcar (lambda (value)
  274. (min 65535 (max 0 (* (+ (/ value 650) percent) 650))))
  275. (color-values color))))
  276. (defun ide-skel-color-percentage (color)
  277. (truncate (* (/ (/ (reduce '+ (color-values color)) 3.0) 65535.0) 100.0)))
  278. (defun ide-skel-shine-face-background (face-sym percent)
  279. (when (>= (ide-skel-color-percentage (face-background 'default)) 50)
  280. (setq percent (- percent)))
  281. (set-face-attribute face-sym nil
  282. :background (ide-skel-shine-color (face-background 'default) percent)))
  283. (defun ide-skel-shine-face-foreground (face-sym percent)
  284. (when (>= (ide-skel-color-percentage (face-foreground 'default)) 50)
  285. (setq percent (- percent)))
  286. (set-face-attribute face-sym nil
  287. :foreground (ide-skel-shine-color (face-foreground 'default) percent)))
  288. (defvar ide-skel-tabbar-tab-label-max-width 25
  289. "Max width for tab label. Nil means no limit. If label width is too big, it will be shortened with ... inside.")
  290. (defvar ide-skel-tabbar-tab-label nil
  291. "Tab name. Local for buffer in side view window.")
  292. (make-variable-buffer-local 'ide-skel-tabbar-tab-label)
  293. (defvar ide-skel-tabbar-tab-help-string nil
  294. "Tooltip text for tab in side view window. Buffer local.")
  295. (make-variable-buffer-local 'ide-skel-tabbar-tab-help-string)
  296. (defvar ide-skel-tabset-name nil)
  297. (make-variable-buffer-local 'ide-skel-tabset-name)
  298. (defvar ide-skel-tabbar-menu-function nil)
  299. (make-variable-buffer-local 'ide-skel-tabbar-menu-function)
  300. (defvar ide-skel-tabbar-enabled nil)
  301. (make-variable-buffer-local 'ide-skel-tabbar-enabled)
  302. (defvar ide-skel-keep-condition-function nil)
  303. (make-variable-buffer-local 'ide-skel-keep-condition-function)
  304. (defvar ide-skel-current-left-view-window nil)
  305. (defvar ide-skel-current-right-view-window nil)
  306. (defvar ide-skel-current-editor-window nil)
  307. (defvar ide-skel-current-editor-buffer nil)
  308. (defvar ide-skel-selected-frame nil)
  309. (defconst ide-skel-left-view-window-xpm "\
  310. /* XPM */
  311. static char * left_view_xpm[] = {
  312. \"24 24 145 2\",
  313. \" c None\",
  314. \". c #000000\",
  315. \"+ c #FBFED6\",
  316. \"@ c #F3F6CE\",
  317. \"# c #EBEEC7\",
  318. \"$ c #E3E7BF\",
  319. \"% c #DCE0B9\",
  320. \"& c #D5D9B2\",
  321. \"* c #FFFFFF\",
  322. \"= c #FDFDFD\",
  323. \"- c #F9F9F9\",
  324. \"; c #F4F4F4\",
  325. \"> c #DDDDDD\",
  326. \", c #F2F5CD\",
  327. \"' c #E4E8C0\",
  328. \") c #DDE1BA\",
  329. \"! c #D7DAB4\",
  330. \"~ c #D1D4AE\",
  331. \"{ c #FEFEFE\",
  332. \"] c #FBFBFB\",
  333. \"^ c #F8F8F8\",
  334. \"/ c #F5F5F5\",
  335. \"( c #F2F2F2\",
  336. \"_ c #DBDBDB\",
  337. \": c #E9EDC5\",
  338. \"< c #D8DBB5\",
  339. \"[ c #D2D5AF\",
  340. \"} c #CDD0AA\",
  341. \"| c #FCFCFC\",
  342. \"1 c #F6F6F6\",
  343. \"2 c #F3F3F3\",
  344. \"3 c #F0F0F0\",
  345. \"4 c #DADADA\",
  346. \"5 c #E1E5BD\",
  347. \"6 c #CDD0AB\",
  348. \"7 c #C8CCA6\",
  349. \"8 c #FAFAFA\",
  350. \"9 c #F7F7F7\",
  351. \"0 c #EFEFEF\",
  352. \"a c #D9D9D9\",
  353. \"b c #DADDB6\",
  354. \"c c #C4C7A2\",
  355. \"d c #EDEDED\",
  356. \"e c #D7D7D7\",
  357. \"f c #D3D6B0\",
  358. \"g c #CFD3AD\",
  359. \"h c #CBCFA9\",
  360. \"i c #C8CBA6\",
  361. \"j c #C0C39F\",
  362. \"k c #F1F1F1\",
  363. \"l c #EEEEEE\",
  364. \"m c #ECECEC\",
  365. \"n c #D6D6D6\",
  366. \"o c #C9CDA7\",
  367. \"p c #C6C9A4\",
  368. \"q c #C3C6A1\",
  369. \"r c #BFC39E\",
  370. \"s c #BCBF9B\",
  371. \"t c #EAEAEA\",
  372. \"u c #D4D4D4\",
  373. \"v c #C7CAA5\",
  374. \"w c #C1C5A0\",
  375. \"x c #BEC29D\",
  376. \"y c #BBBF9B\",
  377. \"z c #B9BC98\",
  378. \"A c #EBEBEB\",
  379. \"B c #E8E8E8\",
  380. \"C c #D3D3D3\",
  381. \"D c #C2C5A0\",
  382. \"E c #BDC09C\",
  383. \"F c #BABE99\",
  384. \"G c #B8BB97\",
  385. \"H c #B5B895\",
  386. \"I c #E9E9E9\",
  387. \"J c #E7E7E7\",
  388. \"K c #D1D1D1\",
  389. \"L c #BBBE9A\",
  390. \"M c #B7BA96\",
  391. \"N c #B4B794\",
  392. \"O c #B2B592\",
  393. \"P c #E5E5E5\",
  394. \"Q c #D0D0D0\",
  395. \"R c #B3B693\",
  396. \"S c #B1B491\",
  397. \"T c #AFB28F\",
  398. \"U c #E3E3E3\",
  399. \"V c #CECECE\",
  400. \"W c #B4B793\",
  401. \"X c #B0B390\",
  402. \"Y c #AEB18F\",
  403. \"Z c #ACAF8D\",
  404. \"` c #E6E6E6\",
  405. \" . c #E4E4E4\",
  406. \".. c #E2E2E2\",
  407. \"+. c #CDCDCD\",
  408. \"@. c #ADB08E\",
  409. \"#. c #ABAE8C\",
  410. \"$. c #AAAD8B\",
  411. \"%. c #E0E0E0\",
  412. \"&. c #CBCBCB\",
  413. \"*. c #A9AC8A\",
  414. \"=. c #A7AA89\",
  415. \"-. c #DEDEDE\",
  416. \";. c #CACACA\",
  417. \">. c #ABAE8B\",
  418. \",. c #A8AB89\",
  419. \"'. c #A6A988\",
  420. \"). c #A5A887\",
  421. \"!. c #C8C8C8\",
  422. \"~. c #A7AA88\",
  423. \"{. c #A6A987\",
  424. \"]. c #A4A786\",
  425. \"^. c #A3A685\",
  426. \"/. c #DFDFDF\",
  427. \"(. c #C7C7C7\",
  428. \"_. c #A5A886\",
  429. \":. c #A2A584\",
  430. \"<. c #A1A483\",
  431. \"[. c #C6C6C6\",
  432. \"}. c #A4A785\",
  433. \"|. c #A0A382\",
  434. \"1. c #9FA282\",
  435. \"2. c #D8D8D8\",
  436. \"3. c #C4C4C4\",
  437. \"4. c #A3A684\",
  438. \"5. c #A2A484\",
  439. \"6. c #A0A383\",
  440. \"7. c #9EA181\",
  441. \"8. c #9DA080\",
  442. \"9. c #C3C3C3\",
  443. \"0. c #8D8F72\",
  444. \"a. c #8C8E72\",
  445. \"b. c #8B8D71\",
  446. \"c. c #8A8C70\",
  447. \"d. c #898B6F\",
  448. \"e. c #888A6F\",
  449. \"f. c #C5C5C5\",
  450. \"g. c #C2C2C2\",
  451. \"h. c #C1C1C1\",
  452. \"i. c #C0C0C0\",
  453. \"j. c #BEBEBE\",
  454. \"k. c #BDBDBD\",
  455. \"l. c #BBBBBB\",
  456. \"m. c #BABABA\",
  457. \"n. c #ABABAB\",
  458. \" \",
  459. \" . . . . . . . . . . . . . . . . . . . . . . \",
  460. \". + @ # $ % & . * * * * * * * * * * = - ; ; > . \",
  461. \". , # ' ) ! ~ . * * * * * * * * * { ] ^ / ( _ . \",
  462. \". : $ ) < [ } . * * * * * * * * * | - 1 2 3 4 . \",
  463. \". 5 % ! [ 6 7 . * * * * * * * * = 8 9 ; 3 0 a . \",
  464. \". b & ~ } 7 c . * * * * * * * { ] ^ / ( 0 d e . \",
  465. \". f g h i c j . * * * * * * * | - 1 2 k l m n . \",
  466. \". } o p q r s . * * * * * * = 8 9 ; 3 0 m t u . \",
  467. \". v c w x y z . * * * * * = 8 9 / ( 0 d A B C . \",
  468. \". D r E F G H . * * * * { ] ^ / 2 3 l A I J K . \",
  469. \". E L z M N O . * * * { ] ^ 1 2 3 l m I J P Q . \",
  470. \". z M H R S T . * * { ] ^ 1 2 k l m t B P U V . \",
  471. \". H W O X Y Z . * = ] ^ 1 2 k 0 m t B ` ...+.. \",
  472. \". O X T @.#.$.. = 8 ^ 1 2 k 0 m t B ` ...%.&.. \",
  473. \". T @.Z $.*.=.. 8 9 / 2 k 0 m t B ` ...%.-.;.. \",
  474. \". Z >.*.,.'.).. 9 / 2 3 l m t B ` ...%.-.> !.. \",
  475. \". *.,.~.{.].^.. ; ( 3 l m t B ` ...%./.> _ (.. \",
  476. \". ~.{._.^.:.<.. k 0 l m t B ` ...%./.> _ a [.. \",
  477. \". _.}.:.<.|.1.. 0 d A I B ` ...%./.> _ a 2.3.. \",
  478. \". 4.5.6.1.7.8.. m A I J P ...%.-.> _ a 2.n 9.. \",
  479. \". 0.a.b.c.d.e.. +.&.;.!.(.f.3.g.h.i.j.k.l.m.n.. \",
  480. \" . . . . . . . . . . . . . . . . . . . . . . \",
  481. \" \"};
  482. "
  483. "XPM format image used as left view window icon")
  484. (defconst ide-skel-left-view-window-image
  485. (create-image ide-skel-left-view-window-xpm 'xpm t))
  486. (defconst ide-skel-right-view-window-xpm "\
  487. /* XPM */
  488. static char * right_view_xpm[] = {
  489. \"24 24 125 2\",
  490. \" c None\",
  491. \". c #000000\",
  492. \"+ c #FFFFFF\",
  493. \"@ c #A8AB89\",
  494. \"# c #A6A987\",
  495. \"$ c #A4A785\",
  496. \"% c #A2A484\",
  497. \"& c #A0A282\",
  498. \"* c #919376\",
  499. \"= c #A7AA88\",
  500. \"- c #A5A886\",
  501. \"; c #A2A584\",
  502. \"> c #A0A383\",
  503. \", c #9FA181\",
  504. \"' c #909275\",
  505. \") c #A3A685\",
  506. \"! c #A1A483\",
  507. \"~ c #9FA282\",
  508. \"{ c #9DA080\",
  509. \"] c #8F9174\",
  510. \"^ c #A4A786\",
  511. \"/ c #A0A382\",
  512. \"( c #9EA181\",
  513. \"_ c #9C9F7F\",
  514. \": c #8E9073\",
  515. \"< c #FEFEFE\",
  516. \"[ c #9B9E7F\",
  517. \"} c #8D8F73\",
  518. \"| c #FCFCFC\",
  519. \"1 c #A1A484\",
  520. \"2 c #9EA180\",
  521. \"3 c #9A9D7E\",
  522. \"4 c #8C8E72\",
  523. \"5 c #FDFDFD\",
  524. \"6 c #FAFAFA\",
  525. \"7 c #9B9E7E\",
  526. \"8 c #999C7D\",
  527. \"9 c #8B8D71\",
  528. \"0 c #F7F7F7\",
  529. \"a c #9FA281\",
  530. \"b c #9A9C7D\",
  531. \"c c #989B7C\",
  532. \"d c #8A8C70\",
  533. \"e c #FBFBFB\",
  534. \"f c #F8F8F8\",
  535. \"g c #F5F5F5\",
  536. \"h c #9C9E7F\",
  537. \"i c #9A9D7D\",
  538. \"j c #979A7B\",
  539. \"k c #898B70\",
  540. \"l c #F6F6F6\",
  541. \"m c #F3F3F3\",
  542. \"n c #999C7C\",
  543. \"o c #96997A\",
  544. \"p c #888A6F\",
  545. \"q c #F1F1F1\",
  546. \"r c #9B9D7E\",
  547. \"s c #989A7B\",
  548. \"t c #959779\",
  549. \"u c #87896E\",
  550. \"v c #EFEFEF\",
  551. \"w c #959879\",
  552. \"x c #949678\",
  553. \"y c #86886D\",
  554. \"z c #ECECEC\",
  555. \"A c #97997B\",
  556. \"B c #949778\",
  557. \"C c #939577\",
  558. \"D c #85876C\",
  559. \"E c #EAEAEA\",
  560. \"F c #95987A\",
  561. \"G c #919476\",
  562. \"H c #84876C\",
  563. \"I c #F9F9F9\",
  564. \"J c #F0F0F0\",
  565. \"K c #EEEEEE\",
  566. \"L c #E8E8E8\",
  567. \"M c #949779\",
  568. \"N c #939578\",
  569. \"O c #929476\",
  570. \"P c #909375\",
  571. \"Q c #83866B\",
  572. \"R c #F4F4F4\",
  573. \"S c #F2F2F2\",
  574. \"T c #E6E6E6\",
  575. \"U c #939678\",
  576. \"V c #929477\",
  577. \"W c #909376\",
  578. \"X c #8F9275\",
  579. \"Y c #82856A\",
  580. \"Z c #E4E4E4\",
  581. \"` c #8E9174\",
  582. \" . c #818469\",
  583. \".. c #EDEDED\",
  584. \"+. c #EBEBEB\",
  585. \"@. c #E9E9E9\",
  586. \"#. c #E2E2E2\",
  587. \"$. c #8D9073\",
  588. \"%. c #808368\",
  589. \"&. c #E7E7E7\",
  590. \"*. c #E5E5E5\",
  591. \"=. c #E0E0E0\",
  592. \"-. c #8C8F72\",
  593. \";. c #7F8268\",
  594. \">. c #D6D6D6\",
  595. \",. c #D5D5D5\",
  596. \"'. c #D4D4D4\",
  597. \"). c #D2D2D2\",
  598. \"!. c #D1D1D1\",
  599. \"~. c #D0D0D0\",
  600. \"{. c #CECECE\",
  601. \"]. c #CDCDCD\",
  602. \"^. c #CBCBCB\",
  603. \"/. c #CACACA\",
  604. \"(. c #C8C8C8\",
  605. \"_. c #C7C7C7\",
  606. \":. c #C5C5C5\",
  607. \"<. c #C4C4C4\",
  608. \"[. c #C2C2C2\",
  609. \"}. c #7D8066\",
  610. \"|. c #7C7F65\",
  611. \"1. c #7B7E64\",
  612. \"2. c #7B7D64\",
  613. \"3. c #7A7C63\",
  614. \"4. c #70725B\",
  615. \" \",
  616. \" . . . . . . . . . . . . . . . . . . . . . . \",
  617. \". + + + + + + + + + + + + + + + . @ # $ % & * . \",
  618. \". + + + + + + + + + + + + + + + . = - ; > , ' . \",
  619. \". + + + + + + + + + + + + + + + . # ) ! ~ { ] . \",
  620. \". + + + + + + + + + + + + + + + . ^ ; / ( _ : . \",
  621. \". + + + + + + + + + + + + + + < . ) ! ~ { [ } . \",
  622. \". + + + + + + + + + + + + + + | . 1 & 2 _ 3 4 . \",
  623. \". + + + + + + + + + + + + + 5 6 . > ( _ 7 8 9 . \",
  624. \". + + + + + + + + + + + + 5 6 0 . a { 7 b c d . \",
  625. \". + + + + + + + + + + + < e f g . { h i c j k . \",
  626. \". + + + + + + + + + + < e f l m . _ 3 n j o p . \",
  627. \". + + + + + + + + + < e f l m q . r 8 s o t u . \",
  628. \". + + + + + + + + 5 e f l m q v . 8 c o w x y . \",
  629. \". + + + + + + + 5 6 f l m q v z . c A w B C D . \",
  630. \". + + + + + < | 6 0 g m q v z E . A F B C G H . \",
  631. \". + + + + 5 e I 0 g m J K z E L . F M N O P Q . \",
  632. \". + + < | 6 f l R S J K z E L T . M U V W X Y . \",
  633. \". < 5 e I 0 g m q v K z E L T Z . U V * X ` .. \",
  634. \". e I f l R S q v ..+.@.L T Z #.. V * X ` $.%.. \",
  635. \". f l g m q J K z +.@.&.*.Z #.=.. W X ` $.-.;.. \",
  636. \". >.,.'.).!.~.{.].^./.(._.:.<.[.. }.|.1.2.3.4.. \",
  637. \" . . . . . . . . . . . . . . . . . . . . . . \",
  638. \" \"};
  639. "
  640. "XPM format image used as right view window icon")
  641. (defconst ide-skel-right-view-window-image
  642. (create-image ide-skel-right-view-window-xpm 'xpm t))
  643. (defconst ide-skel-bottom-view-window-xpm "\
  644. /* XPM */
  645. static char * bottom_view_xpm[] = {
  646. \"24 24 130 2\",
  647. \" c None\",
  648. \". c #000000\",
  649. \"+ c #FFFFFF\",
  650. \"@ c #FDFDFD\",
  651. \"# c #F9F9F9\",
  652. \"$ c #F6F6F6\",
  653. \"% c #F4F4F4\",
  654. \"& c #DDDDDD\",
  655. \"* c #FEFEFE\",
  656. \"= c #FBFBFB\",
  657. \"- c #F8F8F8\",
  658. \"; c #F5F5F5\",
  659. \"> c #F2F2F2\",
  660. \", c #DBDBDB\",
  661. \"' c #FCFCFC\",
  662. \") c #F3F3F3\",
  663. \"! c #F0F0F0\",
  664. \"~ c #DADADA\",
  665. \"{ c #FAFAFA\",
  666. \"] c #F7F7F7\",
  667. \"^ c #F1F1F1\",
  668. \"/ c #EFEFEF\",
  669. \"( c #D9D9D9\",
  670. \"_ c #EDEDED\",
  671. \": c #D7D7D7\",
  672. \"< c #EEEEEE\",
  673. \"[ c #ECECEC\",
  674. \"} c #D6D6D6\",
  675. \"| c #EAEAEA\",
  676. \"1 c #D4D4D4\",
  677. \"2 c #EBEBEB\",
  678. \"3 c #E8E8E8\",
  679. \"4 c #D3D3D3\",
  680. \"5 c #E9E9E9\",
  681. \"6 c #E7E7E7\",
  682. \"7 c #D1D1D1\",
  683. \"8 c #E5E5E5\",
  684. \"9 c #D0D0D0\",
  685. \"0 c #E3E3E3\",
  686. \"a c #CECECE\",
  687. \"b c #E6E6E6\",
  688. \"c c #E4E4E4\",
  689. \"d c #E2E2E2\",
  690. \"e c #CDCDCD\",
  691. \"f c #E0E0E0\",
  692. \"g c #CBCBCB\",
  693. \"h c #CCCFAB\",
  694. \"i c #CACDAA\",
  695. \"j c #C8CBA8\",
  696. \"k c #C7CAA7\",
  697. \"l c #C5C8A5\",
  698. \"m c #C3C6A4\",
  699. \"n c #C2C5A3\",
  700. \"o c #C0C3A1\",
  701. \"p c #BEC1A0\",
  702. \"q c #BDBF9E\",
  703. \"r c #BBBE9D\",
  704. \"s c #B9BC9B\",
  705. \"t c #B8BA9A\",
  706. \"u c #B6B999\",
  707. \"v c #B4B797\",
  708. \"w c #B3B596\",
  709. \"x c #B1B495\",
  710. \"y c #B0B293\",
  711. \"z c #AEB192\",
  712. \"A c #ADAF91\",
  713. \"B c #ABAE8F\",
  714. \"C c #9C9E82\",
  715. \"D c #C9CCA8\",
  716. \"E c #C6C9A6\",
  717. \"F c #C4C7A5\",
  718. \"G c #C1C4A2\",
  719. \"H c #BFC2A1\",
  720. \"I c #BEC19F\",
  721. \"J c #BCBF9E\",
  722. \"K c #BABD9C\",
  723. \"L c #B7BA9A\",
  724. \"M c #B6B998\",
  725. \"N c #ABAE90\",
  726. \"O c #AAAD8E\",
  727. \"P c #9A9D81\",
  728. \"Q c #C2C4A2\",
  729. \"R c #BFC1A0\",
  730. \"S c #BDC09F\",
  731. \"T c #BCBE9D\",
  732. \"U c #B9BB9B\",
  733. \"V c #B7BA99\",
  734. \"W c #B6B898\",
  735. \"X c #B1B494\",
  736. \"Y c #A9AB8D\",
  737. \"Z c #999C80\",
  738. \"` c #C1C3A2\",
  739. \" . c #BFC2A0\",
  740. \".. c #B9BC9C\",
  741. \"+. c #B8BB9A\",
  742. \"@. c #B7B999\",
  743. \"#. c #B5B898\",
  744. \"$. c #B4B697\",
  745. \"%. c #B2B596\",
  746. \"&. c #AAAD8F\",
  747. \"*. c #A7AA8C\",
  748. \"=. c #989B80\",
  749. \"-. c #BDC09E\",
  750. \";. c #B3B696\",
  751. \">. c #B2B595\",
  752. \",. c #B1B394\",
  753. \"'. c #AFB293\",
  754. \"). c #A6A98B\",
  755. \"!. c #97997F\",
  756. \"~. c #A7A98C\",
  757. \"{. c #A6A88B\",
  758. \"]. c #A4A78A\",
  759. \"^. c #A3A689\",
  760. \"/. c #A2A588\",
  761. \"(. c #A1A487\",
  762. \"_. c #A0A286\",
  763. \":. c #9FA185\",
  764. \"<. c #9EA084\",
  765. \"[. c #9D9F83\",
  766. \"}. c #9B9E82\",
  767. \"|. c #999B80\",
  768. \"1. c #989A7F\",
  769. \"2. c #97997E\",
  770. \"3. c #96987D\",
  771. \"4. c #95977D\",
  772. \"5. c #94967C\",
  773. \"6. c #92957B\",
  774. \"7. c #91947A\",
  775. \"8. c #909279\",
  776. \"9. c #85876F\",
  777. \" \",
  778. \" . . . . . . . . . . . . . . . . . . . . . . \",
  779. \". + + + + + + + + + + + + + + + + + @ # $ % & . \",
  780. \". + + + + + + + + + + + + + + + + * = - ; > , . \",
  781. \". + + + + + + + + + + + + + + + + ' # $ ) ! ~ . \",
  782. \". + + + + + + + + + + + + + + + @ { ] % ^ / ( . \",
  783. \". + + + + + + + + + + + + + + * = - ; > ! _ : . \",
  784. \". + + + + + + + + + + + + + + ' # $ ) / < [ } . \",
  785. \". + + + + + + + + + + + + + @ { ] % ^ < [ | 1 . \",
  786. \". + + + + + + + + + + + + @ { ] ; > / _ 2 3 4 . \",
  787. \". + + + + + + + + + + + * = - ; > ! < 2 5 6 7 . \",
  788. \". + + + + + + + + + + * = - $ ) ! < [ 5 6 8 9 . \",
  789. \". + + + + + + + + + * = - $ ) ^ < [ | 3 8 0 a . \",
  790. \". + + + + + + + + @ = - $ ) ^ / [ | 3 b c d e . \",
  791. \". + + + + + + + @ { - $ ) ^ / [ | 3 b c d f g . \",
  792. \". . . . . . . . . . . . . . . . . . . . . . . . \",
  793. \". h i j k l m n o p q r s t u v w x y z A B C . \",
  794. \". D k E F n G H I J K s L M v w x y z A N O P . \",
  795. \". E F m Q o R S T K U V W v w X y z A N O Y Z . \",
  796. \". m n ` .I J r ..+.@.#.$.%.X y z A N &.Y *.=.. \",
  797. \". G H p -.T K s t u #.;.>.,.'.z A N O Y *.).!.. \",
  798. \". ~.{.].^./.(._.:.<.[.}.P |.1.2.3.4.5.6.7.8.9.. \",
  799. \" . . . . . . . . . . . . . . . . . . . . . . \",
  800. \" \"};
  801. "
  802. "XPM format image used as bottom view window icon")
  803. (defconst ide-skel-bottom-view-window-image
  804. (create-image ide-skel-bottom-view-window-xpm 'xpm t))
  805. (defvar ide-skel-win--win2-switch t)
  806. (defvar ide-skel-win--minibuffer-selected-p nil)
  807. ;; (copy-win-node w)
  808. ;; (win-node-corner-pos w)
  809. ;; (make-win-node :corner-pos 0 :buffer b :horiz-scroll 0 :point 0 :mark nil :divisions nil)
  810. ;; (win-node-p w)
  811. (defstruct win-node
  812. "Window configuration tree node."
  813. (corner-pos nil) ; pair - original position of left top window corner
  814. (buf-corner-pos 1) ; position within the buffer at the upper left of the window
  815. buffer ; the buffer window displays
  816. (horiz-scroll 0) ; amount of horizontal scrolling, in columns
  817. (point 1) ; point
  818. (mark nil) ; the mark
  819. (edges nil) ; (window-edges)
  820. (cursor-priority nil)
  821. (fixed-size nil)
  822. (divisions nil)) ; children (list of division)
  823. (defstruct division
  824. "Podzial okienka"
  825. win-node ; winnode for window after division
  826. horizontal-p ; division horizontal or vertical
  827. percent) ; 0.0-1.0: width/height of parent after division
  828. (defvar sel-window nil)
  829. (defvar sel-priority nil)
  830. (defvar ide-skel-ommited-windows nil)
  831. (defvar ide-skel--fixed-size-windows nil)
  832. ;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer...
  833. (defvar ide-skel-side-view-window-functions nil)
  834. (defvar ide-skel-editor-buffer-changed-hook nil)
  835. (defvar ide-skel-last-buffer-change-event nil)
  836. (defvar ide-skel-last-selected-window-or-buffer nil)
  837. (defcustom ide-skel-bottom-view-window-size 0.35
  838. "Default bottom view window height in characters (int >= 5) or percent of Emacs frame height (0.0 - 1.0)"
  839. :group 'ide-skel
  840. :tag "Default Bottom View Window Height"
  841. :type (list 'restricted-sexp
  842. :match-alternatives (list (lambda (value)
  843. (or (and (floatp value)
  844. (> value 0.0)
  845. (< value 1.0))
  846. (and (integerp value)
  847. (>= value 5)))))))
  848. (defcustom ide-skel-bottom-view-on-left-view t
  849. "Non-nil if bottom view lies partially on left view."
  850. :group 'ide-skel
  851. :tag "Bottom View on Left View"
  852. :type '(boolean)
  853. :initialize 'custom-initialize-default
  854. :set (lambda (symbol value)
  855. (let ((is-bottom-view-window (ide-skel-get-bottom-view-window)))
  856. (when is-bottom-view-window
  857. (ide-skel-hide-bottom-view-window))
  858. (unwind-protect
  859. (set-default symbol value)
  860. (when is-bottom-view-window
  861. (ide-skel-show-bottom-view-window))))))
  862. (defcustom ide-skel-bottom-view-on-right-view t
  863. "Non-nil if bottom view lies partially on right view."
  864. :group 'ide-skel
  865. :tag "Bottom View on Right View"
  866. :type '(boolean)
  867. :initialize 'custom-initialize-default
  868. :set (lambda (symbol value)
  869. (let ((is-bottom-view-window (ide-skel-get-bottom-view-window)))
  870. (when is-bottom-view-window
  871. (ide-skel-hide-bottom-view-window))
  872. (unwind-protect
  873. (set-default symbol value)
  874. (when is-bottom-view-window
  875. (ide-skel-show-bottom-view-window))))))
  876. (defconst ide-skel-unexpected-bottom-view-window-buffer-names '("*Completions*" "*Compile-Log*"))
  877. (defvar ide-skel--last-bottom-view-buffer-name nil)
  878. (defvar ide-skel-was-scratch nil)
  879. (defvar ide-skel-bottom-view-window-oper-in-progress nil)
  880. (defvar ide-skel--current-side-windows (cons nil nil))
  881. (defcustom ide-skel-left-view-window-width 25
  882. "Default width of left view window."
  883. :group 'ide-skel
  884. :tag "Default Left View Window Width"
  885. :type '(integer)
  886. :initialize 'custom-initialize-default
  887. :set (lambda (symbol value)
  888. (let ((is-left-view-window (ide-skel-get-left-view-window)))
  889. (when is-left-view-window
  890. (ide-skel-hide-left-view-window))
  891. (unwind-protect
  892. (set-default symbol value)
  893. (when is-left-view-window
  894. (ide-skel-show-left-view-window))))))
  895. (defcustom ide-skel-right-view-window-width 30
  896. "Default width of right view window."
  897. :group 'ide-skel
  898. :tag "Default Right View Window Width"
  899. :type '(integer)
  900. :initialize 'custom-initialize-default
  901. :set (lambda (symbol value)
  902. (let ((is-right-view-window (ide-skel-get-right-view-window)))
  903. (when is-right-view-window
  904. (ide-skel-hide-right-view-window))
  905. (unwind-protect
  906. (set-default symbol value)
  907. (when is-right-view-window
  908. (ide-skel-show-right-view-window))))))
  909. (defcustom ide-skel-side-view-display-cursor nil
  910. "Non-nil if cursor should be displayed in side view windows"
  911. :group 'ide-skel
  912. :tag "Side View Display Cursor"
  913. :type 'boolean)
  914. (defvar ide-skel-highlight-face 'ide-skel-highlight-face)
  915. (defface ide-skel-highlight-face
  916. (list
  917. (list '((background light))
  918. (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) -70) :foreground (face-background 'default))
  919. (when (>= emacs-major-version 22) '(:box (:style released-button)))))
  920. (list '((background dark))
  921. (append (list :inherit 'variable-pitch :background (ide-skel-shine-color (face-background 'default) +70) :foreground (face-background 'default))
  922. (when (>= emacs-major-version 22) '(:box (:style released-button)))))
  923. '(t (:inherit default)))
  924. "Face for selection in side views."
  925. :group 'ide-skel)
  926. ;;; buffer -> alist
  927. ;;; :imenu-buffer
  928. ;;; :default-left-tab-label, :default-right-tab-label
  929. (defvar ide-skel-context-properties (make-hash-table :test 'eq))
  930. (defvar ide-skel-last-left-view-window-tab-label nil)
  931. (defvar ide-skel-last-right-view-window-tab-label nil)
  932. (defvar ide-skel-buffer-list-buffer nil)
  933. (defvar ide-skel-buffer-list nil)
  934. (defvar ide-skel-buffer-list-tick nil)
  935. (defconst ide-skel-tree-widget-open-xpm "\
  936. /* XPM */
  937. static char *open[] = {
  938. /* columns rows colors chars-per-pixel */
  939. \"11 15 49 1\",
  940. \" c #4D084D080B7B\",
  941. \". c #5A705A700DBB\",
  942. \"X c #7B647B6404B5\",
  943. \"o c #7818781810F1\",
  944. \"O c #7E1E7E1E16D4\",
  945. \"+ c #5EB75D2D6FCF\",
  946. \"@ c #5FD85D2D6FCF\",
  947. \"# c #60415D2D6FCF\",
  948. \"$ c #88BD88BD068F\",
  949. \"% c #8A5D8A5D0969\",
  950. \"& c #82F782F71033\",
  951. \"* c #841B841B1157\",
  952. \"= c #87BC87BC1125\",
  953. \"- c #878787871696\",
  954. \"; c #87D587BE172E\",
  955. \": c #87C187C11812\",
  956. \"> c #895A895A1B9C\",
  957. \", c #8A0A8A0A1C10\",
  958. \"< c #8E5B8DF21DE7\",
  959. \"1 c #95DF95DF1A5F\",
  960. \"2 c #95CC95CC1B5B\",
  961. \"3 c #98D498D41EE5\",
  962. \"4 c #9BBB9BBB2414\",
  963. \"5 c #9BBB9BBB2622\",
  964. \"6 c #9CDF9CDF2696\",
  965. \"7 c #984C984C281C\",
  966. \"8 c #9EA19EA129C1\",
  967. \"9 c #A060A0602B4B\",
  968. \"0 c #A3BAA3BA3148\",
  969. \"q c #A78AA78A36FD\",
  970. \"w c #A7BBA7BB38D9\",
  971. \"e c #A7B7A7B73B03\",
  972. \"r c #AB1AAB1A3B03\",
  973. \"t c #ABD7ABD73C6C\",
  974. \"y c #AFC5AFC54435\",
  975. \"u c #B5D2B5D24A67\",
  976. \"i c #B659B6594AEE\",
  977. \"p c #B959B9595378\",
  978. \"a c #BBCEBBCE5267\",
  979. \"s c #BE64BE645A53\",
  980. \"d c #C2D2C2D26078\",
  981. \"f c #C43BC43B60D8\",
  982. \"g c #C42EC42E60EE\",
  983. \"h c #C44FC44F60EC\",
  984. \"j c #C73BC73B66E7\",
  985. \"k c #C65DC65D697B\",
  986. \"l c #CECECECE7676\",
  987. \"z c #D02CD02C7B7B\",
  988. \"x c None\",
  989. /* pixels */
  990. \"xxxxxxxxxxx\",
  991. \"xxxxxxxxxxx\",
  992. \"xxxxxxxxxxx\",
  993. \"xxxxxxxxxxx\",
  994. \"x,> xxxxxxx\",
  995. \"6zlpw07xxxx\",
  996. \"5k32211=oxx\",
  997. \"49ryuasfexx\",
  998. \"$8yuasgdOxx\",
  999. \"%qiashjtxxx\",
  1000. \"X&*<;-:.xxx\",
  1001. \"xxx@xxxxxxx\",
  1002. \"xxx#xxxxxxx\",
  1003. \"xxx+xxxxxxx\",
  1004. \"xxx+xxxxxxx\"
  1005. };
  1006. ")
  1007. (defconst ide-skel-tree-widget-open-image
  1008. (create-image ide-skel-tree-widget-open-xpm 'xpm t))
  1009. (defconst ide-skel-tree-widget-no-handle-xpm "\
  1010. /* XPM */
  1011. static char *no_handle[] = {
  1012. /* columns rows colors chars-per-pixel */
  1013. \"7 15 1 1\",
  1014. \" c None\",
  1015. /* pixels */
  1016. \" \",
  1017. \" \",
  1018. \" \",
  1019. \" \",
  1020. \" \",
  1021. \" \",
  1022. \" \",
  1023. \" \",
  1024. \" \",
  1025. \" \",
  1026. \" \",
  1027. \" \",
  1028. \" \",
  1029. \" \",
  1030. \" \"
  1031. };
  1032. ")
  1033. (defconst ide-skel-tree-widget-no-handle-image
  1034. (create-image ide-skel-tree-widget-no-handle-xpm 'xpm t))
  1035. (defconst ide-skel-tree-widget-no-guide-xpm "\
  1036. /* XPM */
  1037. static char *no_guide[] = {
  1038. /* columns rows colors chars-per-pixel */
  1039. \"4 15 1 1\",
  1040. \" c None\",
  1041. /* pixels */
  1042. \" \",
  1043. \" \",
  1044. \" \",
  1045. \" \",
  1046. \" \",
  1047. \" \",
  1048. \" \",
  1049. \" \",
  1050. \" \",
  1051. \" \",
  1052. \" \",
  1053. \" \",
  1054. \" \",
  1055. \" \",
  1056. \" \"
  1057. };
  1058. ")
  1059. (defconst ide-skel-tree-widget-no-guide-image
  1060. (create-image ide-skel-tree-widget-no-guide-xpm 'xpm t))
  1061. (defconst ide-skel-tree-widget-leaf-xpm "\
  1062. /* XPM */
  1063. static char *leaf[] = {
  1064. /* columns rows colors chars-per-pixel */
  1065. \"11 15 42 1\",
  1066. \" c #224222422242\",
  1067. \". c #254525452545\",
  1068. \"X c #272727272727\",
  1069. \"o c #31DA31DA31DA\",
  1070. \"O c #4CAC4CAC4CAC\",
  1071. \"+ c #4F064F064F06\",
  1072. \"@ c #506050605060\",
  1073. \"# c #511651165116\",
  1074. \"$ c #57D657D657D6\",
  1075. \"% c #59A559A559A5\",
  1076. \"& c #5AAC5AAC5AAC\",
  1077. \"* c #5D5A5D5A5D5A\",
  1078. \"= c #5F025F025F02\",
  1079. \"- c #60C660C660C6\",
  1080. \"; c #617D617D617D\",
  1081. \": c #63D363D363D3\",
  1082. \"> c #8B908B908B90\",
  1083. \", c #8E3C8E3C8E3C\",
  1084. \"< c #8F588F588F58\",
  1085. \"1 c #93FC93FC93FC\",
  1086. \"2 c #949194919491\",
  1087. \"3 c #96AD96AD96AD\",
  1088. \"4 c #991899189918\",
  1089. \"5 c #99EA99EA99EA\",
  1090. \"6 c #9B619B619B61\",
  1091. \"7 c #9CD69CD69CD6\",
  1092. \"8 c #9E769E769E76\",
  1093. \"9 c #9FA59FA59FA5\",
  1094. \"0 c #A0C3A0C3A0C3\",
  1095. \"q c #A293A293A293\",
  1096. \"w c #A32EA32EA32E\",
  1097. \"e c #A480A480A480\",
  1098. \"r c #A5A5A5A5A5A5\",
  1099. \"t c #A755A755A755\",
  1100. \"y c #AA39AA39AA39\",
  1101. \"u c #AC77AC77AC77\",
  1102. \"i c #B1B7B1B7B1B7\",
  1103. \"p c #B283B283B283\",
  1104. \"a c #B7B7B7B7B7B7\",
  1105. \"s c #BD02BD02BD02\",
  1106. \"d c gray74\",
  1107. \"f c None\",
  1108. /* pixels */
  1109. \"fffffffffff\",
  1110. \"fffffffffff\",
  1111. \"fffffffffff\",
  1112. \"XXXXfffffff\",
  1113. \"%,25#offfff\",
  1114. \"*6qr$&.ffff\",
  1115. \"=1<3>wOffff\",
  1116. \";6648a@ffff\",
  1117. \";wweys#ffff\",
  1118. \":970ed#ffff\",
  1119. \"-tuipp+ffff\",
  1120. \"XXXXXX ffff\",
  1121. \"fffffffffff\",
  1122. \"fffffffffff\",
  1123. \"fffffffffff\"
  1124. };
  1125. ")
  1126. (defconst ide-skel-tree-widget-leaf-image
  1127. (create-image ide-skel-tree-widget-leaf-xpm 'xpm t))
  1128. (defconst ide-skel-tree-widget-handle-xpm "\
  1129. /* XPM */
  1130. static char *handle[] = {
  1131. /* columns rows colors chars-per-pixel */
  1132. \"7 15 2 1\",
  1133. \" c #56D752D36363\",
  1134. \". c None\",
  1135. /* pixels */
  1136. \".......\",
  1137. \".......\",
  1138. \".......\",
  1139. \".......\",
  1140. \".......\",
  1141. \".......\",
  1142. \".......\",
  1143. \" \",
  1144. \".......\",
  1145. \".......\",
  1146. \".......\",
  1147. \".......\",
  1148. \".......\",
  1149. \".......\",
  1150. \".......\"
  1151. };
  1152. ")
  1153. (defconst ide-skel-tree-widget-handle-image
  1154. (create-image ide-skel-tree-widget-handle-xpm 'xpm t))
  1155. (defconst ide-skel-tree-widget-guide-xpm "\
  1156. /* XPM */
  1157. static char *guide[] = {
  1158. /* columns rows colors chars-per-pixel */
  1159. \"4 15 2 1\",
  1160. \" c #73C96E6E8484\",
  1161. \". c None\",
  1162. /* pixels */
  1163. \"... \",
  1164. \"... \",
  1165. \"... \",
  1166. \"... \",
  1167. \"... \",
  1168. \"... \",
  1169. \"... \",
  1170. \"... \",
  1171. \"... \",
  1172. \"... \",
  1173. \"... \",
  1174. \"... \",
  1175. \"... \",
  1176. \"... \",
  1177. \"... \"
  1178. };
  1179. ")
  1180. (defconst ide-skel-tree-widget-guide-image
  1181. (create-image ide-skel-tree-widget-guide-xpm 'xpm t))
  1182. (defconst ide-skel-tree-widget-end-guide-xpm "\
  1183. /* XPM */
  1184. static char *end_guide[] = {
  1185. /* columns rows colors chars-per-pixel */
  1186. \"4 15 2 1\",
  1187. \" c #73C96E6E8484\",
  1188. \". c None\",
  1189. /* pixels */
  1190. \"... \",
  1191. \"... \",
  1192. \"... \",
  1193. \"... \",
  1194. \"... \",
  1195. \"... \",
  1196. \"... \",
  1197. \"... \",
  1198. \"....\",
  1199. \"....\",
  1200. \"....\",
  1201. \"....\",
  1202. \"....\",
  1203. \"....\",
  1204. \"....\"
  1205. };
  1206. ")
  1207. (defconst ide-skel-tree-widget-end-guide-image
  1208. (create-image ide-skel-tree-widget-end-guide-xpm 'xpm t))
  1209. (defconst ide-skel-tree-widget-empty-xpm "\
  1210. /* XPM */
  1211. static char *empty[] = {
  1212. /* columns rows colors chars-per-pixel */
  1213. \"11 15 39 1\",
  1214. \" c #2BCF2BCF2BCF\",
  1215. \". c #31F831F831F8\",
  1216. \"X c #3F283F283F28\",
  1217. \"o c #41B141B141B1\",
  1218. \"O c #467946794679\",
  1219. \"+ c #476747674767\",
  1220. \"@ c #484648464846\",
  1221. \"# c #498749874987\",
  1222. \"$ c #4B684B684B68\",
  1223. \"% c #524F524F524F\",
  1224. \"& c #52D352D352D3\",
  1225. \"* c #554155415541\",
  1226. \"= c #561C561C561C\",
  1227. \"- c #598659865986\",
  1228. \"; c #5D775D775D77\",
  1229. \": c #5E7E5E7E5E7E\",
  1230. \"> c #60CE60CE60CE\",
  1231. \", c #615161516151\",
  1232. \"< c #61F361F361F3\",
  1233. \"1 c #642464246424\",
  1234. \"2 c #654865486548\",
  1235. \"3 c #678767876787\",
  1236. \"4 c #68D868D868D8\",
  1237. \"5 c #699569956995\",
  1238. \"6 c #6D556D556D55\",
  1239. \"7 c #6FB56FB56FB5\",
  1240. \"8 c #72CF72CF72CF\",
  1241. \"9 c #731073107310\",
  1242. \"0 c #757775777577\",
  1243. \"q c #7B747B747B74\",
  1244. \"w c #809080908090\",
  1245. \"e c #81F281F281F2\",
  1246. \"r c #820D820D820D\",
  1247. \"t c #84F984F984F9\",
  1248. \"y c #858285828582\",
  1249. \"u c #95E295E295E2\",
  1250. \"i c #9FFF9FFF9FFF\",
  1251. \"p c #A5A5A5A5A5A5\",
  1252. \"a c None\",
  1253. /* pixels */
  1254. \"aaaaaaaaaaa\",
  1255. \"aaaaaaaaaaa\",
  1256. \"aaaaaaaaaaa\",
  1257. \"aaaaaaaaaaa\",
  1258. \"a&% aaaaaaa\",
  1259. \",piy76<aaaa\",
  1260. \">u-===*#oaa\",
  1261. \":14690qe3aa\",
  1262. \"+;680qewOaa\",
  1263. \"@290qrt5aaa\",
  1264. \"XO+@#$$.aaa\",
  1265. \"aaaaaaaaaaa\",
  1266. \"aaaaaaaaaaa\",
  1267. \"aaaaaaaaaaa\",
  1268. \"aaaaaaaaaaa\"
  1269. };
  1270. ")
  1271. (defconst ide-skel-tree-widget-empty-image
  1272. (create-image ide-skel-tree-widget-empty-xpm 'xpm t))
  1273. (defconst ide-skel-tree-widget-close-xpm "\
  1274. /* XPM */
  1275. static char *close[] = {
  1276. /* columns rows colors chars-per-pixel */
  1277. \"11 15 45 1\",
  1278. \" c #4EA14EA10DFA\",
  1279. \". c #5AA05AA00C52\",
  1280. \"X c #75297529068F\",
  1281. \"o c #7B647B6404B5\",
  1282. \"O c #8B888B880B91\",
  1283. \"+ c #8EDE8EDE0F5F\",
  1284. \"@ c #82F782F71033\",
  1285. \"# c #83A683A61157\",
  1286. \"$ c #84AD84AD13BC\",
  1287. \"% c #857985791489\",
  1288. \"& c #868086801590\",
  1289. \"* c #8A8A8A8A1697\",
  1290. \"= c #878787871812\",
  1291. \"- c #885388531936\",
  1292. \"; c #8BAB8BAB17B8\",
  1293. \": c #8CCC8CCC1A7D\",
  1294. \"> c #8DB68DB61BC4\",
  1295. \", c #90EC90EC11D0\",
  1296. \"< c #9161916114B5\",
  1297. \"1 c #92A292A2163F\",
  1298. \"2 c #8E8B8E8B2150\",
  1299. \"3 c #8F0F8F0F2274\",
  1300. \"4 c #9AF79AF72386\",
  1301. \"5 c #9D289D282655\",
  1302. \"6 c #9ED19ED1286E\",
  1303. \"7 c #9F599F592912\",
  1304. \"8 c #A31DA31D2D82\",
  1305. \"9 c #A3DDA3DD2DA2\",
  1306. \"0 c #A144A1442ED2\",
  1307. \"q c #A828A82833B4\",
  1308. \"w c #AB38AB383AEB\",
  1309. \"e c #AD21AD213DC2\",
  1310. \"r c #AD6DAD6D3E56\",
  1311. \"t c #AFFCAFFC4481\",
  1312. \"y c #B0AAB0AA429F\",
  1313. \"u c #B1B1B1B144E8\",
  1314. \"i c #B51DB51D4A5F\",
  1315. \"p c #B535B5354A8A\",
  1316. \"a c #B56FB56F4AEE\",
  1317. \"s c #B7B0B7B0525B\",
  1318. \"d c #BD14BD1459B1\",
  1319. \"f c #BFACBFAC5C55\",
  1320. \"g c #C5D9C5D965F7\",
  1321. \"h c #C85FC85F6D04\",
  1322. \"j c None\",
  1323. /* pixels */
  1324. \"jjjjjjjjjjj\",
  1325. \"jjjjjjjjjjj\",
  1326. \"jjjjjjjjjjj\",
  1327. \"jjjjjjjjjjj\",
  1328. \"j32 jjjjjjj\",
  1329. \"1uy84570.jj\",
  1330. \"O69wtpsd*jj\",
  1331. \"+qrtpsdf;jj\",
  1332. \",etisdfg:jj\",
  1333. \"<tasdfgh>jj\",
  1334. \"o@#$%&=-Xjj\",
  1335. \"jjjjjjjjjjj\",
  1336. \"jjjjjjjjjjj\",
  1337. \"jjjjjjjjjjj\",
  1338. \"jjjjjjjjjjj\"
  1339. };
  1340. ")
  1341. (defconst ide-skel-tree-widget-close-image
  1342. (create-image ide-skel-tree-widget-close-xpm 'xpm t))
  1343. (define-widget 'ide-skel-imenu-internal-node-widget 'tree-widget
  1344. "Internal node widget.")
  1345. (define-widget 'ide-skel-imenu-leaf-widget 'push-button
  1346. "Leaf widget."
  1347. :format "%[%t%]\n"
  1348. :button-face 'variable-pitch
  1349. )
  1350. (defvar ide-skel-imenu-sorted nil)
  1351. (make-variable-buffer-local 'ide-skel-imenu-sorted)
  1352. (defvar ide-skel-imenu-editor-buffer nil)
  1353. (make-variable-buffer-local 'ide-skel-imenu-editor-buffer)
  1354. (defvar ide-skel-imenu-open-paths nil)
  1355. (make-variable-buffer-local 'ide-skel-imenu-open-paths)
  1356. (defface imenu-side-view-face '((t :inherit variable-pitch :height 0.8))
  1357. "Default face used in right view for imenu"
  1358. :group 'ide-skel)
  1359. (define-widget 'ide-skel-info-tree-dir-widget 'tree-widget
  1360. "Directory Tree widget."
  1361. :expander 'ide-skel-info-tree-expand-dir
  1362. :notify 'ide-skel-info-open
  1363. :indent 0)
  1364. (define-widget 'ide-skel-info-tree-file-widget 'push-button
  1365. "File widget."
  1366. :format "%[%t%]%d\n"
  1367. :button-face 'variable-pitch
  1368. :notify 'ide-skel-info-file-open)
  1369. (defvar ide-skel-info-open-paths nil)
  1370. (make-variable-buffer-local 'ide-skel-info-open-paths)
  1371. (defvar ide-skel-info-root-node nil)
  1372. (make-variable-buffer-local 'ide-skel-info-root-node)
  1373. (defvar ide-skel-info-buffer nil)
  1374. (define-widget 'ide-skel-dir-tree-dir-widget 'tree-widget
  1375. "Directory Tree widget."
  1376. :expander 'ide-skel-dir-tree-expand-dir
  1377. :notify 'ide-skel-dir-open
  1378. :indent 0)
  1379. (define-widget 'ide-skel-dir-tree-file-widget 'push-button
  1380. "File widget."
  1381. :format "%[%t%]%d\n"
  1382. :button-face 'variable-pitch
  1383. :notify 'ide-skel-file-open)
  1384. (defvar ide-skel-dir-open-paths nil)
  1385. (make-variable-buffer-local 'ide-skel-dir-open-paths)
  1386. (defvar ide-skel-dir-root-dir "/")
  1387. (make-variable-buffer-local 'ide-skel-dir-root-dir)
  1388. (defvar ide-skel-dir-buffer nil)
  1389. (defconst ide-skel-cvs-dir-regexp "\\(\\.svn\\|CVS\\)$")
  1390. (defstruct ide-skel-project
  1391. root-path
  1392. include-file-path ; for PC-include-file-path variable
  1393. )
  1394. (defvar ide-skel-projects nil)
  1395. (defvar ide-skel-proj-find-results-buffer-name "*Proj find*")
  1396. (defvar ide-skel-project-menu
  1397. '("Project"
  1398. :filter ide-skel-project-menu)
  1399. "Menu for CVS/SVN projects")
  1400. (defvar ide-skel-proj-find-project-files-history nil)
  1401. (defvar ide-skel-proj-grep-project-files-history nil)
  1402. (defvar ide-skel-proj-ignored-extensions '("semantic.cache"))
  1403. (defvar ide-skel-all-text-files-flag nil)
  1404. (defvar ide-skel-proj-grep-header nil)
  1405. (defvar ide-skel-proj-old-compilation-exit-message-function nil)
  1406. (make-variable-buffer-local 'ide-skel-proj-old-compilation-exit-message-function)
  1407. (defvar ide-skel-proj-grep-mode-map nil)
  1408. (defvar ide-skel-proj-grep-replace-history nil)
  1409. ;;;
  1410. (copy-face 'mode-line 'mode-line-inactive)
  1411. (define-key tree-widget-button-keymap [drag-mouse-1] 'ignore)
  1412. (defun ide-skel-tabbar-tab-label (tab)
  1413. "Return a label for TAB.
  1414. That is, a string used to represent it on the tab bar."
  1415. (let* ((object (tabbar-tab-value tab))
  1416. (tabset (tabbar-tab-tabset tab))
  1417. (label (format " %s "
  1418. (or (and (bufferp object)
  1419. (with-current-buffer object ide-skel-tabbar-tab-label)) ; local in buffer
  1420. object))))
  1421. (when (and (not (memq tabset (list (tabbar-get-tabset ide-skel-left-view-window-tabset-name)
  1422. (tabbar-get-tabset ide-skel-right-view-window-tabset-name))))
  1423. (numberp ide-skel-tabbar-tab-label-max-width)
  1424. (> ide-skel-tabbar-tab-label-max-width 0))
  1425. (setq label (tabbar-shorten label ide-skel-tabbar-tab-label-max-width)))
  1426. label))
  1427. (defun ide-skel-tabbar-help-on-tab (tab)
  1428. "Return the help string shown when mouse is onto TAB."
  1429. (let ((tabset (tabbar-tab-tabset tab))
  1430. (object (tabbar-tab-value tab)))
  1431. (or (when (bufferp object)
  1432. (with-current-buffer object
  1433. (or ide-skel-tabbar-tab-help-string ; local in buffer
  1434. (buffer-file-name))))
  1435. "mouse-1: switch to buffer\nmouse-2: delete other windows\nmouse-3: kill buffer")))
  1436. (defun ide-skel-tabbar-buffer-groups ()
  1437. "Return the list of group names the current buffer belongs to."
  1438. (if (and (ide-skel-side-view-buffer-p (current-buffer))
  1439. (or (not ide-skel-tabbar-tab-label)
  1440. (not ide-skel-tabbar-enabled)))
  1441. nil
  1442. (let ((result (list (or ide-skel-tabset-name ; local in current buffer
  1443. (when (ide-skel-bottom-view-buffer-p (current-buffer)) ide-skel-bottom-view-window-tabset-name)
  1444. ide-skel-editor-window-tabset-name))))
  1445. (dolist (window (copy-list (window-list nil 1)))
  1446. (when (eq (window-buffer window) (current-buffer))
  1447. (let ((tabset-name (ide-skel-get-tabset-name-for-window window)))
  1448. (unless (member tabset-name result)
  1449. (push tabset-name result)))))
  1450. result)))
  1451. (defun ide-skel-tabbar-buffer-tabs ()
  1452. "Return the buffers to display on the tab bar, in a tab set."
  1453. ;; (message "ide-skel-tabbar-buffer-tabs %S" (current-buffer))
  1454. (tabbar-buffer-update-groups)
  1455. (let* ((window (selected-window))
  1456. (tabset (tabbar-get-tabset (ide-skel-get-tabset-name-for-window window))))
  1457. (when (not (tabbar-get-tab (current-buffer) tabset))
  1458. (tabbar-add-tab tabset (current-buffer) t))
  1459. (tabbar-select-tab-value (current-buffer) tabset)
  1460. tabset))
  1461. (defun ide-skel-tabbar-buffer-list ()
  1462. "Return the list of buffers to show in tabs.
  1463. The current buffer is always included."
  1464. ;(ide-skel-tabbar-faces-adapt)
  1465. (delq t
  1466. (mapcar #'(lambda (b)
  1467. (let ((buffer-name (buffer-name b)))
  1468. (cond
  1469. ((and (ide-skel-side-view-buffer-p b)
  1470. (with-current-buffer b
  1471. (or (not ide-skel-tabbar-tab-label)
  1472. (not ide-skel-tabbar-enabled))))
  1473. t)
  1474. ;; Always include the current buffer.
  1475. ((eq (current-buffer) b) b)
  1476. ;; accept if buffer has tabset name
  1477. ((with-current-buffer b ide-skel-tabset-name) b)
  1478. ;; remove if matches any regexp from ide-skel-tabbar-hidden-buffer-names-regexp-list
  1479. ((not (null (some (lambda (regexp)
  1480. (string-match regexp buffer-name))
  1481. ide-skel-tabbar-hidden-buffer-names-regexp-list)))
  1482. t)
  1483. ;; accept if buffer has filename
  1484. ((buffer-file-name b) b)
  1485. ;; remove if name starts with space
  1486. ((and (char-equal ?\ (aref (buffer-name b) 0))
  1487. (not (ide-skel-side-view-buffer-p b)))
  1488. t)
  1489. ;; accept otherwise
  1490. (b))))
  1491. (buffer-list (selected-frame)))))
  1492. (defun ide-skel-get-tabset-name-for-window (window)
  1493. (cond ((eq (ide-skel-get-left-view-window) window) ide-skel-left-view-window-tabset-name)
  1494. ((eq (ide-skel-get-right-view-window) window) ide-skel-right-view-window-tabset-name)
  1495. ((eq (ide-skel-get-bottom-view-window) window) ide-skel-bottom-view-window-tabset-name)
  1496. (t ide-skel-editor-window-tabset-name)))
  1497. (defun ide-skel-tabbar-select-tab (event tab)
  1498. "On mouse EVENT, select TAB."
  1499. (let* ((mouse-button (event-basic-type event))
  1500. (buffer (tabbar-tab-value tab))
  1501. (tabset-name (and (buffer-live-p buffer)
  1502. (with-current-buffer buffer ide-skel-tabset-name)))
  1503. (left-tabset (equal tabset-name ide-skel-left-view-window-tabset-name))
  1504. (right-tabset (equal tabset-name ide-skel-right-view-window-tabset-name)))
  1505. (cond
  1506. ((eq mouse-button 'mouse-1)
  1507. (cond (left-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window buffer))
  1508. (right-tabset (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window buffer))
  1509. (t (switch-to-buffer buffer))))
  1510. ((and (eq mouse-button 'mouse-2)
  1511. (not left-tabset)
  1512. (not right-tabset))
  1513. (switch-to-buffer buffer)
  1514. (delete-other-windows))
  1515. ((and (eq mouse-button 'mouse-3)
  1516. (not left-tabset)
  1517. (not right-tabset))
  1518. (kill-buffer buffer)))
  1519. ;; Disable group mode.
  1520. (set 'tabbar-buffer-group-mode nil)))
  1521. (defun ide-skel-tabbar-buffer-kill-buffer-hook ()
  1522. "Hook run just before actually killing a buffer.
  1523. In Tabbar mode, try to switch to a buffer in the current tab bar,
  1524. after the current buffer has been killed. Try first the buffer in tab
  1525. after the current one, then the buffer in tab before. On success, put
  1526. the sibling buffer in front of the buffer list, so it will be selected
  1527. first."
  1528. (let ((buffer-to-kill (current-buffer)))
  1529. (save-selected-window
  1530. (save-current-buffer
  1531. ;; cannot kill buffer from any side view window
  1532. (when (and (eq header-line-format tabbar-header-line-format)
  1533. (not (ide-skel-side-view-buffer-p (current-buffer))))
  1534. (dolist (window (copy-list (window-list nil 1)))
  1535. (when (eq buffer-to-kill (window-buffer window))
  1536. (select-window window)
  1537. (let ((bl (tabbar-tab-values (funcall tabbar-current-tabset-function)))
  1538. found sibling)
  1539. (while (and bl (not found))
  1540. (if (equal buffer-to-kill (car bl))
  1541. (setq found t)
  1542. (setq sibling (car bl)))
  1543. (setq bl (cdr bl)))
  1544. (setq sibling (or sibling (car bl)))
  1545. (if (and sibling
  1546. (not (eq sibling buffer-to-kill))
  1547. (buffer-live-p sibling))
  1548. ;; Move sibling buffer in front of the buffer list.
  1549. (switch-to-buffer sibling)
  1550. (let ((next-buffer (ide-skel--find-buffer-for-bottom-view-window)))
  1551. (when (eq next-buffer buffer-to-kill)
  1552. (setq next-buffer (some (lambda (buf)
  1553. (if (or (eq buf buffer-to-kill)
  1554. (ide-skel-side-view-buffer-p buf)
  1555. (ide-skel-hidden-buffer-name-p (buffer-name buf)))
  1556. nil
  1557. buf))
  1558. (buffer-list (selected-frame)))))
  1559. (when next-buffer
  1560. (switch-to-buffer next-buffer)
  1561. (tabbar-current-tabset t))))))))))))
  1562. (defun ide-skel-tabbar-inhibit-function ()
  1563. "Inhibit display of the tab bar in specified windows, that is
  1564. in `checkdoc' status windows and in windows with its own header
  1565. line."
  1566. (let ((result (tabbar-default-inhibit-function))
  1567. (sw (selected-window)))
  1568. (when (and result
  1569. (ide-skel-side-view-window-p sw))
  1570. (setq result nil))
  1571. (when (not (eq header-line-format tabbar-header-line-format))
  1572. (setq result t))
  1573. result))
  1574. (defun ide-skel-tabbar-home-function (event)
  1575. (let* ((window (posn-window (event-start event)))
  1576. (is-view-window (ide-skel-side-view-window-p window))
  1577. (buffer (window-buffer window))
  1578. extra-commands
  1579. (normal-window-counter 0))
  1580. (dolist (win (copy-list (window-list nil 1)))
  1581. (unless (ide-skel-side-view-window-p win)
  1582. (incf normal-window-counter)))
  1583. (with-selected-window window
  1584. (when (and is-view-window
  1585. ide-skel-tabbar-menu-function)
  1586. (setq extra-commands (funcall ide-skel-tabbar-menu-function)))
  1587. (let ((close-p (when (or is-view-window
  1588. (> normal-window-counter 1))
  1589. (list '(close "Close" t))))
  1590. (maximize-p (when (and (not is-view-window)
  1591. (> normal-window-counter 1))
  1592. (list '(maximize "Maximize" t)))))
  1593. (when (or close-p maximize-p)
  1594. (let ((user-selection
  1595. (car (x-popup-menu event (append (list 'keymap) close-p maximize-p extra-commands)))))
  1596. (cond ((eq user-selection 'close)
  1597. (call-interactively 'delete-window))
  1598. ((eq user-selection 'maximize)
  1599. (delete-other-windows window))
  1600. ((eq user-selection nil))
  1601. (t
  1602. (funcall user-selection)))))))))
  1603. (defun ide-skel-tabbar-mwheel-scroll-forward (event)
  1604. (interactive "@e")
  1605. (tabbar-press-scroll-left))
  1606. (defun ide-skel-tabbar-mwheel-scroll-backward (event)
  1607. (interactive "@e")
  1608. (tabbar-press-scroll-right))
  1609. (defun ide-skel-tabbar-mwheel-scroll (event)
  1610. "Select the next or previous group of tabs according to EVENT."
  1611. (interactive "@e")
  1612. (if (tabbar--mwheel-up-p event)
  1613. (ide-skel-tabbar-mwheel-scroll-forward event)
  1614. (ide-skel-tabbar-mwheel-scroll-backward event)))
  1615. (defun ide-skel-tabbar-mwhell-mode-hook ()
  1616. (setq tabbar-mwheel-mode-map
  1617. (let ((km (make-sparse-keymap)))
  1618. (if (get 'mouse-wheel 'event-symbol-elements)
  1619. ;; Use one generic mouse wheel event
  1620. (define-key km [A-mouse-wheel]
  1621. 'ide-skel-tabbar-mwheel-scroll)
  1622. ;; Use separate up/down mouse wheel events
  1623. (let ((up (tabbar--mwheel-key tabbar--mwheel-up-event))
  1624. (down (tabbar--mwheel-key tabbar--mwheel-down-event)))
  1625. (define-key km `[header-line ,down]
  1626. 'ide-skel-tabbar-mwheel-scroll-backward)
  1627. (define-key km `[header-line ,up]
  1628. 'ide-skel-tabbar-mwheel-scroll-forward)
  1629. ))
  1630. km))
  1631. (setcdr (assoc 'tabbar-mwheel-mode minor-mode-map-alist) tabbar-mwheel-mode-map))
  1632. (defun ide-skel-tabbar-mode-hook ()
  1633. (setq tabbar-prefix-map
  1634. (let ((km (make-sparse-keymap)))
  1635. (define-key km [(control home)] 'tabbar-press-home)
  1636. (define-key km [(control left)] 'tabbar-backward)
  1637. (define-key km [(control right)] 'tabbar-forward)
  1638. (define-key km [(control prior)] 'tabbar-press-scroll-left)
  1639. (define-key km [(control next)] 'tabbar-press-scroll-right)
  1640. km))
  1641. (setq tabbar-mode-map
  1642. (let ((km (make-sparse-keymap)))
  1643. (define-key km tabbar-prefix-key tabbar-prefix-map)
  1644. km))
  1645. (setcdr (assoc 'tabbar-mode minor-mode-map-alist) tabbar-mode-map))
  1646. (defun ide-skel-tabbar-init-hook ()
  1647. (setq tabbar-cycle-scope 'tabs
  1648. tabbar-auto-scroll-flag nil)
  1649. (setq
  1650. tabbar-tab-label-function 'ide-skel-tabbar-tab-label
  1651. tabbar-help-on-tab-function 'ide-skel-tabbar-help-on-tab
  1652. tabbar-buffer-groups-function 'ide-skel-tabbar-buffer-groups
  1653. tabbar-buffer-list-function 'ide-skel-tabbar-buffer-list
  1654. tabbar-current-tabset-function 'ide-skel-tabbar-buffer-tabs
  1655. tabbar-select-tab-function 'ide-skel-tabbar-select-tab
  1656. tabbar-inhibit-functions (append '(ide-skel-tabbar-inhibit-function)
  1657. (delq 'tabbar-default-inhibit-function tabbar-inhibit-functions))
  1658. tabbar-home-function 'ide-skel-tabbar-home-function
  1659. tabbar-home-help-function (lambda () "Window menu"))
  1660. (add-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook))
  1661. (defun ide-skel-tabbar-quit-hook ()
  1662. (setq
  1663. tabbar-current-tabset-function nil
  1664. tabbar-tab-label-function nil
  1665. tabbar-select-tab-function nil
  1666. tabbar-help-on-tab-function nil
  1667. tabbar-home-function nil
  1668. tabbar-home-help-function nil
  1669. tabbar-buffer-groups-function nil
  1670. tabbar-buffer-list-function nil)
  1671. (remove-hook 'kill-buffer-hook 'ide-skel-tabbar-buffer-kill-buffer-hook))
  1672. (defun ide-skel-tabbar-load-hook ()
  1673. (add-hook 'tabbar-mode-hook 'ide-skel-tabbar-mode-hook)
  1674. (add-hook 'tabbar-mwheel-mode-hook 'ide-skel-tabbar-mwhell-mode-hook)
  1675. (add-hook 'tabbar-init-hook 'ide-skel-tabbar-init-hook t)
  1676. (add-hook 'tabbar-quit-hook 'ide-skel-tabbar-quit-hook t)
  1677. ;(custom-set-faces
  1678. ; '(tabbar-default ((t (:inherit variable-pitch :background "gray82" :foreground "gray50" :height 0.8))))
  1679. ; '(tabbar-selected ((t (:inherit tabbar-default :background "white" :foreground "blue" :box (:line-width 1 :color "black")))))
  1680. ; '(tabbar-separator ((t (:inherit tabbar-default :height 0.2))))
  1681. ; '(tabbar-highlight ((t ())))
  1682. ; '(tabbar-button-highlight ((t (:inherit tabbar-button))))
  1683. ; '(tabbar-unselected ((t (:inherit tabbar-default :background "gray72" :foreground "black" :box (:line-width 1 :color "black"))))))
  1684. ;(ide-skel-tabbar-faces-adapt)
  1685. )
  1686. ;(defun ide-skel-tabbar-faces-adapt ()
  1687. ; (ide-skel-shine-face-background 'tabbar-default +18)
  1688. ; (set-face-attribute 'tabbar-selected nil :background (face-background 'default))
  1689. ; (set-face-attribute 'tabbar-selected nil :foreground (face-foreground 'font-lock-function-name-face))
  1690. ; (set-face-attribute 'tabbar-selected nil :box (list :line-width 1 :color (face-foreground 'default)))
  1691. ; (ide-skel-shine-face-background 'tabbar-unselected +30)
  1692. ; (set-face-attribute 'tabbar-unselected nil :foreground (face-foreground 'default))
  1693. ; (set-face-attribute 'tabbar-unselected nil :box (list :line-width 1 :color (face-foreground 'default)))
  1694. ; (ide-skel-shine-face-background 'tabbar-button +18)
  1695. ; (ide-skel-shine-face-foreground 'tabbar-button +20))
  1696. (defun ide-skel-paradox-settings ()
  1697. ;; hide scroll buttons
  1698. (setq tabbar-scroll-left-button (cons (cons "" nil) (cons "" nil))
  1699. tabbar-scroll-right-button (cons (cons "" nil) (cons "" nil))))
  1700. (ide-skel-paradox-settings)
  1701. ;;; Views
  1702. (defun ide-skel-window-list ()
  1703. (delq nil
  1704. (mapcar (lambda (win)
  1705. (unless (memq win ide-skel-ommited-windows)
  1706. win))
  1707. (copy-list (window-list nil 1)))))
  1708. (defun ide-skel-next-window (&optional window minibuf all-frames)
  1709. (let ((nw (next-window window minibuf all-frames)))
  1710. (if (memq nw ide-skel-ommited-windows)
  1711. (ide-skel-next-window nw minibuf all-frames)
  1712. nw)))
  1713. (defun ide-skel-previous-window (window minibuf all-frames)
  1714. (let ((pw (previous-window window minibuf all-frames)))
  1715. (if (memq pw ide-skel-ommited-windows)
  1716. window
  1717. pw)))
  1718. (defun ide-skel-win--absorb-win-node (dest-win-node src-win-node)
  1719. (dotimes (index (length src-win-node))
  1720. (setf (elt dest-win-node index)
  1721. (elt src-win-node index))))
  1722. (defun ide-skel-win--create-win-node (object)
  1723. (cond ((win-node-p object) (copy-win-node object))
  1724. ((windowp object)
  1725. (make-win-node :corner-pos (ide-skel-win-corner object)
  1726. :buf-corner-pos (window-start object)
  1727. :buffer (window-buffer object)
  1728. :horiz-scroll (window-hscroll object)
  1729. :point (window-point object)
  1730. :mark nil
  1731. :edges (window-edges object)
  1732. :fixed-size (cdr (assoc (ide-skel-win-corner object) ide-skel--fixed-size-windows))
  1733. :divisions nil))
  1734. (t (error "Argument is not win-not nor window: %S" object))))
  1735. (defun ide-skel-win--get-corner-pos (object)
  1736. (cond ((windowp object) (ide-skel-win-corner object))
  1737. ((win-node-p object) (win-node-corner-pos object))
  1738. ((consp object) object)
  1739. (t (error "Invalid arg: %S" object))))
  1740. (defun ide-skel-win--corner-pos-equal (win-node1 win-node2)
  1741. (let ((corner-pos1 (ide-skel-win--get-corner-pos win-node1))
  1742. (corner-pos2 (ide-skel-win--get-corner-pos win-node2)))
  1743. (equal corner-pos1 corner-pos2)))
  1744. (defun ide-skel-win--add-division (win-node division &optional at-end-p)
  1745. (setf (win-node-divisions win-node)
  1746. (if at-end-p
  1747. (reverse (cons division (reverse (win-node-divisions win-node))))
  1748. (cons division (win-node-divisions win-node)))))
  1749. (defun ide-skel-win--remove-division (win-node &optional from-end-p)
  1750. (let (result)
  1751. (if from-end-p
  1752. (let ((divs (reverse (win-node-divisions win-node))))
  1753. (setq result (car divs))
  1754. (setf (win-node-divisions win-node)
  1755. (reverse (cdr divs))))
  1756. (setq result (car (win-node-divisions win-node)))
  1757. (setf (win-node-divisions win-node) (cdr (win-node-divisions win-node))))
  1758. result))
  1759. (defun ide-skel-win--find-node (root predicate)
  1760. "Return node for which predicate returns non-nil."
  1761. (when root
  1762. (if (funcall predicate root)
  1763. root
  1764. (some (lambda (division)
  1765. (ide-skel-win--find-node (division-win-node division) predicate))
  1766. (win-node-divisions root)))))
  1767. (defun ide-skel-win--find-node-by-corner-pos (root corner-pos)
  1768. "Return struct for window with specified corner coordinates."
  1769. (setq corner-pos
  1770. (cond ((windowp corner-pos) (ide-skel-win-corner corner-pos))
  1771. ((consp corner-pos) corner-pos)
  1772. (t (error "arg corner-pos %S is not a pair/window" corner-pos))))
  1773. (ide-skel-win--find-node root
  1774. (lambda (win-node)
  1775. (equal corner-pos (win-node-corner-pos win-node)))))
  1776. (defun ide-skel-win--get-window-list ()
  1777. (let* ((start-win (selected-window))
  1778. (cur-win (ide-skel-next-window start-win 1 1))
  1779. (win-list (list start-win)))
  1780. (while (not (eq cur-win start-win))
  1781. (setq win-list (cons cur-win win-list))
  1782. (setq cur-win (ide-skel-next-window cur-win 1 1)))
  1783. (reverse win-list)))
  1784. (defun ide-skel-win--analysis (&optional window-proc)
  1785. ;; (message "ide-skel-win--analysis BEGIN %S" (get-internal-run-time))
  1786. (let ((window-size-fixed nil))
  1787. (setq ide-skel--fixed-size-windows nil)
  1788. (dolist (window (copy-list (window-list nil 1)))
  1789. (with-selected-window window
  1790. (cond ((eq window-size-fixed 'width)
  1791. (push (cons (ide-skel-win-corner window) (cons (window-width window) nil)) ide-skel--fixed-size-windows))
  1792. ((eq window-size-fixed 'height)
  1793. (push (cons (ide-skel-win-corner window) (cons nil (window-height window))) ide-skel--fixed-size-windows))
  1794. ((not window-size-fixed)
  1795. nil)
  1796. (t
  1797. (push (cons (ide-skel-win-corner window) (cons (window-width window) (window-height window))) ide-skel--fixed-size-windows)))))
  1798. (dolist (window (ide-skel-window-list))
  1799. (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window nil)))
  1800. (setq ide-skel-win--minibuffer-selected-p (eq (selected-window) (minibuffer-window)))
  1801. (when ide-skel-win--minibuffer-selected-p
  1802. (select-window (ide-skel-get-editor-window)))
  1803. (when (memq (selected-window) ide-skel-ommited-windows)
  1804. (select-window (ide-skel-next-window (selected-window) 1 1)))
  1805. (let* (leaf-win
  1806. (counter 0)
  1807. (cursor-alist (mapcar (lambda (win) (prog1 (cons win counter) (incf counter))) (ide-skel-win--get-window-list)))
  1808. win-node-set)
  1809. (select-window (ide-skel-win-get-upper-left-window))
  1810. (while (setq leaf-win (get-window-with-predicate
  1811. (lambda (win)
  1812. (if ide-skel-win--win2-switch (ide-skel-win--is-leaf2 win) (ide-skel-win--is-leaf win))) 1 1))
  1813. (let* ((parent-win (ide-skel-previous-window leaf-win 1 1))
  1814. (parent-node (car (member* (ide-skel-win-corner parent-win) win-node-set :test 'ide-skel-win--corner-pos-equal)))
  1815. (leaf-node (car (member* (ide-skel-win-corner leaf-win) win-node-set :test 'ide-skel-win--corner-pos-equal))))
  1816. (unless leaf-node
  1817. (setq leaf-node (ide-skel-win--create-win-node leaf-win))
  1818. (setf (win-node-cursor-priority leaf-node) (cdr (assq leaf-win cursor-alist)))
  1819. (setq win-node-set (adjoin leaf-node win-node-set :test 'ide-skel-win--corner-pos-equal)))
  1820. (unless parent-node
  1821. (setq parent-node (ide-skel-win--create-win-node parent-win))
  1822. (setf (win-node-cursor-priority parent-node) (cdr (assq parent-win cursor-alist)))
  1823. (setq win-node-set (adjoin parent-node win-node-set :test 'ide-skel-win--corner-pos-equal)))
  1824. (let* ((is-horizontal (ide-skel-win--is-adjacent parent-win 'right leaf-win))
  1825. (size (if is-horizontal (window-width parent-win) (window-height parent-win)))
  1826. percent)
  1827. (setf (win-node-edges leaf-node) (window-edges leaf-win))
  1828. (when window-proc (funcall window-proc parent-win))
  1829. (when window-proc (funcall window-proc leaf-win))
  1830. (delete-window leaf-win)
  1831. (when window-proc (funcall window-proc parent-win))
  1832. (setq percent
  1833. (/ (float size) (if is-horizontal (window-width parent-win) (window-height parent-win))))
  1834. (ide-skel-win--add-division parent-node
  1835. (make-division :win-node leaf-node
  1836. :horizontal-p is-horizontal
  1837. :percent percent)))))
  1838. ;; if there was only one window
  1839. (unless win-node-set
  1840. (when window-proc (funcall window-proc (selected-window)))
  1841. (let ((node (ide-skel-win--create-win-node (selected-window))))
  1842. (setq win-node-set (adjoin node win-node-set
  1843. :test 'ide-skel-win--corner-pos-equal))))
  1844. ;; return root node
  1845. (let ((root-node (car (member* (ide-skel-win-corner (selected-window))
  1846. win-node-set
  1847. :test 'ide-skel-win--corner-pos-equal))))
  1848. (setf (win-node-edges root-node) (window-edges (selected-window)))
  1849. ;; (message "ide-skel-win--analysis END %S" (get-internal-run-time))
  1850. root-node))))
  1851. (defun ide-skel-win-get-upper-left-window ()
  1852. "Return window in left upper corner"
  1853. (let (best-window)
  1854. (dolist (win (ide-skel-window-list))
  1855. (if (null best-window)
  1856. (setq best-window win)
  1857. (let* ((best-window-coords (window-edges best-window))
  1858. (best-window-weight (+ (car best-window-coords) (cadr best-window-coords)))
  1859. (win-coords (window-edges win))
  1860. (win-weight (+ (car win-coords) (cadr win-coords))))
  1861. (when (< win-weight best-window-weight)
  1862. (setq best-window win)))))
  1863. best-window))
  1864. (defun ide--is-right-window (window)
  1865. (let ((bounds (window-edges window))
  1866. (result t))
  1867. (dolist (win (ide-skel-window-list))
  1868. (let ((left-edge-pos (car (window-edges win))))
  1869. (when (>= left-edge-pos (nth 2 bounds))
  1870. (setq result nil))))
  1871. result))
  1872. (defun ide-skel-get-win-width-delta (window)
  1873. (if window-system
  1874. (let ((bounds (window-edges window)))
  1875. (+ (- (- (nth 2 bounds) (nth 0 bounds)) (window-width window))
  1876. (if (and (not scroll-bar-mode)
  1877. (ide--is-right-window window))
  1878. 1
  1879. 0)))
  1880. 1))
  1881. (defun ide-skel-win--split (window horizontal-p percentage)
  1882. "Split window and return children."
  1883. (let* ((delta (ide-skel-get-win-width-delta window))
  1884. (weight percentage)
  1885. (new-size (cond
  1886. ((integerp weight) (if (< weight 0)
  1887. (if horizontal-p
  1888. (+ (window-width window) weight)
  1889. (+ (window-height window) weight))
  1890. (if horizontal-p (+ delta weight) weight)))
  1891. (t ; float
  1892. (when (< weight 0.0)
  1893. (setq weight (+ 1.0 weight)))
  1894. (if horizontal-p
  1895. (round (+ delta (* (window-width window) weight)))
  1896. (round (* (window-height window) weight)))))))
  1897. (split-window window new-size horizontal-p)))
  1898. (defun ide-skel-win--process-win-node (win win-node &optional window-proc)
  1899. (let ((win2 win))
  1900. (set-window-buffer win (win-node-buffer win-node))
  1901. ; (set-window-start win (win-node-buf-corner-pos win-node))
  1902. (set-window-hscroll win (win-node-horiz-scroll win-node))
  1903. (set-window-point win (win-node-point win-node))
  1904. (when window-proc (setq win (funcall window-proc win)))
  1905. (dolist (division (win-node-divisions win-node))
  1906. (when (not (null (division-win-node division)))
  1907. (let ((child-window (ide-skel-win--split win (division-horizontal-p division) (division-percent division))))
  1908. (when window-proc (setq win (funcall window-proc win)))
  1909. (ide-skel-win--process-win-node child-window (division-win-node division) window-proc))))
  1910. (with-selected-window win2
  1911. (let ((fixed-size (win-node-fixed-size win-node))
  1912. (window-size-fixed nil))
  1913. (when fixed-size
  1914. (when (car fixed-size)
  1915. (enlarge-window (- (car fixed-size) (window-width win2)) t))
  1916. (when (cdr fixed-size)
  1917. (enlarge-window (- (cdr fixed-size) (window-height win2)) nil)))))
  1918. (when (win-node-cursor-priority win-node)
  1919. (unless sel-window
  1920. (setq sel-window win
  1921. sel-priority (win-node-cursor-priority win-node)))
  1922. (when (< (win-node-cursor-priority win-node) sel-priority)
  1923. (setq sel-window win
  1924. sel-priority (win-node-cursor-priority win-node))))))
  1925. (defun ide-skel-win--synthesis (window win-node &optional window-proc)
  1926. (let ((window-size-fixed nil)
  1927. sel-window
  1928. sel-priority)
  1929. (ide-skel-win--process-win-node window win-node window-proc)
  1930. (when sel-window
  1931. (select-window sel-window))
  1932. (when ide-skel-win--minibuffer-selected-p
  1933. (select-window (minibuffer-window)))
  1934. (setq ide-skel-win--minibuffer-selected-p nil)
  1935. (dolist (window (ide-skel-window-list))
  1936. (when (ide-skel-side-view-window-p window) (set-window-dedicated-p window t)))))
  1937. (defun ide-skel-win--remove-child (win-node child-win-node)
  1938. (if (eq win-node child-win-node)
  1939. (let* ((division (ide-skel-win--remove-division win-node t))
  1940. (divisions (win-node-divisions win-node)))
  1941. (when division
  1942. (ide-skel-win--absorb-win-node win-node (division-win-node division)))
  1943. (setf (win-node-divisions win-node)
  1944. (append divisions (win-node-divisions win-node))))
  1945. (dolist (division (win-node-divisions win-node))
  1946. (if (and (eq (division-win-node division) child-win-node) (null (win-node-divisions (division-win-node division))))
  1947. (setf (division-win-node division) nil)
  1948. (ide-skel-win--remove-child (division-win-node division) child-win-node)))))
  1949. (defun ide-skel-win-remove-window (window)
  1950. "Remove window with coordinates WINDOW."
  1951. (let* ((window-corner-pos (ide-skel-win-corner window))
  1952. (root-win-node (ide-skel-win--analysis))
  1953. (child-win-node (ide-skel-win--find-node-by-corner-pos root-win-node window-corner-pos)))
  1954. (ide-skel-win--remove-child root-win-node child-win-node)
  1955. (ide-skel-win--synthesis (selected-window) root-win-node)))
  1956. (defun ide-skel-win-add-window (buffer parent-window-edges edge-symbol size)
  1957. "Split PARENT-WINDOW-EDGES window along specified edge. In new window with width/height SIZE
  1958. show buffer BUFFER. SIZE can be integer (character count) or float 0.0 - 1.0."
  1959. (when (windowp parent-window-edges)
  1960. (setq parent-window-edges (window-edges parent-window-edges)))
  1961. (let ((horizontal-p (or (eq edge-symbol 'left) (eq edge-symbol 'right)))
  1962. (replace-parent-p (or (eq edge-symbol 'top) (eq edge-symbol 'left)))
  1963. (percentage
  1964. (if (or (eq edge-symbol 'bottom) (eq edge-symbol 'right))
  1965. (- size)
  1966. size)))
  1967. (ide-skel-win--add-window buffer parent-window-edges horizontal-p percentage replace-parent-p)))
  1968. (defun ide-skel-win--add-window (buffer parent-window-edges horizontal-p percentage replace-parent-p)
  1969. (let* ((root-win-node (ide-skel-win--analysis))
  1970. (new-win-node (make-win-node :buffer buffer)))
  1971. (ide-skel-win--synthesis (selected-window) root-win-node
  1972. (lambda (window)
  1973. (if (equal (window-edges window) parent-window-edges)
  1974. (let ((child-window (ide-skel-win--split window horizontal-p percentage)))
  1975. (set-window-buffer (if replace-parent-p window child-window) buffer)
  1976. (if replace-parent-p child-window window))
  1977. window)))))
  1978. (defun ide-skel-win--get-bounds (object)
  1979. (cond ((windowp object) (window-edges object))
  1980. ((and (listp object) (= (length object) 4)) object)
  1981. (t (error "Invalid object param: %S" object))))
  1982. (defun ide-skel-win--win-area (window)
  1983. (let ((win-bounds (ide-skel-win--get-bounds window)))
  1984. (* (- (nth 2 win-bounds) (nth 0 win-bounds))
  1985. (- (nth 3 win-bounds) (nth 1 win-bounds)))))
  1986. (defun ide-skel-win--is-adjacent(window1 edge-symbol window2)
  1987. "Non-nil if WINDOW1 sticks to WINDOW2 along specified edge."
  1988. (let ((bounds1 (ide-skel-win--get-bounds window1))
  1989. (bounds2 (ide-skel-win--get-bounds window2))
  1990. result)
  1991. (if (or (equal edge-symbol 'top) (equal edge-symbol 'bottom))
  1992. (setq result (and
  1993. (equal (nth 0 bounds1) (nth 0 bounds2)) ; bounds.LEFT = bounds2.LEFT
  1994. (equal (nth 2 bounds1) (nth 2 bounds2)))) ; bounds.RIGHT = bounds2.RIGHT
  1995. (setq result (and
  1996. (equal (nth 1 bounds1) (nth 1 bounds2)) ; bounds.TOP = bounds2.TOP
  1997. (equal (nth 3 bounds1) (nth 3 bounds2))))) ; bounds.BOTTOM = bounds2.BOTTOM
  1998. (when result
  1999. (setq result
  2000. (cond ((equal edge-symbol 'top) (equal (nth 1 bounds1) (nth 3 bounds2))) ; bounds.TOP = bounds2.BOTTOM
  2001. ((equal edge-symbol 'bottom) (equal (nth 3 bounds1) (nth 1 bounds2))) ; bounds.BOTTOM = bounds2.TOP
  2002. ((equal edge-symbol 'left) (equal (nth 0 bounds1) (nth 2 bounds2))) ; bounds.LEFT = bounds2.RIGHT
  2003. (t (equal (nth 2 bounds1) (nth 0 bounds2))))))
  2004. result))
  2005. (defun ide-skel-win--is-leaf (&optional window)
  2006. "Non-nil if WINDOW is a leaf."
  2007. (unless window
  2008. (setq window (selected-window)))
  2009. ;; no window can stick from right or bottom
  2010. (when (and (not (get-window-with-predicate
  2011. (lambda (win) (ide-skel-win--is-adjacent window 'right win)) 1 1))
  2012. (not (get-window-with-predicate
  2013. (lambda (win) (ide-skel-win--is-adjacent window 'bottom win)) 1 1)))
  2014. (let ((parent (ide-skel-previous-window window 1 1)))
  2015. ;; parent must exist and come from left or up
  2016. (when (and parent
  2017. (or (ide-skel-win--is-adjacent window 'top parent)
  2018. (ide-skel-win--is-adjacent window 'left parent)))
  2019. window))))
  2020. (defun ide-skel-win--is-leaf2 (&optional win2)
  2021. "Non-nil if WIN2 is leaf."
  2022. (unless win2
  2023. (setq win2 (selected-window)))
  2024. ;; no window can stick from right or bottom
  2025. (when (and (not (get-window-with-predicate
  2026. (lambda (win) (ide-skel-win--is-adjacent win2 'right win))))
  2027. (not (get-window-with-predicate
  2028. (lambda (win) (ide-skel-win--is-adjacent win2 'bottom win)))))
  2029. (let ((parent (ide-skel-previous-window win2 1 1)))
  2030. ;; parent must exist and come from left or up
  2031. (when (and parent
  2032. (or (ide-skel-win--is-adjacent win2 'top parent)
  2033. (ide-skel-win--is-adjacent win2 'left parent)))
  2034. win2))))
  2035. (defun ide-skel-win-corner (window)
  2036. (let ((coords (window-edges window)))
  2037. (cons (car coords) (cadr coords))))
  2038. (defun ide-skel-window-size-changed (frame)
  2039. (let* ((editor-window (ide-skel-get-editor-window))
  2040. (left-view-window (car ide-skel--current-side-windows))
  2041. (right-view-window (cdr ide-skel--current-side-windows))
  2042. (bottom-view-window (ide-skel-get-bottom-view-window)))
  2043. (ide-skel-recalculate-view-cache)
  2044. (when bottom-view-window
  2045. (ide-skel-remember-bottom-view-window))
  2046. (when left-view-window
  2047. (setq ide-skel-left-view-window-width (window-width left-view-window)))
  2048. (when right-view-window
  2049. (setq ide-skel-right-view-window-width (window-width right-view-window)))))
  2050. (add-hook 'window-size-change-functions 'ide-skel-window-size-changed)
  2051. (setq special-display-regexps ide-skel-bottom-view-buffer-names-regexps)
  2052. (defun ide-skel-recalculate-view-cache ()
  2053. (setq ide-skel-selected-frame (selected-frame)
  2054. ide-skel-current-editor-window (ide-skel-get-editor-window))
  2055. (setq ide-skel-current-editor-buffer (window-buffer ide-skel-current-editor-window)
  2056. ide-skel-current-left-view-window (car ide-skel--current-side-windows)
  2057. ide-skel-current-right-view-window (cdr ide-skel--current-side-windows)))
  2058. (defun ide-skel-get-last-selected-window ()
  2059. (and ide-skel-last-selected-window-or-buffer
  2060. (or (and (window-live-p (car ide-skel-last-selected-window-or-buffer))
  2061. (car ide-skel-last-selected-window-or-buffer))
  2062. (and (buffer-live-p (cdr ide-skel-last-selected-window-or-buffer))
  2063. (get-buffer-window (cdr ide-skel-last-selected-window-or-buffer))))))
  2064. (require 'mwheel)
  2065. (defvar ide-skel-mouse-wheel-events (list mouse-wheel-up-event mouse-wheel-down-event))
  2066. (run-with-idle-timer 0 t (lambda ()
  2067. ;; (when ide-skel-current-left-view-window
  2068. ;; (with-selected-window ide-skel-current-left-view-window
  2069. ;; (beginning-of-line)))
  2070. ;; (when ide-skel-current-right-view-window
  2071. ;; (with-selected-window ide-skel-current-right-view-window
  2072. ;; (beginning-of-line)))
  2073. (unless (or (active-minibuffer-window)
  2074. (memq 'down (event-modifiers last-input-event))
  2075. (memq (event-basic-type last-input-event) ide-skel-mouse-wheel-events)
  2076. (mouse-movement-p last-input-event))
  2077. ;; selected frame changed?
  2078. (unless (eq (selected-frame) ide-skel-selected-frame)
  2079. (ide-skel-recalculate-view-cache))
  2080. ;; side view windows cannot have cursor
  2081. (while (memq (selected-window) (list ide-skel-current-left-view-window
  2082. ide-skel-current-right-view-window))
  2083. (let ((win (ide-skel-get-last-selected-window)))
  2084. (if (and win (not (eq (selected-window) win)))
  2085. (select-window win)
  2086. (other-window 1))))
  2087. (setq ide-skel-last-selected-window-or-buffer
  2088. (cons (selected-window) (window-buffer (selected-window))))
  2089. ;; current buffer changed?
  2090. (let ((editor-buffer (window-buffer ide-skel-current-editor-window)))
  2091. (when (not (eq ide-skel-last-buffer-change-event editor-buffer))
  2092. (ide-skel-send-event nil 'editor-buffer-changed ide-skel-last-buffer-change-event editor-buffer))))))
  2093. (setq special-display-function
  2094. (lambda (buffer &optional data)
  2095. (let ((bottom-view-window (ide-skel-get-bottom-view-window)))
  2096. (if (and bottom-view-window
  2097. (eq bottom-view-window (selected-window))
  2098. (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names))
  2099. (progn
  2100. (show-buffer (ide-skel-get-editor-window) buffer)
  2101. (ide-skel-get-editor-window))
  2102. (unless (ide-skel-get-bottom-view-window)
  2103. (ide-skel-show-bottom-view-window))
  2104. (set-window-buffer (ide-skel-get-bottom-view-window) buffer)
  2105. ;; (select-window (ide-skel-get-bottom-view-window))
  2106. (ide-skel-get-bottom-view-window)))))
  2107. ;;; Bottom view
  2108. (defun ide-skel-hidden-buffer-name-p (buffer-name)
  2109. (equal (elt buffer-name 0) 32))
  2110. (defun ide-skel-bottom-view-buffer-p (buffer)
  2111. "Non-nil if buffer should be shown in bottom view."
  2112. (let ((name (buffer-name buffer)))
  2113. (or (with-current-buffer buffer
  2114. (and ide-skel-tabset-name
  2115. (string= ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name)))
  2116. (and (not (ide-skel-hidden-buffer-name-p name))
  2117. (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-regexps)
  2118. (not (some (lambda (regexp) (string-match regexp name)) ide-skel-bottom-view-buffer-names-disallowed-regexps))))))
  2119. (defun ide-skel-remember-bottom-view-window ()
  2120. (let ((bottom-view-window (ide-skel-get-bottom-view-window)))
  2121. (when bottom-view-window
  2122. (setq ide-skel--last-bottom-view-buffer-name (buffer-name (window-buffer bottom-view-window))
  2123. ide-skel-bottom-view-window-size (max 5 (window-height bottom-view-window))))))
  2124. (defun ide-skel--find-buffer-for-bottom-view-window ()
  2125. "Returns first buffer to display in bottom view window (always returns a buffer)."
  2126. (let ((best-buffers (list (car (buffer-list (selected-frame))))))
  2127. (some (lambda (buffer)
  2128. (when (ide-skel-bottom-view-buffer-p buffer)
  2129. (if (member (buffer-name buffer) ide-skel-unexpected-bottom-view-window-buffer-names)
  2130. (setq best-buffers (append best-buffers (list buffer)))
  2131. (setq best-buffers (cons buffer best-buffers)))
  2132. nil))
  2133. (buffer-list (selected-frame)))
  2134. (if (and (not ide-skel-was-scratch)
  2135. (get-buffer "*scratch*"))
  2136. (progn
  2137. (setq ide-skel-was-scratch t)
  2138. (get-buffer "*scratch*"))
  2139. (car best-buffers))))
  2140. (defun ide-skel--is-full-width-window (window &rest except-windows)
  2141. (let ((bounds (window-edges window))
  2142. (result t))
  2143. (dolist (win (ide-skel-window-list))
  2144. (unless (memq win except-windows)
  2145. (let ((left-edge-pos (car (window-edges win))))
  2146. (when (or (< left-edge-pos (car bounds))
  2147. (>= left-edge-pos (nth 2 bounds)))
  2148. (setq result nil)))))
  2149. result))
  2150. (defun ide-skel-get-bottom-view-window ()
  2151. (let* ((editor-window (ide-skel-get-editor-window))
  2152. best-window)
  2153. ;; get lowest window
  2154. (dolist (win (copy-list (window-list nil 1)))
  2155. (when (with-current-buffer (window-buffer win)
  2156. (and (or (not ide-skel-tabset-name)
  2157. (equal ide-skel-tabset-name ide-skel-bottom-view-window-tabset-name))
  2158. (not (eq win editor-window))))
  2159. (if (null best-window)
  2160. (setq best-window win)
  2161. (when (> (cadr (window-edges win)) (cadr (window-edges best-window)))
  2162. (setq best-window win)))))
  2163. (when (and best-window
  2164. (not (ide-skel--is-full-width-window best-window (ide-skel-get-left-view-window) (ide-skel-get-right-view-window))))
  2165. (setq best-window nil))
  2166. best-window))
  2167. (defun ide-skel-show-bottom-view-window (&optional buffer)
  2168. (interactive)
  2169. (unless ide-skel-bottom-view-window-oper-in-progress
  2170. (let ((saved-window (cons (selected-window) (window-buffer (selected-window)))))
  2171. (unwind-protect
  2172. (unless (ide-skel-get-bottom-view-window) ;; if not open yet
  2173. (setq ide-skel-bottom-view-window-oper-in-progress t)
  2174. (unless buffer
  2175. (setq buffer
  2176. (or (and ide-skel--last-bottom-view-buffer-name (get-buffer ide-skel--last-bottom-view-buffer-name))
  2177. (ide-skel--find-buffer-for-bottom-view-window))))
  2178. (let* ((left-view-window (ide-skel-get-left-view-window))
  2179. (left-view-window-bounds (and left-view-window
  2180. (window-edges left-view-window)))
  2181. (right-view-window (ide-skel-get-right-view-window))
  2182. (right-view-window-bounds (and right-view-window
  2183. (window-edges right-view-window)))
  2184. (root-win-node (ide-skel-win--analysis))
  2185. (window-bounds (window-edges (selected-window)))) ; bounds of maximized window (after analysis)
  2186. (when (and left-view-window-bounds (not ide-skel-bottom-view-on-left-view))
  2187. (setf (nth 0 window-bounds) (nth 2 left-view-window-bounds)))
  2188. (when (and right-view-window-bounds (not ide-skel-bottom-view-on-right-view))
  2189. (setf (nth 2 window-bounds) (nth 0 right-view-window-bounds)))
  2190. (ide-skel-win--synthesis (selected-window) root-win-node)
  2191. (let ((ide-skel-win--win2-switch (and (not (null left-view-window))
  2192. ide-skel-bottom-view-on-right-view))
  2193. (old ide-skel-ommited-windows))
  2194. (when (and (not ide-skel-bottom-view-on-left-view)
  2195. (not ide-skel-bottom-view-on-right-view)
  2196. (ide-skel-get-left-view-window))
  2197. (push (ide-skel-get-left-view-window) ide-skel-ommited-windows))
  2198. (ide-skel-win-add-window buffer window-bounds 'bottom ide-skel-bottom-view-window-size)
  2199. (setq ide-skel-ommited-windows old))))
  2200. (if (window-live-p (car saved-window))
  2201. (select-window (car saved-window))
  2202. (when (get-buffer-window (cdr saved-window))
  2203. (select-window (get-buffer-window (cdr saved-window)))))
  2204. (setq ide-skel-bottom-view-window-oper-in-progress nil)))))
  2205. (defun ide-skel-hide-bottom-view-window ()
  2206. (interactive)
  2207. (unless ide-skel-bottom-view-window-oper-in-progress
  2208. (setq ide-skel-bottom-view-window-oper-in-progress t)
  2209. (let ((bottom-view-window (ide-skel-get-bottom-view-window)))
  2210. (when bottom-view-window
  2211. (let ((ide-skel-win--win2-switch nil)
  2212. (select-editor (eq bottom-view-window (selected-window))))
  2213. (ide-skel-remember-bottom-view-window)
  2214. (ide-skel-win-remove-window bottom-view-window)
  2215. (when select-editor (select-window (ide-skel-get-editor-window))))))
  2216. (setq ide-skel-bottom-view-window-oper-in-progress nil)))
  2217. (defun ide-skel-toggle-bottom-view-window ()
  2218. "Toggle bottom view window."
  2219. (interactive)
  2220. (if (ide-skel-get-bottom-view-window)
  2221. (ide-skel-hide-bottom-view-window)
  2222. (ide-skel-show-bottom-view-window)))
  2223. ;;; Editor
  2224. (defun ide-skel-get-editor-window ()
  2225. (let (best-window)
  2226. (setq ide-skel--current-side-windows (cons nil nil))
  2227. (dolist (win (copy-list (window-list nil 1)))
  2228. (when (with-current-buffer (window-buffer win)
  2229. (when (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name)
  2230. (setcar ide-skel--current-side-windows win))
  2231. (when (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name)
  2232. (setcdr ide-skel--current-side-windows win))
  2233. (or (not ide-skel-tabset-name)
  2234. (equal ide-skel-tabset-name ide-skel-editor-window-tabset-name)))
  2235. (if (null best-window)
  2236. (setq best-window win)
  2237. (let* ((best-window-coords (window-edges best-window))
  2238. (win-coords (window-edges win)))
  2239. (when (or (< (cadr win-coords) (cadr best-window-coords))
  2240. (and (= (cadr win-coords) (cadr best-window-coords))
  2241. (< (car win-coords) (car best-window-coords))))
  2242. (setq best-window win))))))
  2243. best-window))
  2244. ;;; Left view & Right view
  2245. (defun ide-skel-toggle-side-view-window (name &optional run-hooks)
  2246. (if (funcall (intern (format "ide-skel-get-%s-view-window" name)))
  2247. (funcall (intern (format "ide-skel-hide-%s-view-window" name)) run-hooks)
  2248. (funcall (intern (format "ide-skel-show-%s-view-window" name)) run-hooks)))
  2249. (defun ide-skel-toggle-left-view-window ()
  2250. (interactive)
  2251. (ide-skel-toggle-side-view-window 'left (called-interactively-p 'any)))
  2252. (defun ide-skel-toggle-right-view-window ()
  2253. (interactive)
  2254. (ide-skel-toggle-side-view-window 'right (called-interactively-p 'any)))
  2255. (add-hook 'kill-buffer-hook (lambda ()
  2256. (when (eq ide-skel-current-editor-buffer (current-buffer))
  2257. (let* ((context (gethash ide-skel-current-editor-buffer ide-skel-context-properties))
  2258. (imenu-buffer (cdr (assq :imenu-buffer context)))
  2259. (imenu-window (when imenu-buffer (get-buffer-window imenu-buffer))))
  2260. (when imenu-window
  2261. (set-window-dedicated-p imenu-window nil)
  2262. (set-window-buffer imenu-window ide-skel-default-right-view-buffer)
  2263. (set-window-dedicated-p imenu-window t))
  2264. (remhash (current-buffer) ide-skel-context-properties)
  2265. (when imenu-buffer
  2266. (kill-buffer imenu-buffer))))))
  2267. (defun ide-skel-send-event (side-symbol event-type &rest params)
  2268. (ide-skel-recalculate-view-cache)
  2269. (cond ((eq event-type 'hide)
  2270. (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'hide)
  2271. (ide-skel-disable-nonactual-side-view-tabs side-symbol 'disable-all))
  2272. ((eq event-type 'show)
  2273. (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'show)
  2274. (ide-skel-side-window-switch-to-buffer (symbol-value (intern (format "ide-skel-current-%s-view-window" side-symbol))) nil))
  2275. ((eq event-type 'editor-buffer-changed)
  2276. (run-hooks 'ide-skel-editor-buffer-changed-hook)
  2277. (when ide-skel-current-left-view-window
  2278. (ide-skel-disable-nonactual-side-view-tabs 'left)
  2279. (run-hook-with-args-until-success 'ide-skel-side-view-window-functions
  2280. 'left 'editor-buffer-changed
  2281. ide-skel-last-buffer-change-event ide-skel-current-editor-buffer)
  2282. (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window nil))
  2283. (when ide-skel-current-right-view-window
  2284. (ide-skel-disable-nonactual-side-view-tabs 'right)
  2285. (run-hook-with-args-until-success 'ide-skel-side-view-window-functions
  2286. 'right 'editor-buffer-changed
  2287. (car params) (cadr params))
  2288. (ide-skel-side-window-switch-to-buffer ide-skel-current-right-view-window nil))
  2289. (setq ide-skel-last-buffer-change-event ide-skel-current-editor-buffer))
  2290. ((eq event-type 'tab-change)
  2291. (run-hook-with-args-until-success 'ide-skel-side-view-window-functions side-symbol 'tab-change (car params) (cadr params)))))
  2292. (defun ide-skel-hide-side-view-window (name &optional run-hooks)
  2293. (let* ((view-window (funcall (intern (format "ide-skel-get-%s-view-window" name))))
  2294. (select-editor (eq view-window (selected-window))))
  2295. (when view-window
  2296. (when (active-minibuffer-window)
  2297. (error "Cannot remove side window while minibuffer is active"))
  2298. (let* ((bottom-view-window (ide-skel-get-bottom-view-window))
  2299. (selected-bottom-view-window (and bottom-view-window (eq bottom-view-window (selected-window))))
  2300. (buffer (window-buffer view-window))
  2301. (second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left))))))
  2302. (set (intern (format "ide-skel-last-%s-view-buffer" name)) buffer)
  2303. (when run-hooks
  2304. (ide-skel-send-event name 'hide))
  2305. (when bottom-view-window
  2306. (ide-skel-hide-bottom-view-window))
  2307. (when second-side-window
  2308. (push second-side-window ide-skel-ommited-windows))
  2309. (let ((ide-skel-win--win2-switch (eq name 'left)))
  2310. (set (intern (format "ide-skel-%s-view-window-width" name)) (window-width view-window))
  2311. (ide-skel-win-remove-window view-window))
  2312. (setq ide-skel-ommited-windows nil)
  2313. (when bottom-view-window
  2314. (ide-skel-show-bottom-view-window)
  2315. (when selected-bottom-view-window
  2316. (select-window (ide-skel-get-bottom-view-window))))
  2317. (ide-skel-recalculate-view-cache)
  2318. (when select-editor (select-window (ide-skel-get-editor-window)))))))
  2319. (defun ide-skel-hide-left-view-window (&optional run-hooks)
  2320. (interactive)
  2321. (let ((right-view-window (ide-skel-get-right-view-window)))
  2322. (when right-view-window
  2323. (ide-skel-hide-right-view-window))
  2324. (ide-skel-hide-side-view-window 'left (or run-hooks (called-interactively-p 'any)))
  2325. (when right-view-window
  2326. (ide-skel-show-right-view-window))))
  2327. (defun ide-skel-hide-right-view-window (&optional run-hooks)
  2328. (interactive)
  2329. (ide-skel-hide-side-view-window 'right (or (called-interactively-p 'any) run-hooks)))
  2330. (defun ide-skel-get-side-view-buffer-create (name side-sym tab-label help-string keep-condition-function)
  2331. (let* ((was-buffer (get-buffer name))
  2332. (km (make-sparse-keymap))
  2333. (buffer (get-buffer-create name)))
  2334. (unless was-buffer
  2335. (with-current-buffer buffer
  2336. (kill-all-local-variables)
  2337. (remove-overlays)
  2338. (define-key km [drag-mouse-1] 'ignore)
  2339. (use-local-map km)
  2340. (make-local-variable 'mouse-wheel-scroll-amount)
  2341. (make-local-variable 'auto-hscroll-mode)
  2342. (make-local-variable 'hscroll-step)
  2343. (make-local-variable 'hscroll-margin)
  2344. (setq ide-skel-tabset-name (if (eq side-sym 'left) ide-skel-left-view-window-tabset-name ide-skel-right-view-window-tabset-name)
  2345. ide-skel-tabbar-tab-label tab-label
  2346. ide-skel-tabbar-tab-help-string help-string
  2347. ide-skel-keep-condition-function keep-condition-function
  2348. auto-hscroll-mode nil
  2349. hscroll-step 0.0
  2350. hscroll-margin 0
  2351. ;; left-fringe-width 0
  2352. ;; right-fringe-width 0
  2353. buffer-read-only t
  2354. mode-line-format " "
  2355. mouse-wheel-scroll-amount '(1)
  2356. window-size-fixed 'width)
  2357. ;; (make-variable-buffer-local 'fringe-indicator-alist)
  2358. (setq fringe-indicator-alist (copy-alist default-fringe-indicator-alist))
  2359. ;; (when (>= emacs-major-version 22)
  2360. ;; (set 'indicate-buffer-boundaries '((up . left) (down . left))))
  2361. (setcdr (assq 'truncation fringe-indicator-alist) nil)
  2362. (set (make-local-variable 'scroll-conservatively) 1500) ; much greater than 0
  2363. (when (and window-system
  2364. (not ide-skel-side-view-display-cursor))
  2365. (setq cursor-type nil))))
  2366. buffer))
  2367. (defvar ide-skel-default-left-view-buffer
  2368. (let ((buffer (ide-skel-get-side-view-buffer-create " Default Left View Buffer" 'left nil nil (lambda (buf) t))))
  2369. (with-current-buffer buffer
  2370. (setq header-line-format " "))
  2371. buffer))
  2372. (defvar ide-skel-last-left-view-buffer ide-skel-default-left-view-buffer)
  2373. (defvar ide-skel-default-right-view-buffer
  2374. (let ((buffer (ide-skel-get-side-view-buffer-create " Default Right View Buffer" 'right nil nil (lambda (buf) t))))
  2375. (with-current-buffer buffer
  2376. (setq header-line-format " "))
  2377. buffer))
  2378. (defvar ide-skel-last-right-view-buffer ide-skel-default-right-view-buffer)
  2379. (defun ide-skel-show-side-view-window (name &optional run-hooks)
  2380. (unless (funcall (intern (format "ide-skel-get-%s-view-window" name)))
  2381. (let* ((current-buffer (window-buffer (selected-window)))
  2382. (bottom-view-window (ide-skel-get-bottom-view-window))
  2383. root-win-node
  2384. (bottom-view-window-bounds (and (or (symbol-value (intern (format "ide-skel-bottom-view-on-%s-view" name)))
  2385. (and ide-skel-bottom-view-on-left-view
  2386. (not ide-skel-bottom-view-on-right-view)))
  2387. bottom-view-window
  2388. (window-edges bottom-view-window)))
  2389. best-window-bounds)
  2390. (when bottom-view-window-bounds
  2391. (ide-skel-hide-bottom-view-window))
  2392. (let ((second-side-window (funcall (intern (format "ide-skel-get-%s-view-window" (if (eq name 'left) 'right 'left))))))
  2393. (when second-side-window
  2394. (push second-side-window ide-skel-ommited-windows))
  2395. (setq root-win-node (ide-skel-win--analysis))
  2396. (setq best-window-bounds (window-edges (selected-window))) ; bounds of maximized window (after analysis)
  2397. (ide-skel-win--synthesis (selected-window) root-win-node)
  2398. (ide-skel-win-add-window
  2399. (symbol-value (intern (format (if run-hooks "ide-skel-default-%s-view-buffer" "ide-skel-last-%s-view-buffer") name)))
  2400. best-window-bounds name
  2401. (symbol-value (intern (format "ide-skel-%s-view-window-width" name))))
  2402. (setq ide-skel-ommited-windows nil)
  2403. (when bottom-view-window-bounds
  2404. (ide-skel-show-bottom-view-window))
  2405. (set-window-dedicated-p (funcall (intern (format "ide-skel-get-%s-view-window" name))) t)
  2406. (when run-hooks
  2407. (dolist (tab (tabbar-tabs (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name))))))
  2408. (tabbar-delete-tab tab))
  2409. (ide-skel-send-event name 'show))
  2410. (some (lambda (win) (when (eq (window-buffer win) current-buffer) (select-window win) t)) (copy-list (window-list nil 1)))))))
  2411. ;; Disables from view all buffers for which keep condition function
  2412. ;; returns nil. If a current buffer is there, select another enabled,
  2413. ;; which implies tab-change event, then select any enabled buffer.
  2414. (defun ide-skel-disable-nonactual-side-view-tabs (name &optional disable-all)
  2415. (let* ((tabset (tabbar-get-tabset (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name)))))
  2416. (tabs (tabbar-tabs tabset))
  2417. (editor-buffer (window-buffer (ide-skel-get-editor-window)))
  2418. selected-deleted
  2419. (selected-tab (tabbar-selected-tab tabset)))
  2420. (when tabs
  2421. (dolist (tab tabs)
  2422. (let ((buffer (tabbar-tab-value tab)))
  2423. (with-current-buffer buffer
  2424. (when (or disable-all
  2425. (not ide-skel-keep-condition-function)
  2426. (not (funcall ide-skel-keep-condition-function editor-buffer)))
  2427. (setq ide-skel-tabbar-enabled nil)
  2428. (when (eq tab selected-tab)
  2429. (setq selected-deleted t))
  2430. (tabbar-delete-tab tab)))))
  2431. (let ((selected-buffer (when (and (not selected-deleted)
  2432. (tabbar-tabs tabset) (tabbar-selected-value tabset)))))
  2433. (when (and (not disable-all)
  2434. (or selected-deleted
  2435. (not (eq (tabbar-selected-tab tabset) selected-tab))))
  2436. (unless selected-buffer
  2437. (setq selected-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" name)))))
  2438. (ide-skel-side-window-switch-to-buffer
  2439. (symbol-value (intern (format "ide-skel-current-%s-view-window" name)))
  2440. selected-buffer))))))
  2441. (defun ide-skel-show-left-view-window (&optional run-hooks)
  2442. (interactive)
  2443. (let ((right-view-window (ide-skel-get-right-view-window)))
  2444. (when right-view-window
  2445. (ide-skel-hide-right-view-window))
  2446. (ide-skel-show-side-view-window 'left (or run-hooks (called-interactively-p 'any)))
  2447. (when right-view-window
  2448. (ide-skel-show-right-view-window))))
  2449. (defun ide-skel-show-right-view-window (&optional run-hooks)
  2450. (interactive)
  2451. (ide-skel-show-side-view-window 'right (or run-hooks (called-interactively-p 'any))))
  2452. (defun ide-skel-get-side-view-window (name)
  2453. (let ((tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" name)))))
  2454. (some (lambda (win)
  2455. (when (with-current-buffer (window-buffer win)
  2456. (equal ide-skel-tabset-name tabset-name))
  2457. win))
  2458. (copy-list (window-list nil 1)))))
  2459. (defun ide-skel-get-left-view-window ()
  2460. (ide-skel-get-side-view-window 'left))
  2461. (defun ide-skel-get-right-view-window ()
  2462. (ide-skel-get-side-view-window 'right))
  2463. (defun ide-skel-get-side-view-windows ()
  2464. (let (result
  2465. (left-view-win (ide-skel-get-left-view-window))
  2466. (right-view-win (ide-skel-get-right-view-window)))
  2467. (when left-view-win (push left-view-win result))
  2468. (when right-view-win (push right-view-win result))
  2469. result))
  2470. (defun ide-skel-side-view-window-p (window)
  2471. (ide-skel-side-view-buffer-p (window-buffer window)))
  2472. (defun ide-skel-side-view-buffer-p (buffer)
  2473. (with-current-buffer buffer
  2474. (or (equal ide-skel-tabset-name ide-skel-left-view-window-tabset-name)
  2475. (equal ide-skel-tabset-name ide-skel-right-view-window-tabset-name))))
  2476. (defadvice delete-window (around delete-window-around-advice (&optional window))
  2477. (let* ((target-window (if window window (selected-window)))
  2478. (editor-window (and (called-interactively-p 'any) (ide-skel-get-editor-window))) ; for ide-skel--current-side-windows (side-effects)
  2479. (hide-view-windows (and (called-interactively-p 'any)
  2480. (not (eq (car ide-skel--current-side-windows) target-window))
  2481. (not (eq (cdr ide-skel--current-side-windows) target-window))))
  2482. (hide-left-view-window (and hide-view-windows (car ide-skel--current-side-windows)))
  2483. (hide-right-view-window (and hide-view-windows (cdr ide-skel--current-side-windows)))
  2484. result)
  2485. (when (called-interactively-p 'any)
  2486. (if (eq (car ide-skel--current-side-windows) target-window)
  2487. (ide-skel-send-event 'left 'hide)
  2488. (when (eq (cdr ide-skel--current-side-windows) target-window)
  2489. (ide-skel-send-event 'right 'hide))))
  2490. (let* ((edges (window-inside-edges window))
  2491. (buf (window-buffer window))
  2492. win
  2493. (center-position (cons (/ (+ (car edges) (caddr edges)) 2)
  2494. (/ (+ (cadr edges) (cadddr edges)) 2))))
  2495. (when hide-left-view-window (ide-skel-hide-left-view-window))
  2496. (when hide-right-view-window (ide-skel-hide-right-view-window))
  2497. (setq win (window-at (car center-position) (cdr center-position)))
  2498. (when (eq (window-buffer win) buf)
  2499. (setq window (window-at (car center-position) (cdr center-position)))))
  2500. (unwind-protect
  2501. (setq result (progn ad-do-it))
  2502. (when hide-left-view-window (ide-skel-show-left-view-window))
  2503. (when hide-right-view-window (ide-skel-show-right-view-window)))
  2504. result))
  2505. (ad-activate 'delete-window)
  2506. (defadvice delete-other-windows (around delete-other-windows-around-advice (&optional window))
  2507. (ide-skel-assert-not-in-side-view-window)
  2508. (let* ((editor-window (ide-skel-get-editor-window))
  2509. (dont-revert-after (and (called-interactively-p 'any) (listp current-prefix-arg) (car current-prefix-arg))) ; C-u
  2510. (hide-left-view-window (and (called-interactively-p 'any) (car ide-skel--current-side-windows)))
  2511. (hide-right-view-window (and (called-interactively-p 'any) (cdr ide-skel--current-side-windows)))
  2512. result)
  2513. (when hide-left-view-window (ide-skel-hide-left-view-window dont-revert-after))
  2514. (when hide-right-view-window (ide-skel-hide-right-view-window dont-revert-after))
  2515. (unwind-protect
  2516. (setq result (progn ad-do-it))
  2517. (when (not dont-revert-after)
  2518. (when hide-left-view-window
  2519. (ide-skel-show-left-view-window))
  2520. (when hide-right-view-window
  2521. (ide-skel-show-right-view-window))))
  2522. result))
  2523. (ad-activate 'delete-other-windows)
  2524. (defun ide-skel-assert-not-in-side-view-window ()
  2525. (when (and (called-interactively-p 'any) (ide-skel-side-view-window-p (selected-window)))
  2526. (error "Cannot do it")))
  2527. (defadvice kill-buffer (before kill-buffer-before-advice (buffer))
  2528. (ide-skel-assert-not-in-side-view-window))
  2529. (ad-activate 'kill-buffer)
  2530. (defadvice split-window-vertically (before split-window-vertically-before-advice (&optional size))
  2531. (ide-skel-assert-not-in-side-view-window))
  2532. (ad-activate 'split-window-vertically)
  2533. (defadvice split-window-horizontally (before split-window-horizontally-before-advice (&optional size))
  2534. (ide-skel-assert-not-in-side-view-window))
  2535. (ad-activate 'split-window-horizontally)
  2536. (defadvice mouse-drag-vertical-line (around mouse-drag-vertical-line-around-advice (start-event))
  2537. (let* ((editor-window (ide-skel-get-editor-window))
  2538. (left-view-window (car ide-skel--current-side-windows))
  2539. (right-view-window (cdr ide-skel--current-side-windows)))
  2540. (when left-view-window (with-selected-window left-view-window (setq window-size-fixed nil)))
  2541. (when right-view-window (with-selected-window right-view-window (setq window-size-fixed nil)))
  2542. (unwind-protect
  2543. (progn ad-do-it)
  2544. (when left-view-window (with-selected-window left-view-window (setq window-size-fixed 'width)))
  2545. (when right-view-window (with-selected-window right-view-window (setq window-size-fixed 'width))))))
  2546. (ad-activate 'mouse-drag-vertical-line)
  2547. (defadvice other-window (after other-window-after-advice (arg &optional all-frames))
  2548. (if (memq (selected-window) (list ide-skel-current-left-view-window ide-skel-current-right-view-window))
  2549. (other-window arg all-frames)
  2550. ad-return-value))
  2551. (ad-activate 'other-window)
  2552. ;; Buffer list buffer (left side view)
  2553. (define-derived-mode fundmental-mode
  2554. fundamental-mode "Fundmental")
  2555. (setq default-major-mode 'fundmental-mode)
  2556. (defun ide-skel-recentf-closed-files-list ()
  2557. "Lista ostatnio otwieranych, ale aktualnie zamknietych plikow"
  2558. (let* ((open-file-paths (delq nil (mapcar (lambda (buffer) (buffer-file-name buffer)) (buffer-list)))))
  2559. (if (featurep 'recentf)
  2560. (sort (reverse (set-difference recentf-list open-file-paths :test 'string=))
  2561. (lambda (path1 path2)
  2562. (string< (file-name-nondirectory path1) (file-name-nondirectory path2))))
  2563. nil)))
  2564. (defun ide-skel-select-buffer (buffer-or-path &optional line-no)
  2565. (let* ((window (ide-skel-get-last-selected-window))
  2566. (buffer (or (and (bufferp buffer-or-path) buffer-or-path)
  2567. (find-file-noselect buffer-or-path)))
  2568. (is-bottom-view-buffer (ide-skel-bottom-view-buffer-p buffer)))
  2569. (when (not (buffer-live-p buffer))
  2570. (error "Buffer %s is dead" buffer))
  2571. (unless (get-buffer-window buffer)
  2572. ;; (message "%S %S" window (ide-skel-get-bottom-view-window))
  2573. (if (and window
  2574. (not (eq window (ide-skel-get-bottom-view-window)))
  2575. (not is-bottom-view-buffer))
  2576. (set-window-buffer window buffer)
  2577. (let ((editor-window (ide-skel-get-editor-window)))
  2578. (select-window editor-window)
  2579. (if is-bottom-view-buffer
  2580. (switch-to-buffer-other-window buffer)
  2581. (set-window-buffer editor-window buffer)))))
  2582. (setq ide-skel-last-selected-window-or-buffer (cons (get-buffer-window buffer) buffer))
  2583. (select-window (car ide-skel-last-selected-window-or-buffer))
  2584. (when line-no
  2585. (with-current-buffer buffer
  2586. (goto-line line-no)))))
  2587. (defun ide-skel-select-buffer-handler (event)
  2588. (interactive "@e")
  2589. ;; (message "EVENT: %S" event)
  2590. (with-selected-window (posn-window (event-start event))
  2591. (let* ((object (get-text-property (posn-point (event-start event)) 'object-to-display)))
  2592. (beginning-of-line)
  2593. (ide-skel-select-buffer object))))
  2594. (defun ide-skel-buffers-view-insert-buffer-list (label buffer-list)
  2595. (setq label (propertize label 'face 'bold))
  2596. (insert (format "%s\n" label))
  2597. (dolist (object buffer-list)
  2598. (let* ((label (format " % -100s" (if (bufferp object) (buffer-name object) (file-name-nondirectory object))))
  2599. (km (make-sparse-keymap)))
  2600. (define-key km [mouse-1] 'ide-skel-select-buffer-handler)
  2601. (setq label (propertize label
  2602. 'mouse-face 'ide-skel-highlight-face
  2603. 'local-map km
  2604. 'face 'variable-pitch
  2605. 'pointer 'hand
  2606. 'object-to-display object
  2607. 'help-echo (if (bufferp object) (buffer-file-name object) object)))
  2608. (insert label)
  2609. (insert "\n"))))
  2610. (defun ide-skel-buffers-view-fill ()
  2611. (when ide-skel-current-left-view-window
  2612. (with-current-buffer ide-skel-buffer-list-buffer
  2613. (let ((point (point))
  2614. (window-start (when (eq (window-buffer ide-skel-current-left-view-window) ide-skel-buffer-list-buffer)
  2615. (save-excursion
  2616. (goto-char (window-start ide-skel-current-left-view-window))
  2617. (cons (line-number-at-pos) (current-column))))))
  2618. ;; (message "%S" window-start)
  2619. (let (asterisk-buffers
  2620. (inhibit-read-only t)
  2621. normal-buffers)
  2622. (erase-buffer)
  2623. (dolist (buffer (sort (buffer-list) (lambda (buf1 buf2) (string< (buffer-name buf1) (buffer-name buf2)))))
  2624. (let* ((name (buffer-name buffer))
  2625. (first-char (aref (buffer-name buffer) 0)))
  2626. (unless (char-equal ?\ first-char)
  2627. (if (char-equal ?* first-char)
  2628. (push buffer asterisk-buffers)
  2629. (push buffer normal-buffers)))))
  2630. (ide-skel-buffers-view-insert-buffer-list "Normal Buffers:" normal-buffers)
  2631. (ide-skel-buffers-view-insert-buffer-list "Scratch Buffers:" asterisk-buffers)
  2632. (ide-skel-buffers-view-insert-buffer-list "Recent Files:" (ide-skel-recentf-closed-files-list)))
  2633. (if window-start
  2634. (let ((pos (save-excursion
  2635. (goto-line (car window-start))
  2636. (beginning-of-line)
  2637. (forward-char (cdr window-start))
  2638. (point))))
  2639. (set-window-start ide-skel-current-left-view-window pos))
  2640. (goto-char point)
  2641. (beginning-of-line))))))
  2642. (defun ide-skel-some-view-window-buffer (side-symbol predicate)
  2643. (some (lambda (buffer)
  2644. (and (buffer-live-p buffer)
  2645. (with-current-buffer buffer
  2646. (and (equal ide-skel-tabset-name (symbol-value (intern (format "ide-skel-%s-view-window-tabset-name" side-symbol))))
  2647. ide-skel-tabbar-enabled
  2648. (funcall predicate buffer)
  2649. buffer))))
  2650. (buffer-list)))
  2651. (defun ide-skel-side-window-switch-to-buffer (side-window buffer)
  2652. "If BUFFER is nil, then select any non-default buffer. The
  2653. TAB-CHANGE event is send only if selected buffer changed."
  2654. (unwind-protect
  2655. (let* ((side-symbol (cond ((eq side-window ide-skel-current-left-view-window) 'left)
  2656. ((eq side-window ide-skel-current-right-view-window) 'right)
  2657. (t nil)))
  2658. (context (gethash ide-skel-current-editor-buffer ide-skel-context-properties))
  2659. (context-default-tab-label-symbol (intern (format "default-%s-tab-label" side-symbol))))
  2660. (when side-symbol
  2661. (unless buffer
  2662. (let* ((default-empty-buffer (symbol-value (intern (format "ide-skel-default-%s-view-buffer" side-symbol))))
  2663. (context-default-tab-label (cdr (assq context-default-tab-label-symbol context)))
  2664. (last-view-window-tab-label (symbol-value (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol)))))
  2665. ;; first non-nil:
  2666. ;; - selected before in this context
  2667. ;; - selected in previous context
  2668. ;; - current if other than default-empty
  2669. ;; - first non default-empty
  2670. ;; - default-empty
  2671. (setq buffer
  2672. (or (and context-default-tab-label
  2673. (ide-skel-some-view-window-buffer side-symbol (lambda (buffer)
  2674. (equal ide-skel-tabbar-tab-label context-default-tab-label))))
  2675. (and last-view-window-tab-label
  2676. (ide-skel-some-view-window-buffer side-symbol (lambda (buffer)
  2677. (equal ide-skel-tabbar-tab-label last-view-window-tab-label))))
  2678. (and (not (eq (window-buffer side-window) default-empty-buffer))
  2679. (window-buffer side-window))
  2680. (ide-skel-some-view-window-buffer side-symbol (lambda (buffer) ide-skel-tabbar-tab-label))
  2681. default-empty-buffer))))
  2682. (unless (eq (window-buffer side-window) buffer)
  2683. (set (intern (format "ide-skel-last-%s-view-window-tab-label" side-symbol)) (with-current-buffer buffer ide-skel-tabbar-tab-label))
  2684. (setq context (assq-delete-all context-default-tab-label-symbol context))
  2685. (puthash ide-skel-current-editor-buffer
  2686. (cons (cons context-default-tab-label-symbol (with-current-buffer buffer ide-skel-tabbar-tab-label)) context)
  2687. ide-skel-context-properties)
  2688. (ide-skel-send-event side-symbol 'tab-change (window-buffer side-window) buffer)))
  2689. (set-window-dedicated-p side-window nil)
  2690. (set-window-buffer side-window buffer))
  2691. (set-window-dedicated-p side-window t)))
  2692. ;; args: 'left/right 'show/editor-buffer-changed/hide/tab-change &rest buffer...
  2693. (defun ide-skel-default-side-view-window-function (side event &rest list)
  2694. ;; (message "SIDE: %S, event: %S, rest: %S %S" side event list ide-skel-current-left-view-window)
  2695. (when (and (eq side 'left) ide-skel-current-left-view-window)
  2696. (cond ((eq event 'show)
  2697. (unless ide-skel-buffer-list-buffer
  2698. (setq ide-skel-buffer-list-buffer (ide-skel-get-side-view-buffer-create
  2699. " Ide-Skel Buffer List Buffer" 'left "Bufs" "List of opened and recent files"
  2700. (lambda (buf) t)))
  2701. (with-current-buffer ide-skel-buffer-list-buffer
  2702. (setq ide-skel-tabbar-enabled t)))
  2703. (ide-skel-buffers-view-fill)
  2704. (ide-skel-side-window-switch-to-buffer ide-skel-current-left-view-window ide-skel-buffer-list-buffer))))
  2705. nil)
  2706. ;; (message "SIDE: %S, event: %S, rest: %S" side event list)
  2707. (add-hook 'change-major-mode-hook (lambda () (setq ide-skel-buffer-list-tick t)))
  2708. (add-hook 'kill-buffer-hook (lambda () (setq ide-skel-buffer-list-tick t)))
  2709. (run-with-idle-timer 0.1 t (lambda ()
  2710. (when ide-skel-buffer-list-tick
  2711. (setq ide-skel-buffer-list-tick nil)
  2712. (ide-skel-buffers-view-fill))))
  2713. (add-hook 'ide-skel-side-view-window-functions 'ide-skel-default-side-view-window-function)
  2714. (define-key-after global-map [tool-bar ide-skel-toggle-left-view-window]
  2715. (list 'menu-item "Left View Window" 'ide-skel-toggle-left-view-window :image ide-skel-left-view-window-image))
  2716. (define-key-after global-map [tool-bar ide-skel-toggle-bottom-view-window]
  2717. (list 'menu-item "Bottom View Window" 'ide-skel-toggle-bottom-view-window :image ide-skel-bottom-view-window-image))
  2718. (define-key-after global-map [tool-bar ide-skel-toggle-right-view-window]
  2719. (list 'menu-item "Right View Window" 'ide-skel-toggle-right-view-window :image ide-skel-right-view-window-image))
  2720. (eval-after-load "tabbar" '(ide-skel-tabbar-load-hook))
  2721. ;;; Tree Widget
  2722. (defadvice tree-widget-lookup-image (around tree-widget-lookup-image-around-advice (name))
  2723. (if (equal (tree-widget-theme-name) "small-folder")
  2724. (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)))
  2725. ad-do-it))
  2726. (ad-activate 'tree-widget-lookup-image)
  2727. ;;; Imenu
  2728. (require 'imenu)
  2729. (defun ide-skel-imenu-refresh ()
  2730. (interactive)
  2731. (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t))
  2732. (defun ide-skel-imenu-sort-change ()
  2733. (interactive)
  2734. (with-current-buffer (window-buffer ide-skel-current-right-view-window)
  2735. (setq ide-skel-imenu-sorted (not ide-skel-imenu-sorted)))
  2736. (ide-skel-imenu-side-view-draw-tree (window-buffer ide-skel-current-right-view-window) t))
  2737. (defun ide-skel-imenu-get-buffer-create (editor-buffer &optional dont-create)
  2738. (let* ((context (gethash editor-buffer ide-skel-context-properties))
  2739. (buffer (cdr (assq :imenu-buffer context))))
  2740. (when (and (not buffer) (not dont-create))
  2741. (setq buffer (ide-skel-get-side-view-buffer-create (concat " " (buffer-name editor-buffer) " Ide Skel Imenu")
  2742. 'right "Imenu" nil
  2743. (lambda (editor-buffer)
  2744. (eq ide-skel-imenu-editor-buffer ide-skel-current-editor-buffer))))
  2745. (with-current-buffer buffer
  2746. (setq ide-skel-tabbar-menu-function
  2747. (lambda ()
  2748. (let ((is-outline-mode (with-current-buffer (window-buffer ide-skel-current-right-view-window)
  2749. (with-current-buffer ide-skel-imenu-editor-buffer
  2750. (or (eq major-mode 'outline-mode)
  2751. (and (boundp 'outline-minor-mode)
  2752. (symbol-value 'outline-minor-mode)))))))
  2753. (append
  2754. (list
  2755. (list 'ide-skel-imenu-refresh "Refresh" t)
  2756. (unless is-outline-mode
  2757. (list 'ide-skel-imenu-sort-change (if (with-current-buffer (window-buffer ide-skel-current-right-view-window)
  2758. ide-skel-imenu-sorted)
  2759. "Natural order"
  2760. "Sorted order") t))))))
  2761. ide-skel-imenu-editor-buffer editor-buffer
  2762. ide-skel-imenu-open-paths (make-hash-table :test 'equal))
  2763. (add-hook 'tree-widget-after-toggle-functions (lambda (widget)
  2764. (let ((path (widget-get widget :path)))
  2765. (when path
  2766. (if (widget-get widget :open)
  2767. (puthash path t ide-skel-imenu-open-paths)
  2768. (remhash path ide-skel-imenu-open-paths)))))
  2769. nil t))
  2770. (puthash editor-buffer (cons (cons :imenu-buffer buffer) context) ide-skel-context-properties))
  2771. buffer))
  2772. (defun ide-skel-tree-node-notify (widget &rest rest)
  2773. (let ((index-name (widget-get widget :index-name))
  2774. (index-position (widget-get widget :index-position))
  2775. (function (widget-get widget :function))
  2776. (arguments (widget-get widget :arguments)))
  2777. (select-window (ide-skel-get-editor-window))
  2778. (if function
  2779. (apply function index-name index-position arguments)
  2780. (goto-char index-position))))
  2781. ;; building hash
  2782. (defun ide-skel-imenu-analyze (hash prefix element)
  2783. (when element
  2784. (if (and (consp (cdr element))
  2785. (listp (cadr element)))
  2786. (dolist (elem (cdr element))
  2787. (ide-skel-imenu-analyze hash (concat prefix "/" (car element)) elem))
  2788. (puthash (concat prefix "/" (car element)) (list (cons :element element)) hash))))
  2789. ;; logical linking, internal nodes creation
  2790. (defun ide-skel-imenu-analyze2 (hash prefix element)
  2791. (when element
  2792. (if (and (consp (cdr element))
  2793. (listp (cadr element)))
  2794. (dolist (elem (cdr element))
  2795. (ide-skel-imenu-analyze2 hash (concat prefix "/" (car element)) elem))
  2796. (let* ((index-name (car element))
  2797. (path (concat prefix "/" index-name))
  2798. (node (gethash path hash))
  2799. (reverse-separators (let ((index 0)
  2800. result)
  2801. (while (string-match "[*#:.]+" index-name index)
  2802. (push (cons (match-beginning 0) (match-end 0)) result)
  2803. (setq index (match-end 0)))
  2804. result))
  2805. found)
  2806. (some (lambda (separator-pair)
  2807. (let* ((begin (car separator-pair))
  2808. (end (cdr separator-pair))
  2809. (before-name (substring index-name 0 begin))
  2810. (after-name (substring index-name end))
  2811. (parent-path (concat prefix "/" before-name))
  2812. (parent-node (gethash parent-path hash)))
  2813. (when parent-node
  2814. (push (cons :parent parent-path) node)
  2815. (unless (assq :name node)
  2816. (push (cons :name after-name) node))
  2817. (puthash path node hash)
  2818. (unless (assq :widget parent-node)
  2819. (let* ((parent-element (cdr (assq :element parent-node)))
  2820. (parent-index-name (car parent-element))
  2821. (parent-index-position (if (consp (cdr parent-element)) (cadr parent-element) (cdr parent-element)))
  2822. (parent-function (when (consp (cdr parent-element)) (caddr parent-element)))
  2823. (open-status (gethash parent-path ide-skel-imenu-open-paths))
  2824. (parent-arguments (when (consp (cdr parent-element)) (cdddr parent-element))))
  2825. (push (cons :widget
  2826. ;; internal node
  2827. (list 'ide-skel-imenu-internal-node-widget
  2828. :open open-status
  2829. :indent 0
  2830. :path parent-path
  2831. :notify 'ide-skel-tree-node-notify
  2832. :index-name parent-index-name
  2833. :index-position parent-index-position
  2834. :function parent-function
  2835. :arguments parent-arguments
  2836. :node (list 'push-button
  2837. :format "%[%t%]\n"
  2838. :button-face 'variable-pitch
  2839. :tag (or (cdr (assq :name parent-node))
  2840. before-name)
  2841. ;; :tag (cadr (assq :element parent-node))
  2842. )))
  2843. parent-node)
  2844. (puthash parent-path parent-node hash)))
  2845. t)))
  2846. reverse-separators)))))
  2847. ;; widget linking, leafs creation
  2848. (defun ide-skel-imenu-analyze3 (hash prefix element)
  2849. (when element
  2850. (if (and (consp (cdr element))
  2851. (listp (cadr element)))
  2852. (dolist (elem (cdr element))
  2853. (ide-skel-imenu-analyze3 hash (concat prefix "/" (car element)) elem))
  2854. (let* ((index-name (car element))
  2855. (index-position (if (consp (cdr element)) (cadr element) (cdr element)))
  2856. (function (when (consp (cdr element)) (caddr element)))
  2857. (arguments (when (consp (cdr element)) (cdddr element)))
  2858. (path (concat prefix "/" index-name))
  2859. (node (gethash path hash))
  2860. (widget (cdr (assq :widget node)))
  2861. (parent-path (cdr (assq :parent node)))
  2862. (parent-node (when parent-path (gethash parent-path hash)))
  2863. (parent-widget (when parent-node (cdr (assq :widget parent-node)))))
  2864. ;; create leaf if not exists
  2865. (unless widget
  2866. ;; leaf node
  2867. (push (cons :widget (list 'ide-skel-imenu-leaf-widget
  2868. :notify 'ide-skel-tree-node-notify
  2869. :index-name index-name
  2870. :index-position index-position
  2871. :function function
  2872. :arguments arguments
  2873. :tag (or (cdr (assq :name node))
  2874. index-name)))
  2875. node)
  2876. (puthash path node hash)
  2877. (setq widget (cdr (assq :widget node))))
  2878. ;; add to parent
  2879. (when parent-widget
  2880. (setcdr (last parent-widget) (cons widget nil)))))))
  2881. (defun ide-skel-imenu-create-tree (hash prefix element)
  2882. (when element
  2883. (if (and (consp (cdr element))
  2884. (listp (cadr element)))
  2885. (let* ((menu-title (car element))
  2886. (sub-alist (cdr element))
  2887. (path (concat prefix "/" menu-title))
  2888. (open-status (gethash path ide-skel-imenu-open-paths)))
  2889. (append
  2890. (list 'ide-skel-imenu-internal-node-widget
  2891. :open open-status
  2892. :indent 0
  2893. :path path
  2894. :node (list 'push-button
  2895. :format "%[%t%]\n"
  2896. :button-face 'variable-pitch
  2897. :tag menu-title))
  2898. (delq nil (mapcar (lambda (elem)
  2899. (ide-skel-imenu-create-tree hash path elem))
  2900. sub-alist))))
  2901. (let* ((index-name (car element))
  2902. (index-position (if (consp (cdr element)) (cadr element) (cdr element)))
  2903. (function (when (consp (cdr element)) (caddr element)))
  2904. (arguments (when (consp (cdr element)) (cdddr element)))
  2905. (path (concat prefix "/" index-name))
  2906. (node (gethash path hash))
  2907. (parent-path (cdr (assq :parent node)))
  2908. (widget (cdr (assq :widget node))))
  2909. (unless parent-path
  2910. widget)))))
  2911. (defun ide-skel-imenu-compare (e1 e2)
  2912. (let ((ce1 (and (consp (cdr e1)) (listp (cadr e1))))
  2913. (ce2 (and (consp (cdr e2)) (listp (cadr e2)))))
  2914. (when ce1
  2915. (setcdr e1 (sort (cdr e1) 'ide-skel-imenu-compare)))
  2916. (when ce2
  2917. (setcdr e2 (sort (cdr e2) 'ide-skel-imenu-compare)))
  2918. (if (or (and ce1 ce2)
  2919. (and (not ce1) (not ce2)))
  2920. (string< (car e1) (car e2))
  2921. (and ce1 (not ce2)))))
  2922. (defun ide-skel-outline-tree-create (index-alist)
  2923. (let (stack
  2924. node-list
  2925. (current-depth 0))
  2926. (dolist (element index-alist)
  2927. (let ((index-name (car element))
  2928. (index-position (if (consp (cdr element)) (cadr element) (cdr element)))
  2929. (function (when (consp (cdr element)) (caddr element)))
  2930. (arguments (when (consp (cdr element)) (cdddr element))))
  2931. ;; (message "index-name: %S" index-name)
  2932. (string-match "^\\([*]+\\)[ ]*\\(.*\\)$" index-name)
  2933. (let* ((depth (length (match-string 1 index-name)))
  2934. (name (match-string 2 index-name))
  2935. parent-node
  2936. node)
  2937. (while (and stack
  2938. (>= (caar stack) depth))
  2939. (setq stack (cdr stack)))
  2940. (when stack
  2941. (setq parent-node (cdar stack))
  2942. (when (eq (car parent-node) 'ide-skel-imenu-leaf-widget)
  2943. (let ((path (plist-get (cdr parent-node) :path)))
  2944. (setcar parent-node 'ide-skel-imenu-internal-node-widget)
  2945. (setcdr parent-node (list :open (gethash path ide-skel-imenu-open-paths)
  2946. :indent 0
  2947. :notify 'ide-skel-tree-node-notify
  2948. :index-name (plist-get (cdr parent-node) :index-name)
  2949. :index-position (plist-get (cdr parent-node) :index-position)
  2950. :function (plist-get (cdr parent-node) :function)
  2951. :arguments (plist-get (cdr parent-node) :arguments)
  2952. :path path
  2953. :node (list 'push-button
  2954. :format "%[%t%]\n"
  2955. :button-face 'variable-pitch
  2956. :tag (plist-get (cdr parent-node) :tag)))))))
  2957. (setq node (list 'ide-skel-imenu-leaf-widget
  2958. :notify 'ide-skel-tree-node-notify
  2959. :index-name index-name
  2960. :index-position index-position
  2961. :function function
  2962. :path (concat (plist-get (cdr parent-node) :path) "/" index-name)
  2963. :arguments arguments
  2964. :tag name))
  2965. (push (cons depth node) stack)
  2966. (if parent-node
  2967. (setcdr (last parent-node) (cons node nil))
  2968. (push node node-list)))))
  2969. (append
  2970. (list 'ide-skel-imenu-internal-node-widget
  2971. :open t
  2972. :indent 0
  2973. :path ""
  2974. :tag "")
  2975. (reverse node-list))))
  2976. (defun ide-skel-imenu-side-view-draw-tree (imenu-buffer &optional refresh)
  2977. (with-current-buffer imenu-buffer
  2978. (let ((index-alist (with-current-buffer ide-skel-imenu-editor-buffer
  2979. (when refresh
  2980. (imenu--cleanup)
  2981. (setq imenu--index-alist nil))
  2982. (cons "" (progn
  2983. (unless imenu--index-alist
  2984. (font-lock-default-fontify-buffer)
  2985. (condition-case err
  2986. (imenu--make-index-alist t)
  2987. (error nil)))
  2988. imenu--index-alist))))
  2989. (is-outline-mode (with-current-buffer ide-skel-imenu-editor-buffer
  2990. (or (eq major-mode 'outline-mode)
  2991. (and (boundp 'outline-minor-mode)
  2992. (symbol-value 'outline-minor-mode)))))
  2993. (inhibit-read-only t)
  2994. (hash (make-hash-table :test 'equal))
  2995. (start-line (save-excursion
  2996. (goto-char (window-start ide-skel-current-right-view-window))
  2997. (line-number-at-pos))))
  2998. (unless is-outline-mode
  2999. (when ide-skel-imenu-sorted
  3000. (setq index-alist (cons "" (sort (copy-tree (cdr index-alist)) 'ide-skel-imenu-compare))))
  3001. (ide-skel-imenu-analyze hash "/" index-alist)
  3002. (ide-skel-imenu-analyze2 hash "/" index-alist)
  3003. (ide-skel-imenu-analyze3 hash "/" index-alist))
  3004. (let ((tree (if is-outline-mode
  3005. (ide-skel-outline-tree-create (cdr index-alist))
  3006. (ide-skel-imenu-create-tree hash "/" index-alist))))
  3007. (plist-put (cdr tree) :open t)
  3008. (plist-put (cdr tree) :indent 0)
  3009. (erase-buffer)
  3010. (tree-widget-set-theme "small-folder")
  3011. (widget-create tree)
  3012. (set-keymap-parent (current-local-map) tree-widget-button-keymap)
  3013. (widget-setup)
  3014. (goto-line start-line)
  3015. (beginning-of-line)
  3016. (set-window-start ide-skel-current-right-view-window (point))))))
  3017. (defun ide-skel-imenu-side-view-window-function (side event &rest list)
  3018. ;; (message "%S %S %S" side event list)
  3019. (when (and (eq side 'right)
  3020. ide-skel-current-right-view-window)
  3021. (let ((imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer t)))
  3022. (when (memq event '(show editor-buffer-changed))
  3023. (when (ide-skel-has-imenu ide-skel-current-editor-buffer)
  3024. (unless imenu-buffer
  3025. (setq imenu-buffer (ide-skel-imenu-get-buffer-create ide-skel-current-editor-buffer)))
  3026. (with-current-buffer imenu-buffer
  3027. (setq ide-skel-tabbar-enabled t))))
  3028. (when (and imenu-buffer
  3029. (eq event 'tab-change)
  3030. (eq (cadr list) imenu-buffer))
  3031. (with-current-buffer imenu-buffer
  3032. (when (= (buffer-size) 0)
  3033. (ide-skel-imenu-side-view-draw-tree imenu-buffer))))))
  3034. nil)
  3035. (add-hook 'ide-skel-side-view-window-functions 'ide-skel-imenu-side-view-window-function)
  3036. ;;; Info
  3037. (require 'info)
  3038. (defun ide-skel-info-get-buffer-create ()
  3039. (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Info"
  3040. 'left "Info" "Info browser"
  3041. (lambda (editor-buffer) t))))
  3042. (with-current-buffer buffer
  3043. (setq ide-skel-tabbar-menu-function
  3044. (lambda ()
  3045. (append
  3046. (list
  3047. (list 'ide-skel-info-refresh "Refresh" t))))
  3048. ide-skel-info-open-paths (make-hash-table :test 'equal)
  3049. ide-skel-info-root-node (cons "Top" "(dir)top"))
  3050. (add-hook 'tree-widget-after-toggle-functions (lambda (widget)
  3051. (let ((path (widget-get widget :path)))
  3052. (when path
  3053. (if (widget-get widget :open)
  3054. (puthash path t ide-skel-info-open-paths)
  3055. (remhash path ide-skel-info-open-paths)))))
  3056. nil t))
  3057. buffer))
  3058. (defun ide-skel-info-file-open (widget &rest rest)
  3059. (let ((path (widget-get widget :path)))
  3060. (if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" path))
  3061. (error "Invalid node %s" path)
  3062. (let ((filename (match-string 1 path))
  3063. (nodename (match-string 2 path))
  3064. (buffer (get-buffer "*info*"))
  3065. buffer-win)
  3066. (unless buffer
  3067. (with-selected-window (ide-skel-get-last-selected-window)
  3068. (info)
  3069. (setq buffer (window-buffer (selected-window)))
  3070. (setq buffer-win (selected-window))))
  3071. (unless buffer-win
  3072. (setq buffer-win (get-buffer-window buffer))
  3073. (unless buffer-win
  3074. (with-selected-window (ide-skel-get-last-selected-window)
  3075. (switch-to-buffer buffer)
  3076. (setq buffer-win (selected-window)))))
  3077. (select-window buffer-win)
  3078. (Info-find-node filename nodename)))))
  3079. (defun ide-skel-info-tree-expand-dir (tree)
  3080. (let ((path (widget-get tree :path)))
  3081. (condition-case err
  3082. (mapcar 'ide-skel-info-tree-widget (Info-speedbar-fetch-file-nodes path))
  3083. (error
  3084. (message "%s" (error-message-string err))
  3085. nil))))
  3086. (defun ide-skel-info-tree-widget (e)
  3087. (let ((name (car e))
  3088. (path (cdr e)))
  3089. (if (condition-case err
  3090. (Info-speedbar-fetch-file-nodes path)
  3091. (error nil))
  3092. (list 'ide-skel-info-tree-dir-widget
  3093. :path path
  3094. :help-echo name
  3095. :open (gethash path ide-skel-info-open-paths)
  3096. :node (list 'push-button
  3097. :tag name
  3098. :format "%[%t%]\n"
  3099. :notify 'ide-skel-info-file-open
  3100. :path path
  3101. :button-face 'variable-pitch
  3102. :help-echo name
  3103. :keymap tree-widget-button-keymap
  3104. ))
  3105. (list 'ide-skel-info-tree-file-widget
  3106. :path path
  3107. :help-echo name
  3108. :keymap tree-widget-button-keymap
  3109. :tag name))))
  3110. (defun ide-skel-info-refresh (&optional show-top)
  3111. (interactive)
  3112. (with-current-buffer ide-skel-info-buffer
  3113. (let ((inhibit-read-only t)
  3114. (start-line (save-excursion
  3115. (goto-char (window-start ide-skel-current-left-view-window))
  3116. (line-number-at-pos))))
  3117. (erase-buffer)
  3118. (tree-widget-set-theme "small-folder")
  3119. (let ((tree (ide-skel-info-tree-widget ide-skel-info-root-node)))
  3120. (plist-put (cdr tree) :open t)
  3121. (widget-create tree))
  3122. (set-keymap-parent (current-local-map) tree-widget-button-keymap)
  3123. (widget-setup)
  3124. (if show-top
  3125. (goto-char (point-min))
  3126. (goto-line start-line))
  3127. (beginning-of-line)
  3128. (set-window-start ide-skel-current-right-view-window (point)))))
  3129. (defun ide-skel-info (root-node)
  3130. (with-current-buffer ide-skel-info-buffer
  3131. (clrhash ide-skel-info-open-paths)
  3132. (setq ide-skel-info-root-node root-node)
  3133. (ide-skel-info-refresh t)))
  3134. (defun ide-skel-info-side-view-window-function (side event &rest list)
  3135. (when (and (eq side 'left) ide-skel-current-left-view-window)
  3136. (cond ((eq event 'show)
  3137. (unless ide-skel-info-buffer
  3138. (setq ide-skel-info-buffer (ide-skel-info-get-buffer-create)))
  3139. (with-current-buffer ide-skel-info-buffer
  3140. (setq ide-skel-tabbar-enabled t)))
  3141. ((and (eq event 'tab-change)
  3142. (eq (cadr list) ide-skel-info-buffer)
  3143. (= (buffer-size ide-skel-info-buffer) 0))
  3144. (ide-skel-info-refresh))))
  3145. nil)
  3146. (add-hook 'ide-skel-side-view-window-functions 'ide-skel-info-side-view-window-function)
  3147. ;;; Dir tree
  3148. (defun ide-skel-dir-node-notify (widget &rest rest)
  3149. (let ((path (widget-get widget :path)))
  3150. (ide-skel-dir path)))
  3151. (defun ide-skel-file-open (widget &rest rest)
  3152. (let ((path (widget-get widget :path)))
  3153. (ide-skel-select-buffer path)))
  3154. (defun ide-skel-dir-tree-widget (e)
  3155. "Return a widget to display file or directory E."
  3156. (if (file-directory-p e)
  3157. `(ide-skel-dir-tree-dir-widget
  3158. :path ,e
  3159. :help-echo ,e
  3160. :open ,(gethash e ide-skel-dir-open-paths)
  3161. :node (push-button
  3162. :tag ,(file-name-as-directory
  3163. (file-name-nondirectory e))
  3164. :format "%[%t%]\n"
  3165. :notify ide-skel-dir-node-notify
  3166. :path ,e
  3167. :button-face (variable-pitch bold)
  3168. :help-echo ,e
  3169. :keymap ,tree-widget-button-keymap ; Emacs
  3170. ))
  3171. `(ide-skel-dir-tree-file-widget
  3172. :path ,e
  3173. :help-echo ,e
  3174. :tag ,(file-name-nondirectory e))))
  3175. (defun ide-skel-dir-get-buffer-create ()
  3176. (let ((buffer (ide-skel-get-side-view-buffer-create " Ide Skel Dirs"
  3177. 'left "Dirs" "Filesystem browser"
  3178. (lambda (editor-buffer) t))))
  3179. (with-current-buffer buffer
  3180. (setq ide-skel-tabbar-menu-function
  3181. (lambda ()
  3182. (append
  3183. (list
  3184. (list 'ide-skel-dir-refresh "Refresh" t)
  3185. (when (and (buffer-file-name ide-skel-current-editor-buffer)
  3186. (fboundp 'ide-skel-proj-get-project-create)
  3187. (funcall 'ide-skel-project-p (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer)))))
  3188. (list 'ide-skel-dir-project "Show project tree" t))
  3189. (list 'ide-skel-dir-home "Home" t)
  3190. (list 'ide-skel-dir-filesystem-root "/" t)
  3191. )))
  3192. ide-skel-dir-open-paths (make-hash-table :test 'equal)
  3193. ide-skel-dir-root-dir (file-truename (substitute-in-file-name "~")))
  3194. (add-hook 'tree-widget-after-toggle-functions (lambda (widget)
  3195. (let ((path (widget-get widget :path)))
  3196. (when path
  3197. (if (widget-get widget :open)
  3198. (puthash path t ide-skel-dir-open-paths)
  3199. (remhash path ide-skel-dir-open-paths)))))
  3200. nil t))
  3201. buffer))
  3202. (defun ide-skel-dir-tree-list (dir)
  3203. "Return the content of the directory DIR.
  3204. Return the list of components found, with sub-directories at the
  3205. beginning of the list."
  3206. (let (files dirs)
  3207. (dolist (entry (directory-files dir 'full))
  3208. (unless (string-equal (substring entry -1) ".")
  3209. (if (file-directory-p entry)
  3210. (push entry dirs)
  3211. (push entry files))))
  3212. (nreverse (nconc files dirs))))
  3213. (defun ide-skel-dir-tree-expand-dir (tree)
  3214. "Expand the tree widget TREE.
  3215. Return a list of child widgets."
  3216. (let ((dir (directory-file-name (widget-get tree :path))))
  3217. (if (file-accessible-directory-p dir)
  3218. (progn
  3219. (message "Reading directory %s..." dir)
  3220. (condition-case err
  3221. (prog1
  3222. (mapcar 'ide-skel-dir-tree-widget (ide-skel-dir-tree-list dir))
  3223. (message "Reading directory %s...done" dir))
  3224. (error
  3225. (message "%s" (error-message-string err))
  3226. nil)))
  3227. (error "This directory is inaccessible"))))
  3228. (defun ide-skel-select-dir-handler (event)
  3229. (interactive "@e")
  3230. (with-selected-window (posn-window (event-start event))
  3231. (let* ((path (get-text-property (posn-point (event-start event)) 'path)))
  3232. (ide-skel-dir path))))
  3233. (defun ide-skel-dir-refresh (&optional show-top)
  3234. (interactive)
  3235. (with-current-buffer ide-skel-dir-buffer
  3236. (let ((inhibit-read-only t)
  3237. (start-line (save-excursion
  3238. (goto-char (window-start ide-skel-current-left-view-window))
  3239. (line-number-at-pos))))
  3240. (erase-buffer)
  3241. (let ((path-dirs (split-string (directory-file-name ide-skel-dir-root-dir) "[/\\]"))
  3242. (km (make-sparse-keymap))
  3243. path)
  3244. (setq path-dirs (reverse (cdr (reverse path-dirs))))
  3245. (define-key km [mouse-1] 'ide-skel-select-dir-handler)
  3246. (while path-dirs
  3247. (let ((dir (car path-dirs)))
  3248. (when (and (> (current-column) 0)
  3249. (>= (+ (current-column) (length dir) 1) (window-width ide-skel-current-left-view-window)))
  3250. (insert "\n"))
  3251. (setq path (directory-file-name (concat path (format "/%s" dir))))
  3252. (unless (equal (char-before) ?/)
  3253. (insert "/"))
  3254. (insert (propertize dir
  3255. 'face 'bold
  3256. 'local-map km
  3257. 'mouse-face 'highlight
  3258. 'path path)))
  3259. (setq path-dirs (cdr path-dirs))))
  3260. (insert "\n\n")
  3261. (tree-widget-set-theme "small-folder")
  3262. (let ((default-directory ide-skel-dir-root-dir)
  3263. (tree (ide-skel-dir-tree-widget (directory-file-name ide-skel-dir-root-dir))))
  3264. (plist-put (cdr tree) :open t)
  3265. (widget-create tree))
  3266. (set-keymap-parent (current-local-map) tree-widget-button-keymap)
  3267. (widget-setup)
  3268. (if show-top
  3269. (goto-char (point-min))
  3270. (goto-line start-line))
  3271. (beginning-of-line)
  3272. (set-window-start ide-skel-current-right-view-window (point))
  3273. )))
  3274. (defun ide-skel-dir (root-dir)
  3275. (with-current-buffer ide-skel-dir-buffer
  3276. (clrhash ide-skel-dir-open-paths)
  3277. (setq ide-skel-dir-root-dir (file-truename (substitute-in-file-name root-dir)))
  3278. (ide-skel-dir-refresh t)))
  3279. (defun ide-skel-dir-project ()
  3280. (interactive)
  3281. (let ((root-dir (funcall 'ide-skel-project-root-path
  3282. (car (funcall 'ide-skel-proj-get-project-create (buffer-file-name ide-skel-current-editor-buffer))))))
  3283. (message "Root dir: %S" root-dir)
  3284. (ide-skel-dir root-dir)))
  3285. (defun ide-skel-dir-home ()
  3286. (interactive)
  3287. (ide-skel-dir "~"))
  3288. (defun ide-skel-dir-filesystem-root ()
  3289. (interactive)
  3290. (ide-skel-dir "/"))
  3291. (defun ide-skel-dirs-side-view-window-function (side event &rest list)
  3292. (when (and (eq side 'left) ide-skel-current-left-view-window)
  3293. (cond ((eq event 'show)
  3294. (unless ide-skel-dir-buffer
  3295. (setq ide-skel-dir-buffer (ide-skel-dir-get-buffer-create)))
  3296. (with-current-buffer ide-skel-dir-buffer
  3297. (setq ide-skel-tabbar-enabled t)))
  3298. ((and (eq event 'tab-change)
  3299. (eq (cadr list) ide-skel-dir-buffer)
  3300. (= (buffer-size ide-skel-dir-buffer) 0))
  3301. (ide-skel-dir-refresh))))
  3302. nil)
  3303. (add-hook 'ide-skel-side-view-window-functions 'ide-skel-dirs-side-view-window-function)
  3304. (easy-menu-add-item nil nil ide-skel-project-menu t)
  3305. (defun ide-skel-proj-insert-with-face (string face)
  3306. (let ((point (point)))
  3307. (insert string)
  3308. (let ((overlay (make-overlay point (point))))
  3309. (overlay-put overlay 'face face))))
  3310. (defun ide-skel-mode-name-stringify (mode-name)
  3311. (let ((name (format "%s" mode-name)))
  3312. (replace-regexp-in-string "-" " "
  3313. (capitalize
  3314. (if (string-match "^\\(.*\\)-mode" name)
  3315. (match-string 1 name)
  3316. name)))))
  3317. (defun ide-skel-proj-get-all-dirs (root-dir)
  3318. (condition-case err
  3319. (split-string (shell-command-to-string (format "find %s -type d | grep -v '/CVS\\|/\\.svn'" root-dir))
  3320. "\n" t)
  3321. (error nil)))
  3322. (defun ide-skel-shell ()
  3323. (interactive)
  3324. (when (fboundp 'ide-skel-show-bottom-view-window)
  3325. (funcall 'ide-skel-show-bottom-view-window)
  3326. (select-window (or (funcall 'ide-skel-get-bottom-view-window)
  3327. (selected-window)))
  3328. (ansi-term (or (getenv "ESHELL") (getenv "SHELL")))))
  3329. (defun ide-skel-project-menu (menu)
  3330. (let* ((curbuf-file (buffer-file-name (current-buffer)))
  3331. (curbuf-mode-name (when (and (buffer-file-name (current-buffer))
  3332. (ide-skel-mode-file-regexp-list (list major-mode)))
  3333. (ide-skel-mode-name-stringify major-mode))))
  3334. (condition-case err
  3335. (append
  3336. (when curbuf-mode-name
  3337. (list (vector (format "Search for %s file..." curbuf-mode-name) 'ide-skel-proj-find-files-by-regexp curbuf-mode-name)))
  3338. (list (vector "Search for file..." 'ide-skel-proj-find-text-files-by-regexp curbuf-mode-name))
  3339. (when curbuf-mode-name
  3340. (list (vector (format "Grep %s files..." curbuf-mode-name) 'ide-skel-proj-grep-files-by-regexp curbuf-mode-name)))
  3341. (list (vector "Grep files..." 'ide-skel-proj-grep-text-files-by-regexp curbuf-file))
  3342. (list (vector "Shell" 'ide-skel-shell t)))
  3343. (error (message (error-message-string err))))))
  3344. ;; (ide-skel-project . relative-path) jesli path nalezy do projektu,
  3345. ;; (qdir . filename) wpp
  3346. (defun ide-skel-proj-get-project-create (path)
  3347. (let ((path (file-truename (substitute-in-file-name path)))
  3348. dir)
  3349. (if (file-directory-p path)
  3350. (progn
  3351. (setq path (file-name-as-directory path))
  3352. (setq dir path))
  3353. (setq dir (file-name-as-directory (file-name-directory path))))
  3354. ;; path - true, qualified file name (no environment variables, ~, links)
  3355. (let ((project (some (lambda (project)
  3356. (let ((root-dir (ide-skel-project-root-path project)))
  3357. (when (string-match (concat "^" (regexp-quote root-dir)) path)
  3358. project)))
  3359. ide-skel-projects)))
  3360. (when project
  3361. (setq dir (ide-skel-project-root-path project)))
  3362. ;; there is no such project
  3363. (unless project
  3364. (let ((last-project-dir dir)
  3365. (dir-list (split-string dir "/"))
  3366. is-project)
  3367. ;; there is no root dir
  3368. (while (directory-files dir t (concat "^" ide-skel-cvs-dir-regexp) t)
  3369. (setq is-project t
  3370. last-project-dir (file-name-as-directory dir)
  3371. dir (file-name-as-directory (file-name-directory (directory-file-name dir)))))
  3372. (when is-project
  3373. (let ((list (nthcdr (1- (length (split-string last-project-dir "/"))) dir-list)))
  3374. (cond ((equal (car list) "trunk")
  3375. (setq last-project-dir (concat last-project-dir "trunk/")))
  3376. ((member (car list) '("branches" "tags"))
  3377. (setq last-project-dir (concat last-project-dir (car list) "/" (when (cdr list) (concat (cadr list) "/")))))
  3378. (t)))
  3379. (setq project (make-ide-skel-project :root-path last-project-dir
  3380. :include-file-path (ide-skel-proj-get-all-dirs last-project-dir))
  3381. dir last-project-dir)
  3382. (push project ide-skel-projects))))
  3383. (list (or project dir) (file-relative-name path dir) path))))
  3384. (defun ide-skel-proj-get-root (proj-or-dir)
  3385. (when proj-or-dir
  3386. (directory-file-name (file-truename (substitute-in-file-name
  3387. (if (ide-skel-project-p proj-or-dir)
  3388. (ide-skel-project-root-path proj-or-dir)
  3389. proj-or-dir))))))
  3390. (defun ide-skel-proj-find-files (dir file-predicate &optional dir-predicate)
  3391. "Return list of all qualified file paths in tree dir with root
  3392. DIR, for which FILE-PREDICATE returns non-nil. We will go into
  3393. directory only if DIR-PREDICATE returns non-nil or DIR-PREDICATE *is* nil."
  3394. (setq dir (file-name-as-directory (file-truename (substitute-in-file-name dir))))
  3395. (let (result-list)
  3396. (mapcar (lambda (path)
  3397. (if (file-directory-p path)
  3398. (when (and (file-accessible-directory-p path)
  3399. (or (null dir-predicate)
  3400. (funcall dir-predicate path)))
  3401. (setq result-list (append result-list (ide-skel-proj-find-files path file-predicate dir-predicate))))
  3402. (when (or (null file-predicate)
  3403. (funcall file-predicate path))
  3404. (push path result-list))))
  3405. (delete (concat (file-name-as-directory dir) ".")
  3406. (delete (concat (file-name-as-directory dir) "..")
  3407. (directory-files dir t nil t))))
  3408. result-list))
  3409. (defun ide-skel-root-dir-for-path (path)
  3410. (let (root-dir)
  3411. (setq root-dir (car (ide-skel-proj-get-project-create path)))
  3412. (unless (stringp root-dir)
  3413. (setq root-dir (ide-skel-project-root-path root-dir)))
  3414. root-dir))
  3415. (defun ide-skel-has-imenu (&optional buffer)
  3416. (with-current-buffer (or buffer (current-buffer))
  3417. (or (and imenu-prev-index-position-function
  3418. imenu-extract-index-name-function)
  3419. imenu-generic-expression
  3420. (not (eq imenu-create-index-function
  3421. 'imenu-default-create-index-function)))))
  3422. (defun ide-skel-mode-file-regexp-list (mode-symbol-list)
  3423. (delq nil (mapcar (lambda (element)
  3424. (let ((fun-name (if (listp (cdr element)) (cadr element) (cdr element))))
  3425. (when (memq fun-name mode-symbol-list) (cons (car element) fun-name))))
  3426. auto-mode-alist)))
  3427. (defun ide-skel-find-project-files (root-dir mode-symbol-list predicate)
  3428. (let ((obj-file-regexp-list (delq nil (mapcar (lambda (element)
  3429. (let ((len (length element)))
  3430. (unless (and (> len 0)
  3431. (equal (elt element (1- len)) ?/))
  3432. (concat (regexp-quote element) "$"))))
  3433. (append ide-skel-proj-ignored-extensions completion-ignored-extensions))))
  3434. (mode-file-regexp-list (ide-skel-mode-file-regexp-list mode-symbol-list))) ; (file-path-regexp . major-mode-function-symbol)
  3435. (when (and mode-symbol-list
  3436. (not mode-file-regexp-list))
  3437. (error (format "No rules for %s major modes in auto-mode-alist." (mapconcat 'identity mode-symbol-list ", "))))
  3438. (ide-skel-proj-find-files root-dir
  3439. (lambda (file-name)
  3440. (and (not (string-match "#" file-name))
  3441. (not (string-match "semantic.cache" file-name))
  3442. (or (and (not mode-symbol-list)
  3443. (not (some (lambda (regexp)
  3444. (string-match regexp file-name))
  3445. obj-file-regexp-list)))
  3446. (and mode-symbol-list
  3447. (some (lambda (element)
  3448. (let ((freg (if (string-match "[$]" (car element))
  3449. (car element)
  3450. (concat (car element) "$"))))
  3451. (when (string-match freg file-name)
  3452. (cdr element))))
  3453. mode-file-regexp-list)))
  3454. (or (not predicate)
  3455. (funcall predicate file-name))))
  3456. (lambda (dir-path)
  3457. (not (string-match (concat "/" ide-skel-cvs-dir-regexp) dir-path))))))
  3458. (defun ide-skel-proj-find-text-files-by-regexp ()
  3459. (interactive)
  3460. (unwind-protect
  3461. (progn
  3462. (setq ide-skel-all-text-files-flag t)
  3463. (call-interactively 'ide-skel-proj-find-files-by-regexp))
  3464. (setq ide-skel-all-text-files-flag nil)))
  3465. (defun ide-skel-proj-grep-text-files-by-regexp ()
  3466. (interactive)
  3467. (unwind-protect
  3468. (progn
  3469. (setq ide-skel-all-text-files-flag t)
  3470. (call-interactively 'ide-skel-proj-grep-files-by-regexp))
  3471. (setq ide-skel-all-text-files-flag nil)))
  3472. (defun ide-skel-proj-grep-files-by-regexp (root-dir mode-symbol-list regexp)
  3473. (interactive (let* ((path (buffer-file-name (current-buffer)))
  3474. (all-text-files (or ide-skel-all-text-files-flag
  3475. (consp current-prefix-arg)))
  3476. (whatever (progn
  3477. (when (and (not all-text-files)
  3478. (not (ide-skel-mode-file-regexp-list (list major-mode))))
  3479. (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode))))
  3480. (unless path
  3481. (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer))))))
  3482. (root-dir (when path (ide-skel-root-dir-for-path path)))
  3483. (thing (let ((res (thing-at-point 'symbol)))
  3484. (set-text-properties 0 (length res) nil res)
  3485. res))
  3486. (chunk (let ((result (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "")
  3487. (format "Search in %s files. Regexp%s: "
  3488. (if all-text-files
  3489. "all text"
  3490. (ide-skel-mode-name-stringify major-mode))
  3491. (if thing (format " (default %s)" thing) "")))
  3492. nil ide-skel-proj-grep-project-files-history thing)))
  3493. (if (and result (> (length result) 0))
  3494. result
  3495. (error "Regexp cannot be null")))))
  3496. (list root-dir (unless all-text-files (list major-mode)) chunk)))
  3497. (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list (lambda (path) t)))
  3498. (temp-file-path (concat (file-name-as-directory temporary-file-directory) (make-temp-name "ide-"))))
  3499. (unless paths
  3500. (error "No files to grep"))
  3501. ;; create temporary file with file paths to search
  3502. (with-temp-file temp-file-path
  3503. (dolist (path paths)
  3504. ;; save buffer if is open
  3505. (let ((buffer (get-file-buffer path)))
  3506. (when (and buffer
  3507. (buffer-live-p buffer))
  3508. (with-current-buffer buffer
  3509. (save-buffer))))
  3510. (setq path (concat "./" (file-relative-name path (file-name-as-directory root-dir))))
  3511. (insert (concat "'" path "'\n"))))
  3512. (let* ((default-directory root-dir)
  3513. (grep-command (format "cat %s | xargs grep -n %s" temp-file-path regexp)))
  3514. (setq ide-skel-proj-grep-header (list root-dir
  3515. (if mode-symbol-list
  3516. (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ")
  3517. "all text")
  3518. regexp))
  3519. (grep grep-command))
  3520. ;; delete file after some time, because grep is executed as external process
  3521. (run-with-idle-timer 5 nil (lambda (file-path)
  3522. (condition-case nil
  3523. nil ; (delete-file file-path)
  3524. (error nil)))
  3525. temp-file-path)))
  3526. (defun ide-skel-proj-find-files-by-regexp (root-dir mode-symbol-list name-regexp &optional case-sensitive)
  3527. "Search directory tree with root in ROOT-DIR and returns
  3528. qualified paths to files which after open in Emacs would have one
  3529. of modes in MODE-SYMBOL-LIST (if list is empty, we will take all
  3530. text files) and their name (without dir) matches NAME-REGEXP."
  3531. (interactive (let* ((path (buffer-file-name (current-buffer)))
  3532. (all-text-files (or ide-skel-all-text-files-flag
  3533. (consp current-prefix-arg)))
  3534. (whatever (progn
  3535. (when (and (not all-text-files)
  3536. (not (ide-skel-mode-file-regexp-list (list major-mode))))
  3537. (error (format "No rules for %s major mode in auto-mode-alist" (symbol-name major-mode))))
  3538. (unless path
  3539. (error "Current buffer (%s) is not visiting any project file" (buffer-name (current-buffer))))))
  3540. (root-dir (when path (ide-skel-root-dir-for-path path)))
  3541. (chunk (read-string (concat (if root-dir (format "Root dir is %s. " root-dir) "")
  3542. (if all-text-files
  3543. "F"
  3544. (concat (ide-skel-mode-name-stringify major-mode) " f"))
  3545. (format "ile name regexp: " ))
  3546. nil ide-skel-proj-find-project-files-history nil)))
  3547. (list root-dir (unless all-text-files (list major-mode)) chunk)))
  3548. (let* ((paths (ide-skel-find-project-files root-dir mode-symbol-list
  3549. (lambda (path)
  3550. (let ((case-fold-search (not case-sensitive)))
  3551. (or (not name-regexp)
  3552. (string-match name-regexp (file-name-nondirectory path)))))))
  3553. (buffer (get-buffer-create ide-skel-proj-find-results-buffer-name))
  3554. (saved-window (cons (selected-window) (window-buffer (selected-window)))))
  3555. (if (= (length paths) 1)
  3556. (find-file (car paths))
  3557. (save-selected-window
  3558. (save-excursion
  3559. (set-buffer buffer)
  3560. (setq buffer-read-only nil
  3561. default-directory root-dir)
  3562. (erase-buffer)
  3563. (insert "Root dir: ")
  3564. (ide-skel-proj-insert-with-face root-dir 'font-lock-keyword-face)
  3565. (insert "; Range: ")
  3566. (ide-skel-proj-insert-with-face
  3567. (if mode-symbol-list
  3568. (mapconcat (lambda (sym) (ide-skel-mode-name-stringify sym)) mode-symbol-list ", ")
  3569. "all text")
  3570. 'font-lock-keyword-face)
  3571. (insert " files; Regexp: ")
  3572. (ide-skel-proj-insert-with-face name-regexp 'font-lock-keyword-face)
  3573. (insert "; Case sensitive: ")
  3574. (ide-skel-proj-insert-with-face (if case-sensitive "Yes" "No") 'font-lock-keyword-face)
  3575. (insert "\n\n")
  3576. (compilation-minor-mode 1)
  3577. (let ((invisible-suffix ":1:1 s"))
  3578. (put-text-property 0 (length invisible-suffix) 'invisible t invisible-suffix)
  3579. (dolist (path paths)
  3580. (let ((relative-path (file-relative-name path root-dir)))
  3581. (put-text-property 0 (length relative-path) 'mouse-face 'highlight relative-path)
  3582. (insert relative-path)
  3583. (insert invisible-suffix)
  3584. (insert "\n"))))
  3585. (insert (format "\n%d files found." (length paths)))
  3586. (goto-char (point-min))
  3587. (setq buffer-read-only t)
  3588. (when (and paths (fboundp 'compile-reinitialize-errors) (funcall (symbol-function 'compile-reinitialize-errors) t)))
  3589. (switch-to-buffer-other-window buffer)
  3590. (goto-line 1)
  3591. (goto-line 3)))
  3592. (if (window-live-p (car saved-window))
  3593. (select-window (car saved-window))
  3594. (when (get-buffer-window (cdr saved-window))
  3595. (select-window (get-buffer-window (cdr saved-window))))))))
  3596. (unless ide-skel-proj-grep-mode-map
  3597. (setq ide-skel-proj-grep-mode-map (make-sparse-keymap))
  3598. (define-key ide-skel-proj-grep-mode-map "r" 'ide-skel-proj-grep-replace))
  3599. (defun ide-skel-proj-grep-replace ()
  3600. (interactive)
  3601. (let ((replace-to (read-string "Replace to: " nil 'ide-skel-proj-grep-replace-history))
  3602. (current-pos 1)
  3603. begin end
  3604. buffers-to-revert
  3605. replace-info)
  3606. (save-excursion
  3607. (while current-pos
  3608. (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer)))
  3609. (when (and current-pos
  3610. (eq (get-text-property current-pos 'font-lock-face) 'match))
  3611. (setq begin current-pos)
  3612. (setq current-pos (next-single-property-change current-pos 'font-lock-face (current-buffer)))
  3613. (setq end current-pos)
  3614. (save-excursion
  3615. (goto-char begin)
  3616. (beginning-of-line)
  3617. (let ((begline (point)))
  3618. (re-search-forward "^\\(.*\\):\\([0-9]+\\):" nil t)
  3619. (let ((len (length (match-string 0)))
  3620. (file-path (expand-file-name (substring-no-properties (match-string 1)) default-directory)))
  3621. (when (get-file-buffer file-path)
  3622. (push (get-file-buffer file-path) buffers-to-revert))
  3623. (push (list file-path
  3624. (string-to-number (match-string 2))
  3625. (- begin begline len)
  3626. (- end begline len))
  3627. replace-info)))))))
  3628. (dolist (replacement replace-info)
  3629. (let ((file-path (nth 0 replacement))
  3630. (line-no (nth 1 replacement))
  3631. (from-column-no (nth 2 replacement))
  3632. (to-column-no (nth 3 replacement)))
  3633. (condition-case err
  3634. (with-temp-file file-path
  3635. (insert-file-contents file-path)
  3636. (goto-line line-no)
  3637. (forward-char from-column-no)
  3638. (delete-region (point) (+ (point) (- to-column-no from-column-no)))
  3639. (insert replace-to))
  3640. (error (message "%s" (error-message-string err))))))
  3641. (dolist (buffer buffers-to-revert)
  3642. (when (buffer-live-p buffer)
  3643. (with-current-buffer buffer
  3644. (revert-buffer t t t)))) ; ignore-auto, nonconfirm, preserve-modes
  3645. (message "Done.")))
  3646. (define-minor-mode ide-skel-proj-grep-mode
  3647. ""
  3648. nil ; init value
  3649. nil ; mode indicator
  3650. ide-skel-proj-grep-mode-map ; keymap
  3651. ;; body
  3652. (unless (assq 'ide-skel-proj-grep-mode minor-mode-map-alist)
  3653. (push (cons 'ide-skel-proj-grep-mode ide-skel-proj-grep-mode-map) minor-mode-map-alist)))
  3654. (add-hook 'grep-setup-hook (lambda ()
  3655. (when ide-skel-proj-grep-header
  3656. (ide-skel-proj-grep-mode 1)
  3657. (unwind-protect
  3658. (progn
  3659. (setq buffer-read-only nil)
  3660. (erase-buffer)
  3661. (remove-overlays)
  3662. (insert "Root dir: ")
  3663. (ide-skel-proj-insert-with-face (car ide-skel-proj-grep-header) 'font-lock-keyword-face)
  3664. (insert "; Range: ")
  3665. (ide-skel-proj-insert-with-face (cadr ide-skel-proj-grep-header) 'font-lock-keyword-face)
  3666. (insert " files; Regexp: ")
  3667. (ide-skel-proj-insert-with-face (caddr ide-skel-proj-grep-header) 'font-lock-keyword-face)
  3668. (insert "\n")
  3669. (insert "mouse-1 toggle match; r replace matches")
  3670. (insert "\n\n"))
  3671. (setq buffer-read-only t
  3672. ide-skel-proj-grep-header nil)
  3673. (setq ide-skel-proj-old-compilation-exit-message-function (symbol-value 'compilation-exit-message-function))
  3674. (set 'compilation-exit-message-function
  3675. (lambda (status code msg)
  3676. (let ((result (if ide-skel-proj-old-compilation-exit-message-function
  3677. (funcall ide-skel-proj-old-compilation-exit-message-function
  3678. status code msg)
  3679. (cons msg code))))
  3680. (save-excursion
  3681. (goto-char (point-min))
  3682. (let (begin
  3683. end
  3684. (km (make-sparse-keymap))
  3685. (inhibit-read-only t))
  3686. (define-key km [down-mouse-1] 'ignore)
  3687. (define-key km [mouse-1] 'ide-skel-proj-grep-click)
  3688. (while (setq begin (next-single-property-change (point) 'font-lock-face (current-buffer) nil))
  3689. (setq end (next-single-property-change begin 'font-lock-face (current-buffer) nil))
  3690. (put-text-property begin end 'pointer 'hand)
  3691. (put-text-property begin end 'local-map km)
  3692. (goto-char end))))
  3693. result)))))))
  3694. (defun ide-skel-proj-grep-click (event)
  3695. (interactive "@e")
  3696. (with-selected-window (posn-window (event-start event))
  3697. (let* ((posn-point (posn-point (event-start event)))
  3698. (begin (or (and (not (get-text-property (1- posn-point) 'font-lock-face))
  3699. posn-point)
  3700. (previous-single-property-change posn-point 'font-lock-face (current-buffer) nil)))
  3701. (end (next-single-property-change posn-point 'font-lock-face (current-buffer) nil))
  3702. (font-lock-face (get-text-property posn-point 'font-lock-face))
  3703. (inhibit-read-only t))
  3704. (put-text-property begin end 'font-lock-face (if (eq font-lock-face 'match) 'widget-field 'match)))))
  3705. (defun ide-skel-proj-change-buffer-hook-function ()
  3706. (let ((path (buffer-file-name)))
  3707. (when path
  3708. (condition-case err
  3709. (let ((project-list (ide-skel-proj-get-project-create path)))
  3710. (when (ide-skel-project-p (car project-list))
  3711. (setq PC-include-file-path (ide-skel-project-include-file-path (car project-list)))))
  3712. (error nil)))))
  3713. (add-hook 'ide-skel-editor-buffer-changed-hook 'ide-skel-proj-change-buffer-hook-function)
  3714. (tabbar-mode 1)
  3715. (provide 'ide-skel)