12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771 |
- ;;; eiffel.el --- major mode for editing Eiffel files.
- ;; Copyright (C) 1989, 1990, 1993, 1994, 1995, 1996, 1999, 2000,
- ;; 2001, 2002, 2003
- ;; Tower Technology Corporation,
- ;; Free Software Foundation,
- ;; Bob Weiner,
- ;; C. Adrian
- ;; Authors: 1989-1990 Stephen Omohundro, ISE and Bob Weiner
- ;; 1993-1996 Tower Technology Corporation
- ;; 1999-2003 Martin Schwenke <martin@meltin.net>
- ;; 2019 Germán A. Arias
- ;;
- ;; Keywords: eiffel languages oop
- ;; Requires: font-lock, compile, easymenu, imenu
- ;; This file is derived from eiffel.el from Liberty Eiffel project.
- ;;
- ;; Known bugs:
- ;;
- ;; * eif-short buffer doesn't get font locked under GNU Emacs 19.34.
- ;;
- ;; * eif-debug can hang under (at least) XEmacs 21.4.[89] in the wait
- ;; loop if there is input pending (that is, if the user hits return
- ;; an extra time). Not yet tested under XEmacs 21.5.
- ;;
- ;; This file is distributed under the same terms as GNU Emacs.
- ;; GNU Emacs is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation; either version 2, or (at your option)
- ;; any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs; see the file COPYING. If not, write to the
- ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
- ;; Boston, MA 02110-1301, USA
- ;;; Commentary:
- ;; INSTALLATION
- ;; To install, simply copy this file into a directory in your
- ;; load-path and add the following two commands in your .emacs file:
- ;;
- ;; (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
- ;; (autoload 'eiffel-mode "eiffel" "Major mode for Eiffel programs" t)
- ;;
- ;;; History:
- ;;
- ;; Add history stuff here!!!
- ;;; Code:
- (require 'font-lock)
- (require 'compile)
- (require 'easymenu)
- (require 'imenu)
- (defconst eiffel-version-string
- "$Id: eiffel.el,v 2.67 2003/06/14 10:41:01 martins Exp $"
- "Version string to make reporting bugs more meaningful.
- Note that if this file becomes part of GNU Emacs then the file might
- be changed by the Emacs maintainers without this version number
- changing. This means that if you are reporting a bug for a version
- that was shipped with Emacs, you should report the Emacs version!")
- (defgroup eiffel nil
- "Eiffel mode for Emacs"
- :group 'oop)
- (defgroup eiffel-indent nil
- "Indentation variables in Eiffel mode"
- :prefix "eif-"
- :group 'eiffel)
- (defgroup eiffel-compile nil
- "Compilation support variables in Eiffel mode"
- :prefix "eif-"
- :group 'eiffel)
- (defun eif-customize ()
- "Run \\[customize-group] for the `eiffel' group."
- (interactive)
- (customize-group 'eiffel))
- ;; Indentation amount variables.
- ;;
- ;; The default values correspond to style used in ``Eiffel: The
- ;; Language''.
- (defcustom eif-indent-increment 3
- "*Default indentation interval (in spaces)."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-class-level-kw-indent 0
- "*Indentation for Class level keywords.
- Specified as number of `eif-indent-increments'. See the variable
- `eif-class-level-keywords-regexp'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-class-level-kw-indent 0
- "*Number of extra spaces to add to `eif-class-level-kw-indent'.
- This results in the actual indentation of a class level keyword. Can
- be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-class-level-comment-indent 0
- "*Indentation of comments at the beginning of a class.
- Specified as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-class-level-comment-indent 0
- "*Number of spaces to add to `eif-class-level-comment-indent'.
- This results in the actual indentation of a class level comment. Can
- be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-inherit-level-kw-indent 2
- "*Indentation of keywords falling under the Inherit clause.
- Specified as number of `eif-indent-increments'. See the variable
- `eif-inherit-level-keywords'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-inherit-level-kw-indent 0
- "*Number of spaces to add to `eif-inherit-level-kw-indent'.
- This results in the actual indentation of an inherit level keyword.
- Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-feature-level-indent 1
- "*Indentation amount of features.
- Specified as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-feature-level-indent 0
- "*Number of spaces to add to `eif-feature-level-indent'.
- This results in the indentation of a feature. Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-feature-level-kw-indent 2
- "*Indentation of keywords belonging to individual features.
- Specified as number of `eif-indent-increments'. See the variable
- `eif-feature-level-keywords-regexp'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-feature-level-kw-indent 0
- "*Number of spaces to add to `eif-feature-level-kw-indent'.
- This results in the actual indentation of a feature level keyword.
- Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-feature-level-comment-indent 3
- "*Indentation of comments at the beginning of a feature.
- Specified as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-feature-level-comment-indent 0
- "*Number of spaces to add to `eif-feature-level-comment-indent'.
- This results in the actual indentation of a feature level comment.
- Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-body-comment-indent 0
- "*Indentation of comments in the body of a routine.
- Specified as number of `eif-indent-increments')"
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-body-comment-indent 0
- "*Number of spaces to add to `eif-body-comment-indent'.
- This results in the actual indentation of a routine body comment. Can
- be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-check-keyword-indent 0
- "*Extra indentation for the check clause as described in ETL.
- Specified as number of `eif-indent-increments'. Default is 0, which
- is different than in ETL's 1."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-check-keyword-indent 0
- "*Number of spaces to add to `eif-check-keyword-indent'.
- This results in the actual indentation of a check keyword. Can be
- negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-rescue-keyword-indent -1
- "*Extra indentation for the rescue clause as described in ETL.
- Specified as number of `eif-indent-increments'. Default is -1."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-rescue-keyword-indent 0
- "*Number of spaces to add to `eif-rescue-keyword-indent'.
- This results in the actual indentation of a rescue keyword. Can be
- negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-then-indent 0
- "*Indentation for a `then' appearing on a line by itself.
- This is as opposed to a `then' on the same line as an `if'. Specified
- as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-then-indent 0
- "*Number of spaces to add to `eif-then-indent'.
- This results in the actual indentation of a `then' appearing on a line
- by itself. Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-continuation-indent 1
- "*Extra indentation for a continued statement line.
- Specified as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-continuation-indent 0
- "*Number of spaces to add to `eif-continuation-indent'.
- This results in the actual indentation of a continued statement
- line. Can be negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-string-continuation-indent 0
- "*Extra indentation for a continued string.
- Specified as number of `eif-indent-increments'."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-extra-string-continuation-indent -1
- "*Number of spaces to add to `eif-string-continuation-indent'.
- This results in the actual indentation of a continued string. Can be
- negative."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-indent-string-continuations-relatively-flag t
- "*Non-nil means string continuations are indented relative to 1st character.
- That is, `eif-string-continuation-indent' and
- `eif-extra-string-continuation-indent' are added to position of first
- character of string. If nil, string continuations are indented
- relative to indent of previous line."
- :type 'boolean
- :group 'eiffel-indent)
- (defcustom eif-set-tab-width-flag t
- "*Non-nil means `tab-width' is set to `eif-indent-increment' in `eiffel-mode'."
- :type 'boolean
- :group 'eiffel-indent)
- (defcustom eif-preprocessor-indent 0
- "*Indentation for lines GOBO preprocessor directives.
- Specified as number of `eif-indent-increments' from left margin."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-fill-max-save 4096
- "*Maximum size of a paragraph to save before filling.
- Normally \\[eif-fill-paragraph] will mark a buffer as modified even if
- the fill operation does not make any changes. If the paragraph being
- filled is smaller than the value of this variable then the contents of
- the paragraph will be saved for comparison with the paragraph after
- the fill operation. If they are the same, the buffer modification
- state is restored. Set this to 0 to disable this feature, or a very
- big number to enable it for all paragraphs."
- :type 'integer
- :group 'eiffel-indent)
- (defcustom eif-use-gobo-eiffel t
- "*If t include support for compilation using GOBO Eiffel."
- :type 'boolean
- :group 'eiffel-compile)
- (defcustom eif-se-command
- "geant"
- "*Program to use for compiling Eiffel programs.
- The default is \"geant\"."
- :type 'string
- :group 'eiffel-compile)
- (defcustom eif-compile-options ""
- "*Options to use for compiling Eiffel programs."
- :type 'string
- :group 'eiffel-compile)
- ;;
- ;; No user-customizable definitions below this point.
- ;;
- ;;
- ;; Indentation macros.
- ;;
- (defmacro eif-class-level-kw-indent-m ()
- "Indentation amount for Class level keywords (in number of spaces)."
- '(+ (* eif-class-level-kw-indent eif-indent-increment)
- eif-extra-class-level-kw-indent))
- (defmacro eif-class-level-comment-indent-m ()
- "Indentation amount for Class level comments (in number of spaces)."
- '(+ (* eif-class-level-comment-indent eif-indent-increment)
- eif-extra-class-level-comment-indent))
- (defmacro eif-inherit-level-kw-indent-m ()
- "Indentation amount for Inherit level keywords (in number of spaces)."
- '(+ (* eif-inherit-level-kw-indent eif-indent-increment)
- eif-extra-inherit-level-kw-indent))
- (defmacro eif-feature-level-indent-m ()
- "Indentation amount for features (in number of spaces)."
- '(+ (* eif-feature-level-indent eif-indent-increment)
- eif-extra-feature-level-indent))
- (defmacro eif-feature-level-kw-indent-m ()
- "Indentation amount for Feature level keywords (in number of spaces)."
- '(+ (* eif-feature-level-kw-indent eif-indent-increment)
- eif-extra-feature-level-kw-indent))
- (defmacro eif-body-comment-indent-m ()
- "Indentation amount for comments in routine bodies (in number of spaces)."
- '(+ (* eif-body-comment-indent eif-indent-increment)
- eif-extra-body-comment-indent))
- (defmacro eif-feature-level-comment-indent-m ()
- "Indentation amount for Feature level comments (in number of spaces)."
- '(+ (* eif-feature-level-comment-indent eif-indent-increment)
- eif-extra-feature-level-comment-indent))
- (defmacro eif-check-keyword-indent-m ()
- "Indentation amount for Check keyword (in number of spaces)."
- '(+ (* eif-check-keyword-indent eif-indent-increment)
- eif-extra-check-keyword-indent))
- (defmacro eif-rescue-keyword-indent-m ()
- "Indentation amount for Rescue keyword (in number of spaces)."
- '(+ (* eif-rescue-keyword-indent eif-indent-increment)
- eif-extra-rescue-keyword-indent))
- (defmacro eif-then-indent-m ()
- "Indentation amount for `then' appearing on a line by itself (in number of spaces)."
- '(+ (* eif-then-indent eif-indent-increment)
- eif-extra-then-indent))
- (defmacro eif-continuation-indent-m ()
- "Indentation amount for a statement continuation line (in number of spaces)."
- '(+ (* eif-continuation-indent eif-indent-increment)
- eif-extra-continuation-indent))
- (defmacro eif-string-continuation-indent-m ()
- "Indentation amount for a statement continuation line (in number of spaces)."
- '(+ (* eif-string-continuation-indent eif-indent-increment)
- eif-extra-string-continuation-indent))
- (defmacro eif-preprocessor-indent-m ()
- "Indentation amount for a preprocessor statement (in number of spaces)."
- '(* eif-preprocessor-indent eif-indent-increment))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Keyword Regular Expression Constants. ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defconst eif-non-id-char-regexp "\\S_" ;; "[^a-z0-9_]"
- "The characters that are not part of identifiers.")
- (defun eif-post-anchor (regexp)
- "Anchor given REGEXP with end-word delimiter and `eif-non-id-char-regexp'."
- (concat "\\(" regexp "\\)\\>" eif-non-id-char-regexp))
- (defun eif-word-anchor (regexp)
- "Anchor given REGEXP with word delimiters and `eif-non-id-char-regexp'."
- (concat "\\<\\(" regexp "\\)\\>" eif-non-id-char-regexp))
- (defun eif-anchor (regexp)
- "Anchor given REGEXP front and back to match line break or non-symbol char."
- (concat "\\(^\\|\\S_\\<\\)\\(" regexp "\\)\\($\\|\\>\\S_\\)"))
- ;; Note invariant is handled as a special case since it is both a
- ;; class-level and a from-level keyword
- ;; Note obsolete is handled as a special case since it is both a
- ;; class-level and a feature-level keyword
- ;; Note create, note, and indexing are also handled as special cases
- (defconst eif-class-level-keywords
- (concat
- "\\(?:"
- (regexp-opt '("deferred" "expanded" "reference" "separate"))
- "[ \t]+\\)?class"
- "\\|"
- (regexp-opt '("inherit" "insert" "convert" "creation" "feature")))
- "Keywords introducing class-level clauses.
- Note that `invariant', `obsolete', `indexing', `note', and `create' are not included here since can
- function as more than one type of keyword.")
- (defconst eif-class-level-keywords-regexp
- (eif-word-anchor eif-class-level-keywords)
- "Regexp of keywords introducing class level clauses, with some context.
- See `eif-class-level-keywords'.")
- (defconst eif-inherit-level-keywords
- (regexp-opt '("rename" "redefine" "undefine" "select" "export"))
- "Those keywords which introduce subclauses of the inherit clause.")
- (defconst eif-feature-level-keywords
- (regexp-opt '("require" "local" "deferred" "separate" "do" "once" "ensure" "alias" "external" "attribute"))
- "Those keywords which are internal to features (in particular, routines).")
- (defconst eif-feature-level-keywords-regexp
- (eif-word-anchor eif-feature-level-keywords)
- "Regexp of keywords internal to features (usually routines).
- See `eif-feature-level-keywords'.")
- (defconst eif-end-keyword "end" "The `end' keyword.")
- (defconst eif-end-on-current-line ".*[ \t]end[ \t]*;?[ \t]*\\(--.*\\)?$"
- "Regular expression to identify lines ending with the `end' keyword.")
- (defconst eif-control-flow-keywords
- (regexp-opt '("if" "inspect" "from" "debug" "across"))
- "Keywords which introduce control-flow constructs.")
- (defconst eif-control-flow-matching-keywords
- (concat (regexp-opt '("deferred" "do" "once")) "\\|" eif-control-flow-keywords)
- "Keywords that may cause the indentation of an `eif-control-flow-keyword'.
- If these occur prior to an `eif-control-flow-keyword' then the
- `eif-control-flow-keyword' is indented. Note that technically, `end'
- is part of this list but it is handled separately in the function
- \[eif-matching-kw\].")
- (defconst eif-control-flow-matching-keywords-regexp
- (eif-word-anchor eif-control-flow-matching-keywords)
- "Regexp of keywords maybe causing indentation of `eif-control-flow-keyword'.
- See `eif-control-flow-keywords'.")
- (defconst eif-check-keyword "check"
- "The `check' keyword.")
- (defconst eif-check-keywords-regexp
- (eif-word-anchor eif-check-keyword)
- "The `check' keyword (with trailing context).")
- ;; FIXME: Doesn't work if once keyword is followed by a string on next
- ;; line, but didn't get broken by this attempt at factoring.
- (defconst eif-check-matching-keywords-regexp
- eif-control-flow-matching-keywords-regexp
- "Keywords that may cause the indentation of an `eif-check-keyword'.
- If these occur prior to an `eif-check-keyword' then the
- `eif-check-keyword' is indented. Note that technically, `end' is part
- of this list but it is handled separately in the function
- \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
- ;; FIXME: This could be fixed or removed.
- (defconst eif-end-keyword-regexp "\\<end\\>"
- "The `end' keyword with context.")
- (defconst eif-end-matching-keywords
- (concat (regexp-opt '("attribute" "check" "class" "feature" "rename" "redefine" "undefine"
- "select" "export" "separate" "external" "alias")) "\\|"
- eif-control-flow-matching-keywords)
- "Those keywords whose clause is terminated by an `end' keyword.")
- (defconst eif-end-matching-keywords-regexp
- (eif-word-anchor eif-end-matching-keywords)
- "Regexp of keywords whose clause is terminated by an `end' keyword.
- See `eif-end-matching-keywords'.")
- (defconst eif-rescue-keyword "rescue" "The `rescue' keyword.")
- (defconst eif-obsolete-keyword "obsolete" "The `obsolete' keyword.")
- (defconst eif-indexing-keyword
- (regexp-opt '("note" "indexing"))
- "The `indexing' and `note' keywords.")
- (defconst eif-indexing-keyword-regexp
- (eif-post-anchor eif-indexing-keyword)
- "Regexp matching `indexing' and `note' keywords, with trailing context.")
- (defconst eif-rescue-keywords-regexp
- (eif-word-anchor eif-rescue-keyword)
- "The `rescue' keyword (with trailing context).")
- (defconst eif-rescue-matching-keywords-regexp
- (eif-word-anchor (regexp-opt '("deferred" "do" "once")))
- "Keywords that may cause the indentation of an `eif-rescue-keyword'.
- If these occur prior to an `eif-rescue-keyword' then the
- `eif-rescue-keyword' is indented. Note that technically, `end' is
- part of this list but it is handled separately in the function
- \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
- (defconst eif-from-level-keywords
- (regexp-opt '("until" "variant" "loop"))
- "Keywords occuring inside of a from clause.")
- (defconst eif-from-level-keywords-regexp
- (eif-word-anchor eif-from-level-keywords)
- "Regexp of keywords occuring inside of a from clause.
- See `eif-from-level-keywords'.")
- (defconst eif-from-keyword "from\\|across" "The keyword `from'.")
- (defconst eif-if-or-inspect-level-keywords
- (regexp-opt '("elseif" "else" "when"))
- "Keywords occuring inside of an if or inspect clause.")
- (defconst eif-if-or-inspect-level-keywords-regexp
- (eif-word-anchor eif-if-or-inspect-level-keywords)
- "Regexp of keywords occuring inside of an if or inspect clause.
- See eif-if-or-inspect-level-keywords.")
- (defconst eif-if-or-inspect-keyword-regexp
- (eif-word-anchor (regexp-opt '("if" "inspect")))
- "Regexp matching the `if' or `inspect' keywords.")
- (defconst eif-then-keyword ".*[ \t)]then[ \t]*$"
- "The keyword `then' with possible leading text.")
- (defconst eif-solitary-then-keyword "then" "The keyword `then'.")
- (defconst eif-then-matching-keywords
- (regexp-opt '("if" "elseif" "when") t)
- "Keywords that may alter the indentation of an `eif-then-keyword'.
- If one of these occur prior to an `eif-then-keyword' then this sets
- the indentation of the `eif-then-keyword'. Note that technically,
- `end' is part of this list but it is handled separately in the
- function \[eif-matching-kw\]. See also
- `eif-control-flow-matching-keywords-regexp'.")
- (defconst eif-invariant-keyword "invariant" "The `invariant' keyword.")
- (defconst eif-invariant-matching-keywords
- (regexp-opt '("from" "feature" "across"))
- "Keywords that may cause the indentation of an `eif-invarient-keyword'.
- If one of these occurs prior to an `eif-invariant-keyword' then the
- `eif-invariant-keyword' is indented. Note that technically, `end' is
- part of this list but it is handled separately in the function
- \[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
- (defconst eif-obsolete-matching-keywords
- (regexp-opt '("is" "class") t)
- "Keywords that may cause the indentation of an `eif-obsolete-keyword'.
- If one of these occurs prior to an `eif-obsolete-keyword' then the
- `eif-obsolete-keyword' is indented.")
- (defconst eif-create-keyword
- "create"
- "Eiffel create keyword. Can be used at class or minor level.")
- (defconst eif-create-keyword-regexp
- (eif-post-anchor eif-create-keyword)
- "Regexp matching `create' keyword, with trailing context.")
- (defconst eif-indentation-keywords
- (concat (regexp-opt '("note" "indexing" "rescue" "inherit" "insert" "convert" "create" "creation"
- "invariant" "require" "local" "ensure" "obsolete")) "\\|"
- eif-from-level-keywords "\\|"
- eif-if-or-inspect-level-keywords "\\|"
- eif-end-matching-keywords)
- "Keywords that match any eiffel keyword triggering indentation.")
- (defconst eif-indentation-keywords-regexp
- (eif-word-anchor eif-indentation-keywords)
- "Regexp of keywords that match any eiffel keyword triggering indentation.
- See `eif-indentation-keywords'.")
- (defconst eif-once-non-indent-regexp
- "\\s-*once\\(\\s-\\|\n\\)+\""
- "Regexp of Eiffel once keyword in context not affecting indentation.")
- (defconst eif-feature-indentation-keywords-regexp
- (eif-word-anchor (regexp-opt '("convert" "creation" "feature")))
- "Keywords which denote the presence of features following them.")
- (defconst eif-is-keyword-regexp "\\(.*[ \t)]\\)?is[ \t]*\\(--.*\\)?$"
- "The `is' keyword (with some context).")
- (defconst eif-multiline-routine-is-keyword-regexp
- ".*([^)]*)\\([ \t\n]*\\|[ \t\n]*:[][ \t\nA-Za-x0-9_,]*\\)is[ \t]*\\(--.*\\)?$"
- "The `is' keyword (with some context).")
- (defconst eif-operator-keywords
- (regexp-opt '("and" "or" "implies"))
- "Eiffel operator keywords.")
- (defconst eif-operator-regexp
- (concat "[ \t]*\\([@*/+]\\|-[^-]\\|\\<\\("
- eif-operator-keywords
- "\\)[ \t(]\\)")
- "Eiffel operators - used to identify continuation lines.
- See `eif-operator-keywords'.")
- (defconst eif-operator-eol-regexp
- (concat ".*\\([@*/+-]\\|\\<\\(" eif-operator-keywords
- "\\)\\|:=\\)[ \t]*\\(--.*\\)?$")
- "Eiffel operators - used to identify continuation lines.")
- (defconst eif-all-keywords
- (concat eif-indentation-keywords "\\|"
- eif-solitary-then-keyword "\\|"
- eif-create-keyword "\\|"
- eif-end-keyword)
- "Regexp matching (nearly) any eiffel keyword in a line.
- Does not include `is'.")
- (defconst eif-all-keywords-regexp
- (concat "\\("
- (eif-word-anchor eif-all-keywords) "\\)")
- "Anchored regexp matching (nearly) any eiffel keyword in a line.
- Does not include `is'. See `eif-all-keywords'.")
- (defconst eiffel-comment-start-skip
- "--+|?[ \t]*"
- "Regexp matching the beginning of an Eiffel comment.")
- (defconst eif-non-source-line
- (concat "[ \t]*\\(\\(" "--" "\\).*\\)?$")
- "RE matching line with only whitespace and comment or preprocessor keyword.")
- (defconst eif-variable-or-const-regexp "[^()\n]*:[^=].*"
- "RE to match a variable or constant declaration.")
- ;; Factor out some important important regexps for use in
- ;; eif-{beginning,end}-of-feature.
- (defun eiffel-feature-re ()
- "Liberty Eiffel feature declarations"
- (let* ((argument-name "\\(?:[A-Za-z]*[a-z0-9_]+[A-Za-z0-9_]*\\)")
- (feature-name (concat "\\(?:\\(infix\\|prefix\\)\\s-+\".+?\"\\|" argument-name "\\(?:\\s-+alias\\s-+\".+?\"\\)?\\)"))
- (type-name "\\(?:like\\s-+\\sw+\\|[A-Z]\\sw*\\(?:\\[.+?\\]\\)?\\)"))
- (concat
- "\\(?:"
- "\\(?:\\<frozen\\s-\\)?"
- "\\s-*" feature-name "\\s-*,?"
- "\\)+"
- "\\(?:(" ; no \\s-* because it is matched above, if there is no trailing coma
- "\\(?:"
- "\\(?:\\s-*" argument-name "\\s-*,?\\)+?"
- ":" type-name "\\s-*;?"
- "\\)*?"
- ")\\)?" ; no \\s-* because it is matched above, if there is no trailing semi-colon
- "\\(?:\\s-*:\\s-*" type-name "\\)?"
- "\\(?:\\s-*assign\\s-*\\sw+\\)?"
- "\\(?:\\s-*is\\>\\)?")))
- (defconst eif-routine-begin-regexp
- ;"\\([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-*\\(--.*\\)?$"
- (eiffel-feature-re)
- "Regexp matching the beginning of an Eiffel routine declaration.")
- (message (concat "Liberty Eiffel features: " eif-routine-begin-regexp))
- (defconst eif-attribute-regexp
- (concat "[a-z_][^-:\n]*:\\s-*"
- "\\(like\\s-*[a-zA-Z][a-z_0-9]*\\|"
- "\\(\\(expanded\\|reference\\)\\s-*\\)?[A-Z][A-Z_0-9]*"
- "\\(\\s-*\\[[^-\n]*\\]\\)?\\)"
- "\\s-*\\($\\|[;)].*\\|--.*\\)")
- "Regexp matching an Eiffel attribute, parameter or local variable.")
- (defconst eif-constant-regexp
- "[a-z_][^-:\n]*:[^-\n]*\\<is\\>\\s-*[^ \t\n]"
- "Regexp matching an Eiffel constant declaration.")
- (defconst eif-probably-feature-regexp
- (concat "\\(" eif-routine-begin-regexp
- "\\|" eif-attribute-regexp
- "\\|" eif-constant-regexp "\\)")
- "Regexp probably matching an Eiffel feature.
- This will also match local variable and parameter declarations.")
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defvar eif-matching-indent -1
- "Indentation of the keyword found on the last call to \[eif-matching-kw\].
- -1 if no match was found.")
- (defvar eif-matching-kw-for-end nil)
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; Font-lock support.
- ;;
- ;; Rewritten from scratch by Cyril Adrian <cyril.adrian@gmail.com>
- ;; Specific to Liberty Eiffel
- ;;
- (defconst eiffel-keywords-feature
- '("across" "agent" "all" "and" "as" "assign" "attached" "attribute" "check" "class"
- "convert" "create" "debug" "deferred" "detachable" "do" "else" "elseif" "end" "ensure"
- "expanded" "export" "external" "feature" "from" "if" "implies"
- "indexing" "inherit" "insert" "inspect" "invariant" "is" "like"
- "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or"
- "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
- "undefine" "until" "variant" "when" "xor"))
- (defconst eiffel-keywords
- '("across" "agent" "alias" "all" "and" "as" "assign" "attached" "attribute" "check" "class"
- "convert" "create" "debug" "deferred" "detachable" "do" "else" "elseif" "end" "ensure"
- "expanded" "export" "external" "feature" "from" "frozen" "if" "implies"
- "indexing" "infix" "inherit" "insert" "inspect" "invariant" "is" "like"
- "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or" "prefix"
- "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
- "undefine" "until" "variant" "when" "xor"))
- (defconst eiffel-constants
- '("Current" "False" "Precursor" "Result" "True" "Void"))
- (defun eiffel-string-re ()
- "Liberty Eiffel strings"
- (concat "U?\"\\(?:"
- "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; single-line strings
- "\\|"
- "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\(?:[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\)*[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; older multiline strings
- "\\|"
- "\\(?:[[{][ \t]*\n\\(?:.*?\n\\)*?[ \t]*[]}]\"\\)" ; newer multiline strings
- "\\)\""))
- (defun eiffel-wordstart-re ()
- "start of words"
- "\\<\\(")
- (defun eiffel-wordend-re ()
- "end of words"
- (concat "\\)\\>"))
- (defun eiffel-keywords-re ()
- (concat
- (eiffel-wordstart-re)
- (regexp-opt eiffel-keywords)
- (eiffel-wordend-re)))
- (defun eiffel-constants-re ()
- (concat
- (eiffel-wordstart-re)
- (regexp-opt eiffel-constants)
- (eiffel-wordend-re)))
- (defun eiffel-preprocessor-re ()
- (concat
- (eiffel-wordstart-re)
- (regexp-opt '("c_inline_c" "c_inline_h" "not_yet_implemented" "se_breakpoint" "breakpoint" "to_pointer"
- "is_expanded_type" "is_basic_expanded_type"
- "object_size" "object_id_memory"
- "se_guru01" "se_guru02" "se_guru03"))
- (eiffel-wordend-re)))
- (defvar eiffel-font-lock-defaults
- (append
- `(
- ("--|\\(.*\\)\n" . font-lock-comment-face)
- ("--\\(.*\\)\n" . font-lock-doc-face)
- (,(eiffel-string-re) . font-lock-string-face)
- ("'\\(?:[^'%]\\|%.\\)'" . font-lock-string-face)
- ("\\<\\([A-Z][A-Z0-9_]*\\)\\>" . font-lock-type-face)
- (,(eiffel-keywords-re) 1 font-lock-keyword-face)
- (,(eiffel-constants-re) 1 font-lock-builtin-face)
- (,(eiffel-preprocessor-re) 1 font-lock-preprocessor-face)))
- "Default highlighting expressions for Liberty Eiffel mode")
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; Compilation support for GNU SmartEiffel.
- ;;
- (defvar eif-compile-dir nil
- "Current directory where Eiffel compilations are taking place.
- Possibly used for error location.")
- (defvar eif-root-class nil
- "Current Eiffel root class being compiled/debugged.")
- (defvar eif-compile-target nil
- "Current Eiffel compilation target.")
- (defvar eif-debug-target nil
- "Current Eiffel debug target.")
- (defvar eif-root-proc nil
- "Current Eiffel root procedure.")
- (defvar eif-run-command nil
- "Current command to run after Eiffel compile.")
- (defvar eif-debug-command nil
- "Current debug command to run after Eiffel debug compile.")
- (defun eif-compilation-mode-hook ()
- "Hook function to set local value for `compilation-error-screen-columns'.
- This should be nil for SmartEiffel compiles, because column positions are
- returned as character positions rather than screen columns."
- ;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
- (or (assq 'compilation-error-screen-columns (buffer-local-variables))
- (make-local-variable 'compilation-error-screen-columns))
- (setq compilation-error-screen-columns nil))
- (defun eif-compile ()
- "Compile an Eiffel root class."
- (interactive)
- ;;(eif-compile-prompt)
- (eif-compile-internal))
- (defun eif-set-compile-options ()
- "Set Eiffel compiler options."
- (interactive)
- (setq eif-compile-options
- (read-string "Eiffel compiler options: " eif-compile-options)))
- ;; Taken from Emacs 20.3 subr.el (just in case we're running under Emacs 19).
- (defun eif-split-string (string &optional separators)
- "Split STRING into substrings separated by SEPARATORS.
- Each match for SEPARATORS is a splitting point. The substrings
- between the splitting points are made into a list which is returned.
- If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
- If there is match for SEPARATORS at the beginning of STRING, we do not
- include a null substring for that. Likewise, if there is a match
- at the end of STRING, we do not include a null substring for that."
- (let ((rexp (or separators "[ \f\t\n\r\v]+"))
- (start 0)
- notfirst
- (list nil))
- (while (and (string-match rexp string
- (if (and notfirst
- (= start (match-beginning 0))
- (< start (length string)))
- (1+ start) start))
- (< (match-beginning 0) (length string)))
- (setq notfirst t)
- (or (eq (match-beginning 0) 0)
- (and (eq (match-beginning 0) (match-end 0))
- (eq (match-beginning 0) start))
- (setq list
- (cons (substring string start (match-beginning 0))
- list)))
- (setq start (match-end 0)))
- (or (eq start (length string))
- (setq list
- (cons (substring string start)
- list)))
- (nreverse list)))
- (defun eif-run ()
- "Run a compiled Eiffel program."
- (interactive)
- (setq eif-run-command
- (read-string "Command to run: "
- (or eif-run-command
- eif-compile-target
- (file-name-sans-extension
- (if (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
- buffer-file-name
- (file-name-nondirectory (buffer-file-name)))))))
- (eif-run-internal))
- ;; (defun eif-debug ()
- ;; "Run the SmartEiffel debugger."
- ;; (interactive)
- ;; (eif-compile-prompt)
- ;; (setq eif-debug-target
- ;; (file-name-sans-extension
- ;; (read-string "Debug target name: "
- ;; (or eif-debug-target
- ;; (concat eif-compile-target "_debug")))))
- ;; (let* ((eif-compile-options (concat "-sedb " eif-compile-options))
- ;; (eif-compile-target eif-debug-target)
- ;; (buff (eif-compile-internal))
- ;; (proc (get-buffer-process buff)))
- ;; ;; This works under GNU Emacs, but hangs under at least some
- ;; ;; versions of XEmacs if there is input pending.
- ;; (while (eq (process-status proc) 'run)
- ;; (sit-for 1))
- ;; (if (= (process-exit-status proc) 0)
- ;; (progn
- ;; (setq eif-debug-command
- ;; (read-string "Debugger command to run: "
- ;; (or eif-debug-command
- ;; eif-debug-target
- ;; (file-name-sans-extension
- ;; (if (eq system-type 'windows-nt)
- ;; buffer-file-name
- ;; (file-name-nondirectory
- ;; (buffer-file-name)))))))
- ;; (let ((eif-run-command eif-debug-command))
- ;; (eif-run-internal))))))
- (defun eif-compile-prompt ()
- "Prompt for information required to compile an Eiffel root class."
- ;; Do the save first, since the user might still have their hand on
- ;; the mouse.
- (save-some-buffers (not compilation-ask-about-save) nil)
- (setq eif-compile-dir (file-name-directory (buffer-file-name)))
- (setq eif-root-class
- (file-name-sans-extension
- (read-string "Name of root class: "
- (or eif-compile-target
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name)))))))
- (setq eif-compile-target eif-root-class)
- (setq eif-root-proc
- (read-string "Name of root procedure: "
- eif-root-proc)))
- (defun eif-compile-internal ()
- "Compile an Eiffel root class. Internal version.
- Returns the same thing as \\[compilation-start] - the compilation buffer."
- ;; Do the save first, since the user might still have their hand on
- ;; the mouse.
- (save-some-buffers (not compilation-ask-about-save) nil)
- (let ((cmd (concat eif-se-command
- " compile_ge "
- eif-compile-options))
- (buf-name "*GOBO Eiffel Compilation*")
- (compilation-mode-hook (cons 'eif-compilation-mode-hook
- compilation-mode-hook)))
- (if (fboundp 'compilation-start) ; Emacs 22 and above
- (compilation-start cmd nil #'(lambda (mode-name) buf-name))
- (compile-internal cmd "No more errors" buf-name))))
- (defun eif-run-internal ()
- "Run a compiled Eiffel program. Internal version."
- (let* ((tmp-buf (current-buffer))
- (words (eif-split-string eif-run-command))
- (cmd (expand-file-name (car words))))
- (apply 'make-comint cmd cmd nil (cdr words))
- (switch-to-buffer tmp-buf)
- (switch-to-buffer-other-window (concat "*" cmd "*"))))
- ;; This has been loosened up to spot parts of messages that contain
- ;; references to multiple locations. Thanks to Andreas
- ;; <nozone@sbox.tu-graz.ac.at>. Also, the column number is a character
- ;; count rather than a screen column, so we need to make sure that
- ;; compilation-error-screen-columns is nil. Note that in XEmacs this
- ;; variable doesn't exist, so we end up in the wrong column. Hey, at
- ;; least we're on the correct line!
- (add-to-list 'compilation-error-regexp-alist
- '("^Line \\([0-9]+\\) column \\([0-9]+\\) in [^ ]+ (\\([^)]+\\.[Ee]\\))" 3 1 2))
- (defun eif-find-file (&optional userclass)
- "Find and open an Eiffel file given by a class name"
- (interactive)
- (let* ((cn (or userclass (current-word))))
- (if (string-match "[A-Z][0-9A-Z_]*" cn)
- (let ((classname (substring cn (match-beginning 0) (match-end 0))))
- (message "Searching %s..." classname)
- (let* ((shellres (shell-command-to-string (concat "se find --raw " classname)))
- (filename (substring shellres 0 (string-match "\n" shellres))))
- (find-file filename)
- )))
- (message nil)))
- (defun eif-short ()
- "Display the short form of an Eiffel class."
- (interactive)
- (let* ((class (read-string
- "Class or file: "
- (if (buffer-file-name)
- (file-name-nondirectory (buffer-file-name)))))
- (buf (get-buffer-create (concat "*Eiffel - short " class "*"))))
- (shell-command (concat eif-se-command " short " class) buf)
- (with-current-buffer buf
- (let ((font-lock-defaults eiffel-font-lock-defaults))
- (font-lock-fontify-buffer))
- (read-only-mode 1))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Utility Functions. ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun eif-feature-quote ()
- "Put a `' around the current feature name."
- (interactive)
- (save-excursion
- ;; Only try to go back to the beginning of the feature if we're
- ;; not already there.
- (if (/= (point)
- (save-excursion
- (forward-sexp)
- (backward-sexp)
- (point)))
- (backward-sexp))
- (insert "`")
- (forward-sexp)
- (insert "'"))
- (if (looking-at "'")
- (forward-char 1)))
- (defun eif-peeking-backwards-at (regexp)
- "Return non-nil is previous character exists and is matched by REGEXP.
- The match is actually an unbounded match starting at the previous character."
- (save-excursion
- (save-match-data
- (and (not (bobp))
- (or (backward-char) t)
- (looking-at regexp)))))
- (defsubst eif-in-comment-p ()
- "Return t if point is in a comment."
- (interactive)
- (save-excursion
- (nth 4 (parse-partial-sexp
- (save-excursion (beginning-of-line) (point))
- (point)))))
- (defun eif-in-comment-or-quoted-string-p ()
- "Return t if point is in a comment or quoted string."
- (or (eif-in-comment-p)
- (eif-in-quoted-string-p)))
- (defun eif-not-in-comment-or-quoted-string-p ()
- "Return t if point is not in a comment or quoted string."
- (not (eif-in-comment-or-quoted-string-p)))
- (defun eif-near-comment-p ()
- "Return t if point is close enough to a comment for filling purposes."
- (or (eif-in-comment-p)
- (and (or (looking-at comment-start-skip)
- (eif-peeking-backwards-at comment-start-skip))
- (not (eif-in-quoted-string-p)))
- (looking-at (concat "[ \t]*" comment-start-skip))))
- (defun eif-re-search-forward (regexp &optional limit noerror)
- "Search forward from point for REGEXP not in comment or string.
- `case-fold-search' is set to nil when searching. For details on other
- arguments see \\[re-search-forward]."
- (interactive "sRE search: ")
- (let ((start (point))
- found case-fold-search)
- (while (and (setq found (re-search-forward regexp limit noerror))
- (eif-in-comment-or-quoted-string-p)))
- (if (and found
- (eif-not-in-comment-or-quoted-string-p))
- found
- (if (eq noerror t)
- (goto-char start))
- nil)))
- (defun eif-re-search-backward (regexp &optional limit noerror)
- "Search backward from point for REGEXP not in comment or string.
- `case-fold-search' is set to nil when searching. For details on other
- arguments see \\[re-search-forward]."
- (interactive "sRE search: ")
- (let ((start (point))
- found case-fold-search)
- (while (and (setq found (re-search-backward regexp limit noerror))
- (eif-in-comment-or-quoted-string-p)))
- (if (and found
- (eif-not-in-comment-or-quoted-string-p))
- found
- (if (eq noerror t)
- (goto-char start))
- nil)))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Indentation Functions. ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun eif-skip-leading-whitespace ()
- "Move to the first non-whitespace character on the current line."
- (end-of-line)
- (let ((line-end (point)))
- (beginning-of-line)
- (skip-syntax-forward "-" line-end)))
- (defun eif-calc-indent ()
- "Calculate the indentation of the current line of eiffel code.
- This function handles the case where there is a keyword that affects
- indentation at the beginning of the current line. For lines that
- don't start with a relevant keyword, the calculation is handed off to
- \\[eif-calc-non-keyword-indent]."
- (let ((indent 0)
- kw-match)
- (save-excursion
- (eif-skip-leading-whitespace)
- ;; Look for a keyword on the current line.
- (if (looking-at eif-all-keywords-regexp)
- (cond ((looking-at eif-create-keyword-regexp)
- ;; Class-level or minor occurence?
- (if (save-excursion (eif-find-beginning-of-feature))
- ;; Minor.
- (setq indent (eif-calc-indent-non-keyword))
- ;; Class-level.
- (setq indent (eif-class-level-kw-indent-m))))
- ;; There's possibly a better way of coding this exception.
- ((looking-at eif-once-non-indent-regexp)
- (setq indent (eif-calc-indent-non-keyword)))
- ((looking-at eif-indexing-keyword-regexp)
- ;; Class-level or minor occurence?
- (if (string-match eif-check-keyword (eif-matching-kw eif-check-keywords-regexp))
- ;; In check.
- (setq indent (+ eif-matching-indent (eif-check-keyword-indent-m)))
- (if (save-excursion (eif-find-beginning-of-feature))
- ;; Minor. (BUG: "note" can also be at the END of the class!!!)
- (setq indent (eif-calc-indent-non-keyword))
- ;; Class-level.
- (setq indent (eif-class-level-kw-indent-m)))))
- ((looking-at eif-class-level-keywords-regexp)
- ;; File level keywords (indent defaults to 0)
- (setq indent (eif-class-level-kw-indent-m)))
- ((looking-at eif-inherit-level-keywords)
- ;; Inherit level keywords (indent defaults to
- ;; 2*eif-indent-increment)
- (setq indent (eif-inherit-level-kw-indent-m)))
- ((looking-at eif-feature-level-keywords-regexp)
- ;; Feature level keywords (indent defaults to
- ;; (eif-feature-level-indent-m) + eif-indent-increment)
- (setq indent (eif-feature-level-kw-indent-m)))
- ((looking-at eif-end-keyword)
- ;; End keyword (indent to level of matching keyword)
- (if (string-match "end"
- (eif-matching-kw
- eif-end-matching-keywords-regexp))
- ;; Then
- (if (= eif-matching-indent
- (eif-feature-level-kw-indent-m))
- ;; Then
- (setq indent (eif-class-level-kw-indent-m))
- ;; Else
- (setq indent
- (- eif-matching-indent eif-indent-increment)))
- ;; Else
- (setq indent eif-matching-indent))
- ;; FIXME: This is broken!!!
- (if (<= indent (eif-feature-level-indent-m))
- (save-excursion
- (end-of-line)
- (while (and (< (point) (point-max))
- (or (forward-char 1) t)
- (looking-at eif-non-source-line))
- (end-of-line))
- (if (not (looking-at eif-non-source-line))
- (setq indent (eif-inherit-level-kw-indent-m))
- (setq indent (eif-class-level-kw-indent-m))))))
- ((looking-at eif-control-flow-keywords)
- ;; Control flow keywords
- ;; Indent to same level as a preceding "end" or
- ;; if no preceding "end" is found, indent to the level
- ;; of the preceding "do" plus the value of
- ;; eif-indent-increment
- (setq kw-match
- (eif-matching-kw
- eif-control-flow-matching-keywords-regexp))
- (cond ((string-match "end" kw-match)
- (setq indent eif-matching-indent))
- (t
- (setq indent
- (+ eif-matching-indent eif-indent-increment)))))
- ((looking-at eif-check-keywords-regexp)
- ;; Check keyword
- ;; Indent to level of preceding "end"+eif-indent-increment or
- ;; if no preceding "end" is found, indent to the level of
- ;; the preceding eif-check-matching-keywords-regexp plus the
- ;; value (eif-indent-increment + eif-check-keyword-indent).
- (setq kw-match (eif-matching-kw
- eif-check-matching-keywords-regexp))
- (cond ((string-match "end" kw-match)
- (setq indent (+ eif-matching-indent
- (eif-check-keyword-indent-m))))
- (t
- (setq indent
- (+ eif-matching-indent
- (+ eif-indent-increment
- (eif-check-keyword-indent-m)))))))
- ((looking-at eif-rescue-keywords-regexp)
- ;; Rescue keyword
- ;; Indent to level of preceding "end"+eif-indent-increment or
- ;; if no preceding "end" is found, indent to the level of
- ;; the preceding eif-rescue-matching-keywords-regexp plus the
- ;; value (eif-indent-increment + eif-rescue-keyword-indent).
- (setq kw-match (eif-matching-kw
- eif-rescue-matching-keywords-regexp))
- (cond ((string-match "end" kw-match)
- (setq indent (+ eif-matching-indent
- (eif-rescue-keyword-indent-m))))
- (t
- (setq indent eif-matching-indent))))
- ((looking-at eif-from-level-keywords-regexp)
- ;; From level keywords (indent to level of matching "From")
- (if (string-match "end" (eif-matching-kw eif-from-keyword))
- ;; Closest matching KW is `end'.
- (setq indent (- eif-matching-indent eif-indent-increment))
- ;; Closest matching KW is one of `eif-from-keyword'.
- (setq indent eif-matching-indent)))
- ((looking-at eif-if-or-inspect-level-keywords-regexp)
- ;; If level keywords (indent to level of matching
- ;; "If" or "Inspect")
- (if (string-match "end"
- (eif-matching-kw
- eif-if-or-inspect-keyword-regexp))
- ;; Closest matching KW is `end'.
- (setq indent (- eif-matching-indent eif-indent-increment))
- ;; Closest matching KW is one of `eif-if-or-inspect-keyword-regexp'.
- (setq indent eif-matching-indent)))
- ((looking-at eif-solitary-then-keyword)
- ;; Handles case where "then" appears on a line by itself
- (if (eif-matching-kw eif-then-matching-keywords t)
- ;; (Indented to level of the matching if, elseif or when)
- (setq indent (+ eif-matching-indent (eif-then-indent-m)))
- (if (save-excursion (eif-find-beginning-of-feature))
- ;; (Feature-level "then")
- (setq indent (eif-feature-level-kw-indent-m))
- (message "Non-matching 'then'")
- (setq indent (eif-calc-indent-non-keyword)))))
- ((looking-at eif-invariant-keyword)
- ;; Invariant keyword
- ;; (Indented to level of the matching from or feature)
- (if (string-match "from"
- (eif-matching-kw eif-invariant-matching-keywords))
- ;; Then - loop invariant
- (setq indent eif-matching-indent)
- ;; Else - class invariant
- (setq indent (eif-class-level-kw-indent-m))))
- ((looking-at eif-obsolete-keyword)
- ;; Obsolete keyword
- ;; (Indented to the level of the matching from or feature)
- (if (string-match "class"
- (eif-matching-kw eif-obsolete-matching-keywords))
- ;; Then - class obsolete
- (setq indent (eif-class-level-kw-indent-m))
- ;; Else - feature obsolete
- (setq indent (eif-feature-level-kw-indent-m)))))
- ;; No keyword. Hand off...
- (setq indent (eif-calc-indent-non-keyword))))
- indent))
- (defun eif-calc-indent-non-keyword ()
- "Calculate indentation of current Eiffel code line, without leading keyword.
- This function generally assumes that the preceding line of code is
- indented properly, and usually bases the indentation of the current
- line on that preceding line."
- (let ((indent 0)
- originally-looking-at-comment originally-looking-at-lone-string
- continuation id-colon)
- (save-excursion
- (eif-skip-leading-whitespace)
- ;; Is the line we are trying to indent a comment line?
- (setq originally-looking-at-comment (looking-at comment-start-skip))
- ;; Is the line we are trying to indent a lone string?
- (setq originally-looking-at-lone-string (looking-at "\"[^\"]*\"[ \t]*$"))
- ;; Are we in a multi-line parenthesis expression?
- (if (or (and (> (eif-in-paren-expression) 0)
- (> (setq indent (eif-indent-multi-line)) -1))
- (setq indent (eif-manifest-array-indent)))
- ;; Multi-line parenthesis expression.
- ;; Move string continuation lines as per configuration.
- (if (looking-at "%")
- (setq indent (+ indent (eif-string-continuation-indent-m))))
- ;; Else Find the first preceding line with non-comment source on it
- ;; that is not a continuation line of a multi-line parenthesized
- ;; expression (and isn't a preprocessor line :-).
- ;; Record whether this line begins with an operator. We assume
- ;; that the line is a continuation line if it begins with an operator
- (beginning-of-line)
- (setq continuation (looking-at eif-operator-regexp))
- ;; Record whether the line being indented begins with an "<id> :"
- ;; This is used in indenting assertion tag expressions.
- (setq id-colon (looking-at "[ \t]*[a-zA-Z0-9_]+[ \t]*:"))
- (forward-line -1)
- (beginning-of-line)
- (while (and (looking-at eif-non-source-line)
- (not (= (point) 1)))
- (forward-line -1)
- (beginning-of-line))
- (if (eif-line-contains-close-paren)
- (backward-sexp))
- (eif-skip-leading-whitespace)
- (cond ((and (= (point) 1)
- originally-looking-at-comment
- (setq indent (eif-class-level-comment-indent-m))))
- ;; 'eif-is-keyword-regexp' case must precede
- ;; '(not eif-all-keywords-regexp)' case since "is" is not
- ;; part of 'eif-all-keywords-regexp'
- ((or (looking-at eif-is-keyword-regexp)
- (looking-at eif-multiline-routine-is-keyword-regexp)
- (looking-at eif-obsolete-keyword))
- (if originally-looking-at-comment
- ;; Then the line we are trying to indent is a comment
- (setq indent (eif-feature-level-comment-indent-m))
- ;; Else the line being indented is not a comment
- (setq indent (eif-feature-level-kw-indent-m))))
- ;; Feature indentation keyword or class-level `create'.
- ((or (looking-at eif-feature-indentation-keywords-regexp)
- (and (looking-at eif-create-keyword-regexp)
- (not (save-excursion
- (eif-find-beginning-of-feature)))))
- (setq indent (eif-feature-level-indent-m)))
- ((looking-at eif-create-keyword-regexp)
- (setq indent (eif-current-line-indent)))
- ((and (looking-at eif-indentation-keywords-regexp)
- (not (looking-at eif-once-non-indent-regexp)))
- (if (looking-at eif-end-on-current-line)
- (setq indent (eif-current-line-indent))
- (setq indent
- (+ (eif-current-line-indent) eif-indent-increment))))
- ((looking-at eif-solitary-then-keyword)
- (setq indent (- (+ (eif-current-line-indent) eif-indent-increment)
- (eif-then-indent-m))))
- ((looking-at eif-then-keyword)
- (setq indent (eif-current-line-indent)))
- ((looking-at (concat eif-end-keyword eif-non-id-char-regexp))
- (if (= (setq indent (eif-current-line-indent))
- (eif-feature-level-kw-indent-m))
- (setq indent (eif-feature-level-indent-m))
- (eif-matching-line)
- (if (string-match eif-check-keyword eif-matching-kw-for-end)
- (setq indent (- indent (eif-check-keyword-indent-m))))))
- ((looking-at eif-variable-or-const-regexp)
- ;;Either a variable declaration or a pre or post condition tag
- (if originally-looking-at-comment
- ;; Then the line we are trying to indent is a comment
- (if (= (setq indent (eif-current-line-indent))
- (eif-feature-level-indent-m))
- ;; Then - a feature level comment
- (setq indent (eif-feature-level-comment-indent-m))
- ;; Else - some other kind of comment
- (setq indent (+ indent (eif-body-comment-indent-m))))
- ;; Else the line being indented is not a comment
- (if (setq indent (eif-indent-assertion-continuation id-colon))
- indent
- ;; One of the ways of getting here is when we're
- ;; in a split line in an indexing clause.
- ;; Strings on their own need to be given some
- ;; extra indent.
- (if originally-looking-at-lone-string
- (if (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
- (setq indent (eif-current-line-indent))
- (setq indent (+ (eif-current-line-indent)
- eif-indent-increment)))
- (setq indent (eif-current-line-indent))))))
- ((setq indent (eif-manifest-array-start))
- indent)
- ;; OK, this is a sanity check, but it kills a minor
- ;; instance of `create', so we need to code the corner
- ;; case. As for minor instance of `once'.
- ((or (not (looking-at eif-all-keywords-regexp))
- (looking-at eif-create-keyword-regexp)
- (looking-at eif-once-non-indent-regexp))
- (if originally-looking-at-comment
- ;; Then the line we are trying to indent is a comment
- (cond ((eif-continuation-line)
- (setq indent
- (+ (- (eif-current-line-indent)
- eif-indent-increment)
- (eif-body-comment-indent-m))))
- ;; preceding line is at eif-feature-level-indent -
- ;; assume that the preceding line is a parent
- ;; class in an inherit clause
- ((= (eif-current-line-indent)
- (eif-feature-level-indent-m))
- (setq indent
- (+ (eif-inherit-level-kw-indent-m)
- (eif-body-comment-indent-m))))
- (t
- (setq indent
- (+ (eif-current-line-indent)
- (eif-body-comment-indent-m)))))
- ;; Else line being indented is not a comment
- ;; The line the point is on is the one above the line being
- ;; indented
- (beginning-of-line)
- (if (or continuation (looking-at eif-operator-eol-regexp))
- ;; Then the line being indented is a continuation line
- (if (eif-continuation-line)
- ;; The line preceding the line being indented is
- ;; also a continuation line. Indent to the current
- ;; line indentation.
- (setq indent (eif-current-line-indent))
- ;; Else The line preceding the line being indented is
- ;; not a continuation line. Indent an extra
- ;; eif-continuation-indent
- (setq indent (+ (eif-current-line-indent)
- (eif-continuation-indent-m))))
- ;; Else the line being indented is not a continuation line.
- (if (eif-continuation-line)
- (if id-colon
- ;; Then the line preceding the one being indented
- ;; is an assertion continuation. Indent the current
- ;; line to the same level as the preceding assertion
- ;; tag.
- (setq indent (eif-indent-assertion-tag))
- ;; Then the line preceding the one being indented is
- ;; a continuation line. Un-indent by an
- ;; eif-continuation-indent.
- (setq indent (- (eif-current-line-indent)
- eif-indent-increment)))
- ;; Else the line preceding the line being indented is
- ;; also not a continuation line.
- (if (and (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
- (not originally-looking-at-lone-string))
- (setq indent (- (eif-current-line-indent)
- eif-indent-increment))
- ;; Else use the current indent.
- (setq indent (eif-current-line-indent))))))))))
- indent))
- (defun eif-continuation-line ()
- "Return non-nil if the current line is a continuation line."
- (or (looking-at eif-operator-regexp)
- (save-excursion
- (forward-line -1)
- (beginning-of-line)
- (looking-at eif-operator-eol-regexp))))
- (defun eif-indent-assertion-continuation (id-colon)
- "Generally, are we in line that is a continuation of an assertion?
- More precisely, are we inside a pre or a post condition clause on a
- line that is a continuation of a multi-line assertion beginning with a
- tag? If so, return the indentation of the continuation line. The
- argument ID-COLON is t if the line we are indenting begins with
- \"<id> :\", and nil otherwise."
- (let ((limit (point)))
- (if (save-excursion
- (if (re-search-backward
- (concat eif-feature-level-keywords-regexp "\\|"
- eif-end-keyword-regexp) nil t)
- (if (looking-at "ensure\\|require")
- (setq limit (point)))))
- (save-excursion
- (end-of-line)
- (if (and (not id-colon) (re-search-backward ": *" limit t))
- (progn
- (goto-char (match-end 0))
- (current-column)))))))
- (defun eif-indent-assertion-tag ()
- "Return indentation for part of a multi-line assertion.
- That is, the current line is assumed to be a continuation of a
- multi-line assertion, and we return the required indentation."
- (save-excursion
- (if (re-search-backward "ensure\\|require\\|variant\\|invariant" nil t)
- (+ (eif-current-line-indent) eif-indent-increment)
- ;; This option should not occur
- (error "Could not find assertion tag"))))
- (defun eif-matching-kw (matching-keyword-regexp &optional noerror)
- "Search backwards and return a keyword in MATCHING-KEYWORD-REGEXP.
- Also set the value of variable `eif-matching-indent' to the
- indentation of the keyword found. If an `end' keyword occurs prior to
- finding one of the keywords in MATCHING-KEYWORD-REGEXP and it
- terminates a check clause, set the value of variable
- `eif-matching-indent' to the indentation of the `end' minus the value
- of `eif-check-keyword-indent'."
- (let ((search-regexp (concat "[^a-z0-9A-Z_.]"
- eif-end-keyword
- "[^a-z0-9A-Z_.]\\|[^a-z0-9A-Z_.]"
- matching-keyword-regexp
- "\\|" eif-once-non-indent-regexp))
- (keyword nil))
- (save-excursion
- ;; Search backward for a matching keyword.
- ;; Note that eif-once-non-indent-regexp indicates we haven't
- ;; found a match so should keep going.
- (while (and (eif-re-search-backward search-regexp 1 t)
- (looking-at eif-once-non-indent-regexp)
- (not (= (point) 1))))
- (if (looking-at search-regexp)
- ;; Then - a keyword was found
- (progn
- (setq keyword
- (buffer-substring (match-beginning 0) (match-end 0)))
- (if (and (looking-at eif-end-keyword-regexp)
- (eif-matching-line)
- (string-match eif-check-keyword eif-matching-kw-for-end))
- ;; Then
- (setq eif-matching-indent (- (eif-current-line-indent)
- (eif-check-keyword-indent-m)))
- ;; Else
- (setq eif-matching-indent (eif-current-line-indent))))
- ;; Else no keyword was found. I think this is an error
- (setq eif-matching-indent 0)
- (if noerror
- nil
- (message "No matching indent keyword was found")))
- keyword)))
- (defun eif-line-contains-close-paren ()
- "Return t if the current line contains a close paren, nil otherwise.
- If a close paren is found, the point is placed immediately after the
- last close paren on the line. If no paren is found, the point is
- placed at the beginning of the line."
- (let ((search-min 0))
- (beginning-of-line)
- (setq search-min (point))
- (end-of-line)
- (if (search-backward ")" search-min t)
- ;; Then
- (progn
- (forward-char 1)
- t)
- ;; Else
- (beginning-of-line)
- nil)))
- ;; Not Currently Used
- ;;(defun eif-quoted-string-on-line-p ()
- ;; "t if an Eiffel quoted string begins, ends, or is continued
- ;; on current line."
- ;; (save-excursion
- ;; (beginning-of-line)
- ;; ;; Line must either start with optional whitespace immediately followed
- ;; ;; by a '%' or include a '\"'. It must either end with a '%' character
- ;; ;; or must include a second '\"' character.
- ;; (looking-at "^\\([ \t]*%\\|[^\"\n]*\"\\)[^\"\n]*\\(%$\\|\"\\)")))
- (defconst eif-opening-regexp
- "\\<\\(external\\|check\\|deferred\\|do\\|once\\|from\\|if\\|inspect\\|debug\\)\\>"
- "Keywords that open eiffel nesting constructs.")
- ;; OK, this is a horrible hack in all of this to handle "once" as a
- ;; special case because it has been overloaded. The search for the
- ;; opening keyword on the current line is quite reasonably limited to
- ;; the current line. Therefore, the standard hacky way that we avoid
- ;; matching once strings, by making sure they're followed by
- ;; whitespace and a non-double-quote, doesn't work here.
- (defconst eif-non-opening-regexp
- "\\<once\\s-+\""
- "Pattern matching exclusions from `eif-opening-regexp'.")
- (defconst eif-closing-regexp "\\<end\\>"
- "Keywords that close eiffel nesting constructs.")
- (defconst eif-do-regexp "^[[:space:]]*\\(do\\|once\\|external\\|attribute\\)\\>"
- "Keyword that opens eiffel routine body.")
- (defconst eif-opening-or-closing-regexp
- (concat "\\(" eif-opening-regexp "\\|" eif-closing-regexp "\\)")
- "Keywords that open or close eiffel nesting constructs.")
- ;;
- ;; Code to allow indenting whole eiffel blocks
- ;;
- (defun eif-matching-line (&optional return-line-break direction)
- "Return the position of the keyword matching the one on the current line.
- For example, a line containing the keyword `do' is matched by a line
- containing the keyword `end' and a line containing `end' may be
- matched by a number of opening keywords. If the optional parameter
- RETURN-LINE-BREAK is non-nil, the character position returned is the
- beginning (or end) of the line containing the matching keyword instead
- of the position of the keyword itself. If the second optional
- parameter, DIRECTION, is non-nil, the current line is not searched for
- a keyword. Instead, if the value of direction is 'forward, the
- function acts as if an `eif-opening-regexp' is on the current line.
- If the value of direction is 'backward, the function acts as if a
- `eif-closing-regexp' is on the current line. The effect of using the
- direction parameter is to locate either the opening or closing keyword
- of the syntactic construct containing the point."
- (let ((nesting-level 0)
- (search-end 0)
- matching-point opening-keyword match-start match-end
- success start-point)
- (unwind-protect
- (save-excursion
- (setq eif-matching-kw-for-end "");; public variable set by this function
- (setq start-point (point))
- (end-of-line)
- (setq search-end (point))
- (beginning-of-line)
- ;; Set starting state: If direction was specified use it.
- ;; If direction is nil, search for a keyword on the current line
- ;; If the keyword is in eif-opening-regexp, set the search
- ;; direction to 'forward, if the keyword on the current line is `end'
- ;; set the search direction to 'backward.
- (cond ((eq direction 'forward)
- (end-of-line) ;; So we wont see keywords on this line.
- (setq nesting-level 1))
- ((eq direction 'backward)
- (beginning-of-line) ;; So we wont see keywords on this line.
- (setq nesting-level -1))
- ((and (re-search-forward eif-opening-regexp search-end t)
- (eif-not-in-comment-or-quoted-string-p))
- (setq match-start (match-beginning 0))
- (setq match-end (match-end 0))
- (goto-char match-start)
- (if (and (not (looking-at eif-non-opening-regexp))
- (eif-not-in-comment-or-quoted-string-p))
- (setq nesting-level 1))
- (setq opening-keyword
- (cons (buffer-substring match-start match-end)
- opening-keyword))
- (goto-char match-end))
- ((and (progn (beginning-of-line) t)
- (re-search-forward eif-closing-regexp search-end t)
- (eif-not-in-comment-or-quoted-string-p))
- (goto-char (match-beginning 0))
- (if (eif-not-in-comment-or-quoted-string-p)
- (setq nesting-level -1))))
- ;; Perform the search
- (while (not (= nesting-level 0))
- (if (> nesting-level 0)
- ;; Then search forward for the next keyword not in a comment
- (while (and (re-search-forward eif-opening-or-closing-regexp nil 1)
- (goto-char (setq match-start (match-beginning 0)))
- (setq match-end (match-end 0))
- (setq success t)
- (or (looking-at eif-non-opening-regexp)
- (eif-in-comment-or-quoted-string-p)))
- (goto-char match-end)
- (setq success nil))
- ;; Else search backward for the next keyword not in a comment
- (while (and (re-search-backward eif-opening-or-closing-regexp nil 1)
- (goto-char (setq match-start (match-beginning 0)))
- (setq success t)
- (or (looking-at eif-non-opening-regexp)
- (eif-in-comment-or-quoted-string-p)))
- (setq success nil)))
- (cond ((and (not (looking-at eif-non-opening-regexp))
- (looking-at eif-opening-regexp)
- success)
- ;; Found an opening keyword
- (if (> nesting-level 0)
- ;; Then
- (if (looking-at eif-do-regexp)
- ;; Then
- (setq nesting-level -1)
- ;; Else
- (setq opening-keyword
- (cons (buffer-substring match-start
- (match-end 0))
- opening-keyword))
- (goto-char (match-end 0)))
- ;; Else
- (if (= nesting-level -1)
- ;; Then
- (progn
- (setq eif-matching-kw-for-end
- (buffer-substring match-start (match-end 0)))
- (if (looking-at "[ \t\n]+")
- (goto-char (match-end 0))))
- ;; Else
- (if (looking-at eif-do-regexp)
- ;; Then
- (progn
- (goto-char (eif-matching-line nil 'forward))
- (setq nesting-level -1))))
- (setq opening-keyword (cdr opening-keyword))
- (if return-line-break
- (beginning-of-line)))
- (setq nesting-level (1+ nesting-level)))
- ((and (looking-at eif-closing-regexp) success)
- ;; Found an opening keyword
- (if (> nesting-level 0)
- ;; Then
- (progn
- (setq opening-keyword (cdr opening-keyword))
- (if return-line-break
- (end-of-line))
- (goto-char (match-end 0)))
- ;; Else
- (setq opening-keyword
- (cons (buffer-substring (match-beginning 0)
- (match-end 0))
- opening-keyword)))
- (setq nesting-level (1- nesting-level)))
- (t (message (concat "Could not find match"
- (if (car opening-keyword)
- (concat " for: "
- (car opening-keyword)))))
- (goto-char start-point)
- (setq nesting-level 0))))
- (setq matching-point (point))))
- (set-mark matching-point)))
- ;; ENHANCEME: Make this function correctly indent more than just routine
- ;; bodies and their sub-constructs. At the least it should
- ;; handle whole routines also.
- (defun eif-indent-construct ()
- "Indent an entire eiffel syntactic construct.
- It is assumed that the point is within a nesting construct ('do',
- `once', 'check', 'if', 'from', or 'inspect'). The whole construct is
- indented up to the matching end. If the point is not within such a
- construct, then only that line is indented"
- (interactive)
- (let ((end-point 0))
- (save-excursion
- (end-of-line)
- (if (not (= (point) (point-max))) (forward-char 1))
- (goto-char (eif-matching-line t 'backward))
- (setq end-point (eif-matching-line t 'forward))
- (while (< (point) end-point)
- (eif-indent-line)
- (forward-line 1)
- (beginning-of-line)))))
- (defun eif-indent-region (&optional start end)
- "Indent the lines in the current region.
- The region may be specified using optional arguments START and END."
- (interactive)
- (let ((start-point (or start (region-beginning)))
- (end-point (copy-marker (or end (region-end)))))
- (save-excursion
- (goto-char start-point)
- (cond ((eq major-mode 'eiffel-mode)
- (while (< (point) end-point)
- (if (not (looking-at "[ \t]*$"))
- (eif-indent-line))
- (forward-line 1)
- (beginning-of-line)))
- (t (error "Buffer must be in eiffel mode"))))))
- (defadvice isearch-yank-word (around eif-isearch-yank-word activate)
- "isearch-yank-word, with the underscore not being a letter"
- (interactive)
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice isearch-yank-word-or-char (around eif-isearch-yank-word-or-char activate)
- "isearch-yank-word-or-char, with the underscore not being a letter"
- (interactive)
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice forward-word (around eif-forward-word activate)
- "forward-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice backward-word (around eif-backward-word activate)
- "backward-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice right-word (around eif-forward-word activate)
- "right-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice left-word (around eif-backward-word activate)
- "left-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice backward-kill-word (around eif-backward-kill-word activate)
- "backward-kill-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defadvice kill-word (around eif-kill-word activate)
- "kill-word, with the underscore not being a letter"
- (interactive "p")
- (modify-syntax-entry ?_ "_ ")
- ad-do-it
- (modify-syntax-entry ?_ "w "))
- (defun eif-local-indent (amount)
- "Set the value of `eif-indent-increment' to AMOUNT buffer-locally."
- (interactive "NNumber of spaces for eif-indent-increment: ")
- (make-local-variable 'eif-indent-increment)
- (setq eif-indent-increment amount))
- ;; ----------------------------------------------------------------------
- ;; This next portion of the file is derived from "eiffel.el"
- ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. and Bob Weiner
- ;; Available for use and distribution under the same terms as GNU Emacs.
- ;; ----------------------------------------------------------------------
- (defvar eiffel-mode-map nil
- "Keymap for Eiffel mode.")
- (if eiffel-mode-map
- nil
- (let ((map (make-sparse-keymap)))
- (define-key map [(control j)] 'newline-and-indent)
- (define-key map [(return)] 'reindent-then-newline-and-indent)
- (define-key map [(meta control q)] 'eif-indent-construct)
- (define-key map [(meta \')] 'eif-feature-quote)
- (define-key map [(meta q)] 'eif-fill-paragraph)
- (define-key map [(meta control a)] 'eif-beginning-of-feature)
- (define-key map [(meta control e)] 'eif-end-of-feature)
- (define-key map [(control x) ?n ?d] 'eif-narrow-to-feature)
- (define-key map [(control c) ?c] 'eif-class)
- (define-key map [(control c) ?f] 'eif-function)
- (define-key map [(control c) ?p] 'eif-procedure)
- (define-key map [(control c) ?a] 'eif-attribute)
- (define-key map [(control c) ?i] 'eif-if)
- (define-key map [(control c) ?l] 'eif-loop)
- (define-key map [(control c) ?s] 'eif-set)
- (define-key map [(control c) ?n] 'eif-inspect)
- (define-key map [(control c) ?w] 'eif-when)
- (define-key map [(control c) ?e] 'eif-elseif)
- (define-key map [(meta control a)] 'eif-beginning-of-feature)
- (define-key map [(meta control e)] 'eif-end-of-feature)
- (define-key map [(meta control h)] 'eif-mark-feature)
- (setq eiffel-mode-map map)))
- (defvar eiffel-mode-syntax-table nil
- "Syntax table in use in Eiffel-mode buffers.")
- (if eiffel-mode-syntax-table
- nil
- (let ((table (make-syntax-table))
- (i 0))
- (while (< i ?0)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?9))
- (while (< i ?A)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?Z))
- (while (< i ?a)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?z))
- (while (< i 128)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (modify-syntax-entry ? " " table)
- (modify-syntax-entry ?- ". 12" table)
- (modify-syntax-entry ?_ "w " table)
- (modify-syntax-entry ?\t " " table)
- (modify-syntax-entry ?\n "> " table)
- (modify-syntax-entry ?\f "> " table)
- (modify-syntax-entry ?\" "\" " table)
- (modify-syntax-entry ?\\ "." table)
- (modify-syntax-entry ?\( "() " table)
- (modify-syntax-entry ?\) ")( " table)
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table)
- (modify-syntax-entry ?\{ "(} " table)
- (modify-syntax-entry ?\} "){ " table)
- (modify-syntax-entry ?' "\"" table)
- (modify-syntax-entry ?` "." table)
- (modify-syntax-entry ?/ "." table)
- (modify-syntax-entry ?* "." table)
- (modify-syntax-entry ?+ "." table)
- (modify-syntax-entry ?= "." table)
- (modify-syntax-entry ?% "\\" table)
- (modify-syntax-entry ?< "." table)
- (modify-syntax-entry ?> "." table)
- (modify-syntax-entry ?& "." table)
- (modify-syntax-entry ?| "." table)
- (modify-syntax-entry ?\; "." table)
- (modify-syntax-entry ?: "." table)
- (modify-syntax-entry ?! "." table)
- (modify-syntax-entry ?. "." table)
- (modify-syntax-entry ?, "." table)
- (setq eiffel-mode-syntax-table table)))
- (defun eif-add-menu ()
- "Add the \"Eiffel\" menu to the menu bar."
- (easy-menu-define
- eiffel-mode-menu
- eiffel-mode-map
- "Menu for eiffel-mode."
- (append (list "Eiffel")
- (if eif-use-gobo-eiffel
- (list
- ["Compile..." eif-compile t]
- ["Compiler Options..." eif-set-compile-options t]
- ["Next Compile Error..." next-error t]
- ["Run..." eif-run t]
- ;;["Debug..." eif-debug t]
- ["Short..." eif-short t]
- ["----------" nil nil]))
- (list
- ["Indent Construct" eif-indent-construct t]
- (list "Insert"
- ["Class" eif-class t]
- ["Command" eif-procedure t]
- ["Query" eif-function t]
- ["Attribute" eif-attribute t]
- ["Attribute setter" eif-set t]
- ["If" eif-if t]
- ["Loop" eif-loop t]
- ["Inspect" eif-inspect t]
- ["When" eif-when t]
- ["Elseif" eif-elseif t])
- ["----------" nil nil]
- (list "Imenu"
- ["By position" eif-imenu-add-menubar-by-position t]
- ["By name" eif-imenu-add-menubar-by-name t])
- (list "Comments"
- ["Feature Quote" eif-feature-quote (eif-in-comment-p)]
- ["Fill " eif-fill-paragraph (eif-near-comment-p)])
- ["----------" nil nil]
- ["Customize" eif-customize t])))
- (easy-menu-add eiffel-mode-menu))
- ;;;###autoload
- (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
- ;;(add-to-list 'auto-mode-alist '("\\.se\\'" . eiffel-mode))
- (defun eiffel-mode ()
- "Major mode for editing Eiffel programs.
- \\[indent-for-tab-command] indents the current Eiffel line correctly and
- \\[reindent-then-newline-and-indent] causes the current and next line to be
- properly indented.
- Key definitions:
- \\{eiffel-mode-map}
- If variable `eif-use-gobo-eiffel' is non-nil (default t) then support
- for using GNU SmartEiffel is enabled. Run \\[eif-customize] to see
- compilation and indentation variables that can be customized."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'eiffel-mode)
- (setq mode-name "Eiffel")
- (if eif-use-gobo-eiffel
- (progn
- (define-key eiffel-mode-map "\C-c\C-c" 'eif-compile)
- (define-key eiffel-mode-map "\C-c\C-o" 'eif-set-compile-options)
- (define-key eiffel-mode-map "\C-c\C-r" 'eif-run)
- ;;(define-key eiffel-mode-map "\C-c\C-d" 'eif-debug)
- (define-key eiffel-mode-map "\C-c\C-s" 'eif-short)
- (define-key eiffel-mode-map "\C-c\C-f" 'eif-find-file))
- (define-key eiffel-mode-map "\C-c\C-c" nil)
- (define-key eiffel-mode-map "\C-c\C-o" nil)
- (define-key eiffel-mode-map "\C-c\C-r" nil)
- (define-key eiffel-mode-map "\C-c\C-s" nil))
- (use-local-map eiffel-mode-map)
- (eif-add-menu)
- (set-syntax-table eiffel-mode-syntax-table)
- ;; Make local variables.
- (make-local-variable 'paragraph-start)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (make-local-variable 'require-final-newline)
- (make-local-variable 'parse-sexp-ignore-comments)
- (make-local-variable 'indent-line-function)
- (make-local-variable 'indent-region-function)
- (make-local-variable 'comment-start)
- (make-local-variable 'comment-end)
- (make-local-variable 'comment-column)
- (make-local-variable 'comment-start-skip)
- (make-local-variable 'imenu-create-index-function)
- ;; Now set their values.
- (setq paragraph-start (concat "^$\\|" page-delimiter)
- paragraph-separate "[ \t]*$"
- paragraph-ignore-fill-prefix t
- require-final-newline t
- parse-sexp-ignore-comments t
- indent-line-function 'eif-indent-line
- indent-region-function 'eif-indent-region
- comment-start "-- "
- comment-end ""
- comment-column 32
- comment-start-skip eiffel-comment-start-skip
- font-lock-multiline t)
- (set (make-local-variable 'font-lock-defaults) #'(eiffel-font-lock-defaults t))
- (if eif-set-tab-width-flag
- (setq tab-width eif-indent-increment))
- (setq auto-fill-function 'eif-auto-fill)
- (run-hooks 'eiffel-mode-hook))
- (defconst eif-prefeature-regexp
- (concat "\\(" eif-non-source-line "\\|\n\\)*" "[ \t]*")
- "Regexp matching whitespace-equivalent content, possibly before a feature.")
- (defun eif-find-end-of-feature ()
- "Find the `end' of the current feature definition.
- Assumes point is at the beginning of the feature, not in a comment or
- quoted string."
- (let (ret)
- (cond ((looking-at (concat eif-prefeature-regexp
- eif-routine-begin-regexp))
- ;; At the start of a routine, find matching end.
- (and (eif-re-search-forward eif-do-regexp nil t)
- (goto-char (match-beginning 0))
- (goto-char (setq ret (eif-matching-line)))))
- ((looking-at (concat eif-prefeature-regexp
- eif-probably-feature-regexp))
- ;; Not a routine, find end of attribute or constant.
- (goto-char (setq ret (match-end 0)))))
- ret))
- ;; OK, this works well, but it doesn't work for the following cases:
- ;; * In the middle of the feature regexp that need to be matched.
- ;; However, it doesn't need to since eif-beginning-of-feature adds
- ;; some smarts around it...
- (defun eif-find-beginning-of-feature ()
- "Find the beginning of the most recent feature definition.
- This will always move backward, if possible."
- (interactive)
- (let ((start (point))
- candidate routine-begin)
- (if (eif-re-search-backward (concat "\\s-" eif-probably-feature-regexp)
- nil t)
- (progn
- (forward-char) ;; Skip the whitespace character matched above.
- (if (looking-at (regexp-opt eiffel-keywords-feature))
- (eif-find-beginning-of-feature)
- (if (not (or (looking-at (concat
- "\\(" eif-attribute-regexp
- "\\|" eif-constant-regexp "\\)"))))
- ;; This is a routine. Done.
- (point)
- ;; Variable/attribute or constant declaration matched.
- ;; Now we go back and find the previous routine start, the
- ;; following end, and see if the current position
- ;; (candidate) is between. If it is, then candidate is a
- ;; variable or constant declaration within a routine, so
- ;; we're interested in the routine start. If it isn't,
- ;; then it must be a class attribute or constant, so it is
- ;; what we're looking for.
- (setq candidate (point))
- (goto-char start)
- (if (eif-re-search-backward
- (concat "\\s-" eif-routine-begin-regexp) nil t)
- (progn
- (forward-char)
- (setq routine-begin (point))
- (eif-find-end-of-feature)
- (if (and (< routine-begin candidate)
- (< candidate (point)))
- (goto-char routine-begin)
- (goto-char candidate)))
- (goto-char candidate))))))))
- (defun eif-beginning-of-feature (&optional arg)
- "Move backward to next feature beginning.
- With ARG, do it that many times. Negative arg -N
- means move forward to Nth following beginning of feature.
- Returns t unless search stops due to beginning or end of buffer."
- (interactive "p")
- (or arg
- (setq arg 1))
- (let ((start (point))
- (success t))
- (cond ((> arg 0)
- ;; Going backward.
- ;; We have to move forward to make sure we find any feature
- ;; that we might be in the middle of the beginning of. How
- ;; far? How about this far?
- (eif-re-search-forward eif-probably-feature-regexp nil 'move)
- ;; Change arg towards zero as we search, failing if we hit
- ;; edge of buffer.
- (while (and (> arg 0)
- (or (eif-find-beginning-of-feature)
- (setq success nil)))
- ;; If we've gone backwards from the original start, then
- ;; this counts.
- (if (< (point) start)
- (setq arg (1- arg))))
- (or success
- (goto-char (point-min))))
- ((< arg 0)
- ;; Going forward.
- ;; Similar to above, let's go back to the beginning of the
- ;; current feature, and then skip over features and find
- ;; the beginning of the next repeatedly.
- (eif-find-beginning-of-feature)
- (while (and (< arg 0)
- (or (not (eobp)) (setq success nil)))
- (eif-find-end-of-feature)
- (if (eif-re-search-forward eif-probably-feature-regexp
- nil 'move)
- (progn
- (goto-char (match-beginning 0))
- (if (> (point) start)
- (setq arg (1+ arg))))))))
- success))
- (defun eif-end-of-feature (&optional arg)
- "Move forward to end of feature.
- With argument, do it that many times. Negative argument means move
- back ARG preceding ends of features."
- (interactive "p")
- ;; Default is to find the first feature's end.
- ;; Huh? Even if they specify 0? - martin@meltin.net
- ;; Hmmm, it is what end-of-defun does...
- (if (or (null arg)
- (= arg 0))
- (setq arg 1))
- ;; This is a bad way of trying to get into position. Happily, it
- ;; seems to work. Hmmm, not sure if the comment skip is needed.
- (if (eif-in-comment-p)
- (end-of-line))
- (cond ((let ((curr (point)))
- (save-excursion
- (and (eif-beginning-of-feature)
- (eif-find-end-of-feature)
- (forward-line)
- (or (< curr (point))
- (and (< arg 0)
- (= curr (point)))))))
- ;; Within a feature. Go to its beginning.
- (eif-beginning-of-feature))
- ((eif-peeking-backwards-at (concat "\\s-"
- eif-probably-feature-regexp))
- ;; Sitting at beginning of feature. Don't move!
- t)
- (t
- ;; Not within a feature or at beginning, go to beginning of
- ;; next feature.
- (eif-beginning-of-feature -1)))
- ;; This part is correct.
- (if (eif-beginning-of-feature (+ (if (< arg 0) 0 1) (- arg)))
- (progn
- (eif-find-end-of-feature)
- (forward-line))))
- (defun eif-narrow-to-feature ()
- "Make text outside current feature invisible.
- The feature visible is the one that contains point or follows point."
- (interactive)
- (save-excursion
- (widen)
- (eif-end-of-feature)
- (let ((end (point)))
- (eif-beginning-of-feature)
- (narrow-to-region (point) end))))
- (defun eif-current-line-indent ()
- "Return the indentation of the line containing the point."
- (save-excursion
- (eif-skip-leading-whitespace)
- (current-column)))
- (defun eif-in-quoted-string-p (&optional non-strict-p)
- "Return t if point is in a quoted string.
- Optional argument NON-STRICT-P if true causes the function to return
- true even if the point is located in leading white space on a
- continuation line. Normally leading white space is not considered part
- of the string."
- (let ((initial-regexp "^[ \t]*%\\|[^%]U?\"\\|%[ \t]*$")
- (search-limit (point))
- (count 0))
- (save-excursion
- ;; Line must either start with optional whitespace immediately followed
- ;; by a '%' or include a '\"' before the search-limit.
- (beginning-of-line)
- (while (re-search-forward initial-regexp search-limit t)
- (setq count (1+ count))
- (if (= count 1) (setq search-limit (1+ search-limit))))
- ;; If the number of quotes (including continuation line markers)
- ;; is odd, then we are inside of a string. Also if non-strict-p
- ;; and we are in the leading white space of a continuation line,
- ;; then we are in a quote.
- (or (= (% count 2) 1)
- (progn
- (beginning-of-line)
- (and non-strict-p
- (looking-at "^[ \t]*%")))))))
- ;; ----------------------------------------------------------------------
- ;; End of portion derived from "eiffel.el"
- ;; ----------------------------------------------------------------------
- (defun eif-comment-prefix ()
- "Return the prefix starting a comment that begins a line.
- Comments that are not the only thing on a line return nil as their prefix."
- (save-excursion
- (end-of-line)
- (let ((limit (point)) len
- (in-string (eif-in-quoted-string-p)))
- (beginning-of-line)
- (cond ((re-search-forward "^[ \t]*--|?[ \t]*" limit t)
- (buffer-substring (match-beginning 0) (match-end 0)))
- ;; Handle string-literal continuation lines
- (in-string
- (end-of-line)
- (re-search-backward "^[ \t]*%\\|[^%]\"" nil t)
- (re-search-forward "%\\|\"" nil t)
- (setq len (1- (current-column)))
- (concat (make-string len ? ) "%"))))))
- (defun eif-auto-fill ()
- "Auto-fill an Eiffel comment."
- (let ((fill-prefix (eif-comment-prefix))
- (pm (point-marker)))
- (if (and (> (current-column) fill-column)
- fill-prefix)
- (if (string-match "^[ \t]*%" fill-prefix)
- (progn
- (backward-char 1)
- (re-search-backward "[^][a-zA-Z0-9]" nil t)
- (forward-char 1)
- (insert "%\n")
- (insert fill-prefix)
- (goto-char pm))
- ;; (do-auto-fill)
- (backward-char 1)
- (re-search-backward "\\s-" nil t)
- (forward-char 1)
- (insert "\n")
- (insert fill-prefix)
- (goto-char pm)))))
- (defun eif-fill-paragraph ()
- "Textually fills Eiffel comments ala \\[fill-paragraph]."
- (interactive)
- (save-excursion
- (let ((current-point (point))
- (fill-prefix (eif-comment-prefix))
- last-point para-begin para-end)
- (if fill-prefix
- (progn
- (setq last-point (point))
- (forward-line -1)
- (end-of-line)
- (while (and (not (= (point) last-point))
- (eif-comment-prefix))
- (setq last-point (point))
- (forward-line -1)
- (end-of-line))
- (if (= (point) last-point)
- (setq para-begin (save-excursion (beginning-of-line) (point)))
- (setq para-begin (1+ (point))))
- (goto-char current-point)
- (setq last-point (point))
- (forward-line 1)
- (end-of-line)
- (while (and (not (= (point) last-point))
- (eif-comment-prefix))
- (setq last-point (point))
- (forward-line 1)
- (end-of-line))
- (if (= (point) last-point)
- (setq para-end (point))
- (beginning-of-line)
- (setq para-end (point)))
- ;; Avert eyes now - gross hack follows... how big can an
- ;; Eiffel comment be anyway? :-)
- (let ((orig-region (and (<= (- para-end para-begin)
- eif-fill-max-save)
- (buffer-substring para-begin para-end)))
- (orig-state (buffer-modified-p))
- (ret (fill-region para-begin para-end)))
- (and orig-region
- (<= para-end (point-max))
- (string-equal
- orig-region (buffer-substring para-begin para-end))
- (set-buffer-modified-p orig-state))
- ret))))))
- (defun eif-indent-line (&optional whole-exp)
- "Indent the current line as Eiffel code.
- With optional argument WHOLE-EXP, indent any additional lines of the
- same clause rigidly along with this one (not implemented yet)."
- (interactive "p")
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (let ((indent (eif-calc-indent)))
- (if (not (= indent (current-column)))
- (progn
- (delete-horizontal-space)
- (indent-to indent)))))
- (skip-chars-forward " \t"))
- (defun eif-move-to-prev-non-blank ()
- "Move point to previous line excluding blank lines.
- Return t if successful, nil if not."
- (beginning-of-line)
- (re-search-backward "^[ \t]*[^ \t\n]" nil t))
- (defvar eif-last-feature-level-indent -1)
- (defvar eif-feature-level-indent-regexp nil)
- (defun eif-in-paren-expression ()
- "Determine if we are inside of a parenthesized expression."
- (interactive)
- (let ((paren-count 0) (limit 0))
- (save-excursion
- (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
- (setq limit
- (re-search-backward eif-feature-level-indent-regexp nil t))
- (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
- (setq eif-feature-level-indent-regexp
- (concat "^" (make-string eif-last-feature-level-indent ? )
- "[^ \t\n]"))
- (setq limit
- (or (re-search-backward eif-feature-level-indent-regexp nil t)
- 0))))
- (save-excursion
- (while (re-search-backward "[][()]" limit t)
- (if (looking-at "[[(]")
- (setq paren-count (1+ paren-count))
- (setq paren-count (1- paren-count)))))
- paren-count))
- (defun eif-manifest-array-common ()
- "Common code for handling indentation/presence of Eiffel manifest arrays."
- (let ((paren-count 0))
- (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
- nil
- (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
- (setq eif-feature-level-indent-regexp
- (concat "^" (make-string eif-last-feature-level-indent ? )
- "[^ \t\n]")))
- (while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
- (if (not (eif-peeking-backwards-at "|\\|@"))
- (if (looking-at "<<")
- (setq paren-count (1+ paren-count))
- (setq paren-count (1- paren-count)))))
- paren-count))
- (defun eif-manifest-array-indent ()
- "Determine if we are inside of a manifest array."
- (interactive)
- (let (indent)
- (save-excursion
- (if (> (eif-manifest-array-common) 0)
- (let ((eol (save-excursion (end-of-line) (point))))
- (setq indent
- (or (and (re-search-forward "[^< \t]" eol t)
- (1- (current-column)))
- (+ (current-column) 2))))))
- indent))
- (defun eif-manifest-array-start ()
- "Determine the indentation of the statement containing a manifest array."
- (interactive)
- (let (indent)
- (save-excursion
- (if (> (eif-manifest-array-common) 0)
- (let ((limit (progn (end-of-line) (point))))
- (beginning-of-line)
- (if (re-search-forward "^[ \t]*<<" limit t)
- (setq indent (- (current-column) 2 eif-indent-increment))
- (re-search-forward "^[ \t]*" limit t)
- (setq indent (current-column))))))
- indent))
- ;; ----------------------------------------------------------------------
- ;; The function below is derived from "eif-mult-fmt.el"
- ;; Copyright (C) 1985 Free Software Foundation, Inc.
- ;; Copyright (C) 1990 Bob Weiner, Motorola Inc.
- ;; Available for use and distribution under the same terms as GNU Emacs.
- ;; ----------------------------------------------------------------------
- (defun eif-indent-multi-line (&optional parse-start)
- "Return indentation for line within parentheses or double quotes.
- That is, we are in a multi-line parenthesised or double-quoted
- expression, and want to know the suggested indentation for the current
- line. If we are not within such an expression then return -1.
- Optional argument PARSE-START is buffer position at which to begin
- parsing, default is to begin at the feature enclosing or preceding
- point."
- (let ((eif-opoint (point))
- (indent-point (progn (beginning-of-line) (point)))
- (eif-ind-val -1)
- (eif-in-str nil)
- (eif-paren-depth 0)
- (retry t)
- state
- ;; setting this to a number inhibits calling hook
- last-sexp containing-sexp)
- (if parse-start
- (goto-char parse-start)
- (eif-beginning-of-feature))
- ;; Find outermost containing sexp
- (while (< (point) indent-point)
- (setq state (parse-partial-sexp (point) indent-point 0)))
- ;; Find innermost containing sexp
- (while (and retry
- state
- (> (setq eif-paren-depth (elt state 0)) 0))
- (setq retry nil)
- (setq last-sexp (elt state 2))
- (setq containing-sexp (elt state 1))
- ;; Position following last unclosed open.
- (goto-char (1+ containing-sexp))
- ;; Is there a complete sexp since then?
- (if (and last-sexp (> last-sexp (point)))
- ;; Yes, but is there a containing sexp after that?
- (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
- (if (setq retry (car (cdr peek))) (setq state peek)))))
- (if retry
- nil
- ;; Innermost containing sexp found
- (goto-char (1+ containing-sexp))
- (if (not last-sexp)
- ;; indent-point immediately follows open paren.
- nil
- ;; Find the start of first element of containing sexp.
- (parse-partial-sexp (point) last-sexp 0 t)
- (cond ((looking-at "\\s(")
- ;; First element of containing sexp is a list.
- ;; Indent under that list.
- )
- ((> (save-excursion (forward-line 1) (point))
- last-sexp)
- ;; This is the first line to start within the containing sexp.
- (backward-prefix-chars))
- (t
- ;; Indent beneath first sexp on same line as last-sexp.
- ;; Again, it's almost certainly a routine call.
- (goto-char last-sexp)
- (beginning-of-line)
- (parse-partial-sexp (point) last-sexp 0 t)
- (backward-prefix-chars))))
- (setq eif-ind-val (current-column)))
- ;; Point is at the point to indent under unless we are inside a string.
- (setq eif-in-str (elt state 3))
- (goto-char eif-opoint)
- (if (not eif-in-str)
- nil
- ;; Inside a string, indent 1 past string start
- (setq eif-paren-depth 1);; To account for being inside string
- (save-excursion
- (if (re-search-backward "\"" nil t)
- (if eif-indent-string-continuations-relatively-flag
- (setq eif-ind-val (1+ (current-column)))
- (setq eif-ind-val (eif-current-line-indent)))
- (goto-char indent-point)
- (if (looking-at "^[ \t]*[^ \t\n]")
- (eif-move-to-prev-non-blank))
- (skip-chars-forward " \t")
- (setq eif-ind-val (current-column)))))
- (if (> eif-paren-depth 0) eif-ind-val -1)))
- ;; ----------------------------------------------------------------------
- ;; imenu support, great for browsing foreign code.
- ;; Originally contributed by Berend de Boer <berend@pobox.com>.
- ;; ----------------------------------------------------------------------
- (defun eif-imenu-add-menubar-by-position ()
- "Add menu of features of a class, sorted in order of occurence."
- (interactive)
- (setq imenu-create-index-function 'eif-imenu-create-index-by-position)
- (imenu-add-to-menubar "Eiffel features")
- )
- (defun eif-imenu-add-menubar-by-name ()
- "Add menu of features of a class, sorted by name."
- (interactive)
- (setq imenu-create-index-function 'eif-imenu-create-index-by-name)
- (imenu-add-to-menubar "Eiffel names"))
- (defun eif-imenu-create-index-by-position ()
- "Generate index of features of a class, sorted in order of occurence."
- (eif-imenu-create-index 0))
- (defun eif-imenu-create-index-by-name ()
- "Generate index of features of a class, sorted by name."
- (eif-imenu-create-index 1))
- (defun eif-imenu-create-index (sort-method)
- "Generate an index of all features of a class.
- Sort by position if sort-method is 0. Sort by name if sort-method is 1."
- (let (menu prevpos)
- (imenu-progress-message prevpos 0 t)
- ;; scan for features
- (goto-char (point-max))
- (while (eif-find-beginning-of-feature)
- (imenu-progress-message prevpos nil t)
- (if (looking-at "\\(\\sw\\|\\s_\\)+")
- (add-to-list 'menu (cons (buffer-substring-no-properties
- (match-beginning 0)
- (match-end 0)) (point)))))
- (imenu-progress-message prevpos 100)
- ;; sort in increasing buffer position order or by name
- (if (= sort-method 0)
- (sort menu (function (lambda (a b) (< (cdr a) (cdr b)))))
- (sort menu (function (lambda (a b) (string< (car a) (car b))))))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; C. Adrian: added good old features for code templating
- (defun eif-class ()
- "Insert a 'class' template."
- (interactive)
- (let ((cname (if (and buffer-file-name
- (string-match "/\\([^/]+\\)\\.e$" buffer-file-name))
- (substring buffer-file-name (match-beginning 1) (match-end 1))
- (read-string "Class: "))))
- (if (not (e-empty-line-p))
- (progn (end-of-line)(newline)))
- (indent-to 0)
- (insert "class " (upcase cname) "\n\n"
- "create {ANY}\n"
- "make\n"
- "\nfeature {ANY}\n\n"
- "\nfeature {}\n"
- "\n\ninvariant\n\n"
- "end -- class " (upcase cname) "\n"))
- (re-search-backward "create {ANY}" nil t)
- (forward-line 1)
- (eif-indent-line)
- (re-search-forward "feature {ANY}" nil t)
- (forward-line 1)
- (eif-indent-line))
- (defun eif-procedure ()
- "Insert a 'procedure' template."
- (interactive)
- (let ((pname (read-string "Procedure name: ")))
- (if (not (e-empty-line-p))
- (progn
- (end-of-line)
- (newline)))
- (indent-to eif-indent-increment)
- (insert pname " is\n")
- (indent-to (* 3 eif-indent-increment))
- (insert "-- \n")
- (mapc #'(lambda (keyword)
- (indent-to (* 2 eif-indent-increment))
- (insert keyword "\n"))
- '("require" "local" "do" "ensure" "end"))
- (search-backward " is" nil t)))
- (defun eif-function ()
- "Insert a 'function' template."
- (interactive)
- (let ((fname (read-string "Function name: "))
- (type (upcase (read-string "Return type: "))))
- (if (not (e-empty-line-p))
- (progn (end-of-line)(newline)))
- (indent-to eif-indent-increment)
- (insert fname ": " type " is\n")
- (indent-to (* 3 eif-indent-increment))
- (insert "-- \n")
- (mapc #'(lambda (keyword)
- (indent-to (* 2 eif-indent-increment))
- (insert keyword "\n"))
- '("require" "local" "do" "ensure" "end"))
- (search-backward ":" nil t)))
- (defun eif-attribute ()
- "Insert an 'attribute' template."
- (interactive)
- (if (not (e-empty-line-p))
- (progn (end-of-line)(newline)))
- (indent-to eif-indent-increment)
- (let ((aname (read-string "Attribute name: "))
- (type (upcase (read-string "Attribute type: "))))
- (insert aname ": " type "\n")
- (indent-to (* 3 eif-indent-increment))
- (insert "-- \n")
- (eif-indent-line)
- (end-of-line)))
- (defun e-empty-line-p ()
- "True if current line is empty."
- (save-excursion
- (beginning-of-line)
- (looking-at "^[ \t]*$")))
- (defun eif-if ()
- "Insert an 'if' statement template."
- (interactive)
- (mapc #'(lambda (s)
- (insert s))
- '("if then" "\n\nelse" "\n\nend" "\n"))
- (re-search-backward " then" nil t)
- (eif-indent-construct))
- (defun eif-loop ()
- "Insert a 'loop' statement template."
- (interactive)
- (let (
- (varname (read-string "Loop variable name: ")
- )
- )
- (if (not (string= varname ""))
- ;; THEN -- A variable is named: insert it
- (
- let ((lower (read-string "Lower bound: "))
- (upper (read-string "Upper bound: "))
- (incr (read-string "Increment: "))
- )
- (insert "from\n" varname " := ")
- (insert lower)
- (insert "\ninvariant")
- (insert "\nvariant\n")
- (if (>= (string-to-number incr) 0)
- (insert "(" upper " - " lower " + " incr ") - " varname)
- (insert varname " - (" upper " - " lower " + " (abs incr) ")")
- )
- (insert "\nuntil\n" varname)
- (if (>= (string-to-number incr) 0)
- (insert " > " upper)
- (insert " < " upper)
- )
- (insert "\nloop\n\n" varname " := " varname)
- (if (>= (string-to-number incr) 0)
- (insert " + " incr)
- (insert " - " (abs incr))
- )
- (insert "\nend\n")
- (re-search-backward "from" nil t)
- (eif-indent-construct)
- (re-search-forward "loop" nil t)
- (forward-line)
- (eif-indent-line)
- )
- ;; ELSE -- No variable: general loop
- (let ()
- (mapc #'(lambda (s)
- (insert s))
- '("from" "\n\ninvariant" "\n\nvariant"
- "\n\nuntil" "\n\nloop\n" "\nend")
- )
- (re-search-backward "from" nil t)
- (eif-indent-construct)
- (forward-line)
- (eif-indent-line)
- )
- )
- )
- )
- (defun eif-set ()
- "Inserts a function to set the value of the given variable."
- (interactive)
- (let ((aname (read-string "Attribute name: ")))
- (insert "set_" aname " (v: like " aname ") is")
- (eif-indent-line)
- (insert "\n-- ")
- (mapc #'(lambda (s)
- (insert s)
- (eif-indent-line))
- (list (concat "Set value of `" aname "'.")
- "\nrequire"
- "\nv /= Void"
- "\ndo"
- (concat "\n" aname " := v")
- "\nensure"
- (concat "\n" aname " = v")
- (concat "\nend;")))
- (insert "\n")))
- (defun eif-inspect ()
- "Insert an 'inspect-when' statement template."
- (interactive)
- (mapc #'(lambda (s)
- (insert s)
- (eif-indent-line))
- '("inspect " "\n\nwhen then" "\n\nelse" "\n\nend" "\n"))
- (beginning-of-line)
- (re-search-backward "inspect" nil t)
- (forward-line)
- (eif-indent-construct)
- (eif-indent-line))
- (defun eif-when ()
- "Insert another 'when-then' clause."
- ;; Obvious improvement -- have this check to see it this is a valid
- ;; location for this construct, before inserting it.
- (interactive)
- (insert "\nwhen then")
- (eif-indent-line)
- (insert "\n\n")
- (re-search-backward " then" nil t))
- (defun eif-elseif ()
- "Insert an 'elseif-then' clause."
- ;; Obvious improvement -- have this check to see it this is a valid
- ;; location for this construct, before inserting it.
- (interactive)
- (insert "\nelseif then")
- (eif-indent-line)
- (insert "\n\n")
- (re-search-backward " then" nil t))
- (defun eif-mark-feature ()
- "Put mark at end of feature, point at beginning."
- (interactive)
- (push-mark (point))
- (eif-end-of-feature)
- (push-mark (point))
- (eif-beginning-of-feature)
- (re-search-backward "^\n" (- (point) 1) t))
- (defun e-comment-line-p ()
- "t if current line is just a comment."
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (looking-at "--")))
- (defun e-comment-on-line-p ()
- "t if current line contains a comment."
- (save-excursion
- (beginning-of-line)
- (looking-at "[^\n]*--")))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; XEmacs addition
- ;;;###autoload(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
- (provide 'eiffel)
- ;;; eiffel.el ends here
|