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