eiffel.el 110 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771
  1. ;;; eiffel.el --- major mode for editing Eiffel files.
  2. ;; Copyright (C) 1989, 1990, 1993, 1994, 1995, 1996, 1999, 2000,
  3. ;; 2001, 2002, 2003
  4. ;; Tower Technology Corporation,
  5. ;; Free Software Foundation,
  6. ;; Bob Weiner,
  7. ;; C. Adrian
  8. ;; Authors: 1989-1990 Stephen Omohundro, ISE and Bob Weiner
  9. ;; 1993-1996 Tower Technology Corporation
  10. ;; 1999-2003 Martin Schwenke <martin@meltin.net>
  11. ;; 2019 Germán A. Arias
  12. ;;
  13. ;; Keywords: eiffel languages oop
  14. ;; Requires: font-lock, compile, easymenu, imenu
  15. ;; This file is derived from eiffel.el from Liberty Eiffel project.
  16. ;;
  17. ;; Known bugs:
  18. ;;
  19. ;; * eif-short buffer doesn't get font locked under GNU Emacs 19.34.
  20. ;;
  21. ;; * eif-debug can hang under (at least) XEmacs 21.4.[89] in the wait
  22. ;; loop if there is input pending (that is, if the user hits return
  23. ;; an extra time). Not yet tested under XEmacs 21.5.
  24. ;;
  25. ;; This file is distributed under the same terms as GNU Emacs.
  26. ;; GNU Emacs is free software; you can redistribute it and/or modify
  27. ;; it under the terms of the GNU General Public License as published by
  28. ;; the Free Software Foundation; either version 2, or (at your option)
  29. ;; any later version.
  30. ;; GNU Emacs is distributed in the hope that it will be useful,
  31. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  33. ;; GNU General Public License for more details.
  34. ;; You should have received a copy of the GNU General Public License
  35. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  36. ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  37. ;; Boston, MA 02110-1301, USA
  38. ;;; Commentary:
  39. ;; INSTALLATION
  40. ;; To install, simply copy this file into a directory in your
  41. ;; load-path and add the following two commands in your .emacs file:
  42. ;;
  43. ;; (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
  44. ;; (autoload 'eiffel-mode "eiffel" "Major mode for Eiffel programs" t)
  45. ;;
  46. ;;; History:
  47. ;;
  48. ;; Add history stuff here!!!
  49. ;;; Code:
  50. (require 'font-lock)
  51. (require 'compile)
  52. (require 'easymenu)
  53. (require 'imenu)
  54. (defconst eiffel-version-string
  55. "$Id: eiffel.el,v 2.67 2003/06/14 10:41:01 martins Exp $"
  56. "Version string to make reporting bugs more meaningful.
  57. Note that if this file becomes part of GNU Emacs then the file might
  58. be changed by the Emacs maintainers without this version number
  59. changing. This means that if you are reporting a bug for a version
  60. that was shipped with Emacs, you should report the Emacs version!")
  61. (defgroup eiffel nil
  62. "Eiffel mode for Emacs"
  63. :group 'oop)
  64. (defgroup eiffel-indent nil
  65. "Indentation variables in Eiffel mode"
  66. :prefix "eif-"
  67. :group 'eiffel)
  68. (defgroup eiffel-compile nil
  69. "Compilation support variables in Eiffel mode"
  70. :prefix "eif-"
  71. :group 'eiffel)
  72. (defun eif-customize ()
  73. "Run \\[customize-group] for the `eiffel' group."
  74. (interactive)
  75. (customize-group 'eiffel))
  76. ;; Indentation amount variables.
  77. ;;
  78. ;; The default values correspond to style used in ``Eiffel: The
  79. ;; Language''.
  80. (defcustom eif-indent-increment 3
  81. "*Default indentation interval (in spaces)."
  82. :type 'integer
  83. :group 'eiffel-indent)
  84. (defcustom eif-class-level-kw-indent 0
  85. "*Indentation for Class level keywords.
  86. Specified as number of `eif-indent-increments'. See the variable
  87. `eif-class-level-keywords-regexp'."
  88. :type 'integer
  89. :group 'eiffel-indent)
  90. (defcustom eif-extra-class-level-kw-indent 0
  91. "*Number of extra spaces to add to `eif-class-level-kw-indent'.
  92. This results in the actual indentation of a class level keyword. Can
  93. be negative."
  94. :type 'integer
  95. :group 'eiffel-indent)
  96. (defcustom eif-class-level-comment-indent 0
  97. "*Indentation of comments at the beginning of a class.
  98. Specified as number of `eif-indent-increments'."
  99. :type 'integer
  100. :group 'eiffel-indent)
  101. (defcustom eif-extra-class-level-comment-indent 0
  102. "*Number of spaces to add to `eif-class-level-comment-indent'.
  103. This results in the actual indentation of a class level comment. Can
  104. be negative."
  105. :type 'integer
  106. :group 'eiffel-indent)
  107. (defcustom eif-inherit-level-kw-indent 2
  108. "*Indentation of keywords falling under the Inherit clause.
  109. Specified as number of `eif-indent-increments'. See the variable
  110. `eif-inherit-level-keywords'."
  111. :type 'integer
  112. :group 'eiffel-indent)
  113. (defcustom eif-extra-inherit-level-kw-indent 0
  114. "*Number of spaces to add to `eif-inherit-level-kw-indent'.
  115. This results in the actual indentation of an inherit level keyword.
  116. Can be negative."
  117. :type 'integer
  118. :group 'eiffel-indent)
  119. (defcustom eif-feature-level-indent 1
  120. "*Indentation amount of features.
  121. Specified as number of `eif-indent-increments'."
  122. :type 'integer
  123. :group 'eiffel-indent)
  124. (defcustom eif-extra-feature-level-indent 0
  125. "*Number of spaces to add to `eif-feature-level-indent'.
  126. This results in the indentation of a feature. Can be negative."
  127. :type 'integer
  128. :group 'eiffel-indent)
  129. (defcustom eif-feature-level-kw-indent 2
  130. "*Indentation of keywords belonging to individual features.
  131. Specified as number of `eif-indent-increments'. See the variable
  132. `eif-feature-level-keywords-regexp'."
  133. :type 'integer
  134. :group 'eiffel-indent)
  135. (defcustom eif-extra-feature-level-kw-indent 0
  136. "*Number of spaces to add to `eif-feature-level-kw-indent'.
  137. This results in the actual indentation of a feature level keyword.
  138. Can be negative."
  139. :type 'integer
  140. :group 'eiffel-indent)
  141. (defcustom eif-feature-level-comment-indent 3
  142. "*Indentation of comments at the beginning of a feature.
  143. Specified as number of `eif-indent-increments'."
  144. :type 'integer
  145. :group 'eiffel-indent)
  146. (defcustom eif-extra-feature-level-comment-indent 0
  147. "*Number of spaces to add to `eif-feature-level-comment-indent'.
  148. This results in the actual indentation of a feature level comment.
  149. Can be negative."
  150. :type 'integer
  151. :group 'eiffel-indent)
  152. (defcustom eif-body-comment-indent 0
  153. "*Indentation of comments in the body of a routine.
  154. Specified as number of `eif-indent-increments')"
  155. :type 'integer
  156. :group 'eiffel-indent)
  157. (defcustom eif-extra-body-comment-indent 0
  158. "*Number of spaces to add to `eif-body-comment-indent'.
  159. This results in the actual indentation of a routine body comment. Can
  160. be negative."
  161. :type 'integer
  162. :group 'eiffel-indent)
  163. (defcustom eif-check-keyword-indent 0
  164. "*Extra indentation for the check clause as described in ETL.
  165. Specified as number of `eif-indent-increments'. Default is 0, which
  166. is different than in ETL's 1."
  167. :type 'integer
  168. :group 'eiffel-indent)
  169. (defcustom eif-extra-check-keyword-indent 0
  170. "*Number of spaces to add to `eif-check-keyword-indent'.
  171. This results in the actual indentation of a check keyword. Can be
  172. negative."
  173. :type 'integer
  174. :group 'eiffel-indent)
  175. (defcustom eif-rescue-keyword-indent -1
  176. "*Extra indentation for the rescue clause as described in ETL.
  177. Specified as number of `eif-indent-increments'. Default is -1."
  178. :type 'integer
  179. :group 'eiffel-indent)
  180. (defcustom eif-extra-rescue-keyword-indent 0
  181. "*Number of spaces to add to `eif-rescue-keyword-indent'.
  182. This results in the actual indentation of a rescue keyword. Can be
  183. negative."
  184. :type 'integer
  185. :group 'eiffel-indent)
  186. (defcustom eif-then-indent 0
  187. "*Indentation for a `then' appearing on a line by itself.
  188. This is as opposed to a `then' on the same line as an `if'. Specified
  189. as number of `eif-indent-increments'."
  190. :type 'integer
  191. :group 'eiffel-indent)
  192. (defcustom eif-extra-then-indent 0
  193. "*Number of spaces to add to `eif-then-indent'.
  194. This results in the actual indentation of a `then' appearing on a line
  195. by itself. Can be negative."
  196. :type 'integer
  197. :group 'eiffel-indent)
  198. (defcustom eif-continuation-indent 1
  199. "*Extra indentation for a continued statement line.
  200. Specified as number of `eif-indent-increments'."
  201. :type 'integer
  202. :group 'eiffel-indent)
  203. (defcustom eif-extra-continuation-indent 0
  204. "*Number of spaces to add to `eif-continuation-indent'.
  205. This results in the actual indentation of a continued statement
  206. line. Can be negative."
  207. :type 'integer
  208. :group 'eiffel-indent)
  209. (defcustom eif-string-continuation-indent 0
  210. "*Extra indentation for a continued string.
  211. Specified as number of `eif-indent-increments'."
  212. :type 'integer
  213. :group 'eiffel-indent)
  214. (defcustom eif-extra-string-continuation-indent -1
  215. "*Number of spaces to add to `eif-string-continuation-indent'.
  216. This results in the actual indentation of a continued string. Can be
  217. negative."
  218. :type 'integer
  219. :group 'eiffel-indent)
  220. (defcustom eif-indent-string-continuations-relatively-flag t
  221. "*Non-nil means string continuations are indented relative to 1st character.
  222. That is, `eif-string-continuation-indent' and
  223. `eif-extra-string-continuation-indent' are added to position of first
  224. character of string. If nil, string continuations are indented
  225. relative to indent of previous line."
  226. :type 'boolean
  227. :group 'eiffel-indent)
  228. (defcustom eif-set-tab-width-flag t
  229. "*Non-nil means `tab-width' is set to `eif-indent-increment' in `eiffel-mode'."
  230. :type 'boolean
  231. :group 'eiffel-indent)
  232. (defcustom eif-preprocessor-indent 0
  233. "*Indentation for lines GOBO preprocessor directives.
  234. Specified as number of `eif-indent-increments' from left margin."
  235. :type 'integer
  236. :group 'eiffel-indent)
  237. (defcustom eif-fill-max-save 4096
  238. "*Maximum size of a paragraph to save before filling.
  239. Normally \\[eif-fill-paragraph] will mark a buffer as modified even if
  240. the fill operation does not make any changes. If the paragraph being
  241. filled is smaller than the value of this variable then the contents of
  242. the paragraph will be saved for comparison with the paragraph after
  243. the fill operation. If they are the same, the buffer modification
  244. state is restored. Set this to 0 to disable this feature, or a very
  245. big number to enable it for all paragraphs."
  246. :type 'integer
  247. :group 'eiffel-indent)
  248. (defcustom eif-use-gobo-eiffel t
  249. "*If t include support for compilation using GOBO Eiffel."
  250. :type 'boolean
  251. :group 'eiffel-compile)
  252. (defcustom eif-se-command
  253. "geant"
  254. "*Program to use for compiling Eiffel programs.
  255. The default is \"geant\"."
  256. :type 'string
  257. :group 'eiffel-compile)
  258. (defcustom eif-compile-options ""
  259. "*Options to use for compiling Eiffel programs."
  260. :type 'string
  261. :group 'eiffel-compile)
  262. ;;
  263. ;; No user-customizable definitions below this point.
  264. ;;
  265. ;;
  266. ;; Indentation macros.
  267. ;;
  268. (defmacro eif-class-level-kw-indent-m ()
  269. "Indentation amount for Class level keywords (in number of spaces)."
  270. '(+ (* eif-class-level-kw-indent eif-indent-increment)
  271. eif-extra-class-level-kw-indent))
  272. (defmacro eif-class-level-comment-indent-m ()
  273. "Indentation amount for Class level comments (in number of spaces)."
  274. '(+ (* eif-class-level-comment-indent eif-indent-increment)
  275. eif-extra-class-level-comment-indent))
  276. (defmacro eif-inherit-level-kw-indent-m ()
  277. "Indentation amount for Inherit level keywords (in number of spaces)."
  278. '(+ (* eif-inherit-level-kw-indent eif-indent-increment)
  279. eif-extra-inherit-level-kw-indent))
  280. (defmacro eif-feature-level-indent-m ()
  281. "Indentation amount for features (in number of spaces)."
  282. '(+ (* eif-feature-level-indent eif-indent-increment)
  283. eif-extra-feature-level-indent))
  284. (defmacro eif-feature-level-kw-indent-m ()
  285. "Indentation amount for Feature level keywords (in number of spaces)."
  286. '(+ (* eif-feature-level-kw-indent eif-indent-increment)
  287. eif-extra-feature-level-kw-indent))
  288. (defmacro eif-body-comment-indent-m ()
  289. "Indentation amount for comments in routine bodies (in number of spaces)."
  290. '(+ (* eif-body-comment-indent eif-indent-increment)
  291. eif-extra-body-comment-indent))
  292. (defmacro eif-feature-level-comment-indent-m ()
  293. "Indentation amount for Feature level comments (in number of spaces)."
  294. '(+ (* eif-feature-level-comment-indent eif-indent-increment)
  295. eif-extra-feature-level-comment-indent))
  296. (defmacro eif-check-keyword-indent-m ()
  297. "Indentation amount for Check keyword (in number of spaces)."
  298. '(+ (* eif-check-keyword-indent eif-indent-increment)
  299. eif-extra-check-keyword-indent))
  300. (defmacro eif-rescue-keyword-indent-m ()
  301. "Indentation amount for Rescue keyword (in number of spaces)."
  302. '(+ (* eif-rescue-keyword-indent eif-indent-increment)
  303. eif-extra-rescue-keyword-indent))
  304. (defmacro eif-then-indent-m ()
  305. "Indentation amount for `then' appearing on a line by itself (in number of spaces)."
  306. '(+ (* eif-then-indent eif-indent-increment)
  307. eif-extra-then-indent))
  308. (defmacro eif-continuation-indent-m ()
  309. "Indentation amount for a statement continuation line (in number of spaces)."
  310. '(+ (* eif-continuation-indent eif-indent-increment)
  311. eif-extra-continuation-indent))
  312. (defmacro eif-string-continuation-indent-m ()
  313. "Indentation amount for a statement continuation line (in number of spaces)."
  314. '(+ (* eif-string-continuation-indent eif-indent-increment)
  315. eif-extra-string-continuation-indent))
  316. (defmacro eif-preprocessor-indent-m ()
  317. "Indentation amount for a preprocessor statement (in number of spaces)."
  318. '(* eif-preprocessor-indent eif-indent-increment))
  319. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  320. ;; Keyword Regular Expression Constants. ;;
  321. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  322. (defconst eif-non-id-char-regexp "\\S_" ;; "[^a-z0-9_]"
  323. "The characters that are not part of identifiers.")
  324. (defun eif-post-anchor (regexp)
  325. "Anchor given REGEXP with end-word delimiter and `eif-non-id-char-regexp'."
  326. (concat "\\(" regexp "\\)\\>" eif-non-id-char-regexp))
  327. (defun eif-word-anchor (regexp)
  328. "Anchor given REGEXP with word delimiters and `eif-non-id-char-regexp'."
  329. (concat "\\<\\(" regexp "\\)\\>" eif-non-id-char-regexp))
  330. (defun eif-anchor (regexp)
  331. "Anchor given REGEXP front and back to match line break or non-symbol char."
  332. (concat "\\(^\\|\\S_\\<\\)\\(" regexp "\\)\\($\\|\\>\\S_\\)"))
  333. ;; Note invariant is handled as a special case since it is both a
  334. ;; class-level and a from-level keyword
  335. ;; Note obsolete is handled as a special case since it is both a
  336. ;; class-level and a feature-level keyword
  337. ;; Note create, note, and indexing are also handled as special cases
  338. (defconst eif-class-level-keywords
  339. (concat
  340. "\\(?:"
  341. (regexp-opt '("deferred" "expanded" "reference" "separate"))
  342. "[ \t]+\\)?class"
  343. "\\|"
  344. (regexp-opt '("inherit" "insert" "convert" "creation" "feature")))
  345. "Keywords introducing class-level clauses.
  346. Note that `invariant', `obsolete', `indexing', `note', and `create' are not included here since can
  347. function as more than one type of keyword.")
  348. (defconst eif-class-level-keywords-regexp
  349. (eif-word-anchor eif-class-level-keywords)
  350. "Regexp of keywords introducing class level clauses, with some context.
  351. See `eif-class-level-keywords'.")
  352. (defconst eif-inherit-level-keywords
  353. (regexp-opt '("rename" "redefine" "undefine" "select" "export"))
  354. "Those keywords which introduce subclauses of the inherit clause.")
  355. (defconst eif-feature-level-keywords
  356. (regexp-opt '("require" "local" "deferred" "separate" "do" "once" "ensure" "alias" "external" "attribute"))
  357. "Those keywords which are internal to features (in particular, routines).")
  358. (defconst eif-feature-level-keywords-regexp
  359. (eif-word-anchor eif-feature-level-keywords)
  360. "Regexp of keywords internal to features (usually routines).
  361. See `eif-feature-level-keywords'.")
  362. (defconst eif-end-keyword "end" "The `end' keyword.")
  363. (defconst eif-end-on-current-line ".*[ \t]end[ \t]*;?[ \t]*\\(--.*\\)?$"
  364. "Regular expression to identify lines ending with the `end' keyword.")
  365. (defconst eif-control-flow-keywords
  366. (regexp-opt '("if" "inspect" "from" "debug" "across"))
  367. "Keywords which introduce control-flow constructs.")
  368. (defconst eif-control-flow-matching-keywords
  369. (concat (regexp-opt '("deferred" "do" "once")) "\\|" eif-control-flow-keywords)
  370. "Keywords that may cause the indentation of an `eif-control-flow-keyword'.
  371. If these occur prior to an `eif-control-flow-keyword' then the
  372. `eif-control-flow-keyword' is indented. Note that technically, `end'
  373. is part of this list but it is handled separately in the function
  374. \[eif-matching-kw\].")
  375. (defconst eif-control-flow-matching-keywords-regexp
  376. (eif-word-anchor eif-control-flow-matching-keywords)
  377. "Regexp of keywords maybe causing indentation of `eif-control-flow-keyword'.
  378. See `eif-control-flow-keywords'.")
  379. (defconst eif-check-keyword "check"
  380. "The `check' keyword.")
  381. (defconst eif-check-keywords-regexp
  382. (eif-word-anchor eif-check-keyword)
  383. "The `check' keyword (with trailing context).")
  384. ;; FIXME: Doesn't work if once keyword is followed by a string on next
  385. ;; line, but didn't get broken by this attempt at factoring.
  386. (defconst eif-check-matching-keywords-regexp
  387. eif-control-flow-matching-keywords-regexp
  388. "Keywords that may cause the indentation of an `eif-check-keyword'.
  389. If these occur prior to an `eif-check-keyword' then the
  390. `eif-check-keyword' is indented. Note that technically, `end' is part
  391. of this list but it is handled separately in the function
  392. \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
  393. ;; FIXME: This could be fixed or removed.
  394. (defconst eif-end-keyword-regexp "\\<end\\>"
  395. "The `end' keyword with context.")
  396. (defconst eif-end-matching-keywords
  397. (concat (regexp-opt '("attribute" "check" "class" "feature" "rename" "redefine" "undefine"
  398. "select" "export" "separate" "external" "alias")) "\\|"
  399. eif-control-flow-matching-keywords)
  400. "Those keywords whose clause is terminated by an `end' keyword.")
  401. (defconst eif-end-matching-keywords-regexp
  402. (eif-word-anchor eif-end-matching-keywords)
  403. "Regexp of keywords whose clause is terminated by an `end' keyword.
  404. See `eif-end-matching-keywords'.")
  405. (defconst eif-rescue-keyword "rescue" "The `rescue' keyword.")
  406. (defconst eif-obsolete-keyword "obsolete" "The `obsolete' keyword.")
  407. (defconst eif-indexing-keyword
  408. (regexp-opt '("note" "indexing"))
  409. "The `indexing' and `note' keywords.")
  410. (defconst eif-indexing-keyword-regexp
  411. (eif-post-anchor eif-indexing-keyword)
  412. "Regexp matching `indexing' and `note' keywords, with trailing context.")
  413. (defconst eif-rescue-keywords-regexp
  414. (eif-word-anchor eif-rescue-keyword)
  415. "The `rescue' keyword (with trailing context).")
  416. (defconst eif-rescue-matching-keywords-regexp
  417. (eif-word-anchor (regexp-opt '("deferred" "do" "once")))
  418. "Keywords that may cause the indentation of an `eif-rescue-keyword'.
  419. If these occur prior to an `eif-rescue-keyword' then the
  420. `eif-rescue-keyword' is indented. Note that technically, `end' is
  421. part of this list but it is handled separately in the function
  422. \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
  423. (defconst eif-from-level-keywords
  424. (regexp-opt '("until" "variant" "loop"))
  425. "Keywords occuring inside of a from clause.")
  426. (defconst eif-from-level-keywords-regexp
  427. (eif-word-anchor eif-from-level-keywords)
  428. "Regexp of keywords occuring inside of a from clause.
  429. See `eif-from-level-keywords'.")
  430. (defconst eif-from-keyword "from\\|across" "The keyword `from'.")
  431. (defconst eif-if-or-inspect-level-keywords
  432. (regexp-opt '("elseif" "else" "when"))
  433. "Keywords occuring inside of an if or inspect clause.")
  434. (defconst eif-if-or-inspect-level-keywords-regexp
  435. (eif-word-anchor eif-if-or-inspect-level-keywords)
  436. "Regexp of keywords occuring inside of an if or inspect clause.
  437. See eif-if-or-inspect-level-keywords.")
  438. (defconst eif-if-or-inspect-keyword-regexp
  439. (eif-word-anchor (regexp-opt '("if" "inspect")))
  440. "Regexp matching the `if' or `inspect' keywords.")
  441. (defconst eif-then-keyword ".*[ \t)]then[ \t]*$"
  442. "The keyword `then' with possible leading text.")
  443. (defconst eif-solitary-then-keyword "then" "The keyword `then'.")
  444. (defconst eif-then-matching-keywords
  445. (regexp-opt '("if" "elseif" "when") t)
  446. "Keywords that may alter the indentation of an `eif-then-keyword'.
  447. If one of these occur prior to an `eif-then-keyword' then this sets
  448. the indentation of the `eif-then-keyword'. Note that technically,
  449. `end' is part of this list but it is handled separately in the
  450. function \[eif-matching-kw\]. See also
  451. `eif-control-flow-matching-keywords-regexp'.")
  452. (defconst eif-invariant-keyword "invariant" "The `invariant' keyword.")
  453. (defconst eif-invariant-matching-keywords
  454. (regexp-opt '("from" "feature" "across"))
  455. "Keywords that may cause the indentation of an `eif-invarient-keyword'.
  456. If one of these occurs prior to an `eif-invariant-keyword' then the
  457. `eif-invariant-keyword' is indented. Note that technically, `end' is
  458. part of this list but it is handled separately in the function
  459. \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
  460. (defconst eif-obsolete-matching-keywords
  461. (regexp-opt '("is" "class") t)
  462. "Keywords that may cause the indentation of an `eif-obsolete-keyword'.
  463. If one of these occurs prior to an `eif-obsolete-keyword' then the
  464. `eif-obsolete-keyword' is indented.")
  465. (defconst eif-create-keyword
  466. "create"
  467. "Eiffel create keyword. Can be used at class or minor level.")
  468. (defconst eif-create-keyword-regexp
  469. (eif-post-anchor eif-create-keyword)
  470. "Regexp matching `create' keyword, with trailing context.")
  471. (defconst eif-indentation-keywords
  472. (concat (regexp-opt '("note" "indexing" "rescue" "inherit" "insert" "convert" "create" "creation"
  473. "invariant" "require" "local" "ensure" "obsolete")) "\\|"
  474. eif-from-level-keywords "\\|"
  475. eif-if-or-inspect-level-keywords "\\|"
  476. eif-end-matching-keywords)
  477. "Keywords that match any eiffel keyword triggering indentation.")
  478. (defconst eif-indentation-keywords-regexp
  479. (eif-word-anchor eif-indentation-keywords)
  480. "Regexp of keywords that match any eiffel keyword triggering indentation.
  481. See `eif-indentation-keywords'.")
  482. (defconst eif-once-non-indent-regexp
  483. "\\s-*once\\(\\s-\\|\n\\)+\""
  484. "Regexp of Eiffel once keyword in context not affecting indentation.")
  485. (defconst eif-feature-indentation-keywords-regexp
  486. (eif-word-anchor (regexp-opt '("convert" "creation" "feature")))
  487. "Keywords which denote the presence of features following them.")
  488. (defconst eif-is-keyword-regexp "\\(.*[ \t)]\\)?is[ \t]*\\(--.*\\)?$"
  489. "The `is' keyword (with some context).")
  490. (defconst eif-multiline-routine-is-keyword-regexp
  491. ".*([^)]*)\\([ \t\n]*\\|[ \t\n]*:[][ \t\nA-Za-x0-9_,]*\\)is[ \t]*\\(--.*\\)?$"
  492. "The `is' keyword (with some context).")
  493. (defconst eif-operator-keywords
  494. (regexp-opt '("and" "or" "implies"))
  495. "Eiffel operator keywords.")
  496. (defconst eif-operator-regexp
  497. (concat "[ \t]*\\([@*/+]\\|-[^-]\\|\\<\\("
  498. eif-operator-keywords
  499. "\\)[ \t(]\\)")
  500. "Eiffel operators - used to identify continuation lines.
  501. See `eif-operator-keywords'.")
  502. (defconst eif-operator-eol-regexp
  503. (concat ".*\\([@*/+-]\\|\\<\\(" eif-operator-keywords
  504. "\\)\\|:=\\)[ \t]*\\(--.*\\)?$")
  505. "Eiffel operators - used to identify continuation lines.")
  506. (defconst eif-all-keywords
  507. (concat eif-indentation-keywords "\\|"
  508. eif-solitary-then-keyword "\\|"
  509. eif-create-keyword "\\|"
  510. eif-end-keyword)
  511. "Regexp matching (nearly) any eiffel keyword in a line.
  512. Does not include `is'.")
  513. (defconst eif-all-keywords-regexp
  514. (concat "\\("
  515. (eif-word-anchor eif-all-keywords) "\\)")
  516. "Anchored regexp matching (nearly) any eiffel keyword in a line.
  517. Does not include `is'. See `eif-all-keywords'.")
  518. (defconst eiffel-comment-start-skip
  519. "--+|?[ \t]*"
  520. "Regexp matching the beginning of an Eiffel comment.")
  521. (defconst eif-non-source-line
  522. (concat "[ \t]*\\(\\(" "--" "\\).*\\)?$")
  523. "RE matching line with only whitespace and comment or preprocessor keyword.")
  524. (defconst eif-variable-or-const-regexp "[^()\n]*:[^=].*"
  525. "RE to match a variable or constant declaration.")
  526. ;; Factor out some important important regexps for use in
  527. ;; eif-{beginning,end}-of-feature.
  528. (defun eiffel-feature-re ()
  529. "Liberty Eiffel feature declarations"
  530. (let* ((argument-name "\\(?:[A-Za-z]*[a-z0-9_]+[A-Za-z0-9_]*\\)")
  531. (feature-name (concat "\\(?:\\(infix\\|prefix\\)\\s-+\".+?\"\\|" argument-name "\\(?:\\s-+alias\\s-+\".+?\"\\)?\\)"))
  532. (type-name "\\(?:like\\s-+\\sw+\\|[A-Z]\\sw*\\(?:\\[.+?\\]\\)?\\)"))
  533. (concat
  534. "\\(?:"
  535. "\\(?:\\<frozen\\s-\\)?"
  536. "\\s-*" feature-name "\\s-*,?"
  537. "\\)+"
  538. "\\(?:(" ; no \\s-* because it is matched above, if there is no trailing coma
  539. "\\(?:"
  540. "\\(?:\\s-*" argument-name "\\s-*,?\\)+?"
  541. ":" type-name "\\s-*;?"
  542. "\\)*?"
  543. ")\\)?" ; no \\s-* because it is matched above, if there is no trailing semi-colon
  544. "\\(?:\\s-*:\\s-*" type-name "\\)?"
  545. "\\(?:\\s-*assign\\s-*\\sw+\\)?"
  546. "\\(?:\\s-*is\\>\\)?")))
  547. (defconst eif-routine-begin-regexp
  548. ;"\\([a-z][a-zA-Z_0-9]*\\)\\s-*\\(([^)]*)\\)?\\s-*\\(:\\s-*[A-Z][A-Z0-9_]*\\(\\s-*\\[[^\\]]*\\]\\)?\\)?\\s-*\\(assign\\s-*[a-zA-Z0-9_]+\\)?\\s-*\\<is\\>\\s-*\\(--.*\\)?$"
  549. (eiffel-feature-re)
  550. "Regexp matching the beginning of an Eiffel routine declaration.")
  551. (message (concat "Liberty Eiffel features: " eif-routine-begin-regexp))
  552. (defconst eif-attribute-regexp
  553. (concat "[a-z_][^-:\n]*:\\s-*"
  554. "\\(like\\s-*[a-zA-Z][a-z_0-9]*\\|"
  555. "\\(\\(expanded\\|reference\\)\\s-*\\)?[A-Z][A-Z_0-9]*"
  556. "\\(\\s-*\\[[^-\n]*\\]\\)?\\)"
  557. "\\s-*\\($\\|[;)].*\\|--.*\\)")
  558. "Regexp matching an Eiffel attribute, parameter or local variable.")
  559. (defconst eif-constant-regexp
  560. "[a-z_][^-:\n]*:[^-\n]*\\<is\\>\\s-*[^ \t\n]"
  561. "Regexp matching an Eiffel constant declaration.")
  562. (defconst eif-probably-feature-regexp
  563. (concat "\\(" eif-routine-begin-regexp
  564. "\\|" eif-attribute-regexp
  565. "\\|" eif-constant-regexp "\\)")
  566. "Regexp probably matching an Eiffel feature.
  567. This will also match local variable and parameter declarations.")
  568. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  569. (defvar eif-matching-indent -1
  570. "Indentation of the keyword found on the last call to \[eif-matching-kw\].
  571. -1 if no match was found.")
  572. (defvar eif-matching-kw-for-end nil)
  573. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  574. ;;
  575. ;; Font-lock support.
  576. ;;
  577. ;; Rewritten from scratch by Cyril Adrian <cyril.adrian@gmail.com>
  578. ;; Specific to Liberty Eiffel
  579. ;;
  580. (defconst eiffel-keywords-feature
  581. '("across" "agent" "all" "and" "as" "assign" "attached" "attribute" "check" "class"
  582. "convert" "create" "debug" "deferred" "detachable" "do" "else" "elseif" "end" "ensure"
  583. "expanded" "export" "external" "feature" "from" "if" "implies"
  584. "indexing" "inherit" "insert" "inspect" "invariant" "is" "like"
  585. "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or"
  586. "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
  587. "undefine" "until" "variant" "when" "xor"))
  588. (defconst eiffel-keywords
  589. '("across" "agent" "alias" "all" "and" "as" "assign" "attached" "attribute" "check" "class"
  590. "convert" "create" "debug" "deferred" "detachable" "do" "else" "elseif" "end" "ensure"
  591. "expanded" "export" "external" "feature" "from" "frozen" "if" "implies"
  592. "indexing" "infix" "inherit" "insert" "inspect" "invariant" "is" "like"
  593. "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or" "prefix"
  594. "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
  595. "undefine" "until" "variant" "when" "xor"))
  596. (defconst eiffel-constants
  597. '("Current" "False" "Precursor" "Result" "True" "Void"))
  598. (defun eiffel-string-re ()
  599. "Liberty Eiffel strings"
  600. (concat "U?\"\\(?:"
  601. "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; single-line strings
  602. "\\|"
  603. "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\(?:[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\)*[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; older multiline strings
  604. "\\|"
  605. "\\(?:[[{][ \t]*\n\\(?:.*?\n\\)*?[ \t]*[]}]\"\\)" ; newer multiline strings
  606. "\\)\""))
  607. (defun eiffel-wordstart-re ()
  608. "start of words"
  609. "\\<\\(")
  610. (defun eiffel-wordend-re ()
  611. "end of words"
  612. (concat "\\)\\>"))
  613. (defun eiffel-keywords-re ()
  614. (concat
  615. (eiffel-wordstart-re)
  616. (regexp-opt eiffel-keywords)
  617. (eiffel-wordend-re)))
  618. (defun eiffel-constants-re ()
  619. (concat
  620. (eiffel-wordstart-re)
  621. (regexp-opt eiffel-constants)
  622. (eiffel-wordend-re)))
  623. (defun eiffel-preprocessor-re ()
  624. (concat
  625. (eiffel-wordstart-re)
  626. (regexp-opt '("c_inline_c" "c_inline_h" "not_yet_implemented" "se_breakpoint" "breakpoint" "to_pointer"
  627. "is_expanded_type" "is_basic_expanded_type"
  628. "object_size" "object_id_memory"
  629. "se_guru01" "se_guru02" "se_guru03"))
  630. (eiffel-wordend-re)))
  631. (defvar eiffel-font-lock-defaults
  632. (append
  633. `(
  634. ("--|\\(.*\\)\n" . font-lock-comment-face)
  635. ("--\\(.*\\)\n" . font-lock-doc-face)
  636. (,(eiffel-string-re) . font-lock-string-face)
  637. ("'\\(?:[^'%]\\|%.\\)'" . font-lock-string-face)
  638. ("\\<\\([A-Z][A-Z0-9_]*\\)\\>" . font-lock-type-face)
  639. (,(eiffel-keywords-re) 1 font-lock-keyword-face)
  640. (,(eiffel-constants-re) 1 font-lock-builtin-face)
  641. (,(eiffel-preprocessor-re) 1 font-lock-preprocessor-face)))
  642. "Default highlighting expressions for Liberty Eiffel mode")
  643. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  644. ;;
  645. ;; Compilation support for GNU SmartEiffel.
  646. ;;
  647. (defvar eif-compile-dir nil
  648. "Current directory where Eiffel compilations are taking place.
  649. Possibly used for error location.")
  650. (defvar eif-root-class nil
  651. "Current Eiffel root class being compiled/debugged.")
  652. (defvar eif-compile-target nil
  653. "Current Eiffel compilation target.")
  654. (defvar eif-debug-target nil
  655. "Current Eiffel debug target.")
  656. (defvar eif-root-proc nil
  657. "Current Eiffel root procedure.")
  658. (defvar eif-run-command nil
  659. "Current command to run after Eiffel compile.")
  660. (defvar eif-debug-command nil
  661. "Current debug command to run after Eiffel debug compile.")
  662. (defun eif-compilation-mode-hook ()
  663. "Hook function to set local value for `compilation-error-screen-columns'.
  664. This should be nil for SmartEiffel compiles, because column positions are
  665. returned as character positions rather than screen columns."
  666. ;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
  667. (or (assq 'compilation-error-screen-columns (buffer-local-variables))
  668. (make-local-variable 'compilation-error-screen-columns))
  669. (setq compilation-error-screen-columns nil))
  670. (defun eif-compile ()
  671. "Compile an Eiffel root class."
  672. (interactive)
  673. ;;(eif-compile-prompt)
  674. (eif-compile-internal))
  675. (defun eif-set-compile-options ()
  676. "Set Eiffel compiler options."
  677. (interactive)
  678. (setq eif-compile-options
  679. (read-string "Eiffel compiler options: " eif-compile-options)))
  680. ;; Taken from Emacs 20.3 subr.el (just in case we're running under Emacs 19).
  681. (defun eif-split-string (string &optional separators)
  682. "Split STRING into substrings separated by SEPARATORS.
  683. Each match for SEPARATORS is a splitting point. The substrings
  684. between the splitting points are made into a list which is returned.
  685. If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
  686. If there is match for SEPARATORS at the beginning of STRING, we do not
  687. include a null substring for that. Likewise, if there is a match
  688. at the end of STRING, we do not include a null substring for that."
  689. (let ((rexp (or separators "[ \f\t\n\r\v]+"))
  690. (start 0)
  691. notfirst
  692. (list nil))
  693. (while (and (string-match rexp string
  694. (if (and notfirst
  695. (= start (match-beginning 0))
  696. (< start (length string)))
  697. (1+ start) start))
  698. (< (match-beginning 0) (length string)))
  699. (setq notfirst t)
  700. (or (eq (match-beginning 0) 0)
  701. (and (eq (match-beginning 0) (match-end 0))
  702. (eq (match-beginning 0) start))
  703. (setq list
  704. (cons (substring string start (match-beginning 0))
  705. list)))
  706. (setq start (match-end 0)))
  707. (or (eq start (length string))
  708. (setq list
  709. (cons (substring string start)
  710. list)))
  711. (nreverse list)))
  712. (defun eif-run ()
  713. "Run a compiled Eiffel program."
  714. (interactive)
  715. (setq eif-run-command
  716. (read-string "Command to run: "
  717. (or eif-run-command
  718. eif-compile-target
  719. (file-name-sans-extension
  720. (if (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
  721. buffer-file-name
  722. (file-name-nondirectory (buffer-file-name)))))))
  723. (eif-run-internal))
  724. ;; (defun eif-debug ()
  725. ;; "Run the SmartEiffel debugger."
  726. ;; (interactive)
  727. ;; (eif-compile-prompt)
  728. ;; (setq eif-debug-target
  729. ;; (file-name-sans-extension
  730. ;; (read-string "Debug target name: "
  731. ;; (or eif-debug-target
  732. ;; (concat eif-compile-target "_debug")))))
  733. ;; (let* ((eif-compile-options (concat "-sedb " eif-compile-options))
  734. ;; (eif-compile-target eif-debug-target)
  735. ;; (buff (eif-compile-internal))
  736. ;; (proc (get-buffer-process buff)))
  737. ;; ;; This works under GNU Emacs, but hangs under at least some
  738. ;; ;; versions of XEmacs if there is input pending.
  739. ;; (while (eq (process-status proc) 'run)
  740. ;; (sit-for 1))
  741. ;; (if (= (process-exit-status proc) 0)
  742. ;; (progn
  743. ;; (setq eif-debug-command
  744. ;; (read-string "Debugger command to run: "
  745. ;; (or eif-debug-command
  746. ;; eif-debug-target
  747. ;; (file-name-sans-extension
  748. ;; (if (eq system-type 'windows-nt)
  749. ;; buffer-file-name
  750. ;; (file-name-nondirectory
  751. ;; (buffer-file-name)))))))
  752. ;; (let ((eif-run-command eif-debug-command))
  753. ;; (eif-run-internal))))))
  754. (defun eif-compile-prompt ()
  755. "Prompt for information required to compile an Eiffel root class."
  756. ;; Do the save first, since the user might still have their hand on
  757. ;; the mouse.
  758. (save-some-buffers (not compilation-ask-about-save) nil)
  759. (setq eif-compile-dir (file-name-directory (buffer-file-name)))
  760. (setq eif-root-class
  761. (file-name-sans-extension
  762. (read-string "Name of root class: "
  763. (or eif-compile-target
  764. (file-name-sans-extension
  765. (file-name-nondirectory (buffer-file-name)))))))
  766. (setq eif-compile-target eif-root-class)
  767. (setq eif-root-proc
  768. (read-string "Name of root procedure: "
  769. eif-root-proc)))
  770. (defun eif-compile-internal ()
  771. "Compile an Eiffel root class. Internal version.
  772. Returns the same thing as \\[compilation-start] - the compilation buffer."
  773. ;; Do the save first, since the user might still have their hand on
  774. ;; the mouse.
  775. (save-some-buffers (not compilation-ask-about-save) nil)
  776. (let ((cmd (concat eif-se-command
  777. " compile_ge "
  778. eif-compile-options))
  779. (buf-name "*GOBO Eiffel Compilation*")
  780. (compilation-mode-hook (cons 'eif-compilation-mode-hook
  781. compilation-mode-hook)))
  782. (if (fboundp 'compilation-start) ; Emacs 22 and above
  783. (compilation-start cmd nil #'(lambda (mode-name) buf-name))
  784. (compile-internal cmd "No more errors" buf-name))))
  785. (defun eif-run-internal ()
  786. "Run a compiled Eiffel program. Internal version."
  787. (let* ((tmp-buf (current-buffer))
  788. (words (eif-split-string eif-run-command))
  789. (cmd (expand-file-name (car words))))
  790. (apply 'make-comint cmd cmd nil (cdr words))
  791. (switch-to-buffer tmp-buf)
  792. (switch-to-buffer-other-window (concat "*" cmd "*"))))
  793. ;; This has been loosened up to spot parts of messages that contain
  794. ;; references to multiple locations. Thanks to Andreas
  795. ;; <nozone@sbox.tu-graz.ac.at>. Also, the column number is a character
  796. ;; count rather than a screen column, so we need to make sure that
  797. ;; compilation-error-screen-columns is nil. Note that in XEmacs this
  798. ;; variable doesn't exist, so we end up in the wrong column. Hey, at
  799. ;; least we're on the correct line!
  800. (add-to-list 'compilation-error-regexp-alist
  801. '("^Line \\([0-9]+\\) column \\([0-9]+\\) in [^ ]+ (\\([^)]+\\.[Ee]\\))" 3 1 2))
  802. (defun eif-find-file (&optional userclass)
  803. "Find and open an Eiffel file given by a class name"
  804. (interactive)
  805. (let* ((cn (or userclass (current-word))))
  806. (if (string-match "[A-Z][0-9A-Z_]*" cn)
  807. (let ((classname (substring cn (match-beginning 0) (match-end 0))))
  808. (message "Searching %s..." classname)
  809. (let* ((shellres (shell-command-to-string (concat "se find --raw " classname)))
  810. (filename (substring shellres 0 (string-match "\n" shellres))))
  811. (find-file filename)
  812. )))
  813. (message nil)))
  814. (defun eif-short ()
  815. "Display the short form of an Eiffel class."
  816. (interactive)
  817. (let* ((class (read-string
  818. "Class or file: "
  819. (if (buffer-file-name)
  820. (file-name-nondirectory (buffer-file-name)))))
  821. (buf (get-buffer-create (concat "*Eiffel - short " class "*"))))
  822. (shell-command (concat eif-se-command " short " class) buf)
  823. (with-current-buffer buf
  824. (let ((font-lock-defaults eiffel-font-lock-defaults))
  825. (font-lock-fontify-buffer))
  826. (read-only-mode 1))))
  827. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  828. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  829. ;; Utility Functions. ;;
  830. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  831. (defun eif-feature-quote ()
  832. "Put a `' around the current feature name."
  833. (interactive)
  834. (save-excursion
  835. ;; Only try to go back to the beginning of the feature if we're
  836. ;; not already there.
  837. (if (/= (point)
  838. (save-excursion
  839. (forward-sexp)
  840. (backward-sexp)
  841. (point)))
  842. (backward-sexp))
  843. (insert "`")
  844. (forward-sexp)
  845. (insert "'"))
  846. (if (looking-at "'")
  847. (forward-char 1)))
  848. (defun eif-peeking-backwards-at (regexp)
  849. "Return non-nil is previous character exists and is matched by REGEXP.
  850. The match is actually an unbounded match starting at the previous character."
  851. (save-excursion
  852. (save-match-data
  853. (and (not (bobp))
  854. (or (backward-char) t)
  855. (looking-at regexp)))))
  856. (defsubst eif-in-comment-p ()
  857. "Return t if point is in a comment."
  858. (interactive)
  859. (save-excursion
  860. (nth 4 (parse-partial-sexp
  861. (save-excursion (beginning-of-line) (point))
  862. (point)))))
  863. (defun eif-in-comment-or-quoted-string-p ()
  864. "Return t if point is in a comment or quoted string."
  865. (or (eif-in-comment-p)
  866. (eif-in-quoted-string-p)))
  867. (defun eif-not-in-comment-or-quoted-string-p ()
  868. "Return t if point is not in a comment or quoted string."
  869. (not (eif-in-comment-or-quoted-string-p)))
  870. (defun eif-near-comment-p ()
  871. "Return t if point is close enough to a comment for filling purposes."
  872. (or (eif-in-comment-p)
  873. (and (or (looking-at comment-start-skip)
  874. (eif-peeking-backwards-at comment-start-skip))
  875. (not (eif-in-quoted-string-p)))
  876. (looking-at (concat "[ \t]*" comment-start-skip))))
  877. (defun eif-re-search-forward (regexp &optional limit noerror)
  878. "Search forward from point for REGEXP not in comment or string.
  879. `case-fold-search' is set to nil when searching. For details on other
  880. arguments see \\[re-search-forward]."
  881. (interactive "sRE search: ")
  882. (let ((start (point))
  883. found case-fold-search)
  884. (while (and (setq found (re-search-forward regexp limit noerror))
  885. (eif-in-comment-or-quoted-string-p)))
  886. (if (and found
  887. (eif-not-in-comment-or-quoted-string-p))
  888. found
  889. (if (eq noerror t)
  890. (goto-char start))
  891. nil)))
  892. (defun eif-re-search-backward (regexp &optional limit noerror)
  893. "Search backward from point for REGEXP not in comment or string.
  894. `case-fold-search' is set to nil when searching. For details on other
  895. arguments see \\[re-search-forward]."
  896. (interactive "sRE search: ")
  897. (let ((start (point))
  898. found case-fold-search)
  899. (while (and (setq found (re-search-backward regexp limit noerror))
  900. (eif-in-comment-or-quoted-string-p)))
  901. (if (and found
  902. (eif-not-in-comment-or-quoted-string-p))
  903. found
  904. (if (eq noerror t)
  905. (goto-char start))
  906. nil)))
  907. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  908. ;; Indentation Functions. ;;
  909. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  910. (defun eif-skip-leading-whitespace ()
  911. "Move to the first non-whitespace character on the current line."
  912. (end-of-line)
  913. (let ((line-end (point)))
  914. (beginning-of-line)
  915. (skip-syntax-forward "-" line-end)))
  916. (defun eif-calc-indent ()
  917. "Calculate the indentation of the current line of eiffel code.
  918. This function handles the case where there is a keyword that affects
  919. indentation at the beginning of the current line. For lines that
  920. don't start with a relevant keyword, the calculation is handed off to
  921. \\[eif-calc-non-keyword-indent]."
  922. (let ((indent 0)
  923. kw-match)
  924. (save-excursion
  925. (eif-skip-leading-whitespace)
  926. ;; Look for a keyword on the current line.
  927. (if (looking-at eif-all-keywords-regexp)
  928. (cond ((looking-at eif-create-keyword-regexp)
  929. ;; Class-level or minor occurence?
  930. (if (save-excursion (eif-find-beginning-of-feature))
  931. ;; Minor.
  932. (setq indent (eif-calc-indent-non-keyword))
  933. ;; Class-level.
  934. (setq indent (eif-class-level-kw-indent-m))))
  935. ;; There's possibly a better way of coding this exception.
  936. ((looking-at eif-once-non-indent-regexp)
  937. (setq indent (eif-calc-indent-non-keyword)))
  938. ((looking-at eif-indexing-keyword-regexp)
  939. ;; Class-level or minor occurence?
  940. (if (string-match eif-check-keyword (eif-matching-kw eif-check-keywords-regexp))
  941. ;; In check.
  942. (setq indent (+ eif-matching-indent (eif-check-keyword-indent-m)))
  943. (if (save-excursion (eif-find-beginning-of-feature))
  944. ;; Minor. (BUG: "note" can also be at the END of the class!!!)
  945. (setq indent (eif-calc-indent-non-keyword))
  946. ;; Class-level.
  947. (setq indent (eif-class-level-kw-indent-m)))))
  948. ((looking-at eif-class-level-keywords-regexp)
  949. ;; File level keywords (indent defaults to 0)
  950. (setq indent (eif-class-level-kw-indent-m)))
  951. ((looking-at eif-inherit-level-keywords)
  952. ;; Inherit level keywords (indent defaults to
  953. ;; 2*eif-indent-increment)
  954. (setq indent (eif-inherit-level-kw-indent-m)))
  955. ((looking-at eif-feature-level-keywords-regexp)
  956. ;; Feature level keywords (indent defaults to
  957. ;; (eif-feature-level-indent-m) + eif-indent-increment)
  958. (setq indent (eif-feature-level-kw-indent-m)))
  959. ((looking-at eif-end-keyword)
  960. ;; End keyword (indent to level of matching keyword)
  961. (if (string-match "end"
  962. (eif-matching-kw
  963. eif-end-matching-keywords-regexp))
  964. ;; Then
  965. (if (= eif-matching-indent
  966. (eif-feature-level-kw-indent-m))
  967. ;; Then
  968. (setq indent (eif-class-level-kw-indent-m))
  969. ;; Else
  970. (setq indent
  971. (- eif-matching-indent eif-indent-increment)))
  972. ;; Else
  973. (setq indent eif-matching-indent))
  974. ;; FIXME: This is broken!!!
  975. (if (<= indent (eif-feature-level-indent-m))
  976. (save-excursion
  977. (end-of-line)
  978. (while (and (< (point) (point-max))
  979. (or (forward-char 1) t)
  980. (looking-at eif-non-source-line))
  981. (end-of-line))
  982. (if (not (looking-at eif-non-source-line))
  983. (setq indent (eif-inherit-level-kw-indent-m))
  984. (setq indent (eif-class-level-kw-indent-m))))))
  985. ((looking-at eif-control-flow-keywords)
  986. ;; Control flow keywords
  987. ;; Indent to same level as a preceding "end" or
  988. ;; if no preceding "end" is found, indent to the level
  989. ;; of the preceding "do" plus the value of
  990. ;; eif-indent-increment
  991. (setq kw-match
  992. (eif-matching-kw
  993. eif-control-flow-matching-keywords-regexp))
  994. (cond ((string-match "end" kw-match)
  995. (setq indent eif-matching-indent))
  996. (t
  997. (setq indent
  998. (+ eif-matching-indent eif-indent-increment)))))
  999. ((looking-at eif-check-keywords-regexp)
  1000. ;; Check keyword
  1001. ;; Indent to level of preceding "end"+eif-indent-increment or
  1002. ;; if no preceding "end" is found, indent to the level of
  1003. ;; the preceding eif-check-matching-keywords-regexp plus the
  1004. ;; value (eif-indent-increment + eif-check-keyword-indent).
  1005. (setq kw-match (eif-matching-kw
  1006. eif-check-matching-keywords-regexp))
  1007. (cond ((string-match "end" kw-match)
  1008. (setq indent (+ eif-matching-indent
  1009. (eif-check-keyword-indent-m))))
  1010. (t
  1011. (setq indent
  1012. (+ eif-matching-indent
  1013. (+ eif-indent-increment
  1014. (eif-check-keyword-indent-m)))))))
  1015. ((looking-at eif-rescue-keywords-regexp)
  1016. ;; Rescue keyword
  1017. ;; Indent to level of preceding "end"+eif-indent-increment or
  1018. ;; if no preceding "end" is found, indent to the level of
  1019. ;; the preceding eif-rescue-matching-keywords-regexp plus the
  1020. ;; value (eif-indent-increment + eif-rescue-keyword-indent).
  1021. (setq kw-match (eif-matching-kw
  1022. eif-rescue-matching-keywords-regexp))
  1023. (cond ((string-match "end" kw-match)
  1024. (setq indent (+ eif-matching-indent
  1025. (eif-rescue-keyword-indent-m))))
  1026. (t
  1027. (setq indent eif-matching-indent))))
  1028. ((looking-at eif-from-level-keywords-regexp)
  1029. ;; From level keywords (indent to level of matching "From")
  1030. (if (string-match "end" (eif-matching-kw eif-from-keyword))
  1031. ;; Closest matching KW is `end'.
  1032. (setq indent (- eif-matching-indent eif-indent-increment))
  1033. ;; Closest matching KW is one of `eif-from-keyword'.
  1034. (setq indent eif-matching-indent)))
  1035. ((looking-at eif-if-or-inspect-level-keywords-regexp)
  1036. ;; If level keywords (indent to level of matching
  1037. ;; "If" or "Inspect")
  1038. (if (string-match "end"
  1039. (eif-matching-kw
  1040. eif-if-or-inspect-keyword-regexp))
  1041. ;; Closest matching KW is `end'.
  1042. (setq indent (- eif-matching-indent eif-indent-increment))
  1043. ;; Closest matching KW is one of `eif-if-or-inspect-keyword-regexp'.
  1044. (setq indent eif-matching-indent)))
  1045. ((looking-at eif-solitary-then-keyword)
  1046. ;; Handles case where "then" appears on a line by itself
  1047. (if (eif-matching-kw eif-then-matching-keywords t)
  1048. ;; (Indented to level of the matching if, elseif or when)
  1049. (setq indent (+ eif-matching-indent (eif-then-indent-m)))
  1050. (if (save-excursion (eif-find-beginning-of-feature))
  1051. ;; (Feature-level "then")
  1052. (setq indent (eif-feature-level-kw-indent-m))
  1053. (message "Non-matching 'then'")
  1054. (setq indent (eif-calc-indent-non-keyword)))))
  1055. ((looking-at eif-invariant-keyword)
  1056. ;; Invariant keyword
  1057. ;; (Indented to level of the matching from or feature)
  1058. (if (string-match "from"
  1059. (eif-matching-kw eif-invariant-matching-keywords))
  1060. ;; Then - loop invariant
  1061. (setq indent eif-matching-indent)
  1062. ;; Else - class invariant
  1063. (setq indent (eif-class-level-kw-indent-m))))
  1064. ((looking-at eif-obsolete-keyword)
  1065. ;; Obsolete keyword
  1066. ;; (Indented to the level of the matching from or feature)
  1067. (if (string-match "class"
  1068. (eif-matching-kw eif-obsolete-matching-keywords))
  1069. ;; Then - class obsolete
  1070. (setq indent (eif-class-level-kw-indent-m))
  1071. ;; Else - feature obsolete
  1072. (setq indent (eif-feature-level-kw-indent-m)))))
  1073. ;; No keyword. Hand off...
  1074. (setq indent (eif-calc-indent-non-keyword))))
  1075. indent))
  1076. (defun eif-calc-indent-non-keyword ()
  1077. "Calculate indentation of current Eiffel code line, without leading keyword.
  1078. This function generally assumes that the preceding line of code is
  1079. indented properly, and usually bases the indentation of the current
  1080. line on that preceding line."
  1081. (let ((indent 0)
  1082. originally-looking-at-comment originally-looking-at-lone-string
  1083. continuation id-colon)
  1084. (save-excursion
  1085. (eif-skip-leading-whitespace)
  1086. ;; Is the line we are trying to indent a comment line?
  1087. (setq originally-looking-at-comment (looking-at comment-start-skip))
  1088. ;; Is the line we are trying to indent a lone string?
  1089. (setq originally-looking-at-lone-string (looking-at "\"[^\"]*\"[ \t]*$"))
  1090. ;; Are we in a multi-line parenthesis expression?
  1091. (if (or (and (> (eif-in-paren-expression) 0)
  1092. (> (setq indent (eif-indent-multi-line)) -1))
  1093. (setq indent (eif-manifest-array-indent)))
  1094. ;; Multi-line parenthesis expression.
  1095. ;; Move string continuation lines as per configuration.
  1096. (if (looking-at "%")
  1097. (setq indent (+ indent (eif-string-continuation-indent-m))))
  1098. ;; Else Find the first preceding line with non-comment source on it
  1099. ;; that is not a continuation line of a multi-line parenthesized
  1100. ;; expression (and isn't a preprocessor line :-).
  1101. ;; Record whether this line begins with an operator. We assume
  1102. ;; that the line is a continuation line if it begins with an operator
  1103. (beginning-of-line)
  1104. (setq continuation (looking-at eif-operator-regexp))
  1105. ;; Record whether the line being indented begins with an "<id> :"
  1106. ;; This is used in indenting assertion tag expressions.
  1107. (setq id-colon (looking-at "[ \t]*[a-zA-Z0-9_]+[ \t]*:"))
  1108. (forward-line -1)
  1109. (beginning-of-line)
  1110. (while (and (looking-at eif-non-source-line)
  1111. (not (= (point) 1)))
  1112. (forward-line -1)
  1113. (beginning-of-line))
  1114. (if (eif-line-contains-close-paren)
  1115. (backward-sexp))
  1116. (eif-skip-leading-whitespace)
  1117. (cond ((and (= (point) 1)
  1118. originally-looking-at-comment
  1119. (setq indent (eif-class-level-comment-indent-m))))
  1120. ;; 'eif-is-keyword-regexp' case must precede
  1121. ;; '(not eif-all-keywords-regexp)' case since "is" is not
  1122. ;; part of 'eif-all-keywords-regexp'
  1123. ((or (looking-at eif-is-keyword-regexp)
  1124. (looking-at eif-multiline-routine-is-keyword-regexp)
  1125. (looking-at eif-obsolete-keyword))
  1126. (if originally-looking-at-comment
  1127. ;; Then the line we are trying to indent is a comment
  1128. (setq indent (eif-feature-level-comment-indent-m))
  1129. ;; Else the line being indented is not a comment
  1130. (setq indent (eif-feature-level-kw-indent-m))))
  1131. ;; Feature indentation keyword or class-level `create'.
  1132. ((or (looking-at eif-feature-indentation-keywords-regexp)
  1133. (and (looking-at eif-create-keyword-regexp)
  1134. (not (save-excursion
  1135. (eif-find-beginning-of-feature)))))
  1136. (setq indent (eif-feature-level-indent-m)))
  1137. ((looking-at eif-create-keyword-regexp)
  1138. (setq indent (eif-current-line-indent)))
  1139. ((and (looking-at eif-indentation-keywords-regexp)
  1140. (not (looking-at eif-once-non-indent-regexp)))
  1141. (if (looking-at eif-end-on-current-line)
  1142. (setq indent (eif-current-line-indent))
  1143. (setq indent
  1144. (+ (eif-current-line-indent) eif-indent-increment))))
  1145. ((looking-at eif-solitary-then-keyword)
  1146. (setq indent (- (+ (eif-current-line-indent) eif-indent-increment)
  1147. (eif-then-indent-m))))
  1148. ((looking-at eif-then-keyword)
  1149. (setq indent (eif-current-line-indent)))
  1150. ((looking-at (concat eif-end-keyword eif-non-id-char-regexp))
  1151. (if (= (setq indent (eif-current-line-indent))
  1152. (eif-feature-level-kw-indent-m))
  1153. (setq indent (eif-feature-level-indent-m))
  1154. (eif-matching-line)
  1155. (if (string-match eif-check-keyword eif-matching-kw-for-end)
  1156. (setq indent (- indent (eif-check-keyword-indent-m))))))
  1157. ((looking-at eif-variable-or-const-regexp)
  1158. ;;Either a variable declaration or a pre or post condition tag
  1159. (if originally-looking-at-comment
  1160. ;; Then the line we are trying to indent is a comment
  1161. (if (= (setq indent (eif-current-line-indent))
  1162. (eif-feature-level-indent-m))
  1163. ;; Then - a feature level comment
  1164. (setq indent (eif-feature-level-comment-indent-m))
  1165. ;; Else - some other kind of comment
  1166. (setq indent (+ indent (eif-body-comment-indent-m))))
  1167. ;; Else the line being indented is not a comment
  1168. (if (setq indent (eif-indent-assertion-continuation id-colon))
  1169. indent
  1170. ;; One of the ways of getting here is when we're
  1171. ;; in a split line in an indexing clause.
  1172. ;; Strings on their own need to be given some
  1173. ;; extra indent.
  1174. (if originally-looking-at-lone-string
  1175. (if (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
  1176. (setq indent (eif-current-line-indent))
  1177. (setq indent (+ (eif-current-line-indent)
  1178. eif-indent-increment)))
  1179. (setq indent (eif-current-line-indent))))))
  1180. ((setq indent (eif-manifest-array-start))
  1181. indent)
  1182. ;; OK, this is a sanity check, but it kills a minor
  1183. ;; instance of `create', so we need to code the corner
  1184. ;; case. As for minor instance of `once'.
  1185. ((or (not (looking-at eif-all-keywords-regexp))
  1186. (looking-at eif-create-keyword-regexp)
  1187. (looking-at eif-once-non-indent-regexp))
  1188. (if originally-looking-at-comment
  1189. ;; Then the line we are trying to indent is a comment
  1190. (cond ((eif-continuation-line)
  1191. (setq indent
  1192. (+ (- (eif-current-line-indent)
  1193. eif-indent-increment)
  1194. (eif-body-comment-indent-m))))
  1195. ;; preceding line is at eif-feature-level-indent -
  1196. ;; assume that the preceding line is a parent
  1197. ;; class in an inherit clause
  1198. ((= (eif-current-line-indent)
  1199. (eif-feature-level-indent-m))
  1200. (setq indent
  1201. (+ (eif-inherit-level-kw-indent-m)
  1202. (eif-body-comment-indent-m))))
  1203. (t
  1204. (setq indent
  1205. (+ (eif-current-line-indent)
  1206. (eif-body-comment-indent-m)))))
  1207. ;; Else line being indented is not a comment
  1208. ;; The line the point is on is the one above the line being
  1209. ;; indented
  1210. (beginning-of-line)
  1211. (if (or continuation (looking-at eif-operator-eol-regexp))
  1212. ;; Then the line being indented is a continuation line
  1213. (if (eif-continuation-line)
  1214. ;; The line preceding the line being indented is
  1215. ;; also a continuation line. Indent to the current
  1216. ;; line indentation.
  1217. (setq indent (eif-current-line-indent))
  1218. ;; Else The line preceding the line being indented is
  1219. ;; not a continuation line. Indent an extra
  1220. ;; eif-continuation-indent
  1221. (setq indent (+ (eif-current-line-indent)
  1222. (eif-continuation-indent-m))))
  1223. ;; Else the line being indented is not a continuation line.
  1224. (if (eif-continuation-line)
  1225. (if id-colon
  1226. ;; Then the line preceding the one being indented
  1227. ;; is an assertion continuation. Indent the current
  1228. ;; line to the same level as the preceding assertion
  1229. ;; tag.
  1230. (setq indent (eif-indent-assertion-tag))
  1231. ;; Then the line preceding the one being indented is
  1232. ;; a continuation line. Un-indent by an
  1233. ;; eif-continuation-indent.
  1234. (setq indent (- (eif-current-line-indent)
  1235. eif-indent-increment)))
  1236. ;; Else the line preceding the line being indented is
  1237. ;; also not a continuation line.
  1238. (if (and (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
  1239. (not originally-looking-at-lone-string))
  1240. (setq indent (- (eif-current-line-indent)
  1241. eif-indent-increment))
  1242. ;; Else use the current indent.
  1243. (setq indent (eif-current-line-indent))))))))))
  1244. indent))
  1245. (defun eif-continuation-line ()
  1246. "Return non-nil if the current line is a continuation line."
  1247. (or (looking-at eif-operator-regexp)
  1248. (save-excursion
  1249. (forward-line -1)
  1250. (beginning-of-line)
  1251. (looking-at eif-operator-eol-regexp))))
  1252. (defun eif-indent-assertion-continuation (id-colon)
  1253. "Generally, are we in line that is a continuation of an assertion?
  1254. More precisely, are we inside a pre or a post condition clause on a
  1255. line that is a continuation of a multi-line assertion beginning with a
  1256. tag? If so, return the indentation of the continuation line. The
  1257. argument ID-COLON is t if the line we are indenting begins with
  1258. \"<id> :\", and nil otherwise."
  1259. (let ((limit (point)))
  1260. (if (save-excursion
  1261. (if (re-search-backward
  1262. (concat eif-feature-level-keywords-regexp "\\|"
  1263. eif-end-keyword-regexp) nil t)
  1264. (if (looking-at "ensure\\|require")
  1265. (setq limit (point)))))
  1266. (save-excursion
  1267. (end-of-line)
  1268. (if (and (not id-colon) (re-search-backward ": *" limit t))
  1269. (progn
  1270. (goto-char (match-end 0))
  1271. (current-column)))))))
  1272. (defun eif-indent-assertion-tag ()
  1273. "Return indentation for part of a multi-line assertion.
  1274. That is, the current line is assumed to be a continuation of a
  1275. multi-line assertion, and we return the required indentation."
  1276. (save-excursion
  1277. (if (re-search-backward "ensure\\|require\\|variant\\|invariant" nil t)
  1278. (+ (eif-current-line-indent) eif-indent-increment)
  1279. ;; This option should not occur
  1280. (error "Could not find assertion tag"))))
  1281. (defun eif-matching-kw (matching-keyword-regexp &optional noerror)
  1282. "Search backwards and return a keyword in MATCHING-KEYWORD-REGEXP.
  1283. Also set the value of variable `eif-matching-indent' to the
  1284. indentation of the keyword found. If an `end' keyword occurs prior to
  1285. finding one of the keywords in MATCHING-KEYWORD-REGEXP and it
  1286. terminates a check clause, set the value of variable
  1287. `eif-matching-indent' to the indentation of the `end' minus the value
  1288. of `eif-check-keyword-indent'."
  1289. (let ((search-regexp (concat "[^a-z0-9A-Z_.]"
  1290. eif-end-keyword
  1291. "[^a-z0-9A-Z_.]\\|[^a-z0-9A-Z_.]"
  1292. matching-keyword-regexp
  1293. "\\|" eif-once-non-indent-regexp))
  1294. (keyword nil))
  1295. (save-excursion
  1296. ;; Search backward for a matching keyword.
  1297. ;; Note that eif-once-non-indent-regexp indicates we haven't
  1298. ;; found a match so should keep going.
  1299. (while (and (eif-re-search-backward search-regexp 1 t)
  1300. (looking-at eif-once-non-indent-regexp)
  1301. (not (= (point) 1))))
  1302. (if (looking-at search-regexp)
  1303. ;; Then - a keyword was found
  1304. (progn
  1305. (setq keyword
  1306. (buffer-substring (match-beginning 0) (match-end 0)))
  1307. (if (and (looking-at eif-end-keyword-regexp)
  1308. (eif-matching-line)
  1309. (string-match eif-check-keyword eif-matching-kw-for-end))
  1310. ;; Then
  1311. (setq eif-matching-indent (- (eif-current-line-indent)
  1312. (eif-check-keyword-indent-m)))
  1313. ;; Else
  1314. (setq eif-matching-indent (eif-current-line-indent))))
  1315. ;; Else no keyword was found. I think this is an error
  1316. (setq eif-matching-indent 0)
  1317. (if noerror
  1318. nil
  1319. (message "No matching indent keyword was found")))
  1320. keyword)))
  1321. (defun eif-line-contains-close-paren ()
  1322. "Return t if the current line contains a close paren, nil otherwise.
  1323. If a close paren is found, the point is placed immediately after the
  1324. last close paren on the line. If no paren is found, the point is
  1325. placed at the beginning of the line."
  1326. (let ((search-min 0))
  1327. (beginning-of-line)
  1328. (setq search-min (point))
  1329. (end-of-line)
  1330. (if (search-backward ")" search-min t)
  1331. ;; Then
  1332. (progn
  1333. (forward-char 1)
  1334. t)
  1335. ;; Else
  1336. (beginning-of-line)
  1337. nil)))
  1338. ;; Not Currently Used
  1339. ;;(defun eif-quoted-string-on-line-p ()
  1340. ;; "t if an Eiffel quoted string begins, ends, or is continued
  1341. ;; on current line."
  1342. ;; (save-excursion
  1343. ;; (beginning-of-line)
  1344. ;; ;; Line must either start with optional whitespace immediately followed
  1345. ;; ;; by a '%' or include a '\"'. It must either end with a '%' character
  1346. ;; ;; or must include a second '\"' character.
  1347. ;; (looking-at "^\\([ \t]*%\\|[^\"\n]*\"\\)[^\"\n]*\\(%$\\|\"\\)")))
  1348. (defconst eif-opening-regexp
  1349. "\\<\\(external\\|check\\|deferred\\|do\\|once\\|from\\|if\\|inspect\\|debug\\)\\>"
  1350. "Keywords that open eiffel nesting constructs.")
  1351. ;; OK, this is a horrible hack in all of this to handle "once" as a
  1352. ;; special case because it has been overloaded. The search for the
  1353. ;; opening keyword on the current line is quite reasonably limited to
  1354. ;; the current line. Therefore, the standard hacky way that we avoid
  1355. ;; matching once strings, by making sure they're followed by
  1356. ;; whitespace and a non-double-quote, doesn't work here.
  1357. (defconst eif-non-opening-regexp
  1358. "\\<once\\s-+\""
  1359. "Pattern matching exclusions from `eif-opening-regexp'.")
  1360. (defconst eif-closing-regexp "\\<end\\>"
  1361. "Keywords that close eiffel nesting constructs.")
  1362. (defconst eif-do-regexp "^[[:space:]]*\\(do\\|once\\|external\\|attribute\\)\\>"
  1363. "Keyword that opens eiffel routine body.")
  1364. (defconst eif-opening-or-closing-regexp
  1365. (concat "\\(" eif-opening-regexp "\\|" eif-closing-regexp "\\)")
  1366. "Keywords that open or close eiffel nesting constructs.")
  1367. ;;
  1368. ;; Code to allow indenting whole eiffel blocks
  1369. ;;
  1370. (defun eif-matching-line (&optional return-line-break direction)
  1371. "Return the position of the keyword matching the one on the current line.
  1372. For example, a line containing the keyword `do' is matched by a line
  1373. containing the keyword `end' and a line containing `end' may be
  1374. matched by a number of opening keywords. If the optional parameter
  1375. RETURN-LINE-BREAK is non-nil, the character position returned is the
  1376. beginning (or end) of the line containing the matching keyword instead
  1377. of the position of the keyword itself. If the second optional
  1378. parameter, DIRECTION, is non-nil, the current line is not searched for
  1379. a keyword. Instead, if the value of direction is 'forward, the
  1380. function acts as if an `eif-opening-regexp' is on the current line.
  1381. If the value of direction is 'backward, the function acts as if a
  1382. `eif-closing-regexp' is on the current line. The effect of using the
  1383. direction parameter is to locate either the opening or closing keyword
  1384. of the syntactic construct containing the point."
  1385. (let ((nesting-level 0)
  1386. (search-end 0)
  1387. matching-point opening-keyword match-start match-end
  1388. success start-point)
  1389. (unwind-protect
  1390. (save-excursion
  1391. (setq eif-matching-kw-for-end "");; public variable set by this function
  1392. (setq start-point (point))
  1393. (end-of-line)
  1394. (setq search-end (point))
  1395. (beginning-of-line)
  1396. ;; Set starting state: If direction was specified use it.
  1397. ;; If direction is nil, search for a keyword on the current line
  1398. ;; If the keyword is in eif-opening-regexp, set the search
  1399. ;; direction to 'forward, if the keyword on the current line is `end'
  1400. ;; set the search direction to 'backward.
  1401. (cond ((eq direction 'forward)
  1402. (end-of-line) ;; So we wont see keywords on this line.
  1403. (setq nesting-level 1))
  1404. ((eq direction 'backward)
  1405. (beginning-of-line) ;; So we wont see keywords on this line.
  1406. (setq nesting-level -1))
  1407. ((and (re-search-forward eif-opening-regexp search-end t)
  1408. (eif-not-in-comment-or-quoted-string-p))
  1409. (setq match-start (match-beginning 0))
  1410. (setq match-end (match-end 0))
  1411. (goto-char match-start)
  1412. (if (and (not (looking-at eif-non-opening-regexp))
  1413. (eif-not-in-comment-or-quoted-string-p))
  1414. (setq nesting-level 1))
  1415. (setq opening-keyword
  1416. (cons (buffer-substring match-start match-end)
  1417. opening-keyword))
  1418. (goto-char match-end))
  1419. ((and (progn (beginning-of-line) t)
  1420. (re-search-forward eif-closing-regexp search-end t)
  1421. (eif-not-in-comment-or-quoted-string-p))
  1422. (goto-char (match-beginning 0))
  1423. (if (eif-not-in-comment-or-quoted-string-p)
  1424. (setq nesting-level -1))))
  1425. ;; Perform the search
  1426. (while (not (= nesting-level 0))
  1427. (if (> nesting-level 0)
  1428. ;; Then search forward for the next keyword not in a comment
  1429. (while (and (re-search-forward eif-opening-or-closing-regexp nil 1)
  1430. (goto-char (setq match-start (match-beginning 0)))
  1431. (setq match-end (match-end 0))
  1432. (setq success t)
  1433. (or (looking-at eif-non-opening-regexp)
  1434. (eif-in-comment-or-quoted-string-p)))
  1435. (goto-char match-end)
  1436. (setq success nil))
  1437. ;; Else search backward for the next keyword not in a comment
  1438. (while (and (re-search-backward eif-opening-or-closing-regexp nil 1)
  1439. (goto-char (setq match-start (match-beginning 0)))
  1440. (setq success t)
  1441. (or (looking-at eif-non-opening-regexp)
  1442. (eif-in-comment-or-quoted-string-p)))
  1443. (setq success nil)))
  1444. (cond ((and (not (looking-at eif-non-opening-regexp))
  1445. (looking-at eif-opening-regexp)
  1446. success)
  1447. ;; Found an opening keyword
  1448. (if (> nesting-level 0)
  1449. ;; Then
  1450. (if (looking-at eif-do-regexp)
  1451. ;; Then
  1452. (setq nesting-level -1)
  1453. ;; Else
  1454. (setq opening-keyword
  1455. (cons (buffer-substring match-start
  1456. (match-end 0))
  1457. opening-keyword))
  1458. (goto-char (match-end 0)))
  1459. ;; Else
  1460. (if (= nesting-level -1)
  1461. ;; Then
  1462. (progn
  1463. (setq eif-matching-kw-for-end
  1464. (buffer-substring match-start (match-end 0)))
  1465. (if (looking-at "[ \t\n]+")
  1466. (goto-char (match-end 0))))
  1467. ;; Else
  1468. (if (looking-at eif-do-regexp)
  1469. ;; Then
  1470. (progn
  1471. (goto-char (eif-matching-line nil 'forward))
  1472. (setq nesting-level -1))))
  1473. (setq opening-keyword (cdr opening-keyword))
  1474. (if return-line-break
  1475. (beginning-of-line)))
  1476. (setq nesting-level (1+ nesting-level)))
  1477. ((and (looking-at eif-closing-regexp) success)
  1478. ;; Found an opening keyword
  1479. (if (> nesting-level 0)
  1480. ;; Then
  1481. (progn
  1482. (setq opening-keyword (cdr opening-keyword))
  1483. (if return-line-break
  1484. (end-of-line))
  1485. (goto-char (match-end 0)))
  1486. ;; Else
  1487. (setq opening-keyword
  1488. (cons (buffer-substring (match-beginning 0)
  1489. (match-end 0))
  1490. opening-keyword)))
  1491. (setq nesting-level (1- nesting-level)))
  1492. (t (message (concat "Could not find match"
  1493. (if (car opening-keyword)
  1494. (concat " for: "
  1495. (car opening-keyword)))))
  1496. (goto-char start-point)
  1497. (setq nesting-level 0))))
  1498. (setq matching-point (point))))
  1499. (set-mark matching-point)))
  1500. ;; ENHANCEME: Make this function correctly indent more than just routine
  1501. ;; bodies and their sub-constructs. At the least it should
  1502. ;; handle whole routines also.
  1503. (defun eif-indent-construct ()
  1504. "Indent an entire eiffel syntactic construct.
  1505. It is assumed that the point is within a nesting construct ('do',
  1506. `once', 'check', 'if', 'from', or 'inspect'). The whole construct is
  1507. indented up to the matching end. If the point is not within such a
  1508. construct, then only that line is indented"
  1509. (interactive)
  1510. (let ((end-point 0))
  1511. (save-excursion
  1512. (end-of-line)
  1513. (if (not (= (point) (point-max))) (forward-char 1))
  1514. (goto-char (eif-matching-line t 'backward))
  1515. (setq end-point (eif-matching-line t 'forward))
  1516. (while (< (point) end-point)
  1517. (eif-indent-line)
  1518. (forward-line 1)
  1519. (beginning-of-line)))))
  1520. (defun eif-indent-region (&optional start end)
  1521. "Indent the lines in the current region.
  1522. The region may be specified using optional arguments START and END."
  1523. (interactive)
  1524. (let ((start-point (or start (region-beginning)))
  1525. (end-point (copy-marker (or end (region-end)))))
  1526. (save-excursion
  1527. (goto-char start-point)
  1528. (cond ((eq major-mode 'eiffel-mode)
  1529. (while (< (point) end-point)
  1530. (if (not (looking-at "[ \t]*$"))
  1531. (eif-indent-line))
  1532. (forward-line 1)
  1533. (beginning-of-line)))
  1534. (t (error "Buffer must be in eiffel mode"))))))
  1535. (defadvice isearch-yank-word (around eif-isearch-yank-word activate)
  1536. "isearch-yank-word, with the underscore not being a letter"
  1537. (interactive)
  1538. (modify-syntax-entry ?_ "_ ")
  1539. ad-do-it
  1540. (modify-syntax-entry ?_ "w "))
  1541. (defadvice isearch-yank-word-or-char (around eif-isearch-yank-word-or-char activate)
  1542. "isearch-yank-word-or-char, with the underscore not being a letter"
  1543. (interactive)
  1544. (modify-syntax-entry ?_ "_ ")
  1545. ad-do-it
  1546. (modify-syntax-entry ?_ "w "))
  1547. (defadvice forward-word (around eif-forward-word activate)
  1548. "forward-word, with the underscore not being a letter"
  1549. (interactive "p")
  1550. (modify-syntax-entry ?_ "_ ")
  1551. ad-do-it
  1552. (modify-syntax-entry ?_ "w "))
  1553. (defadvice backward-word (around eif-backward-word activate)
  1554. "backward-word, with the underscore not being a letter"
  1555. (interactive "p")
  1556. (modify-syntax-entry ?_ "_ ")
  1557. ad-do-it
  1558. (modify-syntax-entry ?_ "w "))
  1559. (defadvice right-word (around eif-forward-word activate)
  1560. "right-word, with the underscore not being a letter"
  1561. (interactive "p")
  1562. (modify-syntax-entry ?_ "_ ")
  1563. ad-do-it
  1564. (modify-syntax-entry ?_ "w "))
  1565. (defadvice left-word (around eif-backward-word activate)
  1566. "left-word, with the underscore not being a letter"
  1567. (interactive "p")
  1568. (modify-syntax-entry ?_ "_ ")
  1569. ad-do-it
  1570. (modify-syntax-entry ?_ "w "))
  1571. (defadvice backward-kill-word (around eif-backward-kill-word activate)
  1572. "backward-kill-word, with the underscore not being a letter"
  1573. (interactive "p")
  1574. (modify-syntax-entry ?_ "_ ")
  1575. ad-do-it
  1576. (modify-syntax-entry ?_ "w "))
  1577. (defadvice kill-word (around eif-kill-word activate)
  1578. "kill-word, with the underscore not being a letter"
  1579. (interactive "p")
  1580. (modify-syntax-entry ?_ "_ ")
  1581. ad-do-it
  1582. (modify-syntax-entry ?_ "w "))
  1583. (defun eif-local-indent (amount)
  1584. "Set the value of `eif-indent-increment' to AMOUNT buffer-locally."
  1585. (interactive "NNumber of spaces for eif-indent-increment: ")
  1586. (make-local-variable 'eif-indent-increment)
  1587. (setq eif-indent-increment amount))
  1588. ;; ----------------------------------------------------------------------
  1589. ;; This next portion of the file is derived from "eiffel.el"
  1590. ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. and Bob Weiner
  1591. ;; Available for use and distribution under the same terms as GNU Emacs.
  1592. ;; ----------------------------------------------------------------------
  1593. (defvar eiffel-mode-map nil
  1594. "Keymap for Eiffel mode.")
  1595. (if eiffel-mode-map
  1596. nil
  1597. (let ((map (make-sparse-keymap)))
  1598. (define-key map [(control j)] 'newline-and-indent)
  1599. (define-key map [(return)] 'reindent-then-newline-and-indent)
  1600. (define-key map [(meta control q)] 'eif-indent-construct)
  1601. (define-key map [(meta \')] 'eif-feature-quote)
  1602. (define-key map [(meta q)] 'eif-fill-paragraph)
  1603. (define-key map [(meta control a)] 'eif-beginning-of-feature)
  1604. (define-key map [(meta control e)] 'eif-end-of-feature)
  1605. (define-key map [(control x) ?n ?d] 'eif-narrow-to-feature)
  1606. (define-key map [(control c) ?c] 'eif-class)
  1607. (define-key map [(control c) ?f] 'eif-function)
  1608. (define-key map [(control c) ?p] 'eif-procedure)
  1609. (define-key map [(control c) ?a] 'eif-attribute)
  1610. (define-key map [(control c) ?i] 'eif-if)
  1611. (define-key map [(control c) ?l] 'eif-loop)
  1612. (define-key map [(control c) ?s] 'eif-set)
  1613. (define-key map [(control c) ?n] 'eif-inspect)
  1614. (define-key map [(control c) ?w] 'eif-when)
  1615. (define-key map [(control c) ?e] 'eif-elseif)
  1616. (define-key map [(meta control a)] 'eif-beginning-of-feature)
  1617. (define-key map [(meta control e)] 'eif-end-of-feature)
  1618. (define-key map [(meta control h)] 'eif-mark-feature)
  1619. (setq eiffel-mode-map map)))
  1620. (defvar eiffel-mode-syntax-table nil
  1621. "Syntax table in use in Eiffel-mode buffers.")
  1622. (if eiffel-mode-syntax-table
  1623. nil
  1624. (let ((table (make-syntax-table))
  1625. (i 0))
  1626. (while (< i ?0)
  1627. (modify-syntax-entry i "_ " table)
  1628. (setq i (1+ i)))
  1629. (setq i (1+ ?9))
  1630. (while (< i ?A)
  1631. (modify-syntax-entry i "_ " table)
  1632. (setq i (1+ i)))
  1633. (setq i (1+ ?Z))
  1634. (while (< i ?a)
  1635. (modify-syntax-entry i "_ " table)
  1636. (setq i (1+ i)))
  1637. (setq i (1+ ?z))
  1638. (while (< i 128)
  1639. (modify-syntax-entry i "_ " table)
  1640. (setq i (1+ i)))
  1641. (modify-syntax-entry ? " " table)
  1642. (modify-syntax-entry ?- ". 12" table)
  1643. (modify-syntax-entry ?_ "w " table)
  1644. (modify-syntax-entry ?\t " " table)
  1645. (modify-syntax-entry ?\n "> " table)
  1646. (modify-syntax-entry ?\f "> " table)
  1647. (modify-syntax-entry ?\" "\" " table)
  1648. (modify-syntax-entry ?\\ "." table)
  1649. (modify-syntax-entry ?\( "() " table)
  1650. (modify-syntax-entry ?\) ")( " table)
  1651. (modify-syntax-entry ?\[ "(] " table)
  1652. (modify-syntax-entry ?\] ")[ " table)
  1653. (modify-syntax-entry ?\{ "(} " table)
  1654. (modify-syntax-entry ?\} "){ " table)
  1655. (modify-syntax-entry ?' "\"" table)
  1656. (modify-syntax-entry ?` "." table)
  1657. (modify-syntax-entry ?/ "." table)
  1658. (modify-syntax-entry ?* "." table)
  1659. (modify-syntax-entry ?+ "." table)
  1660. (modify-syntax-entry ?= "." table)
  1661. (modify-syntax-entry ?% "\\" table)
  1662. (modify-syntax-entry ?< "." table)
  1663. (modify-syntax-entry ?> "." table)
  1664. (modify-syntax-entry ?& "." table)
  1665. (modify-syntax-entry ?| "." table)
  1666. (modify-syntax-entry ?\; "." table)
  1667. (modify-syntax-entry ?: "." table)
  1668. (modify-syntax-entry ?! "." table)
  1669. (modify-syntax-entry ?. "." table)
  1670. (modify-syntax-entry ?, "." table)
  1671. (setq eiffel-mode-syntax-table table)))
  1672. (defun eif-add-menu ()
  1673. "Add the \"Eiffel\" menu to the menu bar."
  1674. (easy-menu-define
  1675. eiffel-mode-menu
  1676. eiffel-mode-map
  1677. "Menu for eiffel-mode."
  1678. (append (list "Eiffel")
  1679. (if eif-use-gobo-eiffel
  1680. (list
  1681. ["Compile..." eif-compile t]
  1682. ["Compiler Options..." eif-set-compile-options t]
  1683. ["Next Compile Error..." next-error t]
  1684. ["Run..." eif-run t]
  1685. ;;["Debug..." eif-debug t]
  1686. ["Short..." eif-short t]
  1687. ["----------" nil nil]))
  1688. (list
  1689. ["Indent Construct" eif-indent-construct t]
  1690. (list "Insert"
  1691. ["Class" eif-class t]
  1692. ["Command" eif-procedure t]
  1693. ["Query" eif-function t]
  1694. ["Attribute" eif-attribute t]
  1695. ["Attribute setter" eif-set t]
  1696. ["If" eif-if t]
  1697. ["Loop" eif-loop t]
  1698. ["Inspect" eif-inspect t]
  1699. ["When" eif-when t]
  1700. ["Elseif" eif-elseif t])
  1701. ["----------" nil nil]
  1702. (list "Imenu"
  1703. ["By position" eif-imenu-add-menubar-by-position t]
  1704. ["By name" eif-imenu-add-menubar-by-name t])
  1705. (list "Comments"
  1706. ["Feature Quote" eif-feature-quote (eif-in-comment-p)]
  1707. ["Fill " eif-fill-paragraph (eif-near-comment-p)])
  1708. ["----------" nil nil]
  1709. ["Customize" eif-customize t])))
  1710. (easy-menu-add eiffel-mode-menu))
  1711. ;;;###autoload
  1712. (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
  1713. ;;(add-to-list 'auto-mode-alist '("\\.se\\'" . eiffel-mode))
  1714. (defun eiffel-mode ()
  1715. "Major mode for editing Eiffel programs.
  1716. \\[indent-for-tab-command] indents the current Eiffel line correctly and
  1717. \\[reindent-then-newline-and-indent] causes the current and next line to be
  1718. properly indented.
  1719. Key definitions:
  1720. \\{eiffel-mode-map}
  1721. If variable `eif-use-gobo-eiffel' is non-nil (default t) then support
  1722. for using GNU SmartEiffel is enabled. Run \\[eif-customize] to see
  1723. compilation and indentation variables that can be customized."
  1724. (interactive)
  1725. (kill-all-local-variables)
  1726. (setq major-mode 'eiffel-mode)
  1727. (setq mode-name "Eiffel")
  1728. (if eif-use-gobo-eiffel
  1729. (progn
  1730. (define-key eiffel-mode-map "\C-c\C-c" 'eif-compile)
  1731. (define-key eiffel-mode-map "\C-c\C-o" 'eif-set-compile-options)
  1732. (define-key eiffel-mode-map "\C-c\C-r" 'eif-run)
  1733. ;;(define-key eiffel-mode-map "\C-c\C-d" 'eif-debug)
  1734. (define-key eiffel-mode-map "\C-c\C-s" 'eif-short)
  1735. (define-key eiffel-mode-map "\C-c\C-f" 'eif-find-file))
  1736. (define-key eiffel-mode-map "\C-c\C-c" nil)
  1737. (define-key eiffel-mode-map "\C-c\C-o" nil)
  1738. (define-key eiffel-mode-map "\C-c\C-r" nil)
  1739. (define-key eiffel-mode-map "\C-c\C-s" nil))
  1740. (use-local-map eiffel-mode-map)
  1741. (eif-add-menu)
  1742. (set-syntax-table eiffel-mode-syntax-table)
  1743. ;; Make local variables.
  1744. (make-local-variable 'paragraph-start)
  1745. (make-local-variable 'paragraph-separate)
  1746. (make-local-variable 'paragraph-ignore-fill-prefix)
  1747. (make-local-variable 'require-final-newline)
  1748. (make-local-variable 'parse-sexp-ignore-comments)
  1749. (make-local-variable 'indent-line-function)
  1750. (make-local-variable 'indent-region-function)
  1751. (make-local-variable 'comment-start)
  1752. (make-local-variable 'comment-end)
  1753. (make-local-variable 'comment-column)
  1754. (make-local-variable 'comment-start-skip)
  1755. (make-local-variable 'imenu-create-index-function)
  1756. ;; Now set their values.
  1757. (setq paragraph-start (concat "^$\\|" page-delimiter)
  1758. paragraph-separate "[ \t ]*$"
  1759. paragraph-ignore-fill-prefix t
  1760. require-final-newline t
  1761. parse-sexp-ignore-comments t
  1762. indent-line-function 'eif-indent-line
  1763. indent-region-function 'eif-indent-region
  1764. comment-start "-- "
  1765. comment-end ""
  1766. comment-column 32
  1767. comment-start-skip eiffel-comment-start-skip
  1768. font-lock-multiline t)
  1769. (set (make-local-variable 'font-lock-defaults) #'(eiffel-font-lock-defaults t))
  1770. (if eif-set-tab-width-flag
  1771. (setq tab-width eif-indent-increment))
  1772. (setq auto-fill-function 'eif-auto-fill)
  1773. (run-hooks 'eiffel-mode-hook))
  1774. (defconst eif-prefeature-regexp
  1775. (concat "\\(" eif-non-source-line "\\|\n\\)*" "[ \t]*")
  1776. "Regexp matching whitespace-equivalent content, possibly before a feature.")
  1777. (defun eif-find-end-of-feature ()
  1778. "Find the `end' of the current feature definition.
  1779. Assumes point is at the beginning of the feature, not in a comment or
  1780. quoted string."
  1781. (let (ret)
  1782. (cond ((looking-at (concat eif-prefeature-regexp
  1783. eif-routine-begin-regexp))
  1784. ;; At the start of a routine, find matching end.
  1785. (and (eif-re-search-forward eif-do-regexp nil t)
  1786. (goto-char (match-beginning 0))
  1787. (goto-char (setq ret (eif-matching-line)))))
  1788. ((looking-at (concat eif-prefeature-regexp
  1789. eif-probably-feature-regexp))
  1790. ;; Not a routine, find end of attribute or constant.
  1791. (goto-char (setq ret (match-end 0)))))
  1792. ret))
  1793. ;; OK, this works well, but it doesn't work for the following cases:
  1794. ;; * In the middle of the feature regexp that need to be matched.
  1795. ;; However, it doesn't need to since eif-beginning-of-feature adds
  1796. ;; some smarts around it...
  1797. (defun eif-find-beginning-of-feature ()
  1798. "Find the beginning of the most recent feature definition.
  1799. This will always move backward, if possible."
  1800. (interactive)
  1801. (let ((start (point))
  1802. candidate routine-begin)
  1803. (if (eif-re-search-backward (concat "\\s-" eif-probably-feature-regexp)
  1804. nil t)
  1805. (progn
  1806. (forward-char) ;; Skip the whitespace character matched above.
  1807. (if (looking-at (regexp-opt eiffel-keywords-feature))
  1808. (eif-find-beginning-of-feature)
  1809. (if (not (or (looking-at (concat
  1810. "\\(" eif-attribute-regexp
  1811. "\\|" eif-constant-regexp "\\)"))))
  1812. ;; This is a routine. Done.
  1813. (point)
  1814. ;; Variable/attribute or constant declaration matched.
  1815. ;; Now we go back and find the previous routine start, the
  1816. ;; following end, and see if the current position
  1817. ;; (candidate) is between. If it is, then candidate is a
  1818. ;; variable or constant declaration within a routine, so
  1819. ;; we're interested in the routine start. If it isn't,
  1820. ;; then it must be a class attribute or constant, so it is
  1821. ;; what we're looking for.
  1822. (setq candidate (point))
  1823. (goto-char start)
  1824. (if (eif-re-search-backward
  1825. (concat "\\s-" eif-routine-begin-regexp) nil t)
  1826. (progn
  1827. (forward-char)
  1828. (setq routine-begin (point))
  1829. (eif-find-end-of-feature)
  1830. (if (and (< routine-begin candidate)
  1831. (< candidate (point)))
  1832. (goto-char routine-begin)
  1833. (goto-char candidate)))
  1834. (goto-char candidate))))))))
  1835. (defun eif-beginning-of-feature (&optional arg)
  1836. "Move backward to next feature beginning.
  1837. With ARG, do it that many times. Negative arg -N
  1838. means move forward to Nth following beginning of feature.
  1839. Returns t unless search stops due to beginning or end of buffer."
  1840. (interactive "p")
  1841. (or arg
  1842. (setq arg 1))
  1843. (let ((start (point))
  1844. (success t))
  1845. (cond ((> arg 0)
  1846. ;; Going backward.
  1847. ;; We have to move forward to make sure we find any feature
  1848. ;; that we might be in the middle of the beginning of. How
  1849. ;; far? How about this far?
  1850. (eif-re-search-forward eif-probably-feature-regexp nil 'move)
  1851. ;; Change arg towards zero as we search, failing if we hit
  1852. ;; edge of buffer.
  1853. (while (and (> arg 0)
  1854. (or (eif-find-beginning-of-feature)
  1855. (setq success nil)))
  1856. ;; If we've gone backwards from the original start, then
  1857. ;; this counts.
  1858. (if (< (point) start)
  1859. (setq arg (1- arg))))
  1860. (or success
  1861. (goto-char (point-min))))
  1862. ((< arg 0)
  1863. ;; Going forward.
  1864. ;; Similar to above, let's go back to the beginning of the
  1865. ;; current feature, and then skip over features and find
  1866. ;; the beginning of the next repeatedly.
  1867. (eif-find-beginning-of-feature)
  1868. (while (and (< arg 0)
  1869. (or (not (eobp)) (setq success nil)))
  1870. (eif-find-end-of-feature)
  1871. (if (eif-re-search-forward eif-probably-feature-regexp
  1872. nil 'move)
  1873. (progn
  1874. (goto-char (match-beginning 0))
  1875. (if (> (point) start)
  1876. (setq arg (1+ arg))))))))
  1877. success))
  1878. (defun eif-end-of-feature (&optional arg)
  1879. "Move forward to end of feature.
  1880. With argument, do it that many times. Negative argument means move
  1881. back ARG preceding ends of features."
  1882. (interactive "p")
  1883. ;; Default is to find the first feature's end.
  1884. ;; Huh? Even if they specify 0? - martin@meltin.net
  1885. ;; Hmmm, it is what end-of-defun does...
  1886. (if (or (null arg)
  1887. (= arg 0))
  1888. (setq arg 1))
  1889. ;; This is a bad way of trying to get into position. Happily, it
  1890. ;; seems to work. Hmmm, not sure if the comment skip is needed.
  1891. (if (eif-in-comment-p)
  1892. (end-of-line))
  1893. (cond ((let ((curr (point)))
  1894. (save-excursion
  1895. (and (eif-beginning-of-feature)
  1896. (eif-find-end-of-feature)
  1897. (forward-line)
  1898. (or (< curr (point))
  1899. (and (< arg 0)
  1900. (= curr (point)))))))
  1901. ;; Within a feature. Go to its beginning.
  1902. (eif-beginning-of-feature))
  1903. ((eif-peeking-backwards-at (concat "\\s-"
  1904. eif-probably-feature-regexp))
  1905. ;; Sitting at beginning of feature. Don't move!
  1906. t)
  1907. (t
  1908. ;; Not within a feature or at beginning, go to beginning of
  1909. ;; next feature.
  1910. (eif-beginning-of-feature -1)))
  1911. ;; This part is correct.
  1912. (if (eif-beginning-of-feature (+ (if (< arg 0) 0 1) (- arg)))
  1913. (progn
  1914. (eif-find-end-of-feature)
  1915. (forward-line))))
  1916. (defun eif-narrow-to-feature ()
  1917. "Make text outside current feature invisible.
  1918. The feature visible is the one that contains point or follows point."
  1919. (interactive)
  1920. (save-excursion
  1921. (widen)
  1922. (eif-end-of-feature)
  1923. (let ((end (point)))
  1924. (eif-beginning-of-feature)
  1925. (narrow-to-region (point) end))))
  1926. (defun eif-current-line-indent ()
  1927. "Return the indentation of the line containing the point."
  1928. (save-excursion
  1929. (eif-skip-leading-whitespace)
  1930. (current-column)))
  1931. (defun eif-in-quoted-string-p (&optional non-strict-p)
  1932. "Return t if point is in a quoted string.
  1933. Optional argument NON-STRICT-P if true causes the function to return
  1934. true even if the point is located in leading white space on a
  1935. continuation line. Normally leading white space is not considered part
  1936. of the string."
  1937. (let ((initial-regexp "^[ \t]*%\\|[^%]U?\"\\|%[ \t]*$")
  1938. (search-limit (point))
  1939. (count 0))
  1940. (save-excursion
  1941. ;; Line must either start with optional whitespace immediately followed
  1942. ;; by a '%' or include a '\"' before the search-limit.
  1943. (beginning-of-line)
  1944. (while (re-search-forward initial-regexp search-limit t)
  1945. (setq count (1+ count))
  1946. (if (= count 1) (setq search-limit (1+ search-limit))))
  1947. ;; If the number of quotes (including continuation line markers)
  1948. ;; is odd, then we are inside of a string. Also if non-strict-p
  1949. ;; and we are in the leading white space of a continuation line,
  1950. ;; then we are in a quote.
  1951. (or (= (% count 2) 1)
  1952. (progn
  1953. (beginning-of-line)
  1954. (and non-strict-p
  1955. (looking-at "^[ \t]*%")))))))
  1956. ;; ----------------------------------------------------------------------
  1957. ;; End of portion derived from "eiffel.el"
  1958. ;; ----------------------------------------------------------------------
  1959. (defun eif-comment-prefix ()
  1960. "Return the prefix starting a comment that begins a line.
  1961. Comments that are not the only thing on a line return nil as their prefix."
  1962. (save-excursion
  1963. (end-of-line)
  1964. (let ((limit (point)) len
  1965. (in-string (eif-in-quoted-string-p)))
  1966. (beginning-of-line)
  1967. (cond ((re-search-forward "^[ \t]*--|?[ \t]*" limit t)
  1968. (buffer-substring (match-beginning 0) (match-end 0)))
  1969. ;; Handle string-literal continuation lines
  1970. (in-string
  1971. (end-of-line)
  1972. (re-search-backward "^[ \t]*%\\|[^%]\"" nil t)
  1973. (re-search-forward "%\\|\"" nil t)
  1974. (setq len (1- (current-column)))
  1975. (concat (make-string len ? ) "%"))))))
  1976. (defun eif-auto-fill ()
  1977. "Auto-fill an Eiffel comment."
  1978. (let ((fill-prefix (eif-comment-prefix))
  1979. (pm (point-marker)))
  1980. (if (and (> (current-column) fill-column)
  1981. fill-prefix)
  1982. (if (string-match "^[ \t]*%" fill-prefix)
  1983. (progn
  1984. (backward-char 1)
  1985. (re-search-backward "[^][a-zA-Z0-9]" nil t)
  1986. (forward-char 1)
  1987. (insert "%\n")
  1988. (insert fill-prefix)
  1989. (goto-char pm))
  1990. ;; (do-auto-fill)
  1991. (backward-char 1)
  1992. (re-search-backward "\\s-" nil t)
  1993. (forward-char 1)
  1994. (insert "\n")
  1995. (insert fill-prefix)
  1996. (goto-char pm)))))
  1997. (defun eif-fill-paragraph ()
  1998. "Textually fills Eiffel comments ala \\[fill-paragraph]."
  1999. (interactive)
  2000. (save-excursion
  2001. (let ((current-point (point))
  2002. (fill-prefix (eif-comment-prefix))
  2003. last-point para-begin para-end)
  2004. (if fill-prefix
  2005. (progn
  2006. (setq last-point (point))
  2007. (forward-line -1)
  2008. (end-of-line)
  2009. (while (and (not (= (point) last-point))
  2010. (eif-comment-prefix))
  2011. (setq last-point (point))
  2012. (forward-line -1)
  2013. (end-of-line))
  2014. (if (= (point) last-point)
  2015. (setq para-begin (save-excursion (beginning-of-line) (point)))
  2016. (setq para-begin (1+ (point))))
  2017. (goto-char current-point)
  2018. (setq last-point (point))
  2019. (forward-line 1)
  2020. (end-of-line)
  2021. (while (and (not (= (point) last-point))
  2022. (eif-comment-prefix))
  2023. (setq last-point (point))
  2024. (forward-line 1)
  2025. (end-of-line))
  2026. (if (= (point) last-point)
  2027. (setq para-end (point))
  2028. (beginning-of-line)
  2029. (setq para-end (point)))
  2030. ;; Avert eyes now - gross hack follows... how big can an
  2031. ;; Eiffel comment be anyway? :-)
  2032. (let ((orig-region (and (<= (- para-end para-begin)
  2033. eif-fill-max-save)
  2034. (buffer-substring para-begin para-end)))
  2035. (orig-state (buffer-modified-p))
  2036. (ret (fill-region para-begin para-end)))
  2037. (and orig-region
  2038. (<= para-end (point-max))
  2039. (string-equal
  2040. orig-region (buffer-substring para-begin para-end))
  2041. (set-buffer-modified-p orig-state))
  2042. ret))))))
  2043. (defun eif-indent-line (&optional whole-exp)
  2044. "Indent the current line as Eiffel code.
  2045. With optional argument WHOLE-EXP, indent any additional lines of the
  2046. same clause rigidly along with this one (not implemented yet)."
  2047. (interactive "p")
  2048. (save-excursion
  2049. (beginning-of-line)
  2050. (skip-chars-forward " \t")
  2051. (let ((indent (eif-calc-indent)))
  2052. (if (not (= indent (current-column)))
  2053. (progn
  2054. (delete-horizontal-space)
  2055. (indent-to indent)))))
  2056. (skip-chars-forward " \t"))
  2057. (defun eif-move-to-prev-non-blank ()
  2058. "Move point to previous line excluding blank lines.
  2059. Return t if successful, nil if not."
  2060. (beginning-of-line)
  2061. (re-search-backward "^[ \t]*[^ \t\n]" nil t))
  2062. (defvar eif-last-feature-level-indent -1)
  2063. (defvar eif-feature-level-indent-regexp nil)
  2064. (defun eif-in-paren-expression ()
  2065. "Determine if we are inside of a parenthesized expression."
  2066. (interactive)
  2067. (let ((paren-count 0) (limit 0))
  2068. (save-excursion
  2069. (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
  2070. (setq limit
  2071. (re-search-backward eif-feature-level-indent-regexp nil t))
  2072. (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
  2073. (setq eif-feature-level-indent-regexp
  2074. (concat "^" (make-string eif-last-feature-level-indent ? )
  2075. "[^ \t\n]"))
  2076. (setq limit
  2077. (or (re-search-backward eif-feature-level-indent-regexp nil t)
  2078. 0))))
  2079. (save-excursion
  2080. (while (re-search-backward "[][()]" limit t)
  2081. (if (looking-at "[[(]")
  2082. (setq paren-count (1+ paren-count))
  2083. (setq paren-count (1- paren-count)))))
  2084. paren-count))
  2085. (defun eif-manifest-array-common ()
  2086. "Common code for handling indentation/presence of Eiffel manifest arrays."
  2087. (let ((paren-count 0))
  2088. (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
  2089. nil
  2090. (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
  2091. (setq eif-feature-level-indent-regexp
  2092. (concat "^" (make-string eif-last-feature-level-indent ? )
  2093. "[^ \t\n]")))
  2094. (while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
  2095. (if (not (eif-peeking-backwards-at "|\\|@"))
  2096. (if (looking-at "<<")
  2097. (setq paren-count (1+ paren-count))
  2098. (setq paren-count (1- paren-count)))))
  2099. paren-count))
  2100. (defun eif-manifest-array-indent ()
  2101. "Determine if we are inside of a manifest array."
  2102. (interactive)
  2103. (let (indent)
  2104. (save-excursion
  2105. (if (> (eif-manifest-array-common) 0)
  2106. (let ((eol (save-excursion (end-of-line) (point))))
  2107. (setq indent
  2108. (or (and (re-search-forward "[^< \t]" eol t)
  2109. (1- (current-column)))
  2110. (+ (current-column) 2))))))
  2111. indent))
  2112. (defun eif-manifest-array-start ()
  2113. "Determine the indentation of the statement containing a manifest array."
  2114. (interactive)
  2115. (let (indent)
  2116. (save-excursion
  2117. (if (> (eif-manifest-array-common) 0)
  2118. (let ((limit (progn (end-of-line) (point))))
  2119. (beginning-of-line)
  2120. (if (re-search-forward "^[ \t]*<<" limit t)
  2121. (setq indent (- (current-column) 2 eif-indent-increment))
  2122. (re-search-forward "^[ \t]*" limit t)
  2123. (setq indent (current-column))))))
  2124. indent))
  2125. ;; ----------------------------------------------------------------------
  2126. ;; The function below is derived from "eif-mult-fmt.el"
  2127. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  2128. ;; Copyright (C) 1990 Bob Weiner, Motorola Inc.
  2129. ;; Available for use and distribution under the same terms as GNU Emacs.
  2130. ;; ----------------------------------------------------------------------
  2131. (defun eif-indent-multi-line (&optional parse-start)
  2132. "Return indentation for line within parentheses or double quotes.
  2133. That is, we are in a multi-line parenthesised or double-quoted
  2134. expression, and want to know the suggested indentation for the current
  2135. line. If we are not within such an expression then return -1.
  2136. Optional argument PARSE-START is buffer position at which to begin
  2137. parsing, default is to begin at the feature enclosing or preceding
  2138. point."
  2139. (let ((eif-opoint (point))
  2140. (indent-point (progn (beginning-of-line) (point)))
  2141. (eif-ind-val -1)
  2142. (eif-in-str nil)
  2143. (eif-paren-depth 0)
  2144. (retry t)
  2145. state
  2146. ;; setting this to a number inhibits calling hook
  2147. last-sexp containing-sexp)
  2148. (if parse-start
  2149. (goto-char parse-start)
  2150. (eif-beginning-of-feature))
  2151. ;; Find outermost containing sexp
  2152. (while (< (point) indent-point)
  2153. (setq state (parse-partial-sexp (point) indent-point 0)))
  2154. ;; Find innermost containing sexp
  2155. (while (and retry
  2156. state
  2157. (> (setq eif-paren-depth (elt state 0)) 0))
  2158. (setq retry nil)
  2159. (setq last-sexp (elt state 2))
  2160. (setq containing-sexp (elt state 1))
  2161. ;; Position following last unclosed open.
  2162. (goto-char (1+ containing-sexp))
  2163. ;; Is there a complete sexp since then?
  2164. (if (and last-sexp (> last-sexp (point)))
  2165. ;; Yes, but is there a containing sexp after that?
  2166. (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
  2167. (if (setq retry (car (cdr peek))) (setq state peek)))))
  2168. (if retry
  2169. nil
  2170. ;; Innermost containing sexp found
  2171. (goto-char (1+ containing-sexp))
  2172. (if (not last-sexp)
  2173. ;; indent-point immediately follows open paren.
  2174. nil
  2175. ;; Find the start of first element of containing sexp.
  2176. (parse-partial-sexp (point) last-sexp 0 t)
  2177. (cond ((looking-at "\\s(")
  2178. ;; First element of containing sexp is a list.
  2179. ;; Indent under that list.
  2180. )
  2181. ((> (save-excursion (forward-line 1) (point))
  2182. last-sexp)
  2183. ;; This is the first line to start within the containing sexp.
  2184. (backward-prefix-chars))
  2185. (t
  2186. ;; Indent beneath first sexp on same line as last-sexp.
  2187. ;; Again, it's almost certainly a routine call.
  2188. (goto-char last-sexp)
  2189. (beginning-of-line)
  2190. (parse-partial-sexp (point) last-sexp 0 t)
  2191. (backward-prefix-chars))))
  2192. (setq eif-ind-val (current-column)))
  2193. ;; Point is at the point to indent under unless we are inside a string.
  2194. (setq eif-in-str (elt state 3))
  2195. (goto-char eif-opoint)
  2196. (if (not eif-in-str)
  2197. nil
  2198. ;; Inside a string, indent 1 past string start
  2199. (setq eif-paren-depth 1);; To account for being inside string
  2200. (save-excursion
  2201. (if (re-search-backward "\"" nil t)
  2202. (if eif-indent-string-continuations-relatively-flag
  2203. (setq eif-ind-val (1+ (current-column)))
  2204. (setq eif-ind-val (eif-current-line-indent)))
  2205. (goto-char indent-point)
  2206. (if (looking-at "^[ \t]*[^ \t\n]")
  2207. (eif-move-to-prev-non-blank))
  2208. (skip-chars-forward " \t")
  2209. (setq eif-ind-val (current-column)))))
  2210. (if (> eif-paren-depth 0) eif-ind-val -1)))
  2211. ;; ----------------------------------------------------------------------
  2212. ;; imenu support, great for browsing foreign code.
  2213. ;; Originally contributed by Berend de Boer <berend@pobox.com>.
  2214. ;; ----------------------------------------------------------------------
  2215. (defun eif-imenu-add-menubar-by-position ()
  2216. "Add menu of features of a class, sorted in order of occurence."
  2217. (interactive)
  2218. (setq imenu-create-index-function 'eif-imenu-create-index-by-position)
  2219. (imenu-add-to-menubar "Eiffel features")
  2220. )
  2221. (defun eif-imenu-add-menubar-by-name ()
  2222. "Add menu of features of a class, sorted by name."
  2223. (interactive)
  2224. (setq imenu-create-index-function 'eif-imenu-create-index-by-name)
  2225. (imenu-add-to-menubar "Eiffel names"))
  2226. (defun eif-imenu-create-index-by-position ()
  2227. "Generate index of features of a class, sorted in order of occurence."
  2228. (eif-imenu-create-index 0))
  2229. (defun eif-imenu-create-index-by-name ()
  2230. "Generate index of features of a class, sorted by name."
  2231. (eif-imenu-create-index 1))
  2232. (defun eif-imenu-create-index (sort-method)
  2233. "Generate an index of all features of a class.
  2234. Sort by position if sort-method is 0. Sort by name if sort-method is 1."
  2235. (let (menu prevpos)
  2236. (imenu-progress-message prevpos 0 t)
  2237. ;; scan for features
  2238. (goto-char (point-max))
  2239. (while (eif-find-beginning-of-feature)
  2240. (imenu-progress-message prevpos nil t)
  2241. (if (looking-at "\\(\\sw\\|\\s_\\)+")
  2242. (add-to-list 'menu (cons (buffer-substring-no-properties
  2243. (match-beginning 0)
  2244. (match-end 0)) (point)))))
  2245. (imenu-progress-message prevpos 100)
  2246. ;; sort in increasing buffer position order or by name
  2247. (if (= sort-method 0)
  2248. (sort menu (function (lambda (a b) (< (cdr a) (cdr b)))))
  2249. (sort menu (function (lambda (a b) (string< (car a) (car b))))))))
  2250. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2251. ;; C. Adrian: added good old features for code templating
  2252. (defun eif-class ()
  2253. "Insert a 'class' template."
  2254. (interactive)
  2255. (let ((cname (if (and buffer-file-name
  2256. (string-match "/\\([^/]+\\)\\.e$" buffer-file-name))
  2257. (substring buffer-file-name (match-beginning 1) (match-end 1))
  2258. (read-string "Class: "))))
  2259. (if (not (e-empty-line-p))
  2260. (progn (end-of-line)(newline)))
  2261. (indent-to 0)
  2262. (insert "class " (upcase cname) "\n\n"
  2263. "create {ANY}\n"
  2264. "make\n"
  2265. "\nfeature {ANY}\n\n"
  2266. "\nfeature {}\n"
  2267. "\n\ninvariant\n\n"
  2268. "end -- class " (upcase cname) "\n"))
  2269. (re-search-backward "create {ANY}" nil t)
  2270. (forward-line 1)
  2271. (eif-indent-line)
  2272. (re-search-forward "feature {ANY}" nil t)
  2273. (forward-line 1)
  2274. (eif-indent-line))
  2275. (defun eif-procedure ()
  2276. "Insert a 'procedure' template."
  2277. (interactive)
  2278. (let ((pname (read-string "Procedure name: ")))
  2279. (if (not (e-empty-line-p))
  2280. (progn
  2281. (end-of-line)
  2282. (newline)))
  2283. (indent-to eif-indent-increment)
  2284. (insert pname " is\n")
  2285. (indent-to (* 3 eif-indent-increment))
  2286. (insert "-- \n")
  2287. (mapc #'(lambda (keyword)
  2288. (indent-to (* 2 eif-indent-increment))
  2289. (insert keyword "\n"))
  2290. '("require" "local" "do" "ensure" "end"))
  2291. (search-backward " is" nil t)))
  2292. (defun eif-function ()
  2293. "Insert a 'function' template."
  2294. (interactive)
  2295. (let ((fname (read-string "Function name: "))
  2296. (type (upcase (read-string "Return type: "))))
  2297. (if (not (e-empty-line-p))
  2298. (progn (end-of-line)(newline)))
  2299. (indent-to eif-indent-increment)
  2300. (insert fname ": " type " is\n")
  2301. (indent-to (* 3 eif-indent-increment))
  2302. (insert "-- \n")
  2303. (mapc #'(lambda (keyword)
  2304. (indent-to (* 2 eif-indent-increment))
  2305. (insert keyword "\n"))
  2306. '("require" "local" "do" "ensure" "end"))
  2307. (search-backward ":" nil t)))
  2308. (defun eif-attribute ()
  2309. "Insert an 'attribute' template."
  2310. (interactive)
  2311. (if (not (e-empty-line-p))
  2312. (progn (end-of-line)(newline)))
  2313. (indent-to eif-indent-increment)
  2314. (let ((aname (read-string "Attribute name: "))
  2315. (type (upcase (read-string "Attribute type: "))))
  2316. (insert aname ": " type "\n")
  2317. (indent-to (* 3 eif-indent-increment))
  2318. (insert "-- \n")
  2319. (eif-indent-line)
  2320. (end-of-line)))
  2321. (defun e-empty-line-p ()
  2322. "True if current line is empty."
  2323. (save-excursion
  2324. (beginning-of-line)
  2325. (looking-at "^[ \t]*$")))
  2326. (defun eif-if ()
  2327. "Insert an 'if' statement template."
  2328. (interactive)
  2329. (mapc #'(lambda (s)
  2330. (insert s))
  2331. '("if then" "\n\nelse" "\n\nend" "\n"))
  2332. (re-search-backward " then" nil t)
  2333. (eif-indent-construct))
  2334. (defun eif-loop ()
  2335. "Insert a 'loop' statement template."
  2336. (interactive)
  2337. (let (
  2338. (varname (read-string "Loop variable name: ")
  2339. )
  2340. )
  2341. (if (not (string= varname ""))
  2342. ;; THEN -- A variable is named: insert it
  2343. (
  2344. let ((lower (read-string "Lower bound: "))
  2345. (upper (read-string "Upper bound: "))
  2346. (incr (read-string "Increment: "))
  2347. )
  2348. (insert "from\n" varname " := ")
  2349. (insert lower)
  2350. (insert "\ninvariant")
  2351. (insert "\nvariant\n")
  2352. (if (>= (string-to-number incr) 0)
  2353. (insert "(" upper " - " lower " + " incr ") - " varname)
  2354. (insert varname " - (" upper " - " lower " + " (abs incr) ")")
  2355. )
  2356. (insert "\nuntil\n" varname)
  2357. (if (>= (string-to-number incr) 0)
  2358. (insert " > " upper)
  2359. (insert " < " upper)
  2360. )
  2361. (insert "\nloop\n\n" varname " := " varname)
  2362. (if (>= (string-to-number incr) 0)
  2363. (insert " + " incr)
  2364. (insert " - " (abs incr))
  2365. )
  2366. (insert "\nend\n")
  2367. (re-search-backward "from" nil t)
  2368. (eif-indent-construct)
  2369. (re-search-forward "loop" nil t)
  2370. (forward-line)
  2371. (eif-indent-line)
  2372. )
  2373. ;; ELSE -- No variable: general loop
  2374. (let ()
  2375. (mapc #'(lambda (s)
  2376. (insert s))
  2377. '("from" "\n\ninvariant" "\n\nvariant"
  2378. "\n\nuntil" "\n\nloop\n" "\nend")
  2379. )
  2380. (re-search-backward "from" nil t)
  2381. (eif-indent-construct)
  2382. (forward-line)
  2383. (eif-indent-line)
  2384. )
  2385. )
  2386. )
  2387. )
  2388. (defun eif-set ()
  2389. "Inserts a function to set the value of the given variable."
  2390. (interactive)
  2391. (let ((aname (read-string "Attribute name: ")))
  2392. (insert "set_" aname " (v: like " aname ") is")
  2393. (eif-indent-line)
  2394. (insert "\n-- ")
  2395. (mapc #'(lambda (s)
  2396. (insert s)
  2397. (eif-indent-line))
  2398. (list (concat "Set value of `" aname "'.")
  2399. "\nrequire"
  2400. "\nv /= Void"
  2401. "\ndo"
  2402. (concat "\n" aname " := v")
  2403. "\nensure"
  2404. (concat "\n" aname " = v")
  2405. (concat "\nend;")))
  2406. (insert "\n")))
  2407. (defun eif-inspect ()
  2408. "Insert an 'inspect-when' statement template."
  2409. (interactive)
  2410. (mapc #'(lambda (s)
  2411. (insert s)
  2412. (eif-indent-line))
  2413. '("inspect " "\n\nwhen then" "\n\nelse" "\n\nend" "\n"))
  2414. (beginning-of-line)
  2415. (re-search-backward "inspect" nil t)
  2416. (forward-line)
  2417. (eif-indent-construct)
  2418. (eif-indent-line))
  2419. (defun eif-when ()
  2420. "Insert another 'when-then' clause."
  2421. ;; Obvious improvement -- have this check to see it this is a valid
  2422. ;; location for this construct, before inserting it.
  2423. (interactive)
  2424. (insert "\nwhen then")
  2425. (eif-indent-line)
  2426. (insert "\n\n")
  2427. (re-search-backward " then" nil t))
  2428. (defun eif-elseif ()
  2429. "Insert an 'elseif-then' clause."
  2430. ;; Obvious improvement -- have this check to see it this is a valid
  2431. ;; location for this construct, before inserting it.
  2432. (interactive)
  2433. (insert "\nelseif then")
  2434. (eif-indent-line)
  2435. (insert "\n\n")
  2436. (re-search-backward " then" nil t))
  2437. (defun eif-mark-feature ()
  2438. "Put mark at end of feature, point at beginning."
  2439. (interactive)
  2440. (push-mark (point))
  2441. (eif-end-of-feature)
  2442. (push-mark (point))
  2443. (eif-beginning-of-feature)
  2444. (re-search-backward "^\n" (- (point) 1) t))
  2445. (defun e-comment-line-p ()
  2446. "t if current line is just a comment."
  2447. (save-excursion
  2448. (beginning-of-line)
  2449. (skip-chars-forward " \t")
  2450. (looking-at "--")))
  2451. (defun e-comment-on-line-p ()
  2452. "t if current line contains a comment."
  2453. (save-excursion
  2454. (beginning-of-line)
  2455. (looking-at "[^\n]*--")))
  2456. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2457. ;; XEmacs addition
  2458. ;;;###autoload(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
  2459. (provide 'eiffel)
  2460. ;;; eiffel.el ends here