ebrowse.el 149 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463
  1. ;;; ebrowse.el --- Emacs C++ class browser & tags facility
  2. ;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
  3. ;; Author: Gerd Moellmann <gerd@gnu.org>
  4. ;; Maintainer: FSF
  5. ;; Keywords: C++ tags tools
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; This package implements
  19. ;; - A class browser for C++
  20. ;; - A complete set of tags-like functions working on class trees
  21. ;; - An electric buffer list showing class browser buffers only
  22. ;; Documentation is found in a separate Info file.
  23. ;;; Code:
  24. (require 'easymenu)
  25. (require 'view)
  26. (require 'ebuff-menu)
  27. (eval-when-compile
  28. (require 'cl)
  29. (require 'helper))
  30. ;;; User-options
  31. (defgroup ebrowse nil
  32. "Settings for the C++ class browser."
  33. :group 'tools)
  34. (defcustom ebrowse-search-path nil
  35. "*List of directories to search for source files in a class tree.
  36. Elements should be directory names; nil as an element means to try
  37. to find source files relative to the location of the BROWSE file loaded."
  38. :group 'ebrowse
  39. :type '(repeat (choice (const :tag "Default" nil)
  40. (string :tag "Directory"))))
  41. (defcustom ebrowse-view/find-hook nil
  42. "*Hooks run after finding or viewing a member or class."
  43. :group 'ebrowse
  44. :type 'hook)
  45. (defcustom ebrowse-not-found-hook nil
  46. "*Hooks run when finding or viewing a member or class was not successful."
  47. :group 'ebrowse
  48. :type 'hook)
  49. (defcustom ebrowse-electric-list-mode-hook nil
  50. "*Hook called by `ebrowse-electric-position-mode'."
  51. :group 'ebrowse
  52. :type 'hook)
  53. (defcustom ebrowse-max-positions 50
  54. "*Number of markers saved on electric position stack."
  55. :group 'ebrowse
  56. :type 'integer)
  57. (defgroup ebrowse-tree nil
  58. "Settings for class tree buffers."
  59. :group 'ebrowse)
  60. (defcustom ebrowse-tree-mode-hook nil
  61. "*Hook run in each new tree buffer."
  62. :group 'ebrowse-tree
  63. :type 'hook)
  64. (defcustom ebrowse-tree-buffer-name "*Tree*"
  65. "*The default name of class tree buffers."
  66. :group 'ebrowse-tree
  67. :type 'string)
  68. (defcustom ebrowse--indentation 4
  69. "*The amount by which subclasses are indented in the tree."
  70. :group 'ebrowse-tree
  71. :type 'integer)
  72. (defcustom ebrowse-source-file-column 40
  73. "*The column in which source file names are displayed in the tree."
  74. :group 'ebrowse-tree
  75. :type 'integer)
  76. (defcustom ebrowse-tree-left-margin 2
  77. "*Amount of space left at the left side of the tree display.
  78. This space is used to display markers."
  79. :group 'ebrowse-tree
  80. :type 'integer)
  81. (defgroup ebrowse-member nil
  82. "Settings for member buffers."
  83. :group 'ebrowse)
  84. (defcustom ebrowse-default-declaration-column 25
  85. "*The column in which member declarations are displayed in member buffers."
  86. :group 'ebrowse-member
  87. :type 'integer)
  88. (defcustom ebrowse-default-column-width 25
  89. "*The width of the columns in member buffers (short display form)."
  90. :group 'ebrowse-member
  91. :type 'integer)
  92. (defcustom ebrowse-member-buffer-name "*Members*"
  93. "*The name of the buffer for member display."
  94. :group 'ebrowse-member
  95. :type 'string)
  96. (defcustom ebrowse-member-mode-hook nil
  97. "*Run in each new member buffer."
  98. :group 'ebrowse-member
  99. :type 'hook)
  100. (defgroup ebrowse-faces nil
  101. "Faces used by Ebrowse."
  102. :group 'ebrowse)
  103. (defface ebrowse-tree-mark
  104. '((((min-colors 88)) (:foreground "red1"))
  105. (t (:foreground "red")))
  106. "*The face used for the mark character in the tree."
  107. :group 'ebrowse-faces)
  108. (define-obsolete-face-alias 'ebrowse-tree-mark-face 'ebrowse-tree-mark "22.1")
  109. (defface ebrowse-root-class
  110. '((((min-colors 88)) (:weight bold :foreground "blue1"))
  111. (t (:weight bold :foreground "blue")))
  112. "*The face used for root classes in the tree."
  113. :group 'ebrowse-faces)
  114. (define-obsolete-face-alias 'ebrowse-root-class-face 'ebrowse-root-class "22.1")
  115. (defface ebrowse-file-name
  116. '((t (:italic t)))
  117. "*The face for filenames displayed in the tree."
  118. :group 'ebrowse-faces)
  119. (define-obsolete-face-alias 'ebrowse-file-name-face 'ebrowse-file-name "22.1")
  120. (defface ebrowse-default
  121. '((t nil))
  122. "*Face for everything else in the tree not having other faces."
  123. :group 'ebrowse-faces)
  124. (define-obsolete-face-alias 'ebrowse-default-face 'ebrowse-default "22.1")
  125. (defface ebrowse-member-attribute
  126. '((((min-colors 88)) (:foreground "red1"))
  127. (t (:foreground "red")))
  128. "*Face used to display member attributes."
  129. :group 'ebrowse-faces)
  130. (define-obsolete-face-alias 'ebrowse-member-attribute-face
  131. 'ebrowse-member-attribute "22.1")
  132. (defface ebrowse-member-class
  133. '((t (:foreground "purple")))
  134. "*Face used to display the class title in member buffers."
  135. :group 'ebrowse-faces)
  136. (define-obsolete-face-alias 'ebrowse-member-class-face
  137. 'ebrowse-member-class "22.1")
  138. (defface ebrowse-progress
  139. '((((min-colors 88)) (:background "blue1"))
  140. (t (:background "blue")))
  141. "*Face for progress indicator."
  142. :group 'ebrowse-faces)
  143. (define-obsolete-face-alias 'ebrowse-progress-face 'ebrowse-progress "22.1")
  144. ;;; Utilities.
  145. (defun ebrowse-some (predicate vector)
  146. "Return true if PREDICATE is true of some element of VECTOR.
  147. If so, return the value returned by PREDICATE."
  148. (let ((length (length vector))
  149. (i 0)
  150. result)
  151. (while (and (< i length) (not result))
  152. (setq result (funcall predicate (aref vector i))
  153. i (1+ i)))
  154. result))
  155. (defun ebrowse-every (predicate vector)
  156. "Return true if PREDICATE is true of every element of VECTOR."
  157. (let ((length (length vector))
  158. (i 0)
  159. (result t))
  160. (while (and (< i length) result)
  161. (setq result (funcall predicate (aref vector i))
  162. i (1+ i)))
  163. result))
  164. (defun ebrowse-position (item list &optional test)
  165. "Return the position of ITEM in LIST or nil if not found.
  166. Compare items with `eq' or TEST if specified."
  167. (let ((i 0) found)
  168. (cond (test
  169. (while list
  170. (when (funcall test item (car list))
  171. (setq found i list nil))
  172. (setq list (cdr list) i (1+ i))))
  173. (t
  174. (while list
  175. (when (eq item (car list))
  176. (setq found i list nil))
  177. (setq list (cdr list) i (1+ i)))))
  178. found))
  179. (defun ebrowse-delete-if-not (predicate list)
  180. "Remove elements not satisfying PREDICATE from LIST and return the result.
  181. This is a destructive operation."
  182. (let (result)
  183. (while list
  184. (let ((next (cdr list)))
  185. (when (funcall predicate (car list))
  186. (setq result (nconc result list))
  187. (setf (cdr list) nil))
  188. (setq list next)))
  189. result))
  190. (defmacro ebrowse-output (&rest body)
  191. "Eval BODY with a writable current buffer.
  192. Preserve buffer's modified state."
  193. (let ((modified (make-symbol "--ebrowse-output--")))
  194. `(let (buffer-read-only (,modified (buffer-modified-p)))
  195. (unwind-protect
  196. (progn ,@body)
  197. (set-buffer-modified-p ,modified)))))
  198. (defmacro ebrowse-ignoring-completion-case (&rest body)
  199. "Eval BODY with `completion-ignore-case' bound to t."
  200. `(let ((completion-ignore-case t))
  201. ,@body))
  202. (defmacro ebrowse-save-selective (&rest body)
  203. "Eval BODY with `selective-display' restored at the end."
  204. (let ((var (make-symbol "var")))
  205. `(let ((,var selective-display))
  206. (unwind-protect
  207. (progn ,@body)
  208. (setq selective-display ,var)))))
  209. (defmacro ebrowse-for-all-trees (spec &rest body)
  210. "For all trees in SPEC, eval BODY."
  211. (let ((var (make-symbol "var"))
  212. (spec-var (car spec))
  213. (array (cadr spec)))
  214. `(loop for ,var being the symbols of ,array
  215. as ,spec-var = (get ,var 'ebrowse-root) do
  216. (when (vectorp ,spec-var)
  217. ,@body))))
  218. ;;; Set indentation for macros above.
  219. (put 'ebrowse-output 'lisp-indent-hook 0)
  220. (put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
  221. (put 'ebrowse-save-selective 'lisp-indent-hook 0)
  222. (put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
  223. (defsubst ebrowse-set-face (start end face)
  224. "Set face of a region START END to FACE."
  225. (overlay-put (make-overlay start end) 'face face))
  226. (defun ebrowse-completing-read-value (prompt table initial-input)
  227. "Read a string in the minibuffer, with completion.
  228. Case is ignored in completions.
  229. PROMPT is a string to prompt with; normally it ends in a colon and a space.
  230. TABLE is an alist whose elements' cars are strings, or an obarray.
  231. TABLE can also be a function to do the completion itself.
  232. If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
  233. If it is (STRING . POSITION), the initial input
  234. is STRING, but point is placed POSITION characters into the string."
  235. (ebrowse-ignoring-completion-case
  236. (completing-read prompt table nil t initial-input)))
  237. (defun ebrowse-value-in-buffer (sym buffer)
  238. "Return the value of SYM in BUFFER."
  239. (let ((old-buffer (current-buffer)))
  240. (unwind-protect
  241. (progn
  242. (set-buffer buffer)
  243. (symbol-value sym))
  244. (set-buffer old-buffer))))
  245. (defun ebrowse-rename-buffer (new-name)
  246. "Rename current buffer to NEW-NAME.
  247. If a buffer with name NEW-NAME already exists, delete it first."
  248. (let ((old-buffer (get-buffer new-name)))
  249. (unless (eq old-buffer (current-buffer))
  250. (when old-buffer
  251. (save-excursion (kill-buffer old-buffer)))
  252. (rename-buffer new-name))))
  253. (defun ebrowse-trim-string (string)
  254. "Return a copy of STRING with leading white space removed.
  255. Replace sequences of newlines with a single space."
  256. (when (string-match "^[ \t\n\r]+" string)
  257. (setq string (substring string (match-end 0))))
  258. (loop while (string-match "[\n]+" string)
  259. finally return string do
  260. (setq string (replace-match " " nil t string))))
  261. (defun ebrowse-width-of-drawable-area ()
  262. "Return the width of the display area for the current buffer.
  263. If buffer is displayed in a window, use that window's width,
  264. otherwise use the current frame's width."
  265. (let ((window (get-buffer-window (current-buffer))))
  266. (if window
  267. (window-width window)
  268. (frame-width))))
  269. ;;; Structure definitions
  270. (defstruct (ebrowse-hs (:type vector) :named)
  271. "Header structure found at the head of BROWSE files."
  272. ;; A version string that is compared against the version number of
  273. ;; the Lisp package when the file is loaded. This is done to
  274. ;; detect file format changes.
  275. version
  276. ;; Command line options used for producing the BROWSE file.
  277. command-line-options
  278. ;; The following slot is currently not used. It's kept to keep
  279. ;; the file format compatible.
  280. unused
  281. ;; A slot that is filled out after the tree is loaded. This slot is
  282. ;; set to a hash table mapping members to lists of classes in which
  283. ;; they are defined.
  284. member-table)
  285. (defstruct (ebrowse-ts (:type vector) :named)
  286. "Tree structure.
  287. Following the header structure, a BROWSE file contains a number
  288. of `ebrowse-ts' structures, each one describing one root class of
  289. the class hierarchy with all its subclasses."
  290. ;; A `ebrowse-cs' structure describing the root class.
  291. class
  292. ;; A list of `ebrowse-ts' structures for all subclasses.
  293. subclasses
  294. ;; Lists of `ebrowse-ms' structures for each member in a group of
  295. ;; members.
  296. member-variables member-functions static-variables static-functions
  297. friends types
  298. ;; List of `ebrowse-ts' structures for base classes. This slot is
  299. ;; filled at load time.
  300. base-classes
  301. ;; A marker slot used in the tree buffer (can be saved back to disk.
  302. mark)
  303. (defstruct (ebrowse-bs (:type vector) :named)
  304. "Common sub-structure.
  305. A common structure defining an occurrence of some name in the
  306. source files."
  307. ;; The class or member name as a string constant
  308. name
  309. ;; An optional string for the scope of nested classes or for
  310. ;; namespaces.
  311. scope
  312. ;; Various flags describing properties of classes/members, e.g. is
  313. ;; template, is const etc.
  314. flags
  315. ;; File in which the entity is found. If this is part of a
  316. ;; `ebrowse-ms' member description structure, and FILE is nil, then
  317. ;; search for the name in the SOURCE-FILE of the members class.
  318. file
  319. ;; Regular expression to search for. This slot can be a number in
  320. ;; which case the number is the file position at which the regular
  321. ;; expression is found in a separate regexp file (see the header
  322. ;; structure). This slot can be nil in which case the regular
  323. ;; expression will be generated from the class/member name.
  324. pattern
  325. ;; The buffer position at which the search for the class or member
  326. ;; will start.
  327. point)
  328. (defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
  329. "Class structure.
  330. This is the structure stored in the CLASS slot of a `ebrowse-ts'
  331. structure. It describes the location of the class declaration."
  332. source-file)
  333. (defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
  334. "Member structure.
  335. This is the structure describing a single member. The `ebrowse-ts'
  336. structure contains various lists for the different types of
  337. members."
  338. ;; Public, protected, private
  339. visibility
  340. ;; The file in which the member's definition can be found.
  341. definition-file
  342. ;; Same as PATTERN above, but for the member definition.
  343. definition-pattern
  344. ;; Same as POINT above but for member definition.
  345. definition-point)
  346. ;;; Some macros to access the FLAGS slot of a MEMBER.
  347. (defsubst ebrowse-member-bit-set-p (member bit)
  348. "Value is non-nil if MEMBER's bit BIT is set."
  349. (/= 0 (logand (ebrowse-bs-flags member) bit)))
  350. (defsubst ebrowse-virtual-p (member)
  351. "Value is non-nil if MEMBER is virtual."
  352. (ebrowse-member-bit-set-p member 1))
  353. (defsubst ebrowse-inline-p (member)
  354. "Value is non-nil if MEMBER is inline."
  355. (ebrowse-member-bit-set-p member 2))
  356. (defsubst ebrowse-const-p (member)
  357. "Value is non-nil if MEMBER is const."
  358. (ebrowse-member-bit-set-p member 4))
  359. (defsubst ebrowse-pure-virtual-p (member)
  360. "Value is non-nil if MEMBER is a pure virtual function."
  361. (ebrowse-member-bit-set-p member 8))
  362. (defsubst ebrowse-mutable-p (member)
  363. "Value is non-nil if MEMBER is mutable."
  364. (ebrowse-member-bit-set-p member 16))
  365. (defsubst ebrowse-template-p (member)
  366. "Value is non-nil if MEMBER is a template."
  367. (ebrowse-member-bit-set-p member 32))
  368. (defsubst ebrowse-explicit-p (member)
  369. "Value is non-nil if MEMBER is explicit."
  370. (ebrowse-member-bit-set-p member 64))
  371. (defsubst ebrowse-throw-list-p (member)
  372. "Value is non-nil if MEMBER has a throw specification."
  373. (ebrowse-member-bit-set-p member 128))
  374. (defsubst ebrowse-extern-c-p (member)
  375. "Value is non-nil if MEMBER.is `extern \"C\"'."
  376. (ebrowse-member-bit-set-p member 256))
  377. (defsubst ebrowse-define-p (member)
  378. "Value is non-nil if MEMBER is a define."
  379. (ebrowse-member-bit-set-p member 512))
  380. (defconst ebrowse-version-string "ebrowse 5.0"
  381. "Version string expected in BROWSE files.")
  382. (defconst ebrowse-globals-name "*Globals*"
  383. "The name used for the surrogate class.containing global entities.
  384. This must be the same that `ebrowse' uses.")
  385. (defvar ebrowse--last-regexp nil
  386. "Last regular expression searched for in tree and member buffers.
  387. Each tree and member buffer maintains its own search history.")
  388. (make-variable-buffer-local 'ebrowse--last-regexp)
  389. (defconst ebrowse-member-list-accessors
  390. '(ebrowse-ts-member-variables
  391. ebrowse-ts-member-functions
  392. ebrowse-ts-static-variables
  393. ebrowse-ts-static-functions
  394. ebrowse-ts-friends
  395. ebrowse-ts-types)
  396. "List of accessors for member lists.
  397. Each element is the symbol of an accessor function.
  398. The nth element must be the accessor for the nth member list
  399. in an `ebrowse-ts' structure.")
  400. ;;; FIXME: Add more doc strings for the buffer-local variables below.
  401. (defvar ebrowse--tree-obarray nil
  402. "Obarray holding all `ebrowse-ts' structures of a class tree.
  403. Buffer-local in Ebrowse buffers.")
  404. (defvar ebrowse--tags-file-name nil
  405. "File from which BROWSE file was loaded.
  406. Buffer-local in Ebrowse buffers.")
  407. (defvar ebrowse--header nil
  408. "Header structure of type `ebrowse-hs' of a class tree.
  409. Buffer-local in Ebrowse buffers.")
  410. (defvar ebrowse--frozen-flag nil
  411. "Non-nil means an Ebrowse buffer won't be reused.
  412. Buffer-local in Ebrowse buffers.")
  413. (defvar ebrowse--show-file-names-flag nil
  414. "Non-nil means show file names in a tree buffer.
  415. Buffer-local in Ebrowse tree buffers.")
  416. (defvar ebrowse--long-display-flag nil
  417. "Non-nil means show members in long display form.
  418. Buffer-local in Ebrowse member buffers.")
  419. (defvar ebrowse--n-columns nil
  420. "Number of columns to display for short member display form.
  421. Buffer-local in Ebrowse member buffers.")
  422. (defvar ebrowse--column-width nil
  423. "Width of a columns to display for short member display form.
  424. Buffer-local in Ebrowse member buffers.")
  425. (defvar ebrowse--virtual-display-flag nil
  426. "Non-nil means display virtual members in a member buffer.
  427. Buffer-local in Ebrowse member buffers.")
  428. (defvar ebrowse--inline-display-flag nil
  429. "Non-nil means display inline members in a member buffer.
  430. Buffer-local in Ebrowse member buffers.")
  431. (defvar ebrowse--const-display-flag nil
  432. "Non-nil means display const members in a member buffer.
  433. Buffer-local in Ebrowse member buffers.")
  434. (defvar ebrowse--pure-display-flag nil
  435. "Non-nil means display pure virtual members in a member buffer.
  436. Buffer-local in Ebrowse member buffers.")
  437. (defvar ebrowse--filters nil
  438. "Filter for display of public, protected, and private members.
  439. This is a vector of three elements. An element nil means the
  440. corresponding members are not shown.
  441. Buffer-local in Ebrowse member buffers.")
  442. (defvar ebrowse--show-inherited-flag nil
  443. "Non-nil means display inherited members in a member buffer.
  444. Buffer-local in Ebrowse member buffers.")
  445. (defvar ebrowse--attributes-flag nil
  446. "Non-nil means display member attributes in a member buffer.
  447. Buffer-local in Ebrowse member buffers.")
  448. (defvar ebrowse--source-regexp-flag nil
  449. "Non-nil means display member regexps in a member buffer.
  450. Buffer-local in Ebrowse member buffers.")
  451. (defvar ebrowse--displayed-class nil
  452. "Class displayed in a member buffer, a `ebrowse-ts' structure.
  453. Buffer-local in Ebrowse member buffers.")
  454. (defvar ebrowse--accessor nil
  455. "Member list displayed in a member buffer.
  456. This is a symbol whose function definition is an accessor for the
  457. member list in `ebrowse-cs' structures.
  458. Buffer-local in Ebrowse member buffers.")
  459. (defvar ebrowse--member-list nil
  460. "The list of `ebrowse-ms' structures displayed in a member buffer.
  461. Buffer-local in Ebrowse member buffers.")
  462. (defvar ebrowse--decl-column nil
  463. "Column in which declarations are displayed in member buffers.
  464. Buffer-local in Ebrowse member buffers.")
  465. (defvar ebrowse--frame-configuration nil
  466. "Frame configuration saved when viewing a class/member in another frame.
  467. Buffer-local in Ebrowse buffers.")
  468. (defvar ebrowse--view-exit-action nil
  469. "Action to perform after viewing a class/member.
  470. Either `kill-buffer' or nil.
  471. Buffer-local in Ebrowse buffers.")
  472. (defvar ebrowse--tree nil
  473. "Class tree.
  474. Buffer-local in Ebrowse buffers.")
  475. ;;; Temporaries used to communicate with `ebrowse-find-pattern'.
  476. (defvar ebrowse-temp-position-to-view nil)
  477. (defvar ebrowse-temp-info-to-view nil)
  478. (defvar ebrowse-tree-mode-map ()
  479. "The keymap used in tree mode buffers.")
  480. (defvar ebrowse--member-mode-strings nil
  481. "Strings displayed in the mode line of member buffers.")
  482. (defvar ebrowse-member-mode-map ()
  483. "The keymap used in the member buffers.")
  484. ;;; Define mode line titles for each member list.
  485. (put 'ebrowse-ts-member-variables 'ebrowse-title "Member Variables")
  486. (put 'ebrowse-ts-member-functions 'ebrowse-title "Member Functions")
  487. (put 'ebrowse-ts-static-variables 'ebrowse-title "Static Variables")
  488. (put 'ebrowse-ts-static-functions 'ebrowse-title "Static Functions")
  489. (put 'ebrowse-ts-friends 'ebrowse-title "Friends")
  490. (put 'ebrowse-ts-types 'ebrowse-title "Types")
  491. (put 'ebrowse-ts-member-variables 'ebrowse-global-title "Global Variables")
  492. (put 'ebrowse-ts-member-functions 'ebrowse-global-title "Global Functions")
  493. (put 'ebrowse-ts-static-variables 'ebrowse-global-title "Static Variables")
  494. (put 'ebrowse-ts-static-functions 'ebrowse-global-title "Static Functions")
  495. (put 'ebrowse-ts-friends 'ebrowse-global-title "Defines")
  496. (put 'ebrowse-ts-types 'ebrowse-global-title "Types")
  497. ;;; Operations on `ebrowse-ts' structures
  498. (defun ebrowse-files-table (&optional marked-only)
  499. "Return an obarray containing all files mentioned in the current tree.
  500. The tree is expected in the buffer-local variable `ebrowse--tree-obarray'.
  501. MARKED-ONLY non-nil means include marked classes only."
  502. (let ((files (make-hash-table :test 'equal))
  503. (i -1))
  504. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  505. (when (or (not marked-only) (ebrowse-ts-mark tree))
  506. (let ((class (ebrowse-ts-class tree)))
  507. (when (zerop (% (incf i) 20))
  508. (ebrowse-show-progress "Preparing file list" (zerop i)))
  509. ;; Add files mentioned in class description
  510. (let ((source-file (ebrowse-cs-source-file class))
  511. (file (ebrowse-cs-file class)))
  512. (when source-file
  513. (puthash source-file source-file files))
  514. (when file
  515. (puthash file file files))
  516. ;; For all member lists in this class
  517. (loop for accessor in ebrowse-member-list-accessors do
  518. (loop for m in (funcall accessor tree)
  519. for file = (ebrowse-ms-file m)
  520. for def-file = (ebrowse-ms-definition-file m) do
  521. (when file
  522. (puthash file file files))
  523. (when def-file
  524. (puthash def-file def-file files))))))))
  525. files))
  526. (defun ebrowse-files-list (&optional marked-only)
  527. "Return a list containing all files mentioned in a tree.
  528. MARKED-ONLY non-nil means include marked classes only."
  529. (let (list)
  530. (maphash (lambda (file _dummy) (setq list (cons file list)))
  531. (ebrowse-files-table marked-only))
  532. list))
  533. (defun* ebrowse-marked-classes-p ()
  534. "Value is non-nil if any class in the current class tree is marked."
  535. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  536. (when (ebrowse-ts-mark tree)
  537. (return-from ebrowse-marked-classes-p tree))))
  538. (defsubst ebrowse-globals-tree-p (tree)
  539. "Return t if TREE is the one for global entities."
  540. (string= (ebrowse-bs-name (ebrowse-ts-class tree))
  541. ebrowse-globals-name))
  542. (defsubst ebrowse-qualified-class-name (class)
  543. "Return the name of CLASS with scope prepended, if any."
  544. (if (ebrowse-cs-scope class)
  545. (concat (ebrowse-cs-scope class) "::" (ebrowse-cs-name class))
  546. (ebrowse-cs-name class)))
  547. (defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p)
  548. "Return an alist describing all classes in a tree.
  549. Each elements in the list has the form (CLASS-NAME . TREE).
  550. CLASS-NAME is the name of the class. TREE is the
  551. class tree whose root is QUALIFIED-CLASS-NAME.
  552. QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
  553. The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
  554. (let (alist)
  555. (if qualified-names-p
  556. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  557. (setq alist
  558. (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree))
  559. tree alist)))
  560. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  561. (setq alist
  562. (acons (ebrowse-cs-name (ebrowse-ts-class tree))
  563. tree alist))))
  564. alist))
  565. (defun ebrowse-sort-tree-list (list)
  566. "Sort a LIST of `ebrowse-ts' structures by qualified class names."
  567. (sort list
  568. (lambda (a b)
  569. (string< (ebrowse-qualified-class-name (ebrowse-ts-class a))
  570. (ebrowse-qualified-class-name (ebrowse-ts-class b))))))
  571. (defun ebrowse-class-in-tree (class tree)
  572. "Search for a class with name CLASS in TREE.
  573. If CLASS is found, return the tail of TREE starting at CLASS. This function
  574. is used during the load phase where classes appended to a file replace older
  575. class information."
  576. (let ((tclass (ebrowse-ts-class class))
  577. found)
  578. (while (and tree (not found))
  579. (let ((root-ptr tree))
  580. (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class (car root-ptr)))
  581. (ebrowse-qualified-class-name tclass))
  582. (setq found root-ptr))
  583. (setq tree (cdr tree))))
  584. found))
  585. (defun ebrowse-base-classes (tree)
  586. "Return list of base-classes of TREE by searching subclass lists.
  587. This function must be used instead of the struct slot
  588. `base-classes' to access the base-class list directly because it
  589. computes this information lazily."
  590. (or (ebrowse-ts-base-classes tree)
  591. (setf (ebrowse-ts-base-classes tree)
  592. (loop with to-search = (list tree)
  593. with result = nil
  594. as search = (pop to-search)
  595. while search finally return result
  596. do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
  597. (when (memq search (ebrowse-ts-subclasses ti))
  598. (unless (memq ti result)
  599. (setq result (nconc result (list ti))))
  600. (push ti to-search)))))))
  601. (defun ebrowse-direct-base-classes (tree)
  602. "Return the list of direct super classes of TREE."
  603. (let (result)
  604. (dolist (s (ebrowse-base-classes tree))
  605. (when (memq tree (ebrowse-ts-subclasses s))
  606. (setq result (cons s result))))
  607. result))
  608. ;;; Operations on MEMBER structures/lists
  609. (defun ebrowse-name/accessor-alist (tree accessor)
  610. "Return an alist containing all members of TREE in group ACCESSOR.
  611. ACCESSOR is the accessor function for the member list.
  612. Elements of the result have the form (NAME . ACCESSOR), where NAME
  613. is the member name."
  614. (loop for member in (funcall accessor tree)
  615. collect (cons (ebrowse-ms-name member) accessor)))
  616. (defun ebrowse-name/accessor-alist-for-visible-members ()
  617. "Return an alist describing all members visible in the current buffer.
  618. Each element of the list has the form (MEMBER-NAME . ACCESSOR),
  619. where MEMBER-NAME is the member's name, and ACCESSOR is the struct
  620. accessor with which the member's list can be accessed in an `ebrowse-ts'
  621. structure. The list includes inherited members if these are visible."
  622. (let* ((list (ebrowse-name/accessor-alist ebrowse--displayed-class
  623. ebrowse--accessor)))
  624. (if ebrowse--show-inherited-flag
  625. (nconc list
  626. (loop for tree in (ebrowse-base-classes
  627. ebrowse--displayed-class)
  628. nconc (ebrowse-name/accessor-alist
  629. tree ebrowse--accessor)))
  630. list)))
  631. (defun ebrowse-name/accessor-alist-for-class-members ()
  632. "Like `ebrowse-name/accessor-alist-for-visible-members'.
  633. This function includes members of base classes if base class members
  634. are visible in the buffer."
  635. (let (list)
  636. (dolist (func ebrowse-member-list-accessors list)
  637. (setq list (nconc list (ebrowse-name/accessor-alist
  638. ebrowse--displayed-class func)))
  639. (when ebrowse--show-inherited-flag
  640. (dolist (class (ebrowse-base-classes ebrowse--displayed-class))
  641. (setq list
  642. (nconc list (ebrowse-name/accessor-alist class func))))))))
  643. ;;; Progress indication
  644. (defvar ebrowse-n-boxes 0)
  645. (defconst ebrowse-max-boxes 60)
  646. (defun ebrowse-show-progress (title &optional start)
  647. "Display a progress indicator.
  648. TITLE is the title of the progress message. START non-nil means
  649. this is the first progress message displayed."
  650. (let (message-log-max)
  651. (when start (setq ebrowse-n-boxes 0))
  652. (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes))
  653. (message "%s: %s" title
  654. (propertize (make-string ebrowse-n-boxes
  655. (if (display-color-p) ?\ ?+))
  656. 'face 'ebrowse-progress))))
  657. ;;; Reading a tree from disk
  658. (defun ebrowse-read ()
  659. "Read `ebrowse-hs' and `ebrowse-ts' structures in the current buffer.
  660. Return a list (HEADER TREE) where HEADER is the file header read
  661. and TREE is a list of `ebrowse-ts' structures forming the class tree."
  662. (let ((header (condition-case nil
  663. (read (current-buffer))
  664. (error (error "No Ebrowse file header found"))))
  665. tree)
  666. ;; Check file format.
  667. (unless (ebrowse-hs-p header)
  668. (error "No Ebrowse file header found"))
  669. (unless (string= (ebrowse-hs-version header) ebrowse-version-string)
  670. (error "File has wrong version `%s' (`%s' expected)"
  671. (ebrowse-hs-version header) ebrowse-version-string))
  672. ;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to
  673. ;; prevent a GC that would not free any memory.
  674. (let ((gc-cons-threshold 2000000))
  675. (while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
  676. (let* ((root (read (current-buffer)))
  677. (old-root-ptr (ebrowse-class-in-tree root tree)))
  678. (ebrowse-show-progress "Reading data" (null tree))
  679. (if old-root-ptr
  680. (setcar old-root-ptr root)
  681. (push root tree)))))
  682. (garbage-collect)
  683. (list header tree)))
  684. (defun ebrowse-revert-tree-buffer-from-file (_ignore-auto-save noconfirm)
  685. "Function installed as `revert-buffer-function' in tree buffers.
  686. See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
  687. NOCONFIRM."
  688. (when (or noconfirm (yes-or-no-p "Revert tree from disk? "))
  689. (loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
  690. do (kill-buffer member-buffer))
  691. (erase-buffer)
  692. (with-no-warnings
  693. (insert-file (or buffer-file-name ebrowse--tags-file-name)))
  694. (ebrowse-tree-mode)
  695. (current-buffer)))
  696. (defun ebrowse-create-tree-buffer (tree tags-file header classes pop)
  697. "Create a new tree buffer for tree TREE.
  698. The tree was loaded from file TAGS-FILE.
  699. HEADER is the header structure of the file.
  700. CLASSES is an obarray with a symbol for each class in the tree.
  701. POP non-nil means popup the buffer up at the end.
  702. Return the buffer created."
  703. (let ((name ebrowse-tree-buffer-name))
  704. (set-buffer (get-buffer-create name))
  705. (ebrowse-tree-mode)
  706. (setq ebrowse--tree tree
  707. ebrowse--tags-file-name tags-file
  708. ebrowse--tree-obarray classes
  709. ebrowse--header header
  710. ebrowse--frozen-flag nil)
  711. (ebrowse-redraw-tree)
  712. (set-buffer-modified-p nil)
  713. (case pop
  714. (switch (switch-to-buffer name))
  715. (pop (pop-to-buffer name)))
  716. (current-buffer)))
  717. ;;; Operations for member obarrays
  718. (defun ebrowse-fill-member-table ()
  719. "Return an obarray holding all members of all classes in the current tree.
  720. For each member, a symbol is added to the obarray. Members are
  721. extracted from the buffer-local tree `ebrowse--tree-obarray'.
  722. Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
  723. MEMBER) where TREE is the tree in which the member is defined,
  724. MEMBER-LIST is a symbol describing the member list in which the member
  725. is found, and MEMBER is a MEMBER structure describing the member.
  726. The slot `member-table' of the buffer-local header structure of
  727. type `ebrowse-hs' is set to the resulting obarray."
  728. (let ((members (make-hash-table :test 'equal))
  729. (i -1))
  730. (setf (ebrowse-hs-member-table ebrowse--header) nil)
  731. (garbage-collect)
  732. ;; For all classes...
  733. (ebrowse-for-all-trees (c ebrowse--tree-obarray)
  734. (when (zerop (% (incf i) 10))
  735. (ebrowse-show-progress "Preparing member lookup" (zerop i)))
  736. (loop for f in ebrowse-member-list-accessors do
  737. (loop for m in (funcall f c) do
  738. (let* ((member-name (ebrowse-ms-name m))
  739. (value (gethash member-name members)))
  740. (push (list c f m) value)
  741. (puthash member-name value members)))))
  742. (setf (ebrowse-hs-member-table ebrowse--header) members)))
  743. (defun ebrowse-member-table (header)
  744. "Return the member obarray. Build it if it hasn't been set up yet.
  745. HEADER is the tree header structure of the class tree."
  746. (when (null (ebrowse-hs-member-table header))
  747. (loop for buffer in (ebrowse-browser-buffer-list)
  748. until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
  749. finally do
  750. (with-current-buffer buffer
  751. (ebrowse-fill-member-table))))
  752. (ebrowse-hs-member-table header))
  753. ;;; Operations on TREE obarrays
  754. (defun ebrowse-build-tree-obarray (tree)
  755. "Make sure every class in TREE is represented by a unique object.
  756. Build obarray of all classes in TREE."
  757. (let ((classes (make-vector 127 0)))
  758. ;; Add root classes...
  759. (loop for root in tree
  760. as sym =
  761. (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes)
  762. do (unless (get sym 'ebrowse-root)
  763. (setf (get sym 'ebrowse-root) root)))
  764. ;; Process subclasses
  765. (ebrowse-insert-supers tree classes)
  766. classes))
  767. (defun ebrowse-insert-supers (tree classes)
  768. "Build base class lists in class tree TREE.
  769. CLASSES is an obarray used to collect classes.
  770. Helper function for `ebrowse-build-tree-obarray'. Base classes should
  771. be ordered so that immediate base classes come first, then the base
  772. class of the immediate base class and so on. This means that we must
  773. construct the base-class list top down with adding each level at the
  774. beginning of the base-class list.
  775. We have to be cautious here not to end up in an infinite recursion
  776. if for some reason a circle is in the inheritance graph."
  777. (loop for class in tree
  778. as subclasses = (ebrowse-ts-subclasses class) do
  779. ;; Make sure every class is represented by a unique object
  780. (loop for subclass on subclasses
  781. as sym = (intern
  782. (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass)))
  783. classes)
  784. as next = nil
  785. do
  786. ;; Replace the subclass tree with the one found in
  787. ;; CLASSES if there is already an entry for that class
  788. ;; in it. Otherwise make a new entry.
  789. ;;
  790. ;; CAVEAT: If by some means (e.g., use of the
  791. ;; preprocessor in class declarations, a name is marked
  792. ;; as a subclass of itself on some path, we would end up
  793. ;; in an endless loop. We have to omit subclasses from
  794. ;; the recursion that already have been processed.
  795. (if (get sym 'ebrowse-root)
  796. (setf (car subclass) (get sym 'ebrowse-root))
  797. (setf (get sym 'ebrowse-root) (car subclass))))
  798. ;; Process subclasses
  799. (ebrowse-insert-supers subclasses classes)))
  800. ;;; Tree buffers
  801. (unless ebrowse-tree-mode-map
  802. (let ((map (make-keymap)))
  803. (setf ebrowse-tree-mode-map map)
  804. (suppress-keymap map)
  805. (when (display-mouse-p)
  806. (define-key map [down-mouse-3] 'ebrowse-mouse-3-in-tree-buffer)
  807. (define-key map [mouse-2] 'ebrowse-mouse-2-in-tree-buffer)
  808. (define-key map [down-mouse-1] 'ebrowse-mouse-1-in-tree-buffer))
  809. (let ((map1 (make-sparse-keymap)))
  810. (suppress-keymap map1 t)
  811. (define-key map "L" map1)
  812. (define-key map1 "d" 'ebrowse-tree-command:show-friends)
  813. (define-key map1 "f" 'ebrowse-tree-command:show-member-functions)
  814. (define-key map1 "F" 'ebrowse-tree-command:show-static-member-functions)
  815. (define-key map1 "t" 'ebrowse-tree-command:show-types)
  816. (define-key map1 "v" 'ebrowse-tree-command:show-member-variables)
  817. (define-key map1 "V" 'ebrowse-tree-command:show-static-member-variables))
  818. (let ((map1 (make-sparse-keymap)))
  819. (suppress-keymap map1 t)
  820. (define-key map "M" map1)
  821. (define-key map1 "a" 'ebrowse-mark-all-classes)
  822. (define-key map1 "t" 'ebrowse-toggle-mark-at-point))
  823. (let ((map1 (make-sparse-keymap)))
  824. (suppress-keymap map1 t)
  825. (define-key map "T" map1)
  826. (define-key map1 "f" 'ebrowse-toggle-file-name-display)
  827. (define-key map1 "s" 'ebrowse-show-file-name-at-point)
  828. (define-key map1 "w" 'ebrowse-set-tree-indentation)
  829. (define-key map "x" 'ebrowse-statistics))
  830. (define-key map "n" 'ebrowse-repeat-member-search)
  831. (define-key map "q" 'bury-buffer)
  832. (define-key map "*" 'ebrowse-expand-all)
  833. (define-key map "+" 'ebrowse-expand-branch)
  834. (define-key map "-" 'ebrowse-collapse-branch)
  835. (define-key map "/" 'ebrowse-read-class-name-and-go)
  836. (define-key map " " 'ebrowse-view-class-declaration)
  837. (define-key map "?" 'describe-mode)
  838. (define-key map "\C-i" 'ebrowse-pop/switch-to-member-buffer-for-same-tree)
  839. (define-key map "\C-k" 'ebrowse-remove-class-at-point)
  840. (define-key map "\C-l" 'ebrowse-redraw-tree)
  841. (define-key map "\C-m" 'ebrowse-find-class-declaration)))
  842. ;;; Tree-mode - mode for tree buffers
  843. ;;;###autoload
  844. (define-derived-mode ebrowse-tree-mode special-mode "Ebrowse-Tree"
  845. "Major mode for Ebrowse class tree buffers.
  846. Each line corresponds to a class in a class tree.
  847. Letters do not insert themselves, they are commands.
  848. File operations in the tree buffer work on class tree data structures.
  849. E.g.\\[save-buffer] writes the tree to the file it was loaded from.
  850. Tree mode key bindings:
  851. \\{ebrowse-tree-mode-map}"
  852. (let* ((ident (propertized-buffer-identification "C++ Tree"))
  853. (inhibit-read-only t)
  854. header tree)
  855. (buffer-disable-undo)
  856. (unless (zerop (buffer-size))
  857. (goto-char (point-min))
  858. (multiple-value-setq (header tree) (values-list (ebrowse-read)))
  859. (message "Sorting. Please be patient...")
  860. (setq tree (ebrowse-sort-tree-list tree))
  861. (erase-buffer)
  862. (message nil))
  863. (set (make-local-variable 'ebrowse--show-file-names-flag) nil)
  864. (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0))
  865. (set (make-local-variable 'ebrowse--frozen-flag) nil)
  866. (setq mode-line-buffer-identification ident)
  867. (setq buffer-read-only t)
  868. (setq selective-display t)
  869. (setq selective-display-ellipses t)
  870. (set (make-local-variable 'revert-buffer-function)
  871. #'ebrowse-revert-tree-buffer-from-file)
  872. (set (make-local-variable 'ebrowse--header) header)
  873. (set (make-local-variable 'ebrowse--tree) tree)
  874. (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name)
  875. (set (make-local-variable 'ebrowse--tree-obarray)
  876. (and tree (ebrowse-build-tree-obarray tree)))
  877. (set (make-local-variable 'ebrowse--frozen-flag) nil)
  878. (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn nil t)
  879. (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
  880. (when tree
  881. (ebrowse-redraw-tree)
  882. (set-buffer-modified-p nil))))
  883. (defun ebrowse-update-tree-buffer-mode-line ()
  884. "Update the tree buffer mode line."
  885. (ebrowse-rename-buffer (if ebrowse--frozen-flag
  886. (ebrowse-frozen-tree-buffer-name
  887. ebrowse--tags-file-name)
  888. ebrowse-tree-buffer-name))
  889. (force-mode-line-update))
  890. ;;; Removing classes from trees
  891. (defun ebrowse-remove-class-and-kill-member-buffers (tree class)
  892. "Remove from TREE class CLASS.
  893. Kill all member buffers still containing a reference to the class."
  894. (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class))
  895. ebrowse--tree-obarray)))
  896. (setf tree (delq class tree)
  897. (get sym 'ebrowse-root) nil)
  898. (dolist (root tree)
  899. (setf (ebrowse-ts-subclasses root)
  900. (delq class (ebrowse-ts-subclasses root))
  901. (ebrowse-ts-base-classes root) nil)
  902. (ebrowse-remove-class-and-kill-member-buffers
  903. (ebrowse-ts-subclasses root) class))
  904. (ebrowse-kill-member-buffers-displaying class)
  905. tree))
  906. (defun ebrowse-remove-class-at-point (forced)
  907. "Remove the class point is on from the class tree.
  908. Do not ask for confirmation if FORCED is non-nil."
  909. (interactive "P")
  910. (let* ((class (ebrowse-tree-at-point))
  911. (class-name (ebrowse-cs-name (ebrowse-ts-class class)))
  912. (subclasses (ebrowse-ts-subclasses class)))
  913. (cond ((or forced
  914. (y-or-n-p (concat "Delete class " class-name "? ")))
  915. (setf ebrowse--tree (ebrowse-remove-class-and-kill-member-buffers
  916. ebrowse--tree class))
  917. (set-buffer-modified-p t)
  918. (message "%s %sdeleted." class-name
  919. (if subclasses "and derived classes " ""))
  920. (ebrowse-redraw-tree))
  921. (t (message "Aborted")))))
  922. ;;; Marking classes in the tree buffer
  923. (defun ebrowse-toggle-mark-at-point (&optional n-times)
  924. "Toggle mark for class cursor is on.
  925. If given a numeric N-TIMES argument, mark that many classes."
  926. (interactive "p")
  927. (let (to-change)
  928. ;; Get the classes whose mark must be toggled. Note that
  929. ;; ebrowse-tree-at-point might issue an error.
  930. (ignore-errors
  931. (loop repeat (or n-times 1)
  932. as tree = (ebrowse-tree-at-point)
  933. do (progn
  934. (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
  935. (forward-line 1)
  936. (push tree to-change))))
  937. (save-excursion
  938. ;; For all these classes, reverse the mark char in the display
  939. ;; by a regexp replace over the whole buffer. The reason for this
  940. ;; is that classes might have multiple base classes. If this is
  941. ;; the case, they are displayed more than once in the tree.
  942. (ebrowse-output
  943. (loop for tree in to-change
  944. as regexp = (concat "^.*\\b"
  945. (regexp-quote
  946. (ebrowse-cs-name (ebrowse-ts-class tree)))
  947. "\\b")
  948. do
  949. (goto-char (point-min))
  950. (loop while (re-search-forward regexp nil t)
  951. do (progn
  952. (goto-char (match-beginning 0))
  953. (delete-char 1)
  954. (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
  955. (ebrowse-set-mark-props (1- (point)) (point) tree)
  956. (goto-char (match-end 0)))))))))
  957. (defun ebrowse-mark-all-classes (prefix)
  958. "Unmark, with PREFIX mark, all classes in the tree."
  959. (interactive "P")
  960. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  961. (setf (ebrowse-ts-mark tree) prefix))
  962. (ebrowse-redraw-marks (point-min) (point-max)))
  963. (defun ebrowse-redraw-marks (start end)
  964. "Display class marker signs in the tree between START and END."
  965. (interactive)
  966. (save-excursion
  967. (ebrowse-output
  968. (catch 'end
  969. (goto-char (point-min))
  970. (dolist (root ebrowse--tree)
  971. (ebrowse-draw-marks-fn root start end))))
  972. (ebrowse-update-tree-buffer-mode-line)))
  973. (defun ebrowse-draw-marks-fn (tree start end)
  974. "Display class marker signs in TREE between START and END."
  975. (when (>= (point) start)
  976. (delete-char 1)
  977. (insert (if (ebrowse-ts-mark tree) ?> ? ))
  978. (ebrowse-set-mark-props (1- (point)) (point) tree))
  979. (forward-line 1)
  980. (when (> (point) end)
  981. (throw 'end nil))
  982. (dolist (sub (ebrowse-ts-subclasses tree))
  983. (ebrowse-draw-marks-fn sub start end)))
  984. ;;; File name display in tree buffers
  985. (defun ebrowse-show-file-name-at-point (prefix)
  986. "Show filename in the line point is in.
  987. With PREFIX, insert that many filenames."
  988. (interactive "p")
  989. (unless ebrowse--show-file-names-flag
  990. (ebrowse-output
  991. (dotimes (i prefix)
  992. (let ((tree (ebrowse-tree-at-point))
  993. start
  994. file-name-existing)
  995. (beginning-of-line)
  996. (skip-chars-forward " \t*a-zA-Z0-9_")
  997. (setq start (point)
  998. file-name-existing (looking-at "("))
  999. (delete-region start (line-end-position))
  1000. (unless file-name-existing
  1001. (indent-to ebrowse-source-file-column)
  1002. (insert "(" (or (ebrowse-cs-file
  1003. (ebrowse-ts-class tree))
  1004. "unknown")
  1005. ")"))
  1006. (ebrowse-set-face start (point) 'ebrowse-file-name)
  1007. (beginning-of-line)
  1008. (forward-line 1))))))
  1009. (defun ebrowse-toggle-file-name-display ()
  1010. "Toggle display of filenames in tree buffer."
  1011. (interactive)
  1012. (setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag))
  1013. (let ((old-line (count-lines (point-min) (point))))
  1014. (ebrowse-redraw-tree)
  1015. (goto-char (point-min))
  1016. (forward-line (1- old-line))))
  1017. ;;; General member and tree buffer functions
  1018. (defun ebrowse-member-buffer-p (buffer)
  1019. "Value is non-nil if BUFFER is a member buffer."
  1020. ;; FIXME: Why not (buffer-local-value 'major-mode buffer)?
  1021. (eq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
  1022. 'ebrowse-member-mode))
  1023. (defun ebrowse-tree-buffer-p (buffer)
  1024. "Value is non-nil if BUFFER is a class tree buffer."
  1025. (eq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
  1026. 'ebrowse-tree-mode))
  1027. (defun ebrowse-buffer-p (buffer)
  1028. "Value is non-nil if BUFFER is a tree or member buffer."
  1029. (memq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
  1030. '(ebrowse-tree-mode ebrowse-member-mode)))
  1031. (defun ebrowse-browser-buffer-list ()
  1032. "Return a list of all tree or member buffers."
  1033. (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list)))
  1034. (defun ebrowse-member-buffer-list ()
  1035. "Return a list of all member buffers."
  1036. (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list)))
  1037. (defun ebrowse-tree-buffer-list ()
  1038. "Return a list of all tree buffers."
  1039. (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list)))
  1040. (defun ebrowse-known-class-trees-buffer-list ()
  1041. "Return a list of buffers containing class trees.
  1042. The list will contain, for each class tree loaded,
  1043. one buffer. Prefer tree buffers over member buffers."
  1044. (let ((buffers (nconc (ebrowse-tree-buffer-list)
  1045. (ebrowse-member-buffer-list)))
  1046. (set (make-hash-table))
  1047. result)
  1048. (dolist (buffer buffers)
  1049. (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer)))
  1050. (unless (gethash tree set)
  1051. (push buffer result))
  1052. (puthash tree t set)))
  1053. result))
  1054. (defun ebrowse-same-tree-member-buffer-list ()
  1055. "Return a list of members buffers with same tree as current buffer."
  1056. (ebrowse-delete-if-not
  1057. (lambda (buffer)
  1058. (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer)
  1059. ebrowse--tree))
  1060. (ebrowse-member-buffer-list)))
  1061. (defun ebrowse-pop/switch-to-member-buffer-for-same-tree (arg)
  1062. "Pop to the buffer displaying members.
  1063. Switch to buffer if prefix ARG.
  1064. If no member buffer exists, make one."
  1065. (interactive "P")
  1066. (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
  1067. (get-buffer ebrowse-member-buffer-name)
  1068. (ebrowse-tree-command:show-member-functions))))
  1069. (when buf
  1070. (if arg
  1071. (switch-to-buffer buf)
  1072. (pop-to-buffer buf)))
  1073. buf))
  1074. (defun ebrowse-switch-to-next-member-buffer ()
  1075. "Switch to next member buffer."
  1076. (interactive)
  1077. (let* ((list (ebrowse-member-buffer-list))
  1078. (next-list (cdr (memq (current-buffer) list)))
  1079. (next-buffer (if next-list (car next-list) (car list))))
  1080. (if (eq next-buffer (current-buffer))
  1081. (error "No next buffer")
  1082. (bury-buffer)
  1083. (switch-to-buffer next-buffer))))
  1084. (defun ebrowse-kill-member-buffers-displaying (tree)
  1085. "Kill all member buffers displaying TREE."
  1086. (loop for buffer in (ebrowse-member-buffer-list)
  1087. as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer)
  1088. when (eq class tree) do (kill-buffer buffer)))
  1089. (defun ebrowse-frozen-tree-buffer-name (tags-file)
  1090. "Return the buffer name of a tree which is associated TAGS-FILE."
  1091. (concat ebrowse-tree-buffer-name " (" tags-file ")"))
  1092. (defun ebrowse-pop-to-browser-buffer (arg)
  1093. "Pop to a browser buffer from any other buffer.
  1094. Pop to member buffer if no prefix ARG, to tree buffer otherwise."
  1095. (interactive "P")
  1096. (let ((buffer (get-buffer (if arg
  1097. ebrowse-tree-buffer-name
  1098. ebrowse-member-buffer-name))))
  1099. (unless buffer
  1100. (setq buffer
  1101. (get-buffer (if arg
  1102. ebrowse-member-buffer-name
  1103. ebrowse-tree-buffer-name))))
  1104. (unless buffer
  1105. (error "No browser buffer found"))
  1106. (pop-to-buffer buffer)))
  1107. ;;; Misc tree buffer commands
  1108. (defun ebrowse-set-tree-indentation ()
  1109. "Set the indentation width of the tree display."
  1110. (interactive)
  1111. (let ((width (string-to-number (read-string
  1112. (concat "Indentation (default "
  1113. (int-to-string ebrowse--indentation)
  1114. "): ")
  1115. nil nil ebrowse--indentation))))
  1116. (when (plusp width)
  1117. (set (make-local-variable 'ebrowse--indentation) width)
  1118. (ebrowse-redraw-tree))))
  1119. (defun ebrowse-read-class-name-and-go (&optional class)
  1120. "Position cursor on CLASS.
  1121. Read a class name from the minibuffer if CLASS is nil."
  1122. (interactive)
  1123. (ebrowse-ignoring-completion-case
  1124. ;; If no class specified, read the class name from mini-buffer
  1125. (unless class
  1126. (setf class
  1127. (completing-read "Goto class: "
  1128. (ebrowse-tree-obarray-as-alist) nil t)))
  1129. (ebrowse-save-selective
  1130. (goto-char (point-min))
  1131. (widen)
  1132. (setf selective-display nil)
  1133. (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
  1134. (if (re-search-forward ebrowse--last-regexp nil t)
  1135. (progn
  1136. (goto-char (match-beginning 0))
  1137. (ebrowse-unhide-base-classes))
  1138. (error "Not found")))))
  1139. ;;; Showing various kinds of member buffers
  1140. (defun ebrowse-tree-command:show-member-variables (arg)
  1141. "Display member variables; with prefix ARG in frozen member buffer."
  1142. (interactive "P")
  1143. (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg))
  1144. (defun ebrowse-tree-command:show-member-functions (&optional arg)
  1145. "Display member functions; with prefix ARG in frozen member buffer."
  1146. (interactive "P")
  1147. (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg))
  1148. (defun ebrowse-tree-command:show-static-member-variables (arg)
  1149. "Display static member variables; with prefix ARG in frozen member buffer."
  1150. (interactive "P")
  1151. (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg))
  1152. (defun ebrowse-tree-command:show-static-member-functions (arg)
  1153. "Display static member functions; with prefix ARG in frozen member buffer."
  1154. (interactive "P")
  1155. (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg))
  1156. (defun ebrowse-tree-command:show-friends (arg)
  1157. "Display friend functions; with prefix ARG in frozen member buffer."
  1158. (interactive "P")
  1159. (ebrowse-display-member-buffer 'ebrowse-ts-friends arg))
  1160. (defun ebrowse-tree-command:show-types (arg)
  1161. "Display types defined in a class; with prefix ARG in frozen member buffer."
  1162. (interactive "P")
  1163. (ebrowse-display-member-buffer 'ebrowse-ts-types arg))
  1164. ;;; Viewing or finding a class declaration
  1165. (defun ebrowse-tree-at-point ()
  1166. "Return the class structure for the class point is on."
  1167. (or (get-text-property (point) 'ebrowse-tree)
  1168. (error "Not on a class")))
  1169. (defun* ebrowse-view/find-class-declaration (&key view where)
  1170. "View or find the declarator of the class point is on.
  1171. VIEW non-nil means view it. WHERE is additional position info."
  1172. (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
  1173. (file (ebrowse-cs-file class))
  1174. (browse-struct (make-ebrowse-bs
  1175. :name (ebrowse-cs-name class)
  1176. :pattern (ebrowse-cs-pattern class)
  1177. :flags (ebrowse-cs-flags class)
  1178. :file (ebrowse-cs-file class)
  1179. :point (ebrowse-cs-point class))))
  1180. (ebrowse-view/find-file-and-search-pattern
  1181. browse-struct
  1182. (list ebrowse--header class nil)
  1183. file
  1184. ebrowse--tags-file-name
  1185. view
  1186. where)))
  1187. (defun ebrowse-find-class-declaration (prefix)
  1188. "Find a class declaration and position cursor on it.
  1189. PREFIX 4 means find it in another window.
  1190. PREFIX 5 means find it in another frame."
  1191. (interactive "p")
  1192. (ebrowse-view/find-class-declaration
  1193. :view nil
  1194. :where (cond ((= prefix 4) 'other-window)
  1195. ((= prefix 5) 'other-frame)
  1196. (t 'this-window))))
  1197. (defun ebrowse-view-class-declaration (prefix)
  1198. "View class declaration and position cursor on it.
  1199. PREFIX 4 means view it in another window.
  1200. PREFIX 5 means view it in another frame."
  1201. (interactive "p")
  1202. (ebrowse-view/find-class-declaration
  1203. :view 'view
  1204. :where (cond ((= prefix 4) 'other-window)
  1205. ((= prefix 5) 'other-frame)
  1206. (t 'this-window))))
  1207. ;;; The FIND engine
  1208. (defun ebrowse-find-source-file (file tags-file)
  1209. "Find source file FILE.
  1210. Source files are searched for (a) relative to TAGS-FILE
  1211. which is the path of the BROWSE file from which the class tree was loaded,
  1212. and (b) in the directories named in `ebrowse-search-path'."
  1213. (let (file-name
  1214. (try-file (expand-file-name file
  1215. (file-name-directory tags-file))))
  1216. (if (file-readable-p try-file)
  1217. (setq file-name try-file)
  1218. (let ((search-in ebrowse-search-path))
  1219. (while (and search-in
  1220. (null file-name))
  1221. (let ((try-file (expand-file-name file (car search-in))))
  1222. (if (file-readable-p try-file)
  1223. (setq file-name try-file))
  1224. (setq search-in (cdr search-in))))))
  1225. (unless file-name
  1226. (error "File `%s' not found" file))
  1227. file-name))
  1228. (defun ebrowse-view-exit-fn (buffer)
  1229. "Function called when exiting View mode in BUFFER.
  1230. Restore frame configuration active before viewing the file,
  1231. and possibly kill the viewed buffer."
  1232. (let (exit-action original-frame-configuration)
  1233. (with-current-buffer buffer
  1234. (setq original-frame-configuration ebrowse--frame-configuration
  1235. exit-action ebrowse--view-exit-action))
  1236. ;; Delete the frame in which we viewed.
  1237. (mapc 'delete-frame
  1238. (loop for frame in (frame-list)
  1239. when (not (assq frame original-frame-configuration))
  1240. collect frame))
  1241. (when exit-action
  1242. (funcall exit-action buffer))))
  1243. (defun ebrowse-view-file-other-frame (file)
  1244. "View a file FILE in another frame.
  1245. The new frame is deleted when you quit viewing the file in that frame."
  1246. (interactive)
  1247. (let ((old-frame-configuration (current-frame-configuration))
  1248. (had-a-buf (get-file-buffer file))
  1249. (buf-to-view (find-file-noselect file)))
  1250. (switch-to-buffer-other-frame buf-to-view)
  1251. (set (make-local-variable 'ebrowse--frame-configuration)
  1252. old-frame-configuration)
  1253. (set (make-local-variable 'ebrowse--view-exit-action)
  1254. (and (not had-a-buf)
  1255. (not (buffer-modified-p buf-to-view))
  1256. 'kill-buffer))
  1257. (view-mode-enter (cons (selected-window) (cons (selected-window) t))
  1258. 'ebrowse-view-exit-fn)))
  1259. (defun ebrowse-view/find-file-and-search-pattern
  1260. (struc info file tags-file &optional view where)
  1261. "Find or view a member or class.
  1262. STRUC is an `ebrowse-bs' structure (or a structure including that)
  1263. describing what to search.
  1264. INFO is a list (HEADER MEMBER-OR-CLASS ACCESSOR). HEADER is the
  1265. header structure of a class tree. MEMBER-OR-CLASS is either an
  1266. `ebrowse-ms' or `ebrowse-cs' structure depending on what is searched.
  1267. ACCESSOR is an accessor function for the member list of a member
  1268. if MEMBER-OR-CLASS is an `ebrowse-ms'.
  1269. FILE is the file to search the member in.
  1270. FILE is not taken out of STRUC here because the filename in STRUC
  1271. may be nil in which case the filename of the class description is used.
  1272. TAGS-FILE is the name of the BROWSE file from which the
  1273. tree was loaded.
  1274. If VIEW is non-nil, view file else find the file.
  1275. WHERE is either `other-window', `other-frame' or `this-window' and
  1276. specifies where to find/view the result."
  1277. (unless file
  1278. (error "Sorry, no file information available for %s"
  1279. (ebrowse-bs-name struc)))
  1280. ;; Get the source file to view or find.
  1281. (setf file (ebrowse-find-source-file file tags-file))
  1282. ;; If current window is dedicated, use another frame.
  1283. (when (window-dedicated-p (selected-window))
  1284. (setf where 'other-window))
  1285. (cond (view
  1286. (setf ebrowse-temp-position-to-view struc
  1287. ebrowse-temp-info-to-view info)
  1288. (unless (boundp 'view-mode-hook)
  1289. (setq view-mode-hook nil))
  1290. (push 'ebrowse-find-pattern view-mode-hook)
  1291. (case where
  1292. (other-window (view-file-other-window file))
  1293. (other-frame (ebrowse-view-file-other-frame file))
  1294. (t (view-file file))))
  1295. (t
  1296. (case where
  1297. (other-window (find-file-other-window file))
  1298. (other-frame (find-file-other-frame file))
  1299. (t (find-file file)))
  1300. (ebrowse-find-pattern struc info))))
  1301. (defun ebrowse-symbol-regexp (name)
  1302. "Generate a suitable regular expression for a member or class NAME.
  1303. This is `regexp-quote' for most symbols, except for operator names
  1304. which may contain whitespace. For these symbols, replace white
  1305. space in the symbol name (generated by BROWSE) with a regular
  1306. expression matching any number of whitespace characters."
  1307. (loop with regexp = (regexp-quote name)
  1308. with start = 0
  1309. finally return regexp
  1310. while (string-match "[ \t]+" regexp start)
  1311. do (setq regexp (concat (substring regexp 0 (match-beginning 0))
  1312. "[ \t]*"
  1313. (substring regexp (match-end 0)))
  1314. start (+ (match-beginning 0) 5))))
  1315. (defun ebrowse-class-declaration-regexp (name)
  1316. "Construct a regexp for a declaration of class NAME."
  1317. (concat "^[ \t]*\\(template[ \t\n]*<.*>\\)?"
  1318. "[ \t\n]*\\(class\\|struct\\|union\\).*\\S_"
  1319. (ebrowse-symbol-regexp name)
  1320. "\\S_"))
  1321. (defun ebrowse-variable-declaration-regexp (name)
  1322. "Construct a regexp for matching a variable NAME."
  1323. (concat "\\S_" (ebrowse-symbol-regexp name) "\\S_"))
  1324. (defun ebrowse-function-declaration/definition-regexp (name)
  1325. "Construct a regexp for matching a function NAME."
  1326. (concat "^[a-zA-Z0-9_:*&<>, \t]*\\S_"
  1327. (ebrowse-symbol-regexp name)
  1328. "[ \t\n]*("))
  1329. (defun ebrowse-pp-define-regexp (name)
  1330. "Construct a regexp matching a define of NAME."
  1331. (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name)))
  1332. (defun* ebrowse-find-pattern (&optional position info &aux viewing)
  1333. "Find a pattern.
  1334. This is a kluge: Ebrowse allows you to find or view a file containing
  1335. a pattern. To be able to do a search in a viewed buffer,
  1336. `view-mode-hook' is temporarily set to this function;
  1337. `ebrowse-temp-position-to-view' holds what to search for.
  1338. INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
  1339. (unless position
  1340. (pop view-mode-hook)
  1341. (setf viewing t
  1342. position ebrowse-temp-position-to-view
  1343. info ebrowse-temp-info-to-view))
  1344. (widen)
  1345. (let* ((pattern (ebrowse-bs-pattern position))
  1346. (start (ebrowse-bs-point position))
  1347. (offset 100)
  1348. found)
  1349. (destructuring-bind (header class-or-member member-list) info
  1350. ;; If no pattern is specified, construct one from the member name.
  1351. (when (stringp pattern)
  1352. (setq pattern (concat "^.*" (regexp-quote pattern))))
  1353. ;; Construct a regular expression if none given.
  1354. (unless pattern
  1355. (typecase class-or-member
  1356. (ebrowse-ms
  1357. (case member-list
  1358. ((ebrowse-ts-member-variables
  1359. ebrowse-ts-static-variables
  1360. ebrowse-ts-types)
  1361. (setf pattern (ebrowse-variable-declaration-regexp
  1362. (ebrowse-bs-name position))))
  1363. (otherwise
  1364. (if (ebrowse-define-p class-or-member)
  1365. (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position)))
  1366. (setf pattern (ebrowse-function-declaration/definition-regexp
  1367. (ebrowse-bs-name position)))))))
  1368. (ebrowse-cs
  1369. (setf pattern (ebrowse-class-declaration-regexp
  1370. (ebrowse-bs-name position))))))
  1371. ;; Begin searching some OFFSET from the original point where the
  1372. ;; regular expression was found by the parse, and step forward.
  1373. ;; When there is no regular expression in the database and a
  1374. ;; member definition/declaration was not seen by the parser,
  1375. ;; START will be 0.
  1376. (when (and (boundp 'ebrowse-debug)
  1377. (symbol-value 'ebrowse-debug))
  1378. (y-or-n-p (format "start = %d? " start))
  1379. (y-or-n-p pattern))
  1380. (setf found
  1381. (loop do (goto-char (max (point-min) (- start offset)))
  1382. when (re-search-forward pattern (+ start offset) t) return t
  1383. never (bobp)
  1384. do (incf offset offset)))
  1385. (cond (found
  1386. (beginning-of-line)
  1387. (run-hooks 'ebrowse-view/find-hook))
  1388. ((numberp (ebrowse-bs-pattern position))
  1389. (goto-char start)
  1390. (if ebrowse-not-found-hook
  1391. (run-hooks 'ebrowse-not-found-hook)
  1392. (message "Not found")
  1393. (sit-for 2)))
  1394. (t
  1395. (if ebrowse-not-found-hook
  1396. (run-hooks 'ebrowse-not-found-hook)
  1397. (unless viewing
  1398. (error "Not found"))
  1399. (message "Not found")
  1400. (sit-for 2)))))))
  1401. ;;; Drawing the tree
  1402. (defun ebrowse-redraw-tree (&optional quietly)
  1403. "Redisplay the complete tree.
  1404. QUIETLY non-nil means don't display progress messages."
  1405. (interactive)
  1406. (or quietly (message "Displaying..."))
  1407. (save-excursion
  1408. (ebrowse-output
  1409. (erase-buffer)
  1410. (ebrowse-draw-tree-fn)))
  1411. (ebrowse-update-tree-buffer-mode-line)
  1412. (or quietly (message nil)))
  1413. (defun ebrowse-set-mark-props (start end tree)
  1414. "Set text properties for class marker signs between START and END.
  1415. TREE denotes the class shown."
  1416. (add-text-properties
  1417. start end
  1418. `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
  1419. help-echo "double-mouse-1: mark/unmark"))
  1420. (ebrowse-set-face start end 'ebrowse-tree-mark))
  1421. (defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
  1422. "Display a single class and recursively its subclasses.
  1423. This function may look weird, but this is faster than recursion."
  1424. (setq stack1 (make-list (length ebrowse--tree) 0)
  1425. stack2 (copy-sequence ebrowse--tree))
  1426. (loop while stack2
  1427. as level = (pop stack1)
  1428. as tree = (pop stack2)
  1429. as class = (ebrowse-ts-class tree) do
  1430. (let ((start-of-line (point))
  1431. start-of-class-name end-of-class-name)
  1432. ;; Insert mark
  1433. (insert (if (ebrowse-ts-mark tree) ">" " "))
  1434. ;; Indent and insert class name
  1435. (indent-to (+ (* level ebrowse--indentation)
  1436. ebrowse-tree-left-margin))
  1437. (setq start (point))
  1438. (insert (ebrowse-qualified-class-name class))
  1439. ;; If template class, add <>
  1440. (when (ebrowse-template-p class)
  1441. (insert "<>"))
  1442. (ebrowse-set-face start (point) (if (zerop level)
  1443. 'ebrowse-root-class
  1444. 'ebrowse-default))
  1445. (setf start-of-class-name start
  1446. end-of-class-name (point))
  1447. ;; If filenames are to be displayed...
  1448. (when ebrowse--show-file-names-flag
  1449. (indent-to ebrowse-source-file-column)
  1450. (setq start (point))
  1451. (insert "("
  1452. (or (ebrowse-cs-file class)
  1453. "unknown")
  1454. ")")
  1455. (ebrowse-set-face start (point) 'ebrowse-file-name))
  1456. (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
  1457. (add-text-properties
  1458. start-of-class-name end-of-class-name
  1459. `(mouse-face highlight ebrowse-what class-name
  1460. ebrowse-tree ,tree
  1461. help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
  1462. (insert "\n"))
  1463. ;; Push subclasses, if any.
  1464. (when (ebrowse-ts-subclasses tree)
  1465. (setq stack2
  1466. (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
  1467. stack1
  1468. (nconc (make-list (length (ebrowse-ts-subclasses tree))
  1469. (1+ level)) stack1)))))
  1470. ;;; Expanding/ collapsing tree branches
  1471. (defun ebrowse-expand-branch (arg)
  1472. "Expand a sub-tree that has been previously collapsed.
  1473. With prefix ARG, expand all sub-trees."
  1474. (interactive "P")
  1475. (if arg
  1476. (ebrowse-expand-all arg)
  1477. (ebrowse-collapse-fn nil)))
  1478. (defun ebrowse-collapse-branch (arg)
  1479. "Fold (do no longer display) the subclasses of the current class.
  1480. \(The class cursor is on.) With prefix ARG, fold all trees in the buffer."
  1481. (interactive "P")
  1482. (if arg
  1483. (ebrowse-expand-all (not arg))
  1484. (ebrowse-collapse-fn t)))
  1485. (defun ebrowse-expand-all (collapse)
  1486. "Expand or fold all trees in the buffer.
  1487. COLLAPSE non-nil means fold them."
  1488. (interactive "P")
  1489. (let ((line-end (if collapse "^\n" "^\r"))
  1490. (insertion (if collapse "\r" "\n")))
  1491. (ebrowse-output
  1492. (save-excursion
  1493. (goto-char (point-min))
  1494. (while (not (progn (skip-chars-forward line-end) (eobp)))
  1495. (when (or (not collapse)
  1496. (looking-at "\n "))
  1497. (delete-char 1)
  1498. (insert insertion))
  1499. (when collapse
  1500. (skip-chars-forward "\n ")))))))
  1501. (defun ebrowse-unhide-base-classes ()
  1502. "Unhide the line the cursor is on and all base classes."
  1503. (ebrowse-output
  1504. (save-excursion
  1505. (let (indent last-indent)
  1506. (skip-chars-backward "^\r\n")
  1507. (when (not (looking-at "[\r\n][^ \t]"))
  1508. (skip-chars-forward "\r\n \t")
  1509. (while (and (or (null last-indent) ;first time
  1510. (> indent 1)) ;not root class
  1511. (re-search-backward "[\r\n][ \t]*" nil t))
  1512. (setf indent (- (match-end 0)
  1513. (match-beginning 0)))
  1514. (when (or (null last-indent)
  1515. (< indent last-indent))
  1516. (setf last-indent indent)
  1517. (when (looking-at "\r")
  1518. (delete-char 1)
  1519. (insert 10)))
  1520. (backward-char 1)))))))
  1521. (defun ebrowse-hide-line (collapse)
  1522. "Hide/show a single line in the tree.
  1523. COLLAPSE non-nil means hide."
  1524. (save-excursion
  1525. (ebrowse-output
  1526. (skip-chars-forward "^\r\n")
  1527. (delete-char 1)
  1528. (insert (if collapse 13 10)))))
  1529. (defun ebrowse-collapse-fn (collapse)
  1530. "Collapse or expand a branch of the tree.
  1531. COLLAPSE non-nil means collapse the branch."
  1532. (ebrowse-output
  1533. (save-excursion
  1534. (beginning-of-line)
  1535. (skip-chars-forward "> \t")
  1536. (let ((indentation (current-column)))
  1537. (while (and (not (eobp))
  1538. (save-excursion
  1539. (skip-chars-forward "^\r\n")
  1540. (goto-char (1+ (point)))
  1541. (skip-chars-forward "> \t")
  1542. (> (current-column) indentation)))
  1543. (ebrowse-hide-line collapse)
  1544. (skip-chars-forward "^\r\n")
  1545. (goto-char (1+ (point))))))))
  1546. ;;; Electric tree selection
  1547. (defvar ebrowse-electric-list-mode-map ()
  1548. "Keymap used in electric Ebrowse buffer list window.")
  1549. (unless ebrowse-electric-list-mode-map
  1550. (let ((map (make-keymap))
  1551. (submap (make-keymap)))
  1552. (setq ebrowse-electric-list-mode-map map)
  1553. (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined)
  1554. (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined)
  1555. (define-key map "\e" submap)
  1556. (define-key map "\C-z" 'suspend-frame)
  1557. (define-key map "\C-h" 'Helper-help)
  1558. (define-key map "?" 'Helper-describe-bindings)
  1559. (define-key map "\C-c" nil)
  1560. (define-key map "\C-c\C-c" 'ebrowse-electric-list-quit)
  1561. (define-key map "q" 'ebrowse-electric-list-quit)
  1562. (define-key map " " 'ebrowse-electric-list-select)
  1563. (define-key map "\C-l" 'recenter)
  1564. (define-key map "\C-u" 'universal-argument)
  1565. (define-key map "\C-p" 'previous-line)
  1566. (define-key map "\C-n" 'next-line)
  1567. (define-key map "p" 'previous-line)
  1568. (define-key map "n" 'next-line)
  1569. (define-key map "v" 'ebrowse-electric-view-buffer)
  1570. (define-key map "\C-v" 'scroll-up-command)
  1571. (define-key map "\ev" 'scroll-down-command)
  1572. (define-key map "\e\C-v" 'scroll-other-window)
  1573. (define-key map "\e>" 'end-of-buffer)
  1574. (define-key map "\e<" 'beginning-of-buffer)
  1575. (define-key map "\e>" 'end-of-buffer)))
  1576. (put 'ebrowse-electric-list-mode 'mode-class 'special)
  1577. (put 'ebrowse-electric-list-undefined 'suppress-keymap t)
  1578. (define-derived-mode ebrowse-electric-list-mode
  1579. fundamental-mode "Electric Position Menu"
  1580. "Mode for electric tree list mode."
  1581. (setq mode-line-buffer-identification "Electric Tree Menu")
  1582. (when (memq 'mode-name mode-line-format)
  1583. (setq mode-line-format (copy-sequence mode-line-format))
  1584. (setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
  1585. (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
  1586. (setq truncate-lines t
  1587. buffer-read-only t))
  1588. (defun ebrowse-list-tree-buffers ()
  1589. "Display a list of all tree buffers."
  1590. (set-buffer (get-buffer-create "*Tree Buffers*"))
  1591. (setq buffer-read-only nil)
  1592. (erase-buffer)
  1593. (insert "Tree\n" "----\n")
  1594. (dolist (buffer (ebrowse-known-class-trees-buffer-list))
  1595. (insert (buffer-name buffer) "\n"))
  1596. (setq buffer-read-only t))
  1597. ;;;###autoload
  1598. (defun ebrowse-electric-choose-tree ()
  1599. "Return a buffer containing a tree or nil if no tree found or canceled."
  1600. (interactive)
  1601. (unless (car (ebrowse-known-class-trees-buffer-list))
  1602. (error "No tree buffers"))
  1603. (let (select buffer window)
  1604. (save-window-excursion
  1605. (save-window-excursion (ebrowse-list-tree-buffers))
  1606. (setq window (Electric-pop-up-window "*Tree Buffers*")
  1607. buffer (window-buffer window))
  1608. (shrink-window-if-larger-than-buffer window)
  1609. (unwind-protect
  1610. (progn
  1611. (set-buffer buffer)
  1612. (ebrowse-electric-list-mode)
  1613. (setq select
  1614. (catch 'ebrowse-electric-list-select
  1615. (message "<<< Press Space to bury the list >>>")
  1616. (let ((first (progn (goto-char (point-min))
  1617. (forward-line 2)
  1618. (point)))
  1619. (last (progn (goto-char (point-max))
  1620. (forward-line -1)
  1621. (point)))
  1622. (goal-column 0))
  1623. (goto-char first)
  1624. (Electric-command-loop 'ebrowse-electric-list-select
  1625. nil
  1626. t
  1627. 'ebrowse-electric-list-looper
  1628. (cons first last))))))
  1629. (set-buffer buffer)
  1630. (bury-buffer buffer)
  1631. (message nil)))
  1632. (when select
  1633. (set-buffer buffer)
  1634. (setq select (ebrowse-electric-get-buffer select)))
  1635. (kill-buffer buffer)
  1636. select))
  1637. (defun ebrowse-electric-list-looper (state condition)
  1638. "Prevent cursor from moving beyond the buffer end.
  1639. Don't let it move into the title lines.
  1640. See 'Electric-command-loop' for a description of STATE and CONDITION."
  1641. (cond ((and condition
  1642. (not (memq (car condition)
  1643. '(buffer-read-only end-of-buffer
  1644. beginning-of-buffer))))
  1645. (signal (car condition) (cdr condition)))
  1646. ((< (point) (car state))
  1647. (goto-char (point-min))
  1648. (forward-line 2))
  1649. ((> (point) (cdr state))
  1650. (goto-char (point-max))
  1651. (forward-line -1)
  1652. (if (pos-visible-in-window-p (point-max))
  1653. (recenter -1)))))
  1654. (defun ebrowse-electric-list-undefined ()
  1655. "Function called for keys that are undefined."
  1656. (interactive)
  1657. (message "Type C-h for help, ? for commands, q to quit, Space to select.")
  1658. (sit-for 4))
  1659. (defun ebrowse-electric-list-quit ()
  1660. "Discard the buffer list."
  1661. (interactive)
  1662. (throw 'ebrowse-electric-list-select nil))
  1663. (defun ebrowse-electric-list-select ()
  1664. "Select a buffer from the buffer list."
  1665. (interactive)
  1666. (throw 'ebrowse-electric-list-select (point)))
  1667. (defun ebrowse-electric-get-buffer (point)
  1668. "Get a buffer corresponding to the line POINT is in."
  1669. (let ((index (- (count-lines (point-min) point) 2)))
  1670. (nth index (ebrowse-known-class-trees-buffer-list))))
  1671. ;;; View a buffer for a tree.
  1672. (defun ebrowse-electric-view-buffer ()
  1673. "View buffer point is on."
  1674. (interactive)
  1675. (let ((buffer (ebrowse-electric-get-buffer (point))))
  1676. (cond (buffer
  1677. (view-buffer buffer))
  1678. (t
  1679. (error "Buffer no longer exists")))))
  1680. (defun ebrowse-choose-from-browser-buffers ()
  1681. "Read a browser buffer name from the minibuffer and return that buffer."
  1682. (let* ((buffers (ebrowse-known-class-trees-buffer-list)))
  1683. (if buffers
  1684. (if (not (second buffers))
  1685. (first buffers)
  1686. (or (ebrowse-electric-choose-tree) (error "No tree buffer")))
  1687. (let* ((insert-default-directory t)
  1688. (file (read-file-name "Find tree: " nil nil t)))
  1689. (save-excursion
  1690. (find-file file))
  1691. (find-buffer-visiting file)))))
  1692. ;;; Member buffers
  1693. (unless ebrowse-member-mode-map
  1694. (let ((map (make-keymap)))
  1695. (setf ebrowse-member-mode-map map)
  1696. (suppress-keymap map)
  1697. (when (display-mouse-p)
  1698. (define-key map [down-mouse-3] 'ebrowse-member-mouse-3)
  1699. (define-key map [mouse-2] 'ebrowse-member-mouse-2))
  1700. (let ((map1 (make-sparse-keymap)))
  1701. (suppress-keymap map1 t)
  1702. (define-key map "C" map1)
  1703. (define-key map1 "b" 'ebrowse-switch-member-buffer-to-base-class)
  1704. (define-key map1 "c" 'ebrowse-switch-member-buffer-to-any-class)
  1705. (define-key map1 "d" 'ebrowse-switch-member-buffer-to-derived-class)
  1706. (define-key map1 "n" 'ebrowse-switch-member-buffer-to-next-sibling-class)
  1707. (define-key map1 "p" 'ebrowse-switch-member-buffer-to-previous-sibling-class))
  1708. (let ((map1 (make-sparse-keymap)))
  1709. (suppress-keymap map1 t)
  1710. (define-key map "D" map1)
  1711. (define-key map1 "a" 'ebrowse-toggle-member-attributes-display)
  1712. (define-key map1 "b" 'ebrowse-toggle-base-class-display)
  1713. (define-key map1 "f" 'ebrowse-freeze-member-buffer)
  1714. (define-key map1 "l" 'ebrowse-toggle-long-short-display)
  1715. (define-key map1 "r" 'ebrowse-toggle-regexp-display)
  1716. (define-key map1 "w" 'ebrowse-set-member-buffer-column-width))
  1717. (let ((map1 (make-sparse-keymap)))
  1718. (suppress-keymap map1 t)
  1719. (define-key map "F" map1)
  1720. (let ((map2 (make-sparse-keymap)))
  1721. (suppress-keymap map2 t)
  1722. (define-key map1 "a" map2)
  1723. (define-key map2 "i" 'ebrowse-toggle-private-member-filter)
  1724. (define-key map2 "o" 'ebrowse-toggle-protected-member-filter)
  1725. (define-key map2 "u" 'ebrowse-toggle-public-member-filter))
  1726. (define-key map1 "c" 'ebrowse-toggle-const-member-filter)
  1727. (define-key map1 "i" 'ebrowse-toggle-inline-member-filter)
  1728. (define-key map1 "p" 'ebrowse-toggle-pure-member-filter)
  1729. (define-key map1 "r" 'ebrowse-remove-all-member-filters)
  1730. (define-key map1 "v" 'ebrowse-toggle-virtual-member-filter))
  1731. (let ((map1 (make-sparse-keymap)))
  1732. (suppress-keymap map1 t)
  1733. (define-key map "L" map1)
  1734. (define-key map1 "d" 'ebrowse-display-friends-member-list)
  1735. (define-key map1 "f" 'ebrowse-display-function-member-list)
  1736. (define-key map1 "F" 'ebrowse-display-static-functions-member-list)
  1737. (define-key map1 "n" 'ebrowse-display-next-member-list)
  1738. (define-key map1 "p" 'ebrowse-display-previous-member-list)
  1739. (define-key map1 "t" 'ebrowse-display-types-member-list)
  1740. (define-key map1 "v" 'ebrowse-display-variables-member-list)
  1741. (define-key map1 "V" 'ebrowse-display-static-variables-member-list))
  1742. (let ((map1 (make-sparse-keymap)))
  1743. (suppress-keymap map1 t)
  1744. (define-key map "G" map1)
  1745. (define-key map1 "m" 'ebrowse-goto-visible-member/all-member-lists)
  1746. (define-key map1 "n" 'ebrowse-repeat-member-search)
  1747. (define-key map1 "v" 'ebrowse-goto-visible-member))
  1748. (define-key map "f" 'ebrowse-find-member-declaration)
  1749. (define-key map "m" 'ebrowse-switch-to-next-member-buffer)
  1750. (define-key map "q" 'bury-buffer)
  1751. (define-key map "t" 'ebrowse-show-displayed-class-in-tree)
  1752. (define-key map "v" 'ebrowse-view-member-declaration)
  1753. (define-key map " " 'ebrowse-view-member-definition)
  1754. (define-key map "?" 'describe-mode)
  1755. (define-key map "\C-i" 'ebrowse-pop-from-member-to-tree-buffer)
  1756. (define-key map "\C-l" 'ebrowse-redisplay-member-buffer)
  1757. (define-key map "\C-m" 'ebrowse-find-member-definition)))
  1758. ;;; Member mode
  1759. ;;;###autoload
  1760. (define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
  1761. "Major mode for Ebrowse member buffers."
  1762. (mapc 'make-local-variable
  1763. '(ebrowse--decl-column ;display column
  1764. ebrowse--n-columns ;number of short columns
  1765. ebrowse--column-width ;width of columns above
  1766. ebrowse--show-inherited-flag ;include inherited members?
  1767. ebrowse--filters ;public, protected, private
  1768. ebrowse--accessor ;vars, functions, friends
  1769. ebrowse--displayed-class ;class displayed
  1770. ebrowse--long-display-flag ;display with regexps?
  1771. ebrowse--source-regexp-flag ;show source regexp?
  1772. ebrowse--attributes-flag ;show `virtual' and `inline'
  1773. ebrowse--member-list ;list of members displayed
  1774. ebrowse--tree ;the class tree
  1775. ebrowse--member-mode-strings ;part of mode line
  1776. ebrowse--tags-file-name ;
  1777. ebrowse--header
  1778. ebrowse--tree-obarray
  1779. ebrowse--virtual-display-flag
  1780. ebrowse--inline-display-flag
  1781. ebrowse--const-display-flag
  1782. ebrowse--pure-display-flag
  1783. ebrowse--frozen-flag)) ;buffer not automagically reused
  1784. (setq mode-line-buffer-identification
  1785. (propertized-buffer-identification "C++ Members")
  1786. buffer-read-only t
  1787. ebrowse--long-display-flag nil
  1788. ebrowse--attributes-flag t
  1789. ebrowse--show-inherited-flag t
  1790. ebrowse--source-regexp-flag nil
  1791. ebrowse--filters [0 1 2]
  1792. ebrowse--decl-column ebrowse-default-declaration-column
  1793. ebrowse--column-width ebrowse-default-column-width
  1794. ebrowse--virtual-display-flag nil
  1795. ebrowse--inline-display-flag nil
  1796. ebrowse--const-display-flag nil
  1797. ebrowse--pure-display-flag nil)
  1798. (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))))
  1799. ;;; Member mode mode line
  1800. (defsubst ebrowse-class-name-displayed-in-member-buffer ()
  1801. "Return the name of the class displayed in the member buffer."
  1802. (ebrowse-cs-name (ebrowse-ts-class ebrowse--displayed-class)))
  1803. (defsubst ebrowse-member-list-name ()
  1804. "Return a string describing what is displayed in the member buffer."
  1805. (get ebrowse--accessor (if (ebrowse-globals-tree-p ebrowse--displayed-class)
  1806. 'ebrowse-global-title
  1807. 'ebrowse-title)))
  1808. (defun ebrowse-update-member-buffer-mode-line ()
  1809. "Update the mode line of member buffers."
  1810. (let* ((name (when ebrowse--frozen-flag
  1811. (concat (ebrowse-class-name-displayed-in-member-buffer)
  1812. " ")))
  1813. (ident (concat name (ebrowse-member-list-name))))
  1814. (setq mode-line-buffer-identification
  1815. (propertized-buffer-identification ident))
  1816. (ebrowse-rename-buffer (if name ident ebrowse-member-buffer-name))
  1817. (force-mode-line-update)))
  1818. ;;; Misc member buffer commands
  1819. (defun ebrowse-freeze-member-buffer ()
  1820. "Toggle frozen status of current buffer."
  1821. (interactive)
  1822. (setq ebrowse--frozen-flag (not ebrowse--frozen-flag))
  1823. (ebrowse-redisplay-member-buffer))
  1824. (defun ebrowse-show-displayed-class-in-tree (arg)
  1825. "Show the currently displayed class in the tree window.
  1826. With prefix ARG, switch to the tree buffer else pop to it."
  1827. (interactive "P")
  1828. (let ((class-name (ebrowse-class-name-displayed-in-member-buffer)))
  1829. (when (ebrowse-pop-from-member-to-tree-buffer arg)
  1830. (ebrowse-read-class-name-and-go class-name))))
  1831. (defun ebrowse-set-member-buffer-column-width ()
  1832. "Set the column width of the member display.
  1833. The new width is read from the minibuffer."
  1834. (interactive)
  1835. (let ((width (string-to-number
  1836. (read-from-minibuffer
  1837. (concat "Column width ("
  1838. (int-to-string (if ebrowse--long-display-flag
  1839. ebrowse--decl-column
  1840. ebrowse--column-width))
  1841. "): ")))))
  1842. (when (plusp width)
  1843. (if ebrowse--long-display-flag
  1844. (setq ebrowse--decl-column width)
  1845. (setq ebrowse--column-width width))
  1846. (ebrowse-redisplay-member-buffer))))
  1847. (defun ebrowse-pop-from-member-to-tree-buffer (arg)
  1848. "Pop from a member buffer to the matching tree buffer.
  1849. Switch to the buffer if prefix ARG. If no tree buffer exists,
  1850. make one."
  1851. (interactive "P")
  1852. (let ((buf (or (get-buffer (ebrowse-frozen-tree-buffer-name
  1853. ebrowse--tags-file-name))
  1854. (get-buffer ebrowse-tree-buffer-name)
  1855. (ebrowse-create-tree-buffer ebrowse--tree
  1856. ebrowse--tags-file-name
  1857. ebrowse--header
  1858. ebrowse--tree-obarray
  1859. 'pop))))
  1860. (and buf
  1861. (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf))
  1862. buf))
  1863. ;;; Switching between member lists
  1864. (defun ebrowse-display-member-list-for-accessor (accessor)
  1865. "Switch the member buffer to display the member list for ACCESSOR."
  1866. (setf ebrowse--accessor accessor
  1867. ebrowse--member-list (funcall accessor ebrowse--displayed-class))
  1868. (ebrowse-redisplay-member-buffer))
  1869. (defun ebrowse-cyclic-display-next/previous-member-list (incr)
  1870. "Switch buffer to INCR'th next/previous list of members."
  1871. (let ((index (ebrowse-position ebrowse--accessor
  1872. ebrowse-member-list-accessors)))
  1873. (setf ebrowse--accessor
  1874. (cond ((plusp incr)
  1875. (or (nth (1+ index)
  1876. ebrowse-member-list-accessors)
  1877. (first ebrowse-member-list-accessors)))
  1878. ((minusp incr)
  1879. (or (and (>= (decf index) 0)
  1880. (nth index
  1881. ebrowse-member-list-accessors))
  1882. (first (last ebrowse-member-list-accessors))))))
  1883. (ebrowse-display-member-list-for-accessor ebrowse--accessor)))
  1884. (defun ebrowse-display-next-member-list ()
  1885. "Switch buffer to next member list."
  1886. (interactive)
  1887. (ebrowse-cyclic-display-next/previous-member-list 1))
  1888. (defun ebrowse-display-previous-member-list ()
  1889. "Switch buffer to previous member list."
  1890. (interactive)
  1891. (ebrowse-cyclic-display-next/previous-member-list -1))
  1892. (defun ebrowse-display-function-member-list ()
  1893. "Display the list of member functions."
  1894. (interactive)
  1895. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions))
  1896. (defun ebrowse-display-variables-member-list ()
  1897. "Display the list of member variables."
  1898. (interactive)
  1899. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables))
  1900. (defun ebrowse-display-static-variables-member-list ()
  1901. "Display the list of static member variables."
  1902. (interactive)
  1903. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables))
  1904. (defun ebrowse-display-static-functions-member-list ()
  1905. "Display the list of static member functions."
  1906. (interactive)
  1907. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions))
  1908. (defun ebrowse-display-friends-member-list ()
  1909. "Display the list of friends."
  1910. (interactive)
  1911. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends))
  1912. (defun ebrowse-display-types-member-list ()
  1913. "Display the list of types."
  1914. (interactive)
  1915. (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types))
  1916. ;;; Filters and other display attributes
  1917. (defun ebrowse-toggle-member-attributes-display ()
  1918. "Toggle display of `virtual', `inline', `const' etc."
  1919. (interactive)
  1920. (setq ebrowse--attributes-flag (not ebrowse--attributes-flag))
  1921. (ebrowse-redisplay-member-buffer))
  1922. (defun ebrowse-toggle-base-class-display ()
  1923. "Toggle the display of members inherited from base classes."
  1924. (interactive)
  1925. (setf ebrowse--show-inherited-flag (not ebrowse--show-inherited-flag))
  1926. (ebrowse-redisplay-member-buffer))
  1927. (defun ebrowse-toggle-pure-member-filter ()
  1928. "Toggle display of pure virtual members."
  1929. (interactive)
  1930. (setf ebrowse--pure-display-flag (not ebrowse--pure-display-flag))
  1931. (ebrowse-redisplay-member-buffer))
  1932. (defun ebrowse-toggle-const-member-filter ()
  1933. "Toggle display of const members."
  1934. (interactive)
  1935. (setf ebrowse--const-display-flag (not ebrowse--const-display-flag))
  1936. (ebrowse-redisplay-member-buffer))
  1937. (defun ebrowse-toggle-inline-member-filter ()
  1938. "Toggle display of inline members."
  1939. (interactive)
  1940. (setf ebrowse--inline-display-flag (not ebrowse--inline-display-flag))
  1941. (ebrowse-redisplay-member-buffer))
  1942. (defun ebrowse-toggle-virtual-member-filter ()
  1943. "Toggle display of virtual members."
  1944. (interactive)
  1945. (setf ebrowse--virtual-display-flag (not ebrowse--virtual-display-flag))
  1946. (ebrowse-redisplay-member-buffer))
  1947. (defun ebrowse-remove-all-member-filters ()
  1948. "Remove all filters."
  1949. (interactive)
  1950. (dotimes (i 3)
  1951. (aset ebrowse--filters i i))
  1952. (setq ebrowse--pure-display-flag nil
  1953. ebrowse--const-display-flag nil
  1954. ebrowse--virtual-display-flag nil
  1955. ebrowse--inline-display-flag nil)
  1956. (ebrowse-redisplay-member-buffer))
  1957. (defun ebrowse-toggle-public-member-filter ()
  1958. "Toggle visibility of public members."
  1959. (interactive)
  1960. (ebrowse-set-member-access-visibility 0)
  1961. (ebrowse-redisplay-member-buffer))
  1962. (defun ebrowse-toggle-protected-member-filter ()
  1963. "Toggle visibility of protected members."
  1964. (interactive)
  1965. (ebrowse-set-member-access-visibility 1)
  1966. (ebrowse-redisplay-member-buffer))
  1967. (defun ebrowse-toggle-private-member-filter ()
  1968. "Toggle visibility of private members."
  1969. (interactive)
  1970. (ebrowse-set-member-access-visibility 2)
  1971. (ebrowse-redisplay-member-buffer))
  1972. (defun ebrowse-set-member-access-visibility (vis)
  1973. (setf (aref ebrowse--filters vis)
  1974. (if (aref ebrowse--filters vis) nil vis)))
  1975. (defun ebrowse-toggle-long-short-display ()
  1976. "Toggle between long and short display form of member buffers."
  1977. (interactive)
  1978. (setf ebrowse--long-display-flag (not ebrowse--long-display-flag))
  1979. (ebrowse-redisplay-member-buffer))
  1980. (defun ebrowse-toggle-regexp-display ()
  1981. "Toggle declaration/definition regular expression display.
  1982. Used in member buffers showing the long display form."
  1983. (interactive)
  1984. (setf ebrowse--source-regexp-flag (not ebrowse--source-regexp-flag))
  1985. (ebrowse-redisplay-member-buffer))
  1986. ;;; Viewing/finding members
  1987. (defun ebrowse-find-member-definition (&optional prefix)
  1988. "Find the file containing a member definition.
  1989. With PREFIX 4. find file in another window, with prefix 5
  1990. find file in another frame."
  1991. (interactive "p")
  1992. (ebrowse-view/find-member-declaration/definition prefix nil t))
  1993. (defun ebrowse-view-member-definition (prefix)
  1994. "View the file containing a member definition.
  1995. With PREFIX 4. find file in another window, with prefix 5
  1996. find file in another frame."
  1997. (interactive "p")
  1998. (ebrowse-view/find-member-declaration/definition prefix t t))
  1999. (defun ebrowse-find-member-declaration (prefix)
  2000. "Find the file containing a member's declaration.
  2001. With PREFIX 4. find file in another window, with prefix 5
  2002. find file in another frame."
  2003. (interactive "p")
  2004. (ebrowse-view/find-member-declaration/definition prefix nil))
  2005. (defun ebrowse-view-member-declaration (prefix)
  2006. "View the file containing a member's declaration.
  2007. With PREFIX 4. find file in another window, with prefix 5
  2008. find file in another frame."
  2009. (interactive "p")
  2010. (ebrowse-view/find-member-declaration/definition prefix t))
  2011. (defun* ebrowse-view/find-member-declaration/definition
  2012. (prefix view &optional definition info header tags-file)
  2013. "Find or view a member declaration or definition.
  2014. With PREFIX 4. find file in another window, with prefix 5
  2015. find file in another frame.
  2016. DEFINITION non-nil means find the definition, otherwise find the
  2017. declaration.
  2018. INFO is a list (TREE ACCESSOR MEMBER) describing the member to
  2019. search.
  2020. TAGS-FILE is the file name of the BROWSE file."
  2021. (unless header
  2022. (setq header ebrowse--header))
  2023. (unless tags-file
  2024. (setq tags-file ebrowse--tags-file-name))
  2025. (let (tree member accessor file on-class
  2026. (where (if (= prefix 4) 'other-window
  2027. (if (= prefix 5) 'other-frame 'this-window))))
  2028. ;; If not given as parameters, get the necessary information
  2029. ;; out of the member buffer.
  2030. (if info
  2031. (setq tree (first info)
  2032. accessor (second info)
  2033. member (third info))
  2034. (multiple-value-setq (tree member on-class)
  2035. (values-list (ebrowse-member-info-from-point)))
  2036. (setq accessor ebrowse--accessor))
  2037. ;; View/find class if on a line containing a class name.
  2038. (when on-class
  2039. (return-from ebrowse-view/find-member-declaration/definition
  2040. (ebrowse-view/find-file-and-search-pattern
  2041. (ebrowse-ts-class tree)
  2042. (list ebrowse--header (ebrowse-ts-class tree) nil)
  2043. (ebrowse-cs-file (ebrowse-ts-class tree))
  2044. tags-file view where)))
  2045. ;; For some member lists, it doesn't make sense to search for
  2046. ;; a definition. If this is requested, silently search for the
  2047. ;; declaration.
  2048. (when (and definition
  2049. (eq accessor 'ebrowse-ts-member-variables))
  2050. (setq definition nil))
  2051. ;; Construct a suitable `browse' struct for definitions.
  2052. (when definition
  2053. (setf member (make-ebrowse-ms
  2054. :name (ebrowse-ms-name member)
  2055. :file (ebrowse-ms-definition-file member)
  2056. :pattern (ebrowse-ms-definition-pattern
  2057. member)
  2058. :flags (ebrowse-ms-flags member)
  2059. :point (ebrowse-ms-definition-point
  2060. member))))
  2061. ;; When no file information in member, use that of the class
  2062. (setf file (or (ebrowse-ms-file member)
  2063. (if definition
  2064. (ebrowse-cs-source-file (ebrowse-ts-class tree))
  2065. (ebrowse-cs-file (ebrowse-ts-class tree)))))
  2066. ;; When we have no regular expressions in the database the only
  2067. ;; indication that the parser hasn't seen a definition/declaration
  2068. ;; is that the search start point will be zero.
  2069. (if (or (null file) (zerop (ebrowse-ms-point member)))
  2070. (if (y-or-n-p (concat "No information about "
  2071. (if definition "definition" "declaration")
  2072. ". Search for "
  2073. (if definition "declaration" "definition")
  2074. " of `"
  2075. (ebrowse-ms-name member)
  2076. "'? "))
  2077. (progn
  2078. (message nil)
  2079. ;; Recurse with new info.
  2080. (ebrowse-view/find-member-declaration/definition
  2081. prefix view (not definition) info header tags-file))
  2082. (error "Search canceled"))
  2083. ;; Find that thing.
  2084. (ebrowse-view/find-file-and-search-pattern
  2085. (make-ebrowse-bs :name (ebrowse-ms-name member)
  2086. :pattern (ebrowse-ms-pattern member)
  2087. :file (ebrowse-ms-file member)
  2088. :flags (ebrowse-ms-flags member)
  2089. :point (ebrowse-ms-point member))
  2090. (list header member accessor)
  2091. file
  2092. tags-file
  2093. view
  2094. where))))
  2095. ;;; Drawing the member buffer
  2096. (defun ebrowse-redisplay-member-buffer ()
  2097. "Force buffer redisplay."
  2098. (interactive)
  2099. (let ((display-fn (if ebrowse--long-display-flag
  2100. 'ebrowse-draw-member-long-fn
  2101. 'ebrowse-draw-member-short-fn)))
  2102. (ebrowse-output
  2103. (erase-buffer)
  2104. ;; Show this class
  2105. (ebrowse-draw-member-buffer-class-line)
  2106. (funcall display-fn ebrowse--member-list ebrowse--displayed-class)
  2107. ;; Show inherited members if corresponding switch is on
  2108. (when ebrowse--show-inherited-flag
  2109. (dolist (super (ebrowse-base-classes ebrowse--displayed-class))
  2110. (goto-char (point-max))
  2111. (insert (if (bolp) "\n\n" "\n"))
  2112. (ebrowse-draw-member-buffer-class-line super)
  2113. (funcall display-fn (funcall ebrowse--accessor super) super)))
  2114. (ebrowse-update-member-buffer-mode-line))))
  2115. (defun ebrowse-draw-member-buffer-class-line (&optional class)
  2116. "Display the title line for a class section in the member buffer.
  2117. CLASS non-nil means display that class' title. Otherwise use
  2118. the class cursor is on."
  2119. (let ((start (point))
  2120. (tree (or class ebrowse--displayed-class))
  2121. class-name-start
  2122. class-name-end)
  2123. (insert "class ")
  2124. (setq class-name-start (point))
  2125. (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree)))
  2126. (when (ebrowse-template-p (ebrowse-ts-class tree))
  2127. (insert "<>"))
  2128. (setq class-name-end (point))
  2129. (insert ":\n\n")
  2130. (ebrowse-set-face start (point) 'ebrowse-member-class)
  2131. (add-text-properties
  2132. class-name-start class-name-end
  2133. '(ebrowse-what class-name
  2134. mouse-face highlight
  2135. help-echo "mouse-3: menu"))
  2136. (put-text-property start class-name-end 'ebrowse-tree tree)))
  2137. (defun ebrowse-display-member-buffer (list &optional stand-alone class)
  2138. "Start point for member buffer creation.
  2139. LIST is the member list to display. STAND-ALONE non-nil
  2140. means the member buffer is standalone. CLASS is its class."
  2141. (let* ((classes ebrowse--tree-obarray)
  2142. (tree ebrowse--tree)
  2143. (tags-file ebrowse--tags-file-name)
  2144. (header ebrowse--header)
  2145. temp-buffer-setup-hook
  2146. (temp-buffer (get-buffer ebrowse-member-buffer-name)))
  2147. ;; Get the class description from the name the cursor
  2148. ;; is on if not specified as an argument.
  2149. (unless class
  2150. (setq class (ebrowse-tree-at-point)))
  2151. (save-selected-window
  2152. (if temp-buffer
  2153. (pop-to-buffer temp-buffer)
  2154. (pop-to-buffer (get-buffer-create ebrowse-member-buffer-name))
  2155. ;; If new buffer, set the mode and initial values of locals
  2156. (ebrowse-member-mode))
  2157. ;; Set local variables
  2158. (setq ebrowse--member-list (funcall list class)
  2159. ebrowse--displayed-class class
  2160. ebrowse--accessor list
  2161. ebrowse--tree-obarray classes
  2162. ebrowse--frozen-flag stand-alone
  2163. ebrowse--tags-file-name tags-file
  2164. ebrowse--header header
  2165. ebrowse--tree tree
  2166. buffer-read-only t)
  2167. (ebrowse-redisplay-member-buffer)
  2168. (current-buffer))))
  2169. (defun ebrowse-member-display-p (member)
  2170. "Return t if MEMBER must be displayed under the current filter settings."
  2171. (if (and (aref ebrowse--filters (ebrowse-ms-visibility member))
  2172. (or (null ebrowse--const-display-flag)
  2173. (ebrowse-const-p member))
  2174. (or (null ebrowse--inline-display-flag)
  2175. (ebrowse-inline-p member))
  2176. (or (null ebrowse--pure-display-flag)
  2177. (ebrowse-bs-p member))
  2178. (or (null ebrowse--virtual-display-flag)
  2179. (ebrowse-virtual-p member)))
  2180. member))
  2181. (defun ebrowse-draw-member-attributes (member)
  2182. "Insert a string for the attributes of MEMBER."
  2183. (insert (if (ebrowse-template-p member) "T" "-")
  2184. (if (ebrowse-extern-c-p member) "C" "-")
  2185. (if (ebrowse-virtual-p member) "v" "-")
  2186. (if (ebrowse-inline-p member) "i" "-")
  2187. (if (ebrowse-const-p member) "c" "-")
  2188. (if (ebrowse-pure-virtual-p member) "0" "-")
  2189. (if (ebrowse-mutable-p member) "m" "-")
  2190. (if (ebrowse-explicit-p member) "e" "-")
  2191. (if (ebrowse-throw-list-p member) "t" "-")))
  2192. (defun ebrowse-draw-member-regexp (member-struc)
  2193. "Insert a string for the regular expression matching MEMBER-STRUC."
  2194. (let ((pattern (if ebrowse--source-regexp-flag
  2195. (ebrowse-ms-definition-pattern
  2196. member-struc)
  2197. (ebrowse-ms-pattern member-struc))))
  2198. (cond ((stringp pattern)
  2199. (insert (ebrowse-trim-string pattern) "...\n")
  2200. (beginning-of-line 0)
  2201. (move-to-column (+ 4 ebrowse--decl-column))
  2202. (while (re-search-forward "[ \t]+" nil t)
  2203. (delete-region (match-beginning 0) (match-end 0))
  2204. (insert " "))
  2205. (beginning-of-line 2))
  2206. (t
  2207. (insert "[not recorded or unknown]\n")))))
  2208. (defun ebrowse-draw-member-long-fn (member-list tree)
  2209. "Display member buffer for MEMBER-LIST in long form.
  2210. TREE is the class tree of MEMBER-LIST."
  2211. (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list))
  2212. (when member-struc
  2213. (let ((name (ebrowse-ms-name member-struc))
  2214. (start (point)))
  2215. ;; Insert member name truncated to the right length
  2216. (insert (substring name
  2217. 0
  2218. (min (length name)
  2219. (1- ebrowse--decl-column))))
  2220. (add-text-properties
  2221. start (point)
  2222. `(mouse-face highlight ebrowse-what member-name
  2223. ebrowse-member ,member-struc
  2224. ebrowse-tree ,tree
  2225. help-echo "mouse-2: view definition; mouse-3: menu"))
  2226. ;; Display virtual, inline, and const status
  2227. (setf start (point))
  2228. (indent-to ebrowse--decl-column)
  2229. (put-text-property start (point) 'mouse-face nil)
  2230. (when ebrowse--attributes-flag
  2231. (let ((start (point)))
  2232. (insert "<")
  2233. (ebrowse-draw-member-attributes member-struc)
  2234. (insert ">")
  2235. (ebrowse-set-face start (point)
  2236. 'ebrowse-member-attribute)))
  2237. (insert " ")
  2238. (ebrowse-draw-member-regexp member-struc))))
  2239. (insert "\n")
  2240. (goto-char (point-min)))
  2241. (defun ebrowse-draw-member-short-fn (member-list tree)
  2242. "Display MEMBER-LIST in short form.
  2243. TREE is the class tree in which the members are found."
  2244. (let ((i 0)
  2245. (column-width (+ ebrowse--column-width
  2246. (if ebrowse--attributes-flag 12 0))))
  2247. ;; Get the number of columns to draw.
  2248. (setq ebrowse--n-columns
  2249. (max 1 (/ (ebrowse-width-of-drawable-area) column-width)))
  2250. (dolist (member (mapcar #'ebrowse-member-display-p member-list))
  2251. (when member
  2252. (let ((name (ebrowse-ms-name member))
  2253. start-of-entry
  2254. (start-of-column (point))
  2255. start-of-name)
  2256. (indent-to (* i column-width))
  2257. (put-text-property start-of-column (point) 'mouse-face nil)
  2258. (setq start-of-entry (point))
  2259. ;; Show various attributes
  2260. (when ebrowse--attributes-flag
  2261. (insert "<")
  2262. (ebrowse-draw-member-attributes member)
  2263. (insert "> ")
  2264. (ebrowse-set-face start-of-entry (point)
  2265. 'ebrowse-member-attribute))
  2266. ;; insert member name truncated to column width
  2267. (setq start-of-name (point))
  2268. (insert (substring name 0
  2269. (min (length name)
  2270. (1- ebrowse--column-width))))
  2271. ;; set text properties
  2272. (add-text-properties
  2273. start-of-name (point)
  2274. `(ebrowse-what member-name
  2275. ebrowse-member ,member
  2276. mouse-face highlight
  2277. ebrowse-tree ,tree
  2278. help-echo "mouse-2: view definition; mouse-3: menu"))
  2279. (incf i)
  2280. (when (>= i ebrowse--n-columns)
  2281. (setf i 0)
  2282. (insert "\n")))))
  2283. (when (plusp i)
  2284. (insert "\n"))
  2285. (goto-char (point-min))))
  2286. ;;; Killing members from tree
  2287. (defun ebrowse-member-info-from-point ()
  2288. "Ger information about the member at point.
  2289. The result has the form (TREE MEMBER NULL-P). TREE is the tree
  2290. we're in, MEMBER is the member we're on. NULL-P is t if MEMBER
  2291. is nil."
  2292. (let ((tree (or (get-text-property (point) 'ebrowse-tree)
  2293. (error "No information at point")))
  2294. (member (get-text-property (point) 'ebrowse-member)))
  2295. (list tree member (null member))))
  2296. ;;; Switching member buffer to display a selected member
  2297. (defun ebrowse-goto-visible-member/all-member-lists (_prefix)
  2298. "Position cursor on a member read from the minibuffer.
  2299. With PREFIX, search all members in the tree. Otherwise consider
  2300. only members visible in the buffer."
  2301. (interactive "p")
  2302. (ebrowse-ignoring-completion-case
  2303. (let* ((completion-list (ebrowse-name/accessor-alist-for-class-members))
  2304. (member (completing-read "Goto member: " completion-list nil t))
  2305. (accessor (cdr (assoc member completion-list))))
  2306. (unless accessor
  2307. (error "`%s' not found" member))
  2308. (unless (eq accessor ebrowse--accessor)
  2309. (setf ebrowse--accessor accessor
  2310. ebrowse--member-list (funcall accessor ebrowse--displayed-class))
  2311. (ebrowse-redisplay-member-buffer))
  2312. (ebrowse-move-point-to-member member))))
  2313. (defun ebrowse-goto-visible-member (repeat)
  2314. "Position point on a member.
  2315. Read the member's name from the minibuffer. Consider only members
  2316. visible in the member buffer.
  2317. REPEAT non-nil means repeat the search that number of times."
  2318. (interactive "p")
  2319. (ebrowse-ignoring-completion-case
  2320. ;; Read member name
  2321. (let* ((completion-list (ebrowse-name/accessor-alist-for-visible-members))
  2322. (member (completing-read "Goto member: " completion-list nil t)))
  2323. (ebrowse-move-point-to-member member repeat))))
  2324. ;;; Searching a member in the member buffer
  2325. (defun ebrowse-repeat-member-search (repeat)
  2326. "Repeat the last regular expression search.
  2327. REPEAT, if specified, says repeat the search REPEAT times."
  2328. (interactive "p")
  2329. (unless ebrowse--last-regexp
  2330. (error "No regular expression remembered"))
  2331. ;; Skip over word the point is on
  2332. (skip-chars-forward "^ \t\n")
  2333. ;; Search for regexp from point
  2334. (if (re-search-forward ebrowse--last-regexp nil t repeat)
  2335. (progn
  2336. (goto-char (match-beginning 0))
  2337. (skip-chars-forward " \t\n"))
  2338. ;; If not found above, repeat search from buffer start
  2339. (goto-char (point-min))
  2340. (if (re-search-forward ebrowse--last-regexp nil t)
  2341. (progn
  2342. (goto-char (match-beginning 0))
  2343. (skip-chars-forward " \t\n"))
  2344. (error "Not found"))))
  2345. (defun* ebrowse-move-point-to-member (name &optional count &aux member)
  2346. "Set point on member NAME in the member buffer
  2347. COUNT, if specified, says search the COUNT'th member with the same name."
  2348. (goto-char (point-min))
  2349. (widen)
  2350. (setq member
  2351. (substring name 0 (min (length name) (1- ebrowse--column-width)))
  2352. ebrowse--last-regexp
  2353. (concat "[ \t\n]" (regexp-quote member) "[ \n\t]"))
  2354. (if (re-search-forward ebrowse--last-regexp nil t count)
  2355. (goto-char (1+ (match-beginning 0)))
  2356. (error "Not found")))
  2357. ;;; Switching member buffer to another class.
  2358. (defun ebrowse-switch-member-buffer-to-other-class (title compl-list)
  2359. "Switch member buffer to a class read from the minibuffer.
  2360. Use TITLE as minibuffer prompt.
  2361. COMPL-LIST is a completion list to use."
  2362. (let* ((initial (unless (second compl-list)
  2363. (first (first compl-list))))
  2364. (class (or (ebrowse-completing-read-value title compl-list initial)
  2365. (error "Not found"))))
  2366. (setf ebrowse--displayed-class class
  2367. ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
  2368. (ebrowse-redisplay-member-buffer)))
  2369. (defun ebrowse-switch-member-buffer-to-any-class ()
  2370. "Switch member buffer to a class read from the minibuffer."
  2371. (interactive)
  2372. (ebrowse-switch-member-buffer-to-other-class
  2373. "Goto class: " (ebrowse-tree-obarray-as-alist)))
  2374. (defun ebrowse-switch-member-buffer-to-base-class (arg)
  2375. "Switch buffer to ARG'th base class."
  2376. (interactive "P")
  2377. (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class)
  2378. (error "No base classes"))))
  2379. (if (and arg (second supers))
  2380. (let ((alist (loop for s in supers
  2381. collect (cons (ebrowse-qualified-class-name
  2382. (ebrowse-ts-class s))
  2383. s))))
  2384. (ebrowse-switch-member-buffer-to-other-class
  2385. "Goto base class: " alist))
  2386. (setq ebrowse--displayed-class (first supers)
  2387. ebrowse--member-list
  2388. (funcall ebrowse--accessor ebrowse--displayed-class))
  2389. (ebrowse-redisplay-member-buffer))))
  2390. (defun ebrowse-switch-member-buffer-to-next-sibling-class (arg)
  2391. "Move to ARG'th next sibling."
  2392. (interactive "p")
  2393. (ebrowse-switch-member-buffer-to-sibling-class arg))
  2394. (defun ebrowse-switch-member-buffer-to-previous-sibling-class (arg)
  2395. "Move to ARG'th previous sibling."
  2396. (interactive "p")
  2397. (ebrowse-switch-member-buffer-to-sibling-class (- arg)))
  2398. (defun ebrowse-switch-member-buffer-to-sibling-class (inc)
  2399. "Switch member display to nth sibling class.
  2400. Prefix arg INC specifies which one."
  2401. (interactive "p")
  2402. (let ((containing-list ebrowse--tree)
  2403. index cls
  2404. (supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
  2405. (flet ((trees-alist (trees)
  2406. (loop for tr in trees
  2407. collect (cons (ebrowse-cs-name
  2408. (ebrowse-ts-class tr)) tr))))
  2409. (when supers
  2410. (let ((tree (if (second supers)
  2411. (ebrowse-completing-read-value
  2412. "Relative to base class: "
  2413. (trees-alist supers) nil)
  2414. (first supers))))
  2415. (unless tree (error "Not found"))
  2416. (setq containing-list (ebrowse-ts-subclasses tree)))))
  2417. (setq index (+ inc (ebrowse-position ebrowse--displayed-class
  2418. containing-list)))
  2419. (cond ((minusp index) (message "No previous class"))
  2420. ((null (nth index containing-list)) (message "No next class")))
  2421. (setq index (max 0 (min index (1- (length containing-list)))))
  2422. (setq cls (nth index containing-list))
  2423. (setf ebrowse--displayed-class cls
  2424. ebrowse--member-list (funcall ebrowse--accessor cls))
  2425. (ebrowse-redisplay-member-buffer)))
  2426. (defun ebrowse-switch-member-buffer-to-derived-class (arg)
  2427. "Switch member display to nth derived class.
  2428. Prefix arg ARG says which class should be displayed. Default is
  2429. the first derived class."
  2430. (interactive "P")
  2431. (flet ((ebrowse-tree-obarray-as-alist ()
  2432. (loop for s in (ebrowse-ts-subclasses
  2433. ebrowse--displayed-class)
  2434. collect (cons (ebrowse-cs-name
  2435. (ebrowse-ts-class s)) s))))
  2436. (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
  2437. (error "No derived classes"))))
  2438. (if (and arg (second subs))
  2439. (ebrowse-switch-member-buffer-to-other-class
  2440. "Goto derived class: " (ebrowse-tree-obarray-as-alist))
  2441. (setq ebrowse--displayed-class (first subs)
  2442. ebrowse--member-list
  2443. (funcall ebrowse--accessor ebrowse--displayed-class))
  2444. (ebrowse-redisplay-member-buffer)))))
  2445. ;;; Member buffer mouse functions
  2446. (defun ebrowse-displaying-functions ()
  2447. (eq ebrowse--accessor 'ebrowse-ts-member-functions))
  2448. (defun ebrowse-displaying-variables ()
  2449. (eq ebrowse--accessor 'ebrowse-ts-member-variables))
  2450. (defun ebrowse-displaying-static-functions ()
  2451. )
  2452. (defun ebrowse-displaying-static-variables ()
  2453. )
  2454. (defun ebrowse-displaying-types ()
  2455. (eq ebrowse--accessor 'ebrowse-ts-types))
  2456. (defun ebrowse-displaying-friends ()
  2457. (eq ebrowse--accessor 'ebrowse-ts-friends))
  2458. (easy-menu-define
  2459. ebrowse-member-buffer-object-menu ebrowse-member-mode-map
  2460. "Object menu for the member buffer itself."
  2461. '("Members"
  2462. ("Members List"
  2463. ["Functions" ebrowse-display-function-member-list
  2464. :help "Show the list of member functions"
  2465. :style radio
  2466. :selected (eq ebrowse--accessor 'ebrowse-ts-member-functions)
  2467. :active t]
  2468. ["Variables" ebrowse-display-variables-member-list
  2469. :help "Show the list of member variables"
  2470. :style radio
  2471. :selected (eq ebrowse--accessor 'ebrowse-ts-member-variables)
  2472. :active t]
  2473. ["Static Functions" ebrowse-display-static-functions-member-list
  2474. :help "Show the list of static member functions"
  2475. :style radio
  2476. :selected (eq ebrowse--accessor 'ebrowse-ts-static-functions)
  2477. :active t]
  2478. ["Static Variables" ebrowse-display-static-variables-member-list
  2479. :help "Show the list of static member variables"
  2480. :style radio
  2481. :selected (eq ebrowse--accessor 'ebrowse-ts-static-variables)
  2482. :active t]
  2483. ["Types" ebrowse-display-types-member-list
  2484. :help "Show the list of nested types"
  2485. :style radio
  2486. :selected (eq ebrowse--accessor 'ebrowse-ts-types)
  2487. :active t]
  2488. ["Friends/Defines" ebrowse-display-friends-member-list
  2489. :help "Show the list of friends or defines"
  2490. :style radio
  2491. :selected (eq ebrowse--accessor 'ebrowse-ts-friends)
  2492. :active t])
  2493. ("Class"
  2494. ["Up" ebrowse-switch-member-buffer-to-base-class
  2495. :help "Show the base class of this class"
  2496. :active t]
  2497. ["Down" ebrowse-switch-member-buffer-to-derived-class
  2498. :help "Show a derived class class of this class"
  2499. :active t]
  2500. ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class
  2501. :help "Show the next sibling class"
  2502. :active t]
  2503. ["Previous Sibling" ebrowse-switch-member-buffer-to-previous-sibling-class
  2504. :help "Show the previous sibling class"
  2505. :active t])
  2506. ("Member"
  2507. ["Show in Tree" ebrowse-show-displayed-class-in-tree
  2508. :help "Show this class in the class tree"
  2509. :active t]
  2510. ["Find in this Class" ebrowse-goto-visible-member
  2511. :help "Search for a member of this class"
  2512. :active t]
  2513. ["Find in Tree" ebrowse-goto-visible-member/all-member-lists
  2514. :help "Search for a member in any class"
  2515. :active t])
  2516. ("Display"
  2517. ["Inherited" ebrowse-toggle-base-class-display
  2518. :help "Toggle display of inherited members"
  2519. :style toggle
  2520. :selected ebrowse--show-inherited-flag
  2521. :active t]
  2522. ["Attributes" ebrowse-toggle-member-attributes-display
  2523. :help "Show member attributes"
  2524. :style toggle
  2525. :selected ebrowse--attributes-flag
  2526. :active t]
  2527. ["Long Display" ebrowse-toggle-long-short-display
  2528. :help "Toggle the member display format"
  2529. :style toggle
  2530. :selected ebrowse--long-display-flag
  2531. :active t]
  2532. ["Column Width" ebrowse-set-member-buffer-column-width
  2533. :help "Set the display's column width"
  2534. :active t])
  2535. ("Filter"
  2536. ["Public" ebrowse-toggle-public-member-filter
  2537. :help "Toggle the visibility of public members"
  2538. :style toggle
  2539. :selected (not (aref ebrowse--filters 0))
  2540. :active t]
  2541. ["Protected" ebrowse-toggle-protected-member-filter
  2542. :help "Toggle the visibility of protected members"
  2543. :style toggle
  2544. :selected (not (aref ebrowse--filters 1))
  2545. :active t]
  2546. ["Private" ebrowse-toggle-private-member-filter
  2547. :help "Toggle the visibility of private members"
  2548. :style toggle
  2549. :selected (not (aref ebrowse--filters 2))
  2550. :active t]
  2551. ["Virtual" ebrowse-toggle-virtual-member-filter
  2552. :help "Toggle the visibility of virtual members"
  2553. :style toggle
  2554. :selected ebrowse--virtual-display-flag
  2555. :active t]
  2556. ["Inline" ebrowse-toggle-inline-member-filter
  2557. :help "Toggle the visibility of inline members"
  2558. :style toggle
  2559. :selected ebrowse--inline-display-flag
  2560. :active t]
  2561. ["Const" ebrowse-toggle-const-member-filter
  2562. :help "Toggle the visibility of const members"
  2563. :style toggle
  2564. :selected ebrowse--const-display-flag
  2565. :active t]
  2566. ["Pure" ebrowse-toggle-pure-member-filter
  2567. :help "Toggle the visibility of pure virtual members"
  2568. :style toggle
  2569. :selected ebrowse--pure-display-flag
  2570. :active t]
  2571. "-----------------"
  2572. ["Show all" ebrowse-remove-all-member-filters
  2573. :help "Remove any display filters"
  2574. :active t])
  2575. ("Buffer"
  2576. ["Tree" ebrowse-pop-from-member-to-tree-buffer
  2577. :help "Pop to the class tree buffer"
  2578. :active t]
  2579. ["Next Member Buffer" ebrowse-switch-to-next-member-buffer
  2580. :help "Switch to the next member buffer of this class tree"
  2581. :active t]
  2582. ["Freeze" ebrowse-freeze-member-buffer
  2583. :help "Freeze (do not reuse) this member buffer"
  2584. :active t])))
  2585. (defun ebrowse-on-class-name ()
  2586. "Value is non-nil if point is on a class name."
  2587. (eq (get-text-property (point) 'ebrowse-what) 'class-name))
  2588. (defun ebrowse-on-member-name ()
  2589. "Value is non-nil if point is on a member name."
  2590. (eq (get-text-property (point) 'ebrowse-what) 'member-name))
  2591. (easy-menu-define
  2592. ebrowse-member-class-name-object-menu ebrowse-member-mode-map
  2593. "Object menu for class names in member buffer."
  2594. '("Class"
  2595. ["Find" ebrowse-find-member-definition
  2596. :help "Find this class in the source files"
  2597. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
  2598. ["View" ebrowse-view-member-definition
  2599. :help "View this class in the source files"
  2600. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]))
  2601. (easy-menu-define
  2602. ebrowse-member-name-object-menu ebrowse-member-mode-map
  2603. "Object menu for member names"
  2604. '("Ebrowse"
  2605. ["Find Definition" ebrowse-find-member-definition
  2606. :help "Find this member's definition in the source files"
  2607. :active (ebrowse-on-member-name)]
  2608. ["Find Declaration" ebrowse-find-member-declaration
  2609. :help "Find this member's declaration in the source files"
  2610. :active (ebrowse-on-member-name)]
  2611. ["View Definition" ebrowse-view-member-definition
  2612. :help "View this member's definition in the source files"
  2613. :active (ebrowse-on-member-name)]
  2614. ["View Declaration" ebrowse-view-member-declaration
  2615. :help "View this member's declaration in the source files"
  2616. :active (ebrowse-on-member-name)]))
  2617. (defun ebrowse-member-mouse-3 (event)
  2618. "Handle `mouse-3' events in member buffers.
  2619. EVENT is the mouse event."
  2620. (interactive "e")
  2621. (mouse-set-point event)
  2622. (case (event-click-count event)
  2623. (2 (ebrowse-find-member-definition))
  2624. (1 (case (get-text-property (posn-point (event-start event))
  2625. 'ebrowse-what)
  2626. (member-name
  2627. (ebrowse-popup-menu ebrowse-member-name-object-menu event))
  2628. (class-name
  2629. (ebrowse-popup-menu ebrowse-member-class-name-object-menu event))
  2630. (t
  2631. (ebrowse-popup-menu ebrowse-member-buffer-object-menu event))))))
  2632. (defun ebrowse-member-mouse-2 (event)
  2633. "Handle `mouse-2' events in member buffers.
  2634. EVENT is the mouse event."
  2635. (interactive "e")
  2636. (mouse-set-point event)
  2637. (case (event-click-count event)
  2638. (2 (ebrowse-find-member-definition))
  2639. (1 (case (get-text-property (posn-point (event-start event))
  2640. 'ebrowse-what)
  2641. (member-name
  2642. (ebrowse-view-member-definition 0))))))
  2643. ;;; Tags view/find
  2644. (defun ebrowse-class-alist-for-member (tree-header name)
  2645. "Return information about a member in a class tree.
  2646. TREE-HEADER is the header structure of the class tree.
  2647. NAME is the name of the member.
  2648. Value is an alist of elements (CLASS-NAME . (CLASS LIST NAME)),
  2649. where each element describes one occurrence of member NAME in the tree.
  2650. CLASS-NAME is the qualified name of the class in which the
  2651. member was found. The CDR of the acons is described in function
  2652. `ebrowse-class/index/member-for-member'."
  2653. (let ((table (ebrowse-member-table tree-header))
  2654. known-classes
  2655. alist)
  2656. (when name
  2657. (dolist (info (gethash name table) alist)
  2658. (unless (memq (first info) known-classes)
  2659. (setf alist (acons (ebrowse-qualified-class-name
  2660. (ebrowse-ts-class (first info)))
  2661. info alist)
  2662. known-classes (cons (first info) known-classes)))))))
  2663. (defun ebrowse-choose-tree ()
  2664. "Choose a class tree to use.
  2665. If there's more than one class tree loaded, let the user choose
  2666. the one he wants. Value is (TREE HEADER BUFFER), with TREE being
  2667. the class tree, HEADER the header structure of the tree, and BUFFER
  2668. being the tree or member buffer containing the tree."
  2669. (let* ((buffer (ebrowse-choose-from-browser-buffers)))
  2670. (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer)
  2671. (ebrowse-value-in-buffer 'ebrowse--header buffer)
  2672. buffer))))
  2673. (defun ebrowse-tags-read-name (header prompt)
  2674. "Read a C++ identifier from the minibuffer.
  2675. HEADER is the `ebrowse-hs' structure of the class tree.
  2676. Prompt with PROMPT. Insert into the minibuffer a C++ identifier read
  2677. from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
  2678. (save-excursion
  2679. (let ((members (ebrowse-member-table header)))
  2680. (multiple-value-bind (class-name member-name)
  2681. (values-list (ebrowse-tags-read-member+class-name))
  2682. (unless member-name
  2683. (error "No member name at point"))
  2684. (if members
  2685. (let* ((name (ebrowse-ignoring-completion-case
  2686. (completing-read prompt members nil nil member-name)))
  2687. (completion-result (try-completion name members)))
  2688. ;; Cannot rely on `try-completion' returning t for exact
  2689. ;; matches! It returns the name as a string.
  2690. (unless (gethash name members)
  2691. (if (y-or-n-p "No exact match found. Try substrings? ")
  2692. (setq name
  2693. (or (first (ebrowse-list-of-matching-members
  2694. members (regexp-quote name) name))
  2695. (error "Sorry, nothing found")))
  2696. (error "Canceled")))
  2697. (list class-name name))
  2698. (list class-name (read-from-minibuffer prompt member-name)))))))
  2699. (defun ebrowse-tags-read-member+class-name ()
  2700. "Read a C++ identifier from point.
  2701. Value is (CLASS-NAME MEMBER-NAME).
  2702. CLASS-NAME is the name of the class if the identifier was qualified.
  2703. It is nil otherwise.
  2704. MEMBER-NAME is the name of the member found."
  2705. (save-excursion
  2706. (skip-chars-backward "a-zA-Z0-9_")
  2707. (let* ((start (point))
  2708. (name (progn (skip-chars-forward "a-zA-Z0-9_")
  2709. (buffer-substring start (point))))
  2710. class)
  2711. (list class name))))
  2712. (defun ebrowse-tags-choose-class (_tree header name initial-class-name)
  2713. "Read a class name for a member from the minibuffer.
  2714. TREE is the class tree we operate on.
  2715. HEADER is its header structure.
  2716. NAME is the name of the member.
  2717. INITIAL-CLASS-NAME is an initial class name to insert in the minibuffer.
  2718. Value is a list (TREE ACCESSOR MEMBER) for the member."
  2719. (let ((alist (or (ebrowse-class-alist-for-member header name)
  2720. (error "No classes with member `%s' found" name))))
  2721. (ebrowse-ignoring-completion-case
  2722. (if (null (second alist))
  2723. (cdr (first alist))
  2724. (push ?\? unread-command-events)
  2725. (cdr (assoc (completing-read "In class: "
  2726. alist nil t initial-class-name)
  2727. alist))))))
  2728. (defun* ebrowse-tags-view/find-member-decl/defn
  2729. (prefix &key view definition member-name)
  2730. "If VIEW is t, view, else find an occurrence of MEMBER-NAME.
  2731. If DEFINITION is t, find or view the member definition else its
  2732. declaration. This function reads the member's name from the
  2733. current buffer like FIND-TAG. It then prepares a completion list
  2734. of all classes containing a member with the given name and lets
  2735. the user choose the class to use. As a last step, a tags search
  2736. is performed that positions point on the member declaration or
  2737. definition."
  2738. (multiple-value-bind
  2739. (tree header tree-buffer) (values-list (ebrowse-choose-tree))
  2740. (unless tree (error "No class tree"))
  2741. (let* ((marker (point-marker))
  2742. class-name
  2743. (name member-name)
  2744. info)
  2745. (unless name
  2746. (multiple-value-setq (class-name name)
  2747. (values-list
  2748. (ebrowse-tags-read-name
  2749. header
  2750. (concat (if view "View" "Find") " member "
  2751. (if definition "definition" "declaration") ": ")))))
  2752. (setq info (ebrowse-tags-choose-class tree header name class-name))
  2753. (ebrowse-push-position marker info)
  2754. ;; Goto the occurrence of the member
  2755. (ebrowse-view/find-member-declaration/definition
  2756. prefix view definition info
  2757. header
  2758. (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer))
  2759. ;; Record position jumped to
  2760. (ebrowse-push-position (point-marker) info t))))
  2761. ;;;###autoload
  2762. (defun ebrowse-tags-view-declaration ()
  2763. "View declaration of member at point."
  2764. (interactive)
  2765. (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition nil))
  2766. ;;;###autoload
  2767. (defun ebrowse-tags-find-declaration ()
  2768. "Find declaration of member at point."
  2769. (interactive)
  2770. (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition nil))
  2771. ;;;###autoload
  2772. (defun ebrowse-tags-view-definition ()
  2773. "View definition of member at point."
  2774. (interactive)
  2775. (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition t))
  2776. ;;;###autoload
  2777. (defun ebrowse-tags-find-definition ()
  2778. "Find definition of member at point."
  2779. (interactive)
  2780. (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition t))
  2781. (defun ebrowse-tags-view-declaration-other-window ()
  2782. "View declaration of member at point in other window."
  2783. (interactive)
  2784. (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition nil))
  2785. ;;;###autoload
  2786. (defun ebrowse-tags-find-declaration-other-window ()
  2787. "Find declaration of member at point in other window."
  2788. (interactive)
  2789. (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition nil))
  2790. ;;;###autoload
  2791. (defun ebrowse-tags-view-definition-other-window ()
  2792. "View definition of member at point in other window."
  2793. (interactive)
  2794. (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition t))
  2795. ;;;###autoload
  2796. (defun ebrowse-tags-find-definition-other-window ()
  2797. "Find definition of member at point in other window."
  2798. (interactive)
  2799. (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition t))
  2800. (defun ebrowse-tags-view-declaration-other-frame ()
  2801. "View definition of member at point in other frame."
  2802. (interactive)
  2803. (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition nil))
  2804. ;;;###autoload
  2805. (defun ebrowse-tags-find-declaration-other-frame ()
  2806. "Find definition of member at point in other frame."
  2807. (interactive)
  2808. (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition nil))
  2809. ;;;###autoload
  2810. (defun ebrowse-tags-view-definition-other-frame ()
  2811. "View definition of member at point in other frame."
  2812. (interactive)
  2813. (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition t))
  2814. ;;;###autoload
  2815. (defun ebrowse-tags-find-definition-other-frame ()
  2816. "Find definition of member at point in other frame."
  2817. (interactive)
  2818. (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition t))
  2819. (defun ebrowse-tags-select/create-member-buffer (tree-buffer info)
  2820. "Select or create member buffer.
  2821. TREE-BUFFER specifies the tree to use. INFO describes the member.
  2822. It is a list (TREE ACCESSOR MEMBER)."
  2823. (let ((buffer (get-buffer ebrowse-member-buffer-name)))
  2824. (cond ((null buffer)
  2825. (set-buffer tree-buffer)
  2826. (switch-to-buffer (ebrowse-display-member-buffer
  2827. (second info) nil (first info))))
  2828. (t
  2829. (switch-to-buffer buffer)
  2830. (setq ebrowse--displayed-class (first info)
  2831. ebrowse--accessor (second info)
  2832. ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
  2833. (ebrowse-redisplay-member-buffer)))
  2834. (ebrowse-move-point-to-member (ebrowse-ms-name (third info)))))
  2835. (defun ebrowse-tags-display-member-buffer (&optional fix-name)
  2836. "Display a member buffer for a member.
  2837. FIX-NAME non-nil means display the buffer for that member.
  2838. Otherwise read a member name from point."
  2839. (interactive)
  2840. (multiple-value-bind
  2841. (tree header tree-buffer) (values-list (ebrowse-choose-tree))
  2842. (unless tree (error "No class tree"))
  2843. (let* ((marker (point-marker)) class-name (name fix-name) info)
  2844. (unless name
  2845. (multiple-value-setq (class-name name)
  2846. (values-list
  2847. (ebrowse-tags-read-name header
  2848. (concat "Find member list of: ")))))
  2849. (setq info (ebrowse-tags-choose-class tree header name class-name))
  2850. (ebrowse-push-position marker info)
  2851. (ebrowse-tags-select/create-member-buffer tree-buffer info))))
  2852. (defun ebrowse-list-of-matching-members (members regexp &optional name)
  2853. "Return a list of members in table MEMBERS matching REGEXP or NAME.
  2854. Both NAME and REGEXP may be nil in which case exact or regexp matches
  2855. are not performed."
  2856. (let (list)
  2857. (when (or name regexp)
  2858. (maphash (lambda (member-name _info)
  2859. (when (or (and name (string= name member-name))
  2860. (and regexp (string-match regexp member-name)))
  2861. (setq list (cons member-name list))))
  2862. members))
  2863. list))
  2864. (defun ebrowse-tags-apropos ()
  2865. "Display a list of members matching a regexp read from the minibuffer."
  2866. (interactive)
  2867. (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
  2868. (error "No tree buffer")))
  2869. (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
  2870. (members (ebrowse-member-table header))
  2871. temp-buffer-setup-hook
  2872. (regexp (read-from-minibuffer "List members matching regexp: ")))
  2873. (with-output-to-temp-buffer (concat "*Apropos Members*")
  2874. (set-buffer standard-output)
  2875. (erase-buffer)
  2876. (insert "Members matching `" regexp "'\n\n")
  2877. (loop for s in (ebrowse-list-of-matching-members members regexp) do
  2878. (loop for info in (gethash s members) do
  2879. (ebrowse-draw-file-member-info info))))))
  2880. (defun ebrowse-tags-list-members-in-file ()
  2881. "Display a list of members found in a file.
  2882. The file name is read from the minibuffer."
  2883. (interactive)
  2884. (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
  2885. (error "No tree buffer")))
  2886. (files (with-current-buffer buffer (ebrowse-files-table)))
  2887. (file (completing-read "List members in file: " files nil t))
  2888. (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
  2889. temp-buffer-setup-hook
  2890. (members (ebrowse-member-table header)))
  2891. (with-output-to-temp-buffer (concat "*Members in file " file "*")
  2892. (set-buffer standard-output)
  2893. (maphash
  2894. (lambda (_member-name list)
  2895. (loop for info in list
  2896. as member = (third info)
  2897. as class = (ebrowse-ts-class (first info))
  2898. when (or (and (null (ebrowse-ms-file member))
  2899. (string= (ebrowse-cs-file class) file))
  2900. (string= file (ebrowse-ms-file member)))
  2901. do (ebrowse-draw-file-member-info info "decl.")
  2902. when (or (and (null (ebrowse-ms-definition-file member))
  2903. (string= (ebrowse-cs-source-file class) file))
  2904. (string= file (ebrowse-ms-definition-file member)))
  2905. do (ebrowse-draw-file-member-info info "defn.")))
  2906. members))))
  2907. (defun* ebrowse-draw-file-member-info (info &optional (kind ""))
  2908. "Display a line in the members info buffer.
  2909. INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
  2910. TREE is the class of the member to display.
  2911. ACCESSOR is the accessor symbol of its member list.
  2912. MEMBER is the member structure.
  2913. KIND is an additional string printed in the buffer."
  2914. (let* ((tree (first info))
  2915. (globals-p (ebrowse-globals-tree-p tree)))
  2916. (unless globals-p
  2917. (insert (ebrowse-cs-name (ebrowse-ts-class tree))))
  2918. (insert "::" (ebrowse-ms-name (third info)))
  2919. (indent-to 40)
  2920. (insert kind)
  2921. (indent-to 50)
  2922. (insert (case (second info)
  2923. (ebrowse-ts-member-functions "member function")
  2924. (ebrowse-ts-member-variables "member variable")
  2925. (ebrowse-ts-static-functions "static function")
  2926. (ebrowse-ts-static-variables "static variable")
  2927. (ebrowse-ts-friends (if globals-p "define" "friend"))
  2928. (ebrowse-ts-types "type")
  2929. (t "unknown"))
  2930. "\n")))
  2931. (defvar ebrowse-last-completion nil
  2932. "Text inserted by the last completion operation.")
  2933. (defvar ebrowse-last-completion-start nil
  2934. "String which was the basis for the last completion operation.")
  2935. (defvar ebrowse-last-completion-location nil
  2936. "Buffer position at which the last completion operation was initiated.")
  2937. (defvar ebrowse-last-completion-obarray nil
  2938. "Member used in last completion operation.")
  2939. (make-variable-buffer-local 'ebrowse-last-completion-obarray)
  2940. (make-variable-buffer-local 'ebrowse-last-completion-location)
  2941. (make-variable-buffer-local 'ebrowse-last-completion)
  2942. (make-variable-buffer-local 'ebrowse-last-completion-start)
  2943. (defun ebrowse-some-member-table ()
  2944. "Return a hash table containing all members of a tree.
  2945. If there's only one tree loaded, use that. Otherwise let the
  2946. use choose a tree."
  2947. (let* ((buffers (ebrowse-known-class-trees-buffer-list))
  2948. (buffer (cond ((and (first buffers) (not (second buffers)))
  2949. (first buffers))
  2950. (t (or (ebrowse-electric-choose-tree)
  2951. (error "No tree buffer")))))
  2952. (header (ebrowse-value-in-buffer 'ebrowse--header buffer)))
  2953. (ebrowse-member-table header)))
  2954. (defun ebrowse-cyclic-successor-in-string-list (string list)
  2955. "Return the item following STRING in LIST.
  2956. If STRING is the last element, return the first element as successor."
  2957. (or (nth (1+ (ebrowse-position string list 'string=)) list)
  2958. (first list)))
  2959. ;;; Symbol completion
  2960. ;;;###autoload
  2961. (defun* ebrowse-tags-complete-symbol (prefix)
  2962. "Perform completion on the C++ symbol preceding point.
  2963. A second call of this function without changing point inserts the next match.
  2964. A call with prefix PREFIX reads the symbol to insert from the minibuffer with
  2965. completion."
  2966. (interactive "P")
  2967. (let* ((end (point))
  2968. (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point)))
  2969. (pattern (buffer-substring begin end))
  2970. list completion)
  2971. (cond
  2972. ;; With prefix, read name from minibuffer with completion.
  2973. (prefix
  2974. (let* ((members (ebrowse-some-member-table))
  2975. (completion (completing-read "Insert member: "
  2976. members nil t pattern)))
  2977. (when completion
  2978. (setf ebrowse-last-completion-location nil)
  2979. (delete-region begin end)
  2980. (insert completion))))
  2981. ;; If this function is called at the same point the last
  2982. ;; expansion ended, insert the next expansion.
  2983. ((eq (point) ebrowse-last-completion-location)
  2984. (setf list (all-completions ebrowse-last-completion-start
  2985. ebrowse-last-completion-obarray)
  2986. completion (ebrowse-cyclic-successor-in-string-list
  2987. ebrowse-last-completion list))
  2988. (cond ((null completion)
  2989. (error "No completion"))
  2990. ((string= completion pattern)
  2991. (error "No further completion"))
  2992. (t
  2993. (delete-region begin end)
  2994. (insert completion)
  2995. (setf ebrowse-last-completion completion
  2996. ebrowse-last-completion-location (point)))))
  2997. ;; First time the function is called at some position in the
  2998. ;; buffer: Start new completion.
  2999. (t
  3000. (let* ((members (ebrowse-some-member-table))
  3001. (completion (first (all-completions pattern members nil))))
  3002. (cond ((eq completion t))
  3003. ((null completion)
  3004. (error "Can't find completion for `%s'" pattern))
  3005. (t
  3006. (delete-region begin end)
  3007. (insert completion)
  3008. (setf ebrowse-last-completion-location (point)
  3009. ebrowse-last-completion-start pattern
  3010. ebrowse-last-completion completion
  3011. ebrowse-last-completion-obarray members))))))))
  3012. ;;; Tags query replace & search
  3013. (defvar ebrowse-tags-loop-form ()
  3014. "Form for `ebrowse-loop-continue'.
  3015. Evaluated for each file in the tree. If it returns nil, proceed
  3016. with the next file.")
  3017. (defvar ebrowse-tags-next-file-list ()
  3018. "A list of files to be processed.")
  3019. (defvar ebrowse-tags-next-file-path nil
  3020. "The path relative to which files have to be searched.")
  3021. (defvar ebrowse-tags-loop-last-file nil
  3022. "The last file visited via `ebrowse-tags-loop'.")
  3023. (defun ebrowse-tags-next-file (&optional initialize tree-buffer)
  3024. "Select next file among files in current tag table.
  3025. Non-nil argument INITIALIZE (prefix arg, if interactive) initializes
  3026. to the beginning of the list of files in the tag table.
  3027. TREE-BUFFER specifies the class tree we operate on."
  3028. (interactive "P")
  3029. ;; Call with INITIALIZE non-nil initializes the files list.
  3030. ;; If more than one tree buffer is loaded, let the user choose
  3031. ;; on which tree (s)he wants to operate.
  3032. (when initialize
  3033. (let ((buffer (or tree-buffer (ebrowse-choose-from-browser-buffers))))
  3034. (with-current-buffer buffer
  3035. (setq ebrowse-tags-next-file-list
  3036. (ebrowse-files-list (ebrowse-marked-classes-p))
  3037. ebrowse-tags-loop-last-file
  3038. nil
  3039. ebrowse-tags-next-file-path
  3040. (file-name-directory ebrowse--tags-file-name)))))
  3041. ;; End of the loop if the stack of files is empty.
  3042. (unless ebrowse-tags-next-file-list
  3043. (error "All files processed"))
  3044. ;; ebrowse-tags-loop-last-file is the last file that was visited due
  3045. ;; to a call to BROWSE-LOOP (see below). If that file is still
  3046. ;; in memory, and it wasn't modified, throw its buffer away to
  3047. ;; prevent cluttering up the buffer list.
  3048. (when ebrowse-tags-loop-last-file
  3049. (let ((buffer (get-file-buffer ebrowse-tags-loop-last-file)))
  3050. (when (and buffer
  3051. (not (buffer-modified-p buffer)))
  3052. (kill-buffer buffer))))
  3053. ;; Remember this buffer file name for later deletion, if it
  3054. ;; wasn't visited by other means.
  3055. (let ((file (expand-file-name (car ebrowse-tags-next-file-list)
  3056. ebrowse-tags-next-file-path)))
  3057. (setq ebrowse-tags-loop-last-file (if (get-file-buffer file) nil file))
  3058. ;; Find the file and pop the file list. Pop has to be done
  3059. ;; before the file is loaded because FIND-FILE might encounter
  3060. ;; an error, and we want to be able to proceed with the next
  3061. ;; file in this case.
  3062. (pop ebrowse-tags-next-file-list)
  3063. (find-file file)))
  3064. ;;;###autoload
  3065. (defun ebrowse-tags-loop-continue (&optional first-time tree-buffer)
  3066. "Repeat last operation on files in tree.
  3067. FIRST-TIME non-nil means this is not a repetition, but the first time.
  3068. TREE-BUFFER if indirectly specifies which files to loop over."
  3069. (interactive)
  3070. (when first-time
  3071. (ebrowse-tags-next-file first-time tree-buffer)
  3072. (goto-char (point-min)))
  3073. (while (not (eval ebrowse-tags-loop-form))
  3074. (ebrowse-tags-next-file)
  3075. (message "Scanning file `%s'..." buffer-file-name)
  3076. (goto-char (point-min))))
  3077. ;;;###autoload
  3078. (defun ebrowse-tags-search (regexp)
  3079. "Search for REGEXP in all files in a tree.
  3080. If marked classes exist, process marked classes, only.
  3081. If regular expression is nil, repeat last search."
  3082. (interactive "sTree search (regexp): ")
  3083. (if (and (string= regexp "")
  3084. (eq (car ebrowse-tags-loop-form) 're-search-forward))
  3085. (ebrowse-tags-loop-continue)
  3086. (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
  3087. (ebrowse-tags-loop-continue 'first-time)))
  3088. ;;;###autoload
  3089. (defun ebrowse-tags-query-replace (from to)
  3090. "Query replace FROM with TO in all files of a class tree.
  3091. With prefix arg, process files of marked classes only."
  3092. (interactive
  3093. "sTree query replace (regexp): \nsTree query replace %s by: ")
  3094. (setq ebrowse-tags-loop-form
  3095. (list 'and (list 'save-excursion
  3096. (list 're-search-forward from nil t))
  3097. (list 'not (list 'perform-replace from to t t nil))))
  3098. (ebrowse-tags-loop-continue 'first-time))
  3099. ;;;###autoload
  3100. (defun ebrowse-tags-search-member-use (&optional fix-name)
  3101. "Search for call sites of a member.
  3102. If FIX-NAME is specified, search uses of that member.
  3103. Otherwise, read a member name from the minibuffer.
  3104. Searches in all files mentioned in a class tree for something that
  3105. looks like a function call to the member."
  3106. (interactive)
  3107. ;; Choose the tree to use if there is more than one.
  3108. (multiple-value-bind (tree header tree-buffer)
  3109. (values-list (ebrowse-choose-tree))
  3110. (unless tree
  3111. (error "No class tree"))
  3112. ;; Get the member name NAME (class-name is ignored).
  3113. (let ((name fix-name) class-name regexp)
  3114. (unless name
  3115. (multiple-value-setq (class-name name)
  3116. (values-list (ebrowse-tags-read-name header "Find calls of: "))))
  3117. ;; Set tags loop form to search for member and begin loop.
  3118. (setq regexp (concat "\\<" name "[ \t]*(")
  3119. ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
  3120. (ebrowse-tags-loop-continue 'first-time tree-buffer))))
  3121. ;;; Tags position management
  3122. ;;; Structures of this kind are the elements of the position stack.
  3123. (defstruct (ebrowse-position (:type vector) :named)
  3124. file-name ; in which file
  3125. point ; point in file
  3126. target ; t if target of a jump
  3127. info) ; (CLASS FUNC MEMBER) jumped to
  3128. (defvar ebrowse-position-stack ()
  3129. "Stack of `ebrowse-position' structured.")
  3130. (defvar ebrowse-position-index 0
  3131. "Current position in position stack.")
  3132. (defun ebrowse-position-name (position)
  3133. "Return an identifying string for POSITION.
  3134. The string is printed in the electric position list buffer."
  3135. (let ((info (ebrowse-position-info position)))
  3136. (concat (if (ebrowse-position-target position) "at " "to ")
  3137. (ebrowse-cs-name (ebrowse-ts-class (first info)))
  3138. "::" (ebrowse-ms-name (third info)))))
  3139. (defun ebrowse-view/find-position (position &optional view)
  3140. "Position point on POSITION.
  3141. If VIEW is non-nil, view the position, otherwise find it."
  3142. (cond ((not view)
  3143. (find-file (ebrowse-position-file-name position))
  3144. (goto-char (ebrowse-position-point position)))
  3145. (t
  3146. (unwind-protect
  3147. (progn
  3148. (push (function
  3149. (lambda ()
  3150. (goto-char (ebrowse-position-point position))))
  3151. view-mode-hook)
  3152. (view-file (ebrowse-position-file-name position)))
  3153. (pop view-mode-hook)))))
  3154. (defun ebrowse-push-position (marker info &optional target)
  3155. "Push current position on position stack.
  3156. MARKER is the marker to remember as position.
  3157. INFO is a list (CLASS FUNC MEMBER) specifying what we jumped to.
  3158. TARGET non-nil means we performed a jump.
  3159. Positions in buffers that have no file names are not saved."
  3160. (when (buffer-file-name (marker-buffer marker))
  3161. (let ((too-much (- (length ebrowse-position-stack)
  3162. ebrowse-max-positions)))
  3163. ;; Do not let the stack grow to infinity.
  3164. (when (plusp too-much)
  3165. (setq ebrowse-position-stack
  3166. (butlast ebrowse-position-stack too-much)))
  3167. ;; Push the position.
  3168. (push (make-ebrowse-position
  3169. :file-name (buffer-file-name (marker-buffer marker))
  3170. :point (marker-position marker)
  3171. :target target
  3172. :info info)
  3173. ebrowse-position-stack))))
  3174. (defun ebrowse-move-in-position-stack (increment)
  3175. "Move by INCREMENT in the position stack."
  3176. (let ((length (length ebrowse-position-stack)))
  3177. (when (zerop length)
  3178. (error "No positions remembered"))
  3179. (setq ebrowse-position-index
  3180. (mod (+ increment ebrowse-position-index) length))
  3181. (message "Position %d of %d " ebrowse-position-index length)
  3182. (ebrowse-view/find-position (nth ebrowse-position-index
  3183. ebrowse-position-stack))))
  3184. ;;;###autoload
  3185. (defun ebrowse-back-in-position-stack (arg)
  3186. "Move backward in the position stack.
  3187. Prefix arg ARG says how much."
  3188. (interactive "p")
  3189. (ebrowse-move-in-position-stack (max 1 arg)))
  3190. ;;;###autoload
  3191. (defun ebrowse-forward-in-position-stack (arg)
  3192. "Move forward in the position stack.
  3193. Prefix arg ARG says how much."
  3194. (interactive "p")
  3195. (ebrowse-move-in-position-stack (min -1 (- arg))))
  3196. ;;; Electric position list
  3197. (defvar ebrowse-electric-position-mode-map ()
  3198. "Keymap used in electric position stack window.")
  3199. (defvar ebrowse-electric-position-mode-hook nil
  3200. "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
  3201. (unless ebrowse-electric-position-mode-map
  3202. (let ((map (make-keymap))
  3203. (submap (make-keymap)))
  3204. (setq ebrowse-electric-position-mode-map map)
  3205. (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
  3206. (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
  3207. (define-key map "\e" submap)
  3208. (define-key map "\C-z" 'suspend-frame)
  3209. (define-key map "\C-h" 'Helper-help)
  3210. (define-key map "?" 'Helper-describe-bindings)
  3211. (define-key map "\C-c" nil)
  3212. (define-key map "\C-c\C-c" 'ebrowse-electric-position-quit)
  3213. (define-key map "q" 'ebrowse-electric-position-quit)
  3214. (define-key map " " 'ebrowse-electric-select-position)
  3215. (define-key map "\C-l" 'recenter)
  3216. (define-key map "\C-u" 'universal-argument)
  3217. (define-key map "\C-p" 'previous-line)
  3218. (define-key map "\C-n" 'next-line)
  3219. (define-key map "p" 'previous-line)
  3220. (define-key map "n" 'next-line)
  3221. (define-key map "v" 'ebrowse-electric-view-position)
  3222. (define-key map "\C-v" 'scroll-up-command)
  3223. (define-key map "\ev" 'scroll-down-command)
  3224. (define-key map "\e\C-v" 'scroll-other-window)
  3225. (define-key map "\e>" 'end-of-buffer)
  3226. (define-key map "\e<" 'beginning-of-buffer)
  3227. (define-key map "\e>" 'end-of-buffer)))
  3228. (put 'ebrowse-electric-position-mode 'mode-class 'special)
  3229. (put 'ebrowse-electric-position-undefined 'suppress-keymap t)
  3230. (define-derived-mode ebrowse-electric-position-mode
  3231. fundamental-mode "Electric Position Menu"
  3232. "Mode for electric position buffers.
  3233. Runs the hook `ebrowse-electric-position-mode-hook'."
  3234. (setq mode-line-buffer-identification "Electric Position Menu")
  3235. (when (memq 'mode-name mode-line-format)
  3236. (setq mode-line-format (copy-sequence mode-line-format))
  3237. (setcar (memq 'mode-name mode-line-format) "Positions"))
  3238. (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
  3239. (setq truncate-lines t
  3240. buffer-read-only t))
  3241. (defun ebrowse-draw-position-buffer ()
  3242. "Display positions in buffer *Positions*."
  3243. (set-buffer (get-buffer-create "*Positions*"))
  3244. (setq buffer-read-only nil)
  3245. (erase-buffer)
  3246. (insert "File Point Description\n"
  3247. "---- ----- -----------\n")
  3248. (dolist (position ebrowse-position-stack)
  3249. (insert (file-name-nondirectory (ebrowse-position-file-name position)))
  3250. (indent-to 15)
  3251. (insert (int-to-string (ebrowse-position-point position)))
  3252. (indent-to 22)
  3253. (insert (ebrowse-position-name position) "\n"))
  3254. (setq buffer-read-only t))
  3255. ;;;###autoload
  3256. (defun ebrowse-electric-position-menu ()
  3257. "List positions in the position stack in an electric buffer."
  3258. (interactive)
  3259. (unless ebrowse-position-stack
  3260. (error "No positions remembered"))
  3261. (let (select buffer window)
  3262. (save-window-excursion
  3263. (save-window-excursion (ebrowse-draw-position-buffer))
  3264. (setq window (Electric-pop-up-window "*Positions*")
  3265. buffer (window-buffer window))
  3266. (shrink-window-if-larger-than-buffer window)
  3267. (unwind-protect
  3268. (progn
  3269. (set-buffer buffer)
  3270. (ebrowse-electric-position-mode)
  3271. (setq select
  3272. (catch 'ebrowse-electric-select-position
  3273. (message "<<< Press Space to bury the list >>>")
  3274. (let ((first (progn (goto-char (point-min))
  3275. (forward-line 2)
  3276. (point)))
  3277. (last (progn (goto-char (point-max))
  3278. (forward-line -1)
  3279. (point)))
  3280. (goal-column 0))
  3281. (goto-char first)
  3282. (Electric-command-loop 'ebrowse-electric-select-position
  3283. nil t
  3284. 'ebrowse-electric-position-looper
  3285. (cons first last))))))
  3286. (set-buffer buffer)
  3287. (bury-buffer buffer)
  3288. (message nil)))
  3289. (when select
  3290. (set-buffer buffer)
  3291. (ebrowse-electric-find-position select))
  3292. (kill-buffer buffer)))
  3293. (defun ebrowse-electric-position-looper (state condition)
  3294. "Prevent moving point on invalid lines.
  3295. Called from `Electric-command-loop'. See there for the meaning
  3296. of STATE and CONDITION."
  3297. (cond ((and condition
  3298. (not (memq (car condition) '(buffer-read-only
  3299. end-of-buffer
  3300. beginning-of-buffer))))
  3301. (signal (car condition) (cdr condition)))
  3302. ((< (point) (car state))
  3303. (goto-char (point-min))
  3304. (forward-line 2))
  3305. ((> (point) (cdr state))
  3306. (goto-char (point-max))
  3307. (forward-line -1)
  3308. (if (pos-visible-in-window-p (point-max))
  3309. (recenter -1)))))
  3310. (defun ebrowse-electric-position-undefined ()
  3311. "Function called for undefined keys."
  3312. (interactive)
  3313. (message "Type C-h for help, ? for commands, q to quit, Space to execute")
  3314. (sit-for 4))
  3315. (defun ebrowse-electric-position-quit ()
  3316. "Leave the electric position list."
  3317. (interactive)
  3318. (throw 'ebrowse-electric-select-position nil))
  3319. (defun ebrowse-electric-select-position ()
  3320. "Select a position from the list."
  3321. (interactive)
  3322. (throw 'ebrowse-electric-select-position (point)))
  3323. (defun ebrowse-electric-find-position (point &optional view)
  3324. "View/find what is described by the line at POINT.
  3325. If VIEW is non-nil, view else find source files."
  3326. (let ((index (- (count-lines (point-min) point) 2)))
  3327. (ebrowse-view/find-position (nth index
  3328. ebrowse-position-stack) view)))
  3329. (defun ebrowse-electric-view-position ()
  3330. "View the position described by the line point is in."
  3331. (interactive)
  3332. (ebrowse-electric-find-position (point) t))
  3333. ;;; Saving trees to disk
  3334. (defun ebrowse-write-file-hook-fn ()
  3335. "Write current buffer as a class tree.
  3336. Installed on `local-write-file-hooks'."
  3337. (ebrowse-save-tree)
  3338. t)
  3339. ;;;###autoload
  3340. (defun ebrowse-save-tree ()
  3341. "Save current tree in same file it was loaded from."
  3342. (interactive)
  3343. (ebrowse-save-tree-as (or buffer-file-name ebrowse--tags-file-name)))
  3344. ;;;###autoload
  3345. (defun ebrowse-save-tree-as (&optional file-name)
  3346. "Write the current tree data structure to a file.
  3347. Read the file name from the minibuffer if interactive.
  3348. Otherwise, FILE-NAME specifies the file to save the tree in."
  3349. (interactive "FSave tree as: ")
  3350. (let ((temp-buffer (get-buffer-create "*Tree Output"))
  3351. (old-standard-output standard-output)
  3352. (header (copy-ebrowse-hs ebrowse--header))
  3353. (tree ebrowse--tree))
  3354. (unwind-protect
  3355. (with-current-buffer (setq standard-output temp-buffer)
  3356. (erase-buffer)
  3357. (setf (ebrowse-hs-member-table header) nil)
  3358. (insert (prin1-to-string header) " ")
  3359. (mapc 'ebrowse-save-class tree)
  3360. (write-file file-name)
  3361. (message "Tree written to file `%s'" file-name))
  3362. (kill-buffer temp-buffer)
  3363. (set-buffer-modified-p nil)
  3364. (ebrowse-update-tree-buffer-mode-line)
  3365. (setq standard-output old-standard-output))))
  3366. (defun ebrowse-save-class (class)
  3367. "Write single class CLASS to current buffer."
  3368. (message "%s..." (ebrowse-cs-name (ebrowse-ts-class class)))
  3369. (insert "[ebrowse-ts ")
  3370. (prin1 (ebrowse-ts-class class)) ;class name
  3371. (insert "(") ;list of subclasses
  3372. (mapc 'ebrowse-save-class (ebrowse-ts-subclasses class))
  3373. (insert ")")
  3374. (dolist (func ebrowse-member-list-accessors)
  3375. (prin1 (funcall func class))
  3376. (insert "\n"))
  3377. (insert "()") ;base-classes slot
  3378. (prin1 (ebrowse-ts-mark class))
  3379. (insert "]\n"))
  3380. ;;; Statistics
  3381. ;;;###autoload
  3382. (defun ebrowse-statistics ()
  3383. "Display statistics for a class tree."
  3384. (interactive)
  3385. (let ((tree-file (buffer-file-name))
  3386. temp-buffer-setup-hook)
  3387. (with-output-to-temp-buffer "*Tree Statistics*"
  3388. (multiple-value-bind (classes member-functions member-variables
  3389. static-functions static-variables)
  3390. (values-list (ebrowse-gather-statistics))
  3391. (set-buffer standard-output)
  3392. (erase-buffer)
  3393. (insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
  3394. (ebrowse-print-statistics-line "Number of classes:" classes)
  3395. (ebrowse-print-statistics-line "Number of member functions:"
  3396. member-functions)
  3397. (ebrowse-print-statistics-line "Number of member variables:"
  3398. member-variables)
  3399. (ebrowse-print-statistics-line "Number of static functions:"
  3400. static-functions)
  3401. (ebrowse-print-statistics-line "Number of static variables:"
  3402. static-variables)))))
  3403. (defun ebrowse-print-statistics-line (title value)
  3404. "Print a line in the statistics buffer.
  3405. TITLE is the title of the line, VALUE is a number to be printed
  3406. after that."
  3407. (insert title)
  3408. (indent-to 40)
  3409. (insert (format "%d\n" value)))
  3410. (defun ebrowse-gather-statistics ()
  3411. "Return statistics for a class tree.
  3412. The result is a list (NUMBER-OF-CLASSES NUMBER-OF-MEMBER-FUNCTIONS
  3413. NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
  3414. NUMBER-OF-STATIC-VARIABLES:"
  3415. (let ((classes 0) (member-functions 0) (member-variables 0)
  3416. (static-functions 0) (static-variables 0))
  3417. (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
  3418. (incf classes)
  3419. (incf member-functions (length (ebrowse-ts-member-functions tree)))
  3420. (incf member-variables (length (ebrowse-ts-member-variables tree)))
  3421. (incf static-functions (length (ebrowse-ts-static-functions tree)))
  3422. (incf static-variables (length (ebrowse-ts-static-variables tree))))
  3423. (list classes member-functions member-variables
  3424. static-functions static-variables)))
  3425. ;;; Global key bindings
  3426. ;; The following can be used to bind key sequences starting with
  3427. ;; prefix `\C-c\C-m' to browse commands.
  3428. (defvar ebrowse-global-map nil
  3429. "*Keymap for Ebrowse commands.")
  3430. (defvar ebrowse-global-prefix-key "\C-c\C-m"
  3431. "Prefix key for Ebrowse commands.")
  3432. (defvar ebrowse-global-submap-4 nil
  3433. "Keymap used for `ebrowse-global-prefix' followed by `4'.")
  3434. (defvar ebrowse-global-submap-5 nil
  3435. "Keymap used for `ebrowse-global-prefix' followed by `5'.")
  3436. (unless ebrowse-global-map
  3437. (setq ebrowse-global-map (make-sparse-keymap))
  3438. (setq ebrowse-global-submap-4 (make-sparse-keymap))
  3439. (setq ebrowse-global-submap-5 (make-sparse-keymap))
  3440. (define-key ebrowse-global-map "a" 'ebrowse-tags-apropos)
  3441. (define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer)
  3442. (define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack)
  3443. (define-key ebrowse-global-map "+" 'ebrowse-forward-in-position-stack)
  3444. (define-key ebrowse-global-map "l" 'ebrowse-tags-list-members-in-file)
  3445. (define-key ebrowse-global-map "m" 'ebrowse-tags-display-member-buffer)
  3446. (define-key ebrowse-global-map "n" 'ebrowse-tags-next-file)
  3447. (define-key ebrowse-global-map "p" 'ebrowse-electric-position-menu)
  3448. (define-key ebrowse-global-map "s" 'ebrowse-tags-search)
  3449. (define-key ebrowse-global-map "u" 'ebrowse-tags-search-member-use)
  3450. (define-key ebrowse-global-map "v" 'ebrowse-tags-view-definition)
  3451. (define-key ebrowse-global-map "V" 'ebrowse-tags-view-declaration)
  3452. (define-key ebrowse-global-map "%" 'ebrowse-tags-query-replace)
  3453. (define-key ebrowse-global-map "." 'ebrowse-tags-find-definition)
  3454. (define-key ebrowse-global-map "f" 'ebrowse-tags-find-definition)
  3455. (define-key ebrowse-global-map "F" 'ebrowse-tags-find-declaration)
  3456. (define-key ebrowse-global-map "," 'ebrowse-tags-loop-continue)
  3457. (define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list)
  3458. (define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol)
  3459. (define-key ebrowse-global-map "4" ebrowse-global-submap-4)
  3460. (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window)
  3461. (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window)
  3462. (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window)
  3463. (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window)
  3464. (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window)
  3465. (define-key ebrowse-global-map "5" ebrowse-global-submap-5)
  3466. (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame)
  3467. (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame)
  3468. (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame)
  3469. (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame)
  3470. (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame)
  3471. (define-key global-map ebrowse-global-prefix-key ebrowse-global-map))
  3472. ;;; Electric C++ browser buffer menu
  3473. ;; Electric buffer menu customization to display only some buffers
  3474. ;; (in this case Tree buffers). There is only one problem with this:
  3475. ;; If the very first character typed in the buffer menu is a space,
  3476. ;; this will select the buffer from which the buffer menu was
  3477. ;; invoked. But this buffer is not displayed in the buffer list if
  3478. ;; it isn't a tree buffer. I therefore let the buffer menu command
  3479. ;; loop read the command `p' via `unread-command-char'. This command
  3480. ;; has no effect since we are on the first line of the buffer.
  3481. (defvar electric-buffer-menu-mode-hook nil)
  3482. (defun ebrowse-hack-electric-buffer-menu ()
  3483. "Hack the electric buffer menu to display browser buffers."
  3484. (let (non-empty)
  3485. (unwind-protect
  3486. (save-excursion
  3487. (setq buffer-read-only nil)
  3488. (goto-char 1)
  3489. (forward-line 2)
  3490. (while (not (eobp))
  3491. (let ((b (Buffer-menu-buffer nil)))
  3492. (if (or (ebrowse-buffer-p b)
  3493. (string= (buffer-name b) "*Apropos Members*"))
  3494. (progn (forward-line 1)
  3495. (setq non-empty t))
  3496. (delete-region (point)
  3497. (save-excursion (end-of-line)
  3498. (min (point-max)
  3499. (1+ (point)))))))))
  3500. (unless non-empty
  3501. (error "No tree buffers"))
  3502. (setf unread-command-events (listify-key-sequence "p"))
  3503. (shrink-window-if-larger-than-buffer (selected-window))
  3504. (setq buffer-read-only t))))
  3505. (defun ebrowse-select-1st-to-9nth ()
  3506. "Select the nth entry in the list by the keys 1..9."
  3507. (interactive)
  3508. (let* ((maxlin (count-lines (point-min) (point-max)))
  3509. (n (min maxlin (+ 2 (string-to-number (this-command-keys))))))
  3510. (goto-char (point-min))
  3511. (forward-line (1- n))
  3512. (throw 'electric-buffer-menu-select (point))))
  3513. (defun ebrowse-install-1-to-9-keys ()
  3514. "Define keys 1..9 to select the 1st to 9nth entry in the list."
  3515. (dotimes (i 9)
  3516. (define-key (current-local-map) (char-to-string (+ i ?1))
  3517. 'ebrowse-select-1st-to-9nth)))
  3518. (defun ebrowse-electric-buffer-list ()
  3519. "Display an electric list of Ebrowse buffers."
  3520. (interactive)
  3521. (unwind-protect
  3522. (progn
  3523. (add-hook 'electric-buffer-menu-mode-hook
  3524. 'ebrowse-hack-electric-buffer-menu)
  3525. (add-hook 'electric-buffer-menu-mode-hook
  3526. 'ebrowse-install-1-to-9-keys)
  3527. (call-interactively 'electric-buffer-list))
  3528. (remove-hook 'electric-buffer-menu-mode-hook
  3529. 'ebrowse-hack-electric-buffer-menu)))
  3530. ;;; Mouse support
  3531. (defun ebrowse-mouse-find-member (event)
  3532. "Find the member clicked on in another frame.
  3533. EVENT is a mouse button event."
  3534. (interactive "e")
  3535. (mouse-set-point event)
  3536. (let (start name)
  3537. (save-excursion
  3538. (skip-chars-backward "a-zA-Z0-9_")
  3539. (setq start (point))
  3540. (skip-chars-forward "a-zA-Z0-9_")
  3541. (setq name (buffer-substring start (point))))
  3542. (ebrowse-tags-view/find-member-decl/defn
  3543. 5 :view nil :definition t :member-name name)))
  3544. (defun ebrowse-popup-menu (menu event)
  3545. "Pop up MENU and perform an action if something was selected.
  3546. EVENT is the mouse event."
  3547. (save-selected-window
  3548. (select-window (posn-window (event-start event)))
  3549. (let ((selection (x-popup-menu event menu)) binding)
  3550. (while selection
  3551. (setq binding (lookup-key (or binding menu) (vector (car selection)))
  3552. selection (cdr selection)))
  3553. (when binding
  3554. (call-interactively binding)))))
  3555. (easy-menu-define
  3556. ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map
  3557. "Object menu for classes in the tree buffer"
  3558. '("Class"
  3559. ["Functions" ebrowse-tree-command:show-member-functions
  3560. :help "Display a list of member functions"
  3561. :active t]
  3562. ["Variables" ebrowse-tree-command:show-member-variables
  3563. :help "Display a list of member variables"
  3564. :active t]
  3565. ["Static Functions" ebrowse-tree-command:show-static-member-functions
  3566. :help "Display a list of static member functions"
  3567. :active t]
  3568. ["Static Variables" ebrowse-tree-command:show-static-member-variables
  3569. :help "Display a list of static member variables"
  3570. :active t]
  3571. ["Friends/ Defines" ebrowse-tree-command:show-friends
  3572. :help "Display a list of friends of a class"
  3573. :active t]
  3574. ["Types" ebrowse-tree-command:show-types
  3575. :help "Display a list of types defined in a class"
  3576. :active t]
  3577. "-----------------"
  3578. ["View" ebrowse-view-class-declaration
  3579. :help "View class declaration"
  3580. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
  3581. ["Find" ebrowse-find-class-declaration
  3582. :help "Find class declaration in file"
  3583. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
  3584. "-----------------"
  3585. ["Mark" ebrowse-toggle-mark-at-point
  3586. :help "Mark class point is on"
  3587. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
  3588. "-----------------"
  3589. ["Collapse" ebrowse-collapse-branch
  3590. :help "Collapse subtree under class point is on"
  3591. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
  3592. ["Expand" ebrowse-expand-branch
  3593. :help "Expand subtree under class point is on"
  3594. :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]))
  3595. (easy-menu-define
  3596. ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map
  3597. "Object menu for tree buffers"
  3598. '("Ebrowse"
  3599. ["Filename Display" ebrowse-toggle-file-name-display
  3600. :help "Toggle display of source files names"
  3601. :style toggle
  3602. :selected ebrowse--show-file-names-flag
  3603. :active t]
  3604. ["Tree Indentation" ebrowse-set-tree-indentation
  3605. :help "Set the tree's indentation"
  3606. :active t]
  3607. ["Unmark All Classes" ebrowse-mark-all-classes
  3608. :help "Unmark all classes in the class tree"
  3609. :active t]
  3610. ["Expand All" ebrowse-expand-all
  3611. :help "Expand all subtrees in the class tree"
  3612. :active t]
  3613. ["Statistics" ebrowse-statistics
  3614. :help "Show a buffer with class hierarchy statistics"
  3615. :active t]
  3616. ["Find Class" ebrowse-read-class-name-and-go
  3617. :help "Find a class in the tree"
  3618. :active t]
  3619. ["Member Buffer" ebrowse-pop/switch-to-member-buffer-for-same-tree
  3620. :help "Show a member buffer for this class tree"
  3621. :active t]))
  3622. (defun ebrowse-mouse-3-in-tree-buffer (event)
  3623. "Perform mouse actions in tree buffers.
  3624. EVENT is the mouse event."
  3625. (interactive "e")
  3626. (mouse-set-point event)
  3627. (let* ((where (posn-point (event-start event)))
  3628. (property (get-text-property where 'ebrowse-what)))
  3629. (case (event-click-count event)
  3630. (1
  3631. (case property
  3632. (class-name
  3633. (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event))
  3634. (t
  3635. (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event)))))))
  3636. (defun ebrowse-mouse-2-in-tree-buffer (event)
  3637. "Perform mouse actions in tree buffers.
  3638. EVENT is the mouse event."
  3639. (interactive "e")
  3640. (mouse-set-point event)
  3641. (let* ((where (posn-point (event-start event)))
  3642. (property (get-text-property where 'ebrowse-what)))
  3643. (case (event-click-count event)
  3644. (1 (case property
  3645. (class-name
  3646. (ebrowse-tree-command:show-member-functions)))))))
  3647. (defun ebrowse-mouse-1-in-tree-buffer (event)
  3648. "Perform mouse actions in tree buffers.
  3649. EVENT is the mouse event."
  3650. (interactive "e")
  3651. (mouse-set-point event)
  3652. (let* ((where (posn-point (event-start event)))
  3653. (property (get-text-property where 'ebrowse-what)))
  3654. (case (event-click-count event)
  3655. (2 (case property
  3656. (class-name
  3657. (let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
  3658. (looking-at "\r"))))
  3659. (ebrowse-collapse-fn (not collapsed))))
  3660. (mark
  3661. (ebrowse-toggle-mark-at-point 1)))))))
  3662. (provide 'ebrowse)
  3663. ;; Local variables:
  3664. ;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
  3665. ;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
  3666. ;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
  3667. ;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
  3668. ;; End:
  3669. ;;; ebrowse.el ends here