12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333 |
- (defvar comment-auto-fill-only-comments)
- (defvar font-lock-keywords)
- (defgroup f90 nil
- "Major mode for editing free format Fortran 90,95 code."
- :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
- :group 'languages)
- (defgroup f90-indent nil
- "Indentation in free format Fortran."
- :prefix "f90-"
- :group 'f90)
- (defcustom f90-do-indent 3
- "Extra indentation applied to DO blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent)
- (defcustom f90-if-indent 3
- "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent)
- (defcustom f90-type-indent 3
- "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent)
- (defcustom f90-program-indent 2
- "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent)
- (defcustom f90-associate-indent 2
- "Extra indentation applied to ASSOCIATE blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent
- :version "23.1")
- (defcustom f90-critical-indent 2
- "Extra indentation applied to BLOCK, CRITICAL blocks."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent
- :version "24.1")
- (defcustom f90-continuation-indent 5
- "Extra indentation applied to continuation lines."
- :type 'integer
- :safe 'integerp
- :group 'f90-indent)
- (defcustom f90-comment-region "!!$"
- "String inserted by \\[f90-comment-region] at start of each line in region."
- :type 'string
- :safe 'stringp
- :group 'f90-indent)
- (defcustom f90-indented-comment-re "!"
- "Regexp matching comments to indent as code."
- :type 'regexp
- :safe 'stringp
- :group 'f90-indent)
- (defcustom f90-directive-comment-re "!hpf\\$"
- "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
- :type 'regexp
- :safe 'stringp
- :group 'f90-indent)
- (defcustom f90-beginning-ampersand t
- "Non-nil gives automatic insertion of \& at start of continuation line."
- :type 'boolean
- :safe 'booleanp
- :group 'f90)
- (defcustom f90-smart-end 'blink
- "Qualification of END statements according to the matching block start.
- For example, the END that closes an IF block is changed to END
- IF. If the block has a label, this is added as well. Allowed
- values are 'blink, 'no-blink, and nil. If nil, nothing is done.
- The other two settings have the same effect, but 'blink
- additionally blinks the cursor to the start of the block."
- :type '(choice (const blink) (const no-blink) (const nil))
- :safe (lambda (value) (memq value '(blink no-blink nil)))
- :group 'f90)
- (defcustom f90-break-delimiters "[-+\\*/><=,% \t]"
- "Regexp matching delimiter characters at which lines may be broken.
- There are some common two-character tokens where one or more of
- the members matches this regexp. Although Fortran allows breaks
- within lexical tokens (provided the next line has a beginning ampersand),
- the constant `f90-no-break-re' ensures that such tokens are not split."
- :type 'regexp
- :safe 'stringp
- :group 'f90)
- (defcustom f90-break-before-delimiters t
- "Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
- :type 'boolean
- :safe 'booleanp
- :group 'f90)
- (defcustom f90-auto-keyword-case nil
- "Automatic case conversion of keywords.
- The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
- :type '(choice (const downcase-word) (const upcase-word)
- (const capitalize-word) (const nil))
- :safe (lambda (value) (memq value '(downcase-word
- capitalize-word upcase-word nil)))
- :group 'f90)
- (defcustom f90-leave-line-no nil
- "If non-nil, line numbers are not left justified."
- :type 'boolean
- :safe 'booleanp
- :group 'f90)
- (defcustom f90-mode-hook nil
- "Hook run when entering F90 mode."
- :type 'hook
-
- :safe (lambda (value) (member value '((f90-add-imenu-menu) nil)))
- :options '(f90-add-imenu-menu)
- :group 'f90)
- (defconst f90-keywords-re
- (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace"
- "block" "call" "case" "character" "close" "common" "complex"
- "contains" "continue" "cycle" "data" "deallocate"
- "dimension" "do" "double" "else" "elseif" "elsewhere" "end"
- "enddo" "endfile" "endif" "entry" "equivalence" "exit"
- "external" "forall" "format" "function" "goto" "if"
- "implicit" "include" "inquire" "integer" "intent"
- "interface" "intrinsic" "logical" "module" "namelist" "none"
- "nullify" "only" "open" "operator" "optional" "parameter"
- "pause" "pointer" "precision" "print" "private" "procedure"
- "program" "public" "read" "real" "recursive" "result" "return"
- "rewind" "save" "select" "sequence" "stop" "subroutine"
- "target" "then" "type" "use" "where" "while" "write"
-
- "elemental" "pure"
-
- "abstract" "associate" "asynchronous" "bind" "class"
- "deferred" "enum" "enumerator" "extends" "extends_type_of"
- "final" "generic" "import" "non_intrinsic" "non_overridable"
- "nopass" "pass" "protected" "same_type_as" "value" "volatile"
-
- "contiguous" "submodule" "concurrent" "codimension"
- "sync all" "sync memory" "critical" "image_index"
- ) 'words)
- "Regexp used by the function `f90-change-keywords'.")
- (defconst f90-keywords-level-3-re
- (regexp-opt
- '("allocatable" "allocate" "assign" "assignment" "backspace"
- "close" "deallocate" "dimension" "endfile" "entry" "equivalence"
- "external" "inquire" "intent" "intrinsic" "nullify" "only" "open"
-
- "operator" "optional" "parameter" "pause" "pointer" "print" "private"
- "public" "read" "recursive" "result" "rewind" "save" "select"
- "sequence" "target" "write"
-
- "elemental" "pure"
-
- "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable"
- "nopass" "pass" "protected" "value" "volatile"
-
-
-
- "contiguous" "concurrent" "codimension" "sync all" "sync memory"
- ) 'words)
- "Keyword-regexp for font-lock level >= 3.")
- (defconst f90-procedures-re
- (concat "\\<"
- (regexp-opt
- '("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
- "all" "allocated" "anint" "any" "asin" "associated"
- "atan" "atan2" "bit_size" "btest" "ceiling" "char" "cmplx"
- "conjg" "cos" "cosh" "count" "cshift" "date_and_time" "dble"
- "digits" "dim" "dot_product" "dprod" "eoshift" "epsilon"
- "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand"
- "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior"
- "ishft" "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt"
- "lle" "llt" "log" "log10" "logical" "matmul" "max"
- "maxexponent" "maxloc" "maxval" "merge" "min" "minexponent"
- "minloc" "minval" "mod" "modulo" "mvbits" "nearest" "nint"
- "not" "pack" "precision" "present" "product" "radix"
-
- "random_number" "random_seed" "range"
- "repeat" "reshape" "rrspacing" "scale" "scan"
- "selected_int_kind" "selected_real_kind" "set_exponent"
- "shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt"
- "sum" "system_clock" "tan" "tanh" "tiny" "transfer"
- "transpose" "trim" "ubound" "unpack" "verify"
-
- "null" "cpu_time"
-
- "move_alloc" "command_argument_count" "get_command"
- "get_command_argument" "get_environment_variable"
- "selected_char_kind" "wait" "flush" "new_line"
- "extends" "extends_type_of" "same_type_as" "bind"
-
- "ieee_support_underflow_control" "ieee_get_underflow_mode"
- "ieee_set_underflow_mode"
-
- "c_loc" "c_funloc" "c_associated" "c_f_pointer"
- "c_f_procpointer"
-
- "bge" "bgt" "ble" "blt" "dshiftl" "dshiftr" "leadz" "popcnt"
- "poppar" "trailz" "maskl" "maskr" "shifta" "shiftl" "shiftr"
- "merge_bits" "iall" "iany" "iparity" "storage_size"
- "bessel_j0" "bessel_j1" "bessel_jn"
- "bessel_y0" "bessel_y1" "bessel_yn"
- "erf" "erfc" "erfc_scaled" "gamma" "hypot" "log_gamma"
- "norm2" "parity" "findloc" "is_contiguous"
- "sync images" "lock" "unlock" "image_index"
- "lcobound" "ucobound" "num_images" "this_image"
-
- "compiler_options" "compiler_version"
-
- "c_sizeof"
- ) t)
-
- "[ \t]*(")
- "Regexp whose first part matches F90 intrinsic procedures.")
- (defconst f90-operators-re
- (concat "\\."
- (regexp-opt '("and" "eq" "eqv" "false" "ge" "gt" "le" "lt" "ne"
- "neqv" "not" "or" "true") t)
- "\\.")
- "Regexp matching intrinsic operators.")
- (defconst f90-hpf-keywords-re
- (regexp-opt
-
- '("all_prefix" "all_scatter" "all_suffix" "any_prefix"
- "any_scatter" "any_suffix" "copy_prefix" "copy_scatter"
- "copy_suffix" "count_prefix" "count_scatter" "count_suffix"
- "grade_down" "grade_up"
- "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix"
- "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter"
- "iany_suffix" "ilen" "iparity" "iparity_prefix"
- "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix"
- "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter"
- "minval_suffix" "number_of_processors" "parity"
- "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar"
- "processors_shape" "product_prefix" "product_scatter"
- "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix"
-
- "align" "distribute" "dynamic" "independent" "inherit" "processors"
- "realign" "redistribute" "template"
-
- "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words)
- "Regexp for all HPF keywords, procedures and directives.")
- (defconst f90-constants-re
- (regexp-opt '(
- "iso_fortran_env"
- "input_unit" "output_unit" "error_unit"
- "iostat_end" "iostat_eor"
- "numeric_storage_size" "character_storage_size"
- "file_storage_size"
-
- "iso_c_binding"
- "c_int" "c_short" "c_long" "c_long_long" "c_signed_char"
- "c_size_t"
- "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t"
- "c_int_least8_t" "c_int_least16_t" "c_int_least32_t"
- "c_int_least64_t"
- "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t"
- "c_int_fast64_t"
- "c_intmax_t" "c_intptr_t"
- "c_float" "c_double" "c_long_double"
- "c_float_complex" "c_double_complex" "c_long_double_complex"
- "c_bool" "c_char"
- "c_null_char" "c_alert" "c_backspace" "c_form_feed"
- "c_new_line" "c_carriage_return" "c_horizontal_tab"
- "c_vertical_tab"
- "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr"
- "ieee_exceptions"
- "ieee_arithmetic"
- "ieee_features"
-
- "character_kinds" "int8" "int16" "int32" "int64"
- "integer_kinds" "iostat_inquire_internal_unit"
- "logical_kinds" "real_kinds" "real32" "real64" "real128"
- "lock_type" "atomic_int_kind" "atomic_logical_kind"
- ) 'words)
- "Regexp for Fortran intrinsic constants.")
- (defun f90-typedef-matcher (limit)
- "Search for the start/end of the definition of a derived type, up to LIMIT.
- Set the match data so that subexpression 1,2 are the TYPE, and
- type-name parts, respectively."
- (let (found l)
- (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)\\>[ \t]*"
- limit t)
- (not (setq found
- (progn
- (setq l (match-data))
- (unless (looking-at "\\(is\\>\\|(\\)")
- (when (if (looking-at "\\(\\sw+\\)")
- (goto-char (match-end 0))
- (re-search-forward
- "[ \t]*::[ \t]*\\(\\sw+\\)"
- (line-end-position) t))
-
- (set-match-data
- (append l (list (match-beginning 1)
- (match-end 1))))
- t)))))))
- found))
- (defvar f90-font-lock-keywords-1
- (list
-
- '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
-
- '(f90-typedef-matcher
- (1 font-lock-keyword-face) (2 font-lock-function-name-face))
-
- '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\
- read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t))
-
-
- '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\
- function\\|associate\\|subroutine\\|interface\\)\\|use\\|call\\)\
- \\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
-
- '("\\<\\(submodule\\)\\>[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-
- '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\
- \\(\\sw+\\)"
- (1 font-lock-keyword-face) (2 font-lock-keyword-face)
- (3 font-lock-function-name-face))
- "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\>"
-
- '("\\<abstract[ \t]*interface\\>" (0 font-lock-keyword-face t)))
- "This does fairly subdued highlighting of comments and function calls.")
- (defun f90-typedec-matcher (limit)
- "Search for the declaration of variables of derived type, up to LIMIT.
- Set the match data so that subexpression 1,2 are the TYPE(...),
- and variable-name parts, respectively."
-
-
- (let (found l)
- (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t)
- (not
- (setq found
- (condition-case nil
- (progn
-
-
- (backward-char 1)
-
- (forward-sexp)
- (setq l (list (match-beginning 0) (point)))
- (skip-chars-forward " \t")
- (when
- (re-search-forward
-
- (if (looking-at "\\sw+")
- "\\([^&!\n]+\\)"
-
- "::[ \t]*\\([^&!\n]+\\)")
- (line-end-position) t)
- (set-match-data
- (append (list (car l) (match-end 1))
- l (list (match-beginning 1)
- (match-end 1))))
- t))
- (error nil))))))
- found))
- (defvar f90-font-lock-keywords-2
- (append
- f90-font-lock-keywords-1
- (list
-
-
-
-
-
-
-
-
- '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\
- \\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
- enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\
- \\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)"
- (1 font-lock-type-face t) (4 font-lock-variable-name-face t))
-
-
-
-
- '(f90-typedec-matcher
- (1 font-lock-type-face) (2 font-lock-variable-name-face))
-
-
-
-
-
-
-
- '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
- logical\\|double[ \t]*precision\\|\
- \\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\
- \\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)"
- (1 font-lock-type-face t) (4 font-lock-keyword-face t)
- (5 font-lock-function-name-face t) (6 'default t))
-
- '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face))
-
-
-
-
- '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\
- block\\|critical\\)\\)\\>\
- \\([ \t]+\\(\\sw+\\)\\)?"
- (1 font-lock-keyword-face) (3 font-lock-constant-face nil t))
- '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\
- do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\
- forall\\|block\\|critical\\)\\)\\>"
- (2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
-
- '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
- \\|enumerator\\|procedure\\|\
- logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
- (1 font-lock-keyword-face) (2 font-lock-type-face))
- '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
- (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
- "\\<else\\([ \t]*if\\|where\\)?\\>"
- '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
- "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
- '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
- (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
- '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
-
- '("\\<\\(class\\)[ \t]*default" . 1)
-
- '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t))
- '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)"
- (1 font-lock-keyword-face) (2 font-lock-constant-face))
-
- '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t))
-
- '("^#[ \t]*\\w+" (0 font-lock-preprocessor-face t)
- ("\\<defined\\>" nil nil (0 font-lock-preprocessor-face)))
- '("^#" ("\\(&&\\|||\\)" nil nil (0 font-lock-constant-face t)))
- '("^#[ \t]*define[ \t]+\\(\\w+\\)(" (1 font-lock-function-name-face))
- '("^#[ \t]*define[ \t]+\\(\\w+\\)" (1 font-lock-variable-name-face))
- '("^#[ \t]*include[ \t]+\\(<.+>\\)" (1 font-lock-string-face))))
- "Highlights declarations, do-loops and other constructs.")
- (defvar f90-font-lock-keywords-3
- (append f90-font-lock-keywords-2
- (list
- f90-keywords-level-3-re
- f90-operators-re
-
-
- (list f90-procedures-re '(1 font-lock-keyword-face keep))
- "\\<real\\>"
-
- '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1)))
- "Highlights all F90 keywords and intrinsic procedures.")
- (defvar f90-font-lock-keywords-4
- (append f90-font-lock-keywords-3
- (list (cons f90-constants-re 'font-lock-constant-face)
- f90-hpf-keywords-re))
- "Highlights all F90 and HPF keywords and constants.")
- (defvar f90-font-lock-keywords
- f90-font-lock-keywords-2
- "*Default expressions to highlight in F90 mode.
- Can be overridden by the value of `font-lock-maximum-decoration'.")
- (defvar f90-mode-syntax-table
- (let ((table (make-syntax-table)))
- (modify-syntax-entry ?\! "<" table)
- (modify-syntax-entry ?\n ">" table)
-
- (modify-syntax-entry ?_ "w" table)
- (modify-syntax-entry ?\' "\"" table)
- (modify-syntax-entry ?\" "\"" table)
-
-
- (modify-syntax-entry ?\` "_" table)
- (modify-syntax-entry ?\r " " 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)
- table)
- "Syntax table used in F90 mode.")
- (defvar f90-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "`" 'f90-abbrev-start)
- (define-key map "\C-c;" 'f90-comment-region)
- (define-key map "\C-\M-a" 'f90-beginning-of-subprogram)
- (define-key map "\C-\M-e" 'f90-end-of-subprogram)
- (define-key map "\C-\M-h" 'f90-mark-subprogram)
- (define-key map "\C-\M-n" 'f90-end-of-block)
- (define-key map "\C-\M-p" 'f90-beginning-of-block)
- (define-key map "\C-\M-q" 'f90-indent-subprogram)
- (define-key map "\C-j" 'f90-indent-new-line)
- (define-key map "\C-c\r" 'f90-break-line)
- (define-key map "\C-c\C-a" 'f90-previous-block)
- (define-key map "\C-c\C-e" 'f90-next-block)
- (define-key map "\C-c\C-d" 'f90-join-lines)
- (define-key map "\C-c\C-f" 'f90-fill-region)
- (define-key map "\C-c\C-p" 'f90-previous-statement)
- (define-key map "\C-c\C-n" 'f90-next-statement)
- (define-key map "\C-c]" 'f90-insert-end)
- (define-key map "\C-c\C-w" 'f90-insert-end)
-
- (define-key map "," 'f90-electric-insert)
- (define-key map "+" 'f90-electric-insert)
- (define-key map "-" 'f90-electric-insert)
- (define-key map "*" 'f90-electric-insert)
- (define-key map "/" 'f90-electric-insert)
- (easy-menu-define f90-menu map "Menu for F90 mode."
- `("F90"
- ("Customization"
- ,(custom-menu-create 'f90)
-
- ["Set" Custom-set :active t
- :help "Set current value of all edited settings in the buffer"]
- ["Save" Custom-save :active t
- :help "Set and save all edited settings"]
- ["Reset to Current" Custom-reset-current :active t
- :help "Reset all edited settings to current"]
- ["Reset to Saved" Custom-reset-saved :active t
- :help "Reset all edited or set settings to saved"]
- ["Reset to Standard Settings" Custom-reset-standard :active t
- :help "Erase all customizations in buffer"]
- )
- "--"
- ["Indent Subprogram" f90-indent-subprogram t]
- ["Mark Subprogram" f90-mark-subprogram :active t :help
- "Mark the end of the current subprogram, move point to the start"]
- ["Beginning of Subprogram" f90-beginning-of-subprogram :active t
- :help "Move point to the start of the current subprogram"]
- ["End of Subprogram" f90-end-of-subprogram :active t
- :help "Move point to the end of the current subprogram"]
- "--"
- ["(Un)Comment Region" f90-comment-region :active mark-active
- :help "Comment or uncomment the region"]
- ["Indent Region" f90-indent-region :active mark-active]
- ["Fill Region" f90-fill-region :active mark-active
- :help "Fill long lines in the region"]
- "--"
- ["Break Line at Point" f90-break-line :active t
- :help "Break the current line at point"]
- ["Join with Previous Line" f90-join-lines :active t
- :help "Join the current line to the previous one"]
- ["Insert Block End" f90-insert-end :active t
- :help "Insert an end statement for the current code block"]
- "--"
- ("Highlighting"
- :help "Fontify this buffer to varying degrees"
- ["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode
- :style toggle :help "Fontify text in this buffer"]
- "--"
- ["Light highlighting (level 1)" f90-font-lock-1 t]
- ["Moderate highlighting (level 2)" f90-font-lock-2 t]
- ["Heavy highlighting (level 3)" f90-font-lock-3 t]
- ["Maximum highlighting (level 4)" f90-font-lock-4 t]
- )
- ("Change Keyword Case"
- :help "Change the case of keywords in the buffer or region"
- ["Upcase Keywords (buffer)" f90-upcase-keywords t]
- ["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
- ["Downcase Keywords (buffer)" f90-downcase-keywords t]
- "--"
- ["Upcase Keywords (region)" f90-upcase-region-keywords
- mark-active]
- ["Capitalize Keywords (region)" f90-capitalize-region-keywords
- mark-active]
- ["Downcase Keywords (region)" f90-downcase-region-keywords
- mark-active]
- )
- "--"
- ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function
- :style toggle
- :help "Automatically fill text while typing in this buffer"]
- ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode
- :style toggle :help "Expand abbreviations while typing in this buffer"]
- ["Add Imenu Menu" f90-add-imenu-menu
- :active (not (lookup-key (current-local-map) [menu-bar index]))
- :included (fboundp 'imenu-add-to-menubar)
- :help "Add an index menu to the menu-bar"
- ]))
- map)
- "Keymap used in F90 mode.")
- (defun f90-font-lock-n (n)
- "Set `font-lock-keywords' to F90 level N keywords."
- (font-lock-mode 1)
- (setq font-lock-keywords
- (symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n))))
- (font-lock-fontify-buffer))
- (defun f90-font-lock-1 ()
- "Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
- (interactive)
- (f90-font-lock-n 1))
- (defun f90-font-lock-2 ()
- "Set `font-lock-keywords' to `f90-font-lock-keywords-2'."
- (interactive)
- (f90-font-lock-n 2))
- (defun f90-font-lock-3 ()
- "Set `font-lock-keywords' to `f90-font-lock-keywords-3'."
- (interactive)
- (f90-font-lock-n 3))
- (defun f90-font-lock-4 ()
- "Set `font-lock-keywords' to `f90-font-lock-keywords-4'."
- (interactive)
- (f90-font-lock-n 4))
- (defconst f90-blocks-re
- (concat "\\(block[ \t]*data\\|"
- (regexp-opt '("do" "if" "interface" "function" "module" "program"
- "select" "subroutine" "type" "where" "forall"
-
- "enum" "associate"
-
- "submodule" "block" "critical"))
- "\\)\\>")
- "Regexp potentially indicating a \"block\" of F90 code.")
- (defconst f90-program-block-re
- (regexp-opt '("program" "module" "subroutine" "function" "submodule") 'paren)
- "Regexp used to locate the start/end of a \"subprogram\".")
- (defconst f90-else-like-re
- "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\
- \\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)"
- "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.")
- (defconst f90-end-if-re
- (concat "end[ \t]*"
- (regexp-opt '("if" "select" "where" "forall") 'paren)
- "\\>")
- "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.")
- (defconst f90-end-type-re
- "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>"
- "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.")
- (defconst f90-end-associate-re
- "end[ \t]*associate\\>"
- "Regexp matching the end of an ASSOCIATE block.")
- (defconst f90-type-def-re
-
-
-
-
-
- "\\<\\(type\\)\\>\\(?:\\(?:[^()\n]*\\|\
- .*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\sw+\\)"
- "Regexp matching the definition of a derived type.")
- (defconst f90-typeis-re
- "\\<\\(class\\|type\\)[ \t]*is[ \t]*("
- "Regexp matching a CLASS/TYPE IS statement.")
- (defconst f90-no-break-re
- (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=" "(/" "/)") 'paren)
- "Regexp specifying two-character tokens not to split when breaking lines.
- Each token has one or more of the characters from `f90-break-delimiters'.
- Note that if only one of the characters is from that variable,
- then the presence of the token here allows a line-break before or
- after the other character, where a break would not normally be
- allowed. This minor issue currently only affects \"(/\" and \"/)\".")
- (defvar f90-cache-position nil
- "Temporary position used to speed up region operations.")
- (make-variable-buffer-local 'f90-cache-position)
- (defconst f90-end-block-re
- (concat "^[ \t0-9]*\\<end[ \t]*"
- (regexp-opt '("do" "if" "forall" "function" "interface"
- "module" "program" "select" "subroutine"
- "type" "where" "enum" "associate" "submodule"
- "block" "critical") t)
- "\\>")
- "Regexp matching the end of an F90 \"block\", from the line start.
- Used in the F90 entry in `hs-special-modes-alist'.")
- (defconst f90-start-block-re
- (concat
- "^[ \t0-9]*"
- "\\(\\("
- "\\(\\sw+[ \t]*:[ \t]*\\)?"
- "\\(do\\|select[ \t]*\\(case\\|type\\)\\|"
-
- "if[ \t]*(\\(.*\\|"
- ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
-
- "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
- "\\|"
-
-
-
- "type[ \t,]\\("
- "[^i(!\n\"\& \t]\\|"
- "i[^s!\n\"\& \t]\\|"
- "is\\sw\\)\\|"
-
- "program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|"
-
- "function\\|subroutine\\|enum[^e]\\|associate\\|block\\|critical"
- "\\)"
- "[ \t]*")
- "Regexp matching the start of an F90 \"block\", from the line start.
- A simple regexp cannot do this in fully correct fashion, so this
- tries to strike a compromise between complexity and flexibility.
- Used in the F90 entry in `hs-special-modes-alist'.")
- (add-to-list 'hs-special-modes-alist
- `(f90-mode ,f90-start-block-re ,f90-end-block-re
- "!" f90-end-of-block nil))
- (defun f90-imenu-type-matcher ()
- "Search backward for the start of a derived type.
- Set subexpression 1 in the match-data to the name of the type."
- (let (found)
- (while (and (re-search-backward "^[ \t0-9]*type[ \t]*" nil t)
- (not (setq found
- (save-excursion
- (goto-char (match-end 0))
- (unless (looking-at "\\(is\\>\\|(\\)")
- (or (looking-at "\\(\\sw+\\)")
- (re-search-forward
- "[ \t]*::[ \t]*\\(\\sw+\\)"
- (line-end-position) t))))))))
- found))
- (defvar f90-imenu-generic-expression
- (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
- (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")
-
- )
- (list
- '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
- '("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\
- \\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
- '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
- (list "Types" 'f90-imenu-type-matcher 1)
-
-
- (list
- "Procedures"
- (concat
- "^[ \t0-9]*"
- "\\("
-
-
- "[^!\"\&\n]*\\("
- not-e good-char good-char "\\|"
- good-char not-n good-char "\\|"
- good-char good-char not-d "\\)"
- "\\|"
-
- good-char "?" good-char "?"
- "\\)"
- "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
- 4)))
- "Value for `imenu-generic-expression' in F90 mode.")
- (defun f90-add-imenu-menu ()
- "Add an imenu menu to the menubar."
- (interactive)
- (if (lookup-key (current-local-map) [menu-bar index])
- (message "%s" "F90-imenu already exists.")
- (imenu-add-to-menubar "F90-imenu")
- (redraw-frame (selected-frame))))
- (define-abbrev-table 'f90-mode-abbrev-table
- (mapcar (lambda (e) (list (car e) (cdr e) nil :system t))
- '(("`al" . "allocate" )
- ("`ab" . "allocatable" )
- ("`ai" . "abstract interface")
- ("`as" . "assignment" )
- ("`asy" . "asynchronous" )
- ("`ba" . "backspace" )
- ("`bd" . "block data" )
- ("`bl" . "block" )
- ("`c" . "character" )
- ("`cl" . "close" )
- ("`cm" . "common" )
- ("`cx" . "complex" )
- ("`cn" . "contains" )
- ("`cr" . "critical" )
- ("`cy" . "cycle" )
- ("`de" . "deallocate" )
- ("`df" . "define" )
- ("`di" . "dimension" )
- ("`dp" . "double precision")
- ("`dw" . "do while" )
- ("`el" . "else" )
- ("`eli" . "else if" )
- ("`elw" . "elsewhere" )
- ("`em" . "elemental" )
- ("`e" . "enumerator" )
- ("`eq" . "equivalence" )
- ("`ex" . "external" )
- ("`ey" . "entry" )
- ("`fl" . "forall" )
- ("`fo" . "format" )
- ("`fu" . "function" )
- ("`fa" . ".false." )
- ("`im" . "implicit none")
- ("`in" . "include" )
- ("`i" . "integer" )
- ("`it" . "intent" )
- ("`if" . "interface" )
- ("`lo" . "logical" )
- ("`mo" . "module" )
- ("`na" . "namelist" )
- ("`nu" . "nullify" )
- ("`op" . "optional" )
- ("`pa" . "parameter" )
- ("`po" . "pointer" )
- ("`pr" . "print" )
- ("`pi" . "private" )
- ("`pm" . "program" )
- ("`pr" . "protected" )
- ("`pu" . "public" )
- ("`r" . "real" )
- ("`rc" . "recursive" )
- ("`rt" . "return" )
- ("`rw" . "rewind" )
- ("`se" . "select" )
- ("`sq" . "sequence" )
- ("`su" . "subroutine" )
- ("`ta" . "target" )
- ("`tr" . ".true." )
- ("`t" . "type" )
- ("`vo" . "volatile" )
- ("`wh" . "where" )
- ("`wr" . "write" )))
- "Abbrev table for F90 mode."
-
- :regexp "\\(?:[^[:word:]_`]\\|^\\)\\(`?[[:word:]_]+\\)[^[:word:]_]*")
- (define-derived-mode f90-mode prog-mode "F90"
- "Major mode for editing Fortran 90,95 code in free format.
- For fixed format code, use `fortran-mode'.
- \\[f90-indent-line] indents the current line.
- \\[f90-indent-new-line] indents current line and creates a new\
- indented line.
- \\[f90-indent-subprogram] indents the current subprogram.
- Type `? or `\\[help-command] to display a list of built-in\
- abbrevs for F90 keywords.
- Key definitions:
- \\{f90-mode-map}
- Variables controlling indentation style and extra features:
- `f90-do-indent'
- Extra indentation within do blocks (default 3).
- `f90-if-indent'
- Extra indentation within if/select/where/forall blocks (default 3).
- `f90-type-indent'
- Extra indentation within type/enum/interface/block-data blocks (default 3).
- `f90-program-indent'
- Extra indentation within program/module/subroutine/function blocks
- (default 2).
- `f90-associate-indent'
- Extra indentation within associate blocks (default 2).
- `f90-critical-indent'
- Extra indentation within critical/block blocks (default 2).
- `f90-continuation-indent'
- Extra indentation applied to continuation lines (default 5).
- `f90-comment-region'
- String inserted by function \\[f90-comment-region] at start of each
- line in region (default \"!!!$\").
- `f90-indented-comment-re'
- Regexp determining the type of comment to be intended like code
- (default \"!\").
- `f90-directive-comment-re'
- Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented
- (default \"!hpf\\\\$\").
- `f90-break-delimiters'
- Regexp holding list of delimiters at which lines may be broken
- (default \"[-+*/><=,% \\t]\").
- `f90-break-before-delimiters'
- Non-nil causes `f90-do-auto-fill' to break lines before delimiters
- (default t).
- `f90-beginning-ampersand'
- Automatic insertion of \& at beginning of continuation lines (default t).
- `f90-smart-end'
- From an END statement, check and fill the end using matching block start.
- Allowed values are 'blink, 'no-blink, and nil, which determine
- whether to blink the matching beginning (default 'blink).
- `f90-auto-keyword-case'
- Automatic change of case of keywords (default nil).
- The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
- `f90-leave-line-no'
- Do not left-justify line numbers (default nil).
- Turning on F90 mode calls the value of the variable `f90-mode-hook'
- with no args, if that value is non-nil."
- :group 'f90
- :abbrev-table f90-mode-abbrev-table
- (set (make-local-variable 'indent-line-function) 'f90-indent-line)
- (set (make-local-variable 'indent-region-function) 'f90-indent-region)
- (set (make-local-variable 'comment-start) "!")
- (set (make-local-variable 'comment-start-skip) "!+ *")
- (set (make-local-variable 'comment-indent-function) 'f90-comment-indent)
- (set (make-local-variable 'abbrev-all-caps) t)
- (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)
- (setq indent-tabs-mode nil)
- (set (make-local-variable 'font-lock-defaults)
- '((f90-font-lock-keywords f90-font-lock-keywords-1
- f90-font-lock-keywords-2
- f90-font-lock-keywords-3
- f90-font-lock-keywords-4)
- nil t))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-generic-expression)
- f90-imenu-generic-expression)
- (set (make-local-variable 'beginning-of-defun-function)
- 'f90-beginning-of-subprogram)
- (set (make-local-variable 'end-of-defun-function) 'f90-end-of-subprogram)
- (set (make-local-variable 'add-log-current-defun-function)
- #'f90-current-defun))
- (defsubst f90-in-string ()
- "Return non-nil if point is inside a string.
- Checks from `point-min', or `f90-cache-position', if that is non-nil
- and lies before point."
- (let ((beg-pnt
- (if (and f90-cache-position (> (point) f90-cache-position))
- f90-cache-position
- (point-min))))
- (nth 3 (parse-partial-sexp beg-pnt (point)))))
- (defsubst f90-in-comment ()
- "Return non-nil if point is inside a comment.
- Checks from `point-min', or `f90-cache-position', if that is non-nil
- and lies before point."
- (let ((beg-pnt
- (if (and f90-cache-position (> (point) f90-cache-position))
- f90-cache-position
- (point-min))))
- (nth 4 (parse-partial-sexp beg-pnt (point)))))
- (defsubst f90-line-continued ()
- "Return t if the current line is a continued one.
- This includes comment lines embedded in continued lines, but
- not the last line of a continued statement."
- (save-excursion
- (beginning-of-line)
- (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1))))
- (end-of-line)
- (while (f90-in-comment)
- (search-backward "!" (line-beginning-position))
- (skip-chars-backward "!"))
- (skip-chars-backward " \t")
- (= (preceding-char) ?&)))
- (defsubst f90-current-indentation ()
- "Return indentation of current line.
- Line-numbers are considered whitespace characters."
- (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")))
- (defsubst f90-indent-to (col &optional no-line-number)
- "Indent current line to column COL.
- If optional argument NO-LINE-NUMBER is nil, jump over a possible
- line-number before indenting."
- (beginning-of-line)
- (or no-line-number
- (skip-chars-forward " \t0-9"))
- (delete-horizontal-space)
-
- (indent-to col (if (zerop (current-column)) 0 1)))
- (defsubst f90-get-present-comment-type ()
- "If point lies within a comment, return the string starting the comment.
- For example, \"!\" or \"!!\", followed by the appropriate amount of
- whitespace, if any."
-
- (save-excursion
- (when (f90-in-comment)
- (beginning-of-line)
- (re-search-forward "!+[ \t]*" (line-end-position))
- (while (f90-in-string)
- (re-search-forward "!+[ \t]*" (line-end-position)))
- (match-string-no-properties 0))))
- (defsubst f90-equal-symbols (a b)
- "Compare strings A and B neglecting case and allowing for nil value."
- (equal (if a (downcase a) nil)
- (if b (downcase b) nil)))
- (defsubst f90-looking-at-do ()
- "Return (\"do\" NAME) if a do statement starts after point.
- NAME is nil if the statement has no label."
- (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")
- (list (match-string 3) (match-string 2))))
- (defsubst f90-looking-at-select-case ()
- "Return (\"select\" NAME) if a select statement starts after point.
- NAME is nil if the statement has no label."
- (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
- \\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(")
- (list (match-string 3) (match-string 2))))
- (defsubst f90-looking-at-if-then ()
- "Return (\"if\" NAME) if an if () then statement starts after point.
- NAME is nil if the statement has no label."
- (save-excursion
- (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>")
- (let ((struct (match-string 3))
- (label (match-string 2))
- (pos (scan-lists (point) 1 0)))
- (and pos (goto-char pos))
- (skip-chars-forward " \t")
- (if (or (looking-at "then\\>")
- (when (f90-line-continued)
- (f90-next-statement)
- (skip-chars-forward " \t0-9&")
- (looking-at "then\\>")))
- (list struct label))))))
- (defsubst f90-looking-at-associate ()
- "Return (\"associate\") if an associate block starts after point."
- (if (looking-at "\\<\\(associate\\)[ \t]*(")
- (list (match-string 1))))
- (defsubst f90-looking-at-critical ()
- "Return (KIND NAME) if a critical or block block starts after point."
- (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\>")
- (let ((struct (match-string 3))
- (label (match-string 2)))
- (if (or (not (string-equal "block" struct))
- (save-excursion
- (skip-chars-forward " \t")
- (not (looking-at "data\\>"))))
- (list struct label)))))
- (defsubst f90-looking-at-end-critical ()
- "Return non-nil if a critical or block block ends after point."
- (if (looking-at "end[ \t]*\\(critical\\|block\\)\\>")
- (or (not (string-equal "block" (match-string 1)))
- (save-excursion
- (skip-chars-forward " \t")
- (not (looking-at "data\\>"))))))
- (defsubst f90-looking-at-where-or-forall ()
- "Return (KIND NAME) if a where or forall block starts after point.
- NAME is nil if the statement has no label."
- (save-excursion
- (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
- \\(where\\|forall\\)\\>")
- (let ((struct (match-string 3))
- (label (match-string 2))
- (pos (scan-lists (point) 1 0)))
- (and pos (goto-char pos))
- (skip-chars-forward " \t")
- (if (looking-at "\\(!\\|$\\)") (list struct label))))))
- (defsubst f90-looking-at-type-like ()
- "Return (KIND NAME) if a type/enum/interface/block-data starts after point.
- NAME is non-nil only for type and certain interfaces."
- (cond
- ((save-excursion
- (and (looking-at "\\<type\\>[ \t]*")
- (goto-char (match-end 0))
- (not (looking-at "\\(is\\>\\|(\\)"))
- (or (looking-at "\\(\\sw+\\)")
- (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)"
- (line-end-position) t))))
- (list "type" (match-string 1)))
- ((looking-at "\\<\\(interface\\)\\>[ \t]*")
- (list (match-string 1)
- (save-excursion
- (goto-char (match-end 0))
- (if (or (looking-at "\\(operator\\|assignment\\|read\\|\
- write\\)[ \t]*([^)\n]*)")
- (looking-at "\\sw+"))
- (match-string 0)))))
- ((looking-at "\\(enum\\|block[ \t]*data\\)\\>")
- (list (match-string 1) nil))
- ((looking-at "abstract[ \t]*\\(interface\\)\\>")
- (list (match-string 1) nil))))
- (defsubst f90-looking-at-program-block-start ()
- "Return (KIND NAME) if a program block with name NAME starts after point."
- (cond
- ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
- (list (match-string 1) (match-string 2)))
- ((and (not (looking-at "module[ \t]*procedure\\>"))
- (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
- (list (match-string 1) (match-string 2)))
- ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)\\>")
- (list (match-string 1) (match-string 2)))
- ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
- (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
- \\(\\sw+\\)"))
- (list (match-string 1) (match-string 2)))))
- (defsubst f90-looking-at-program-block-end ()
- "Return (KIND NAME) if a block with name NAME ends after point."
- (cond ((looking-at "end[ \t]*\\(interface\\)[ \t]*\\(\
- \\(?:assignment\\|operator\\|read\\|write\\)[ \t]*([^)\n]*)\\)")
- (list (match-string 1) (match-string 2)))
- ((looking-at (concat "end[ \t]*" f90-blocks-re
- "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
- (list (match-string 1) (match-string 3)))))
- (defsubst f90-comment-indent ()
- "Return the indentation to be used for a comment starting at point.
- Used for `comment-indent-function' by F90 mode.
- \"!!!\", `f90-directive-comment-re', variable `f90-comment-region' return 0.
- `f90-indented-comment-re' (if not trailing code) calls `f90-calculate-indent'.
- All others return `comment-column', leaving at least one space after code."
- (cond ((looking-at "!!!") 0)
- ((and f90-directive-comment-re
- (looking-at f90-directive-comment-re)) 0)
- ((looking-at (regexp-quote f90-comment-region)) 0)
- ((and (looking-at f90-indented-comment-re)
-
- (save-excursion
- (skip-chars-backward " \t")
- (bolp)))
- (f90-calculate-indent))
- (t (save-excursion
- (skip-chars-backward " \t")
- (max (if (bolp) 0 (1+ (current-column))) comment-column)))))
- (defsubst f90-present-statement-cont ()
- "Return continuation properties of present statement.
- Possible return values are:
- single - statement is not continued.
- begin - current line is the first in a continued statement.
- end - current line is the last in a continued statement
- middle - current line is neither first nor last in a continued statement.
- Comment lines embedded amongst continued lines return 'middle."
- (let (pcont cont)
- (save-excursion
- (setq pcont (if (f90-previous-statement) (f90-line-continued))))
- (setq cont (f90-line-continued))
- (cond ((and (not pcont) (not cont)) 'single)
- ((and (not pcont) cont) 'begin)
- ((and pcont (not cont)) 'end)
- ((and pcont cont) 'middle)
- (t (error "The impossible occurred")))))
- (defsubst f90-indent-line-no ()
- "If `f90-leave-line-no' is nil, left-justify a line number.
- Leaves point at the first non-blank character after the line number.
- Call from beginning of line."
- (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]")
- (delete-horizontal-space))
- (skip-chars-forward " \t0-9"))
- (defsubst f90-no-block-limit ()
- "Return nil if point is at the edge of a code block.
- Searches line forward for \"function\" or \"subroutine\",
- if all else fails."
- (save-excursion
- (not (or (looking-at "end")
- (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
- \\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\
- block\\|critical\\)\\>")
- (looking-at "\\(program\\|\\(?:sub\\)?module\\|\
- \\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>")
- (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
- (looking-at f90-type-def-re)
- (re-search-forward "\\(function\\|subroutine\\)"
- (line-end-position) t)))))
- (defsubst f90-update-line ()
- "Change case of current line as per `f90-auto-keyword-case'."
- (if f90-auto-keyword-case
- (f90-change-keywords f90-auto-keyword-case
- (line-beginning-position) (line-end-position))))
- (defun f90-electric-insert (&optional arg)
- "Change keyword case and auto-fill line as operators are inserted."
- (interactive "*p")
- (self-insert-command arg)
- (if auto-fill-function (f90-do-auto-fill)
- (f90-update-line)))
- (put 'f90-electric-insert 'delete-selection t)
- (defun f90-get-correct-indent ()
- "Get correct indent for a line starting with line number.
- Does not check type and subprogram indentation."
- (let ((epnt (line-end-position)) icol)
- (save-excursion
- (while (and (f90-previous-statement)
- (or (memq (f90-present-statement-cont) '(middle end))
- (looking-at "[ \t]*[0-9]"))))
- (setq icol (current-indentation))
- (beginning-of-line)
- (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
- (line-end-position) t)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (cond ((f90-looking-at-do)
- (setq icol (+ icol f90-do-indent)))
- ((or (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)
- (f90-looking-at-select-case))
- (setq icol (+ icol f90-if-indent)))
-
-
- ((f90-looking-at-associate)
- (setq icol (+ icol f90-associate-indent))))
- (end-of-line))
- (while (re-search-forward
- "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((f90-looking-at-do)
- (setq icol (+ icol f90-do-indent)))
- ((or (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)
- (f90-looking-at-select-case))
- (setq icol (+ icol f90-if-indent)))
-
-
- ((f90-looking-at-associate)
- (setq icol (+ icol f90-associate-indent)))
- ((looking-at f90-end-if-re)
- (setq icol (- icol f90-if-indent)))
- ((looking-at f90-end-associate-re)
- (setq icol (- icol f90-associate-indent)))
- ((f90-looking-at-end-critical)
- (setq icol (- icol f90-critical-indent)))
- ((looking-at "end[ \t]*do\\>")
- (setq icol (- icol f90-do-indent))))
- (end-of-line))
- icol)))
- (defun f90-calculate-indent ()
- "Calculate the indent column based on previous statements."
- (interactive)
- (let (icol cont (case-fold-search t) (pnt (point)))
- (save-excursion
- (if (not (f90-previous-statement))
-
-
- (setq icol (if (or (save-excursion
- (goto-char pnt)
- (beginning-of-line)
-
- (looking-at "[ \t]*#"))
- (progn
-
-
-
- (when (looking-at "[ \t]*\\([!#]\\|$\\)")
- (f90-next-statement))
- (skip-chars-forward " \t0-9")
- (f90-looking-at-program-block-start)))
- 0
-
- f90-program-indent))
- (setq cont (f90-present-statement-cont))
- (if (eq cont 'end)
- (while (not (eq 'begin (f90-present-statement-cont)))
- (f90-previous-statement)))
- (cond ((eq cont 'begin)
- (setq icol (+ (f90-current-indentation)
- f90-continuation-indent)))
- ((eq cont 'middle) (setq icol (current-indentation)))
- (t (setq icol (f90-current-indentation))
- (skip-chars-forward " \t")
- (if (looking-at "[0-9]")
- (setq icol (f90-get-correct-indent))
- (cond ((or (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)
- (f90-looking-at-select-case)
- (looking-at f90-else-like-re))
- (setq icol (+ icol f90-if-indent)))
- ((f90-looking-at-do)
- (setq icol (+ icol f90-do-indent)))
- ((f90-looking-at-type-like)
- (setq icol (+ icol f90-type-indent)))
- ((f90-looking-at-associate)
- (setq icol (+ icol f90-associate-indent)))
- ((f90-looking-at-critical)
- (setq icol (+ icol f90-critical-indent)))
- ((or (f90-looking-at-program-block-start)
- (looking-at "contains[ \t]*\\($\\|!\\)"))
- (setq icol (+ icol f90-program-indent)))))
- (goto-char pnt)
- (beginning-of-line)
- (cond ((looking-at "[ \t]*$"))
- ((looking-at "[ \t]*#")
- (setq icol 0))
- (t
- (skip-chars-forward " \t0-9")
- (cond ((or (looking-at f90-else-like-re)
- (looking-at f90-end-if-re))
- (setq icol (- icol f90-if-indent)))
- ((looking-at "end[ \t]*do\\>")
- (setq icol (- icol f90-do-indent)))
- ((looking-at f90-end-type-re)
- (setq icol (- icol f90-type-indent)))
- ((looking-at f90-end-associate-re)
- (setq icol (- icol f90-associate-indent)))
- ((f90-looking-at-end-critical)
- (setq icol (- icol f90-critical-indent)))
- ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
- (f90-looking-at-program-block-end))
- (setq icol (- icol f90-program-indent))))))))))
- icol))
- (defun f90-previous-statement ()
- "Move point to beginning of the previous F90 statement.
- If no previous statement is found (i.e. if called from the first
- statement in the buffer), move to the start of the buffer and
- return nil. A statement is a line which is neither blank nor a
- comment."
- (interactive)
- (let (not-first-statement)
- (beginning-of-line)
- (while (and (setq not-first-statement (zerop (forward-line -1)))
- (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
- not-first-statement))
- (defun f90-next-statement ()
- "Move point to beginning of the next F90 statement.
- Return nil if no later statement is found."
- (interactive)
- (let (not-last-statement)
- (beginning-of-line)
- (while (and (setq not-last-statement
- (and (zerop (forward-line 1))
- (not (eobp))))
- (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
- not-last-statement))
- (defun f90-beginning-of-subprogram ()
- "Move point to the beginning of the current subprogram.
- Return (TYPE NAME), or nil if not found."
- (interactive)
- (let ((count 1) (case-fold-search t) matching-beg)
- (beginning-of-line)
- (while (and (> count 0)
- (re-search-backward f90-program-block-re nil 'move))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((setq matching-beg (f90-looking-at-program-block-start))
- (setq count (1- count)))
- ((f90-looking-at-program-block-end)
- (setq count (1+ count)))))
- (beginning-of-line)
- (if (zerop count)
- matching-beg
-
-
- (if (called-interactively-p 'interactive)
- (message "No beginning found"))
- nil)))
- (defun f90-end-of-subprogram ()
- "Move point to the end of the current subprogram.
- Return (TYPE NAME), or nil if not found."
- (interactive)
- (let ((case-fold-search t)
- (count 1)
- matching-end)
- (end-of-line)
- (while (and (> count 0)
- (re-search-forward f90-program-block-re nil 'move))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((f90-looking-at-program-block-start)
- (setq count (1+ count)))
- ((setq matching-end (f90-looking-at-program-block-end))
- (setq count (1- count))))
- (end-of-line))
-
-
- (if (zerop count)
- matching-end
- (if (called-interactively-p 'interactive)
- (message "No end found"))
- nil)))
- (defun f90-end-of-block (&optional num)
- "Move point forward to the end of the current code block.
- With optional argument NUM, go forward that many balanced blocks.
- If NUM is negative, go backward to the start of a block. Checks
- for consistency of block types and labels (if present), and
- completes outermost block if `f90-smart-end' is non-nil.
- Interactively, pushes mark before moving point."
- (interactive "p")
-
- (if (called-interactively-p 'any) (push-mark (point) t))
- (and num (< num 0) (f90-beginning-of-block (- num)))
- (let ((f90-smart-end (if f90-smart-end 'no-blink))
- (case-fold-search t)
- (count (or num 1))
- start-list start-this start-type start-label end-type end-label)
- (end-of-line)
- (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((or (f90-in-string) (f90-in-comment)))
- ((setq start-this
- (or
- (f90-looking-at-do)
- (f90-looking-at-select-case)
- (f90-looking-at-type-like)
- (f90-looking-at-associate)
- (f90-looking-at-critical)
- (f90-looking-at-program-block-start)
- (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)))
- (setq start-list (cons start-this start-list)
- count (1+ count)))
- ((looking-at (concat "end[ \t]*" f90-blocks-re
- "[ \t]*\\(\\sw+\\)?"))
- (setq end-type (match-string 1)
- end-label (match-string 2)
- count (1- count))
-
- (when start-list
- (setq start-this (car start-list)
- start-list (cdr start-list)
- start-type (car start-this)
- start-label (cadr start-this))
- (or (f90-equal-symbols start-type end-type)
- (error "End type `%s' does not match start type `%s'"
- end-type start-type))
- (or (f90-equal-symbols start-label end-label)
- (error "End label `%s' does not match start label `%s'"
- end-label start-label)))))
- (end-of-line))
- (if (> count 0) (error "Missing block end"))
-
- (when f90-smart-end
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (f90-match-end)))))
- (defun f90-beginning-of-block (&optional num)
- "Move point backwards to the start of the current code block.
- With optional argument NUM, go backward that many balanced blocks.
- If NUM is negative, go forward to the end of a block.
- Checks for consistency of block types and labels (if present).
- Does not check the outermost block, because it may be incomplete.
- Interactively, pushes mark before moving point."
- (interactive "p")
- (if (called-interactively-p 'any) (push-mark (point) t))
- (and num (< num 0) (f90-end-of-block (- num)))
- (let ((case-fold-search t)
- (count (or num 1))
- end-list end-this end-type end-label
- start-this start-type start-label)
- (beginning-of-line)
- (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((or (f90-in-string) (f90-in-comment)))
- ((looking-at (concat "end[ \t]*" f90-blocks-re
- "[ \t]*\\(\\sw+\\)?"))
- (setq end-list (cons (list (match-string 1) (match-string 2))
- end-list)
- count (1+ count)))
- ((setq start-this
- (or
- (f90-looking-at-do)
- (f90-looking-at-select-case)
- (f90-looking-at-type-like)
- (f90-looking-at-associate)
- (f90-looking-at-critical)
- (f90-looking-at-program-block-start)
- (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)))
- (setq start-type (car start-this)
- start-label (cadr start-this)
- count (1- count))
-
- (when end-list
- (setq end-this (car end-list)
- end-list (cdr end-list)
- end-type (car end-this)
- end-label (cadr end-this))
- (or (f90-equal-symbols start-type end-type)
- (error "Start type `%s' does not match end type `%s'"
- start-type end-type))
- (or (f90-equal-symbols start-label end-label)
- (error "Start label `%s' does not match end label `%s'"
- start-label end-label))))))
-
- (if (> count 0) (error "Missing block start"))))
- (defun f90-next-block (&optional num)
- "Move point forward to the next end or start of a code block.
- With optional argument NUM, go forward that many blocks.
- If NUM is negative, go backwards.
- A block is a subroutine, if-endif, etc."
- (interactive "p")
- (let ((case-fold-search t)
- (count (if num (abs num) 1)))
- (while (and (> count 0)
- (if (> num 0) (re-search-forward f90-blocks-re nil 'move)
- (re-search-backward f90-blocks-re nil 'move)))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (cond ((or (f90-in-string) (f90-in-comment)))
- ((or
- (looking-at "end[ \t]*")
- (f90-looking-at-do)
- (f90-looking-at-select-case)
- (f90-looking-at-type-like)
- (f90-looking-at-associate)
- (f90-looking-at-critical)
- (f90-looking-at-program-block-start)
- (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall))
- (setq count (1- count))))
- (if (> num 0) (end-of-line)
- (beginning-of-line)))))
- (defun f90-previous-block (&optional num)
- "Move point backward to the previous end or start of a code block.
- With optional argument NUM, go backward that many blocks.
- If NUM is negative, go forwards.
- A block is a subroutine, if-endif, etc."
- (interactive "p")
- (f90-next-block (- (or num 1))))
- (defun f90-mark-subprogram ()
- "Put mark at end of F90 subprogram, point at beginning, push mark."
- (interactive)
- (let ((pos (point)) program)
- (f90-end-of-subprogram)
- (push-mark)
- (goto-char pos)
- (setq program (f90-beginning-of-subprogram))
- (if (featurep 'xemacs)
- (zmacs-activate-region)
- (setq mark-active t
- deactivate-mark nil))
- program))
- (defun f90-comment-region (beg-region end-region)
- "Comment/uncomment every line in the region.
- Insert the variable `f90-comment-region' at the start of every line
- in the region, or, if already present, remove it."
- (interactive "*r")
- (let ((end (copy-marker end-region)))
- (goto-char beg-region)
- (beginning-of-line)
- (if (looking-at (regexp-quote f90-comment-region))
- (delete-region (point) (match-end 0))
- (insert f90-comment-region))
- (while (and (zerop (forward-line 1))
- (< (point) end))
- (if (looking-at (regexp-quote f90-comment-region))
- (delete-region (point) (match-end 0))
- (insert f90-comment-region)))
- (set-marker end nil)))
- (defun f90-indent-line (&optional no-update)
- "Indent current line as F90 code.
- Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'
- after indenting."
- (interactive "*P")
- (let ((case-fold-search t)
- (pos (point-marker))
- indent no-line-number)
- (beginning-of-line)
- (if (not (save-excursion (and (f90-previous-statement)
- (f90-line-continued))))
- (f90-indent-line-no)
- (setq no-line-number t)
- (skip-chars-forward " \t"))
- (if (looking-at "!")
- (setq indent (f90-comment-indent))
- (and f90-smart-end (looking-at "end")
- (f90-match-end))
- (setq indent (f90-calculate-indent)))
- (or (= indent (current-column))
- (f90-indent-to indent no-line-number))
-
-
- (and (< (point) pos)
- (goto-char pos))
- (if auto-fill-function
-
- (f90-do-auto-fill)
- (or no-update (f90-update-line)))
- (set-marker pos nil)))
- (defun f90-indent-new-line ()
- "Re-indent current line, insert a newline and indent the newline.
- An abbrev before point is expanded if the variable `abbrev-mode' is non-nil.
- If run in the middle of a line, the line is not broken."
- (interactive "*")
- (if abbrev-mode (expand-abbrev))
- (beginning-of-line)
- (f90-indent-line)
- (end-of-line)
- (delete-horizontal-space)
- (let ((string (f90-in-string))
- (cont (f90-line-continued)))
- (and string (not cont) (insert "&"))
- (newline)
- (if (or string (and cont f90-beginning-ampersand)) (insert "&")))
- (f90-indent-line 'no-update))
- (defun f90-indent-region (beg-region end-region)
- "Indent every line in region by forward parsing."
- (interactive "*r")
- (let ((end-region-mark (copy-marker end-region))
- (save-point (point-marker))
- (case-fold-search t)
- block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct)
- (goto-char beg-region)
-
- (beginning-of-line)
- (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)")
- (progn (f90-indent-line 'no-update)
- (zerop (forward-line 1)))
- (< (point) end-region-mark)))
- (setq cont (f90-present-statement-cont))
- (while (and (memq cont '(middle end))
- (f90-previous-statement))
- (setq cont (f90-present-statement-cont)))
-
- (setq f90-cache-position (point))
- (f90-indent-line 'no-update)
- (setq ind-lev (f90-current-indentation)
- ind-curr ind-lev)
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (setq struct nil
- ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
- ((or (setq struct (f90-looking-at-if-then))
- (setq struct (f90-looking-at-select-case))
- (setq struct (f90-looking-at-where-or-forall))
- (looking-at f90-else-like-re))
- f90-if-indent)
- ((setq struct (f90-looking-at-type-like))
- f90-type-indent)
- ((setq struct (f90-looking-at-associate))
- f90-associate-indent)
- ((setq struct (f90-looking-at-critical))
- f90-critical-indent)
- ((or (setq struct (f90-looking-at-program-block-start))
- (looking-at "contains[ \t]*\\($\\|!\\)"))
- f90-program-indent)))
- (if ind-b (setq ind-lev (+ ind-lev ind-b)))
- (if struct (setq block-list (cons struct block-list)))
- (while (and (f90-line-continued) (zerop (forward-line 1))
- (< (point) end-region-mark))
- (if (looking-at "[ \t]*!")
- (f90-indent-to (f90-comment-indent))
- (or (= (current-indentation)
- (+ ind-curr f90-continuation-indent))
- (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))
-
- (while (and (zerop (forward-line 1)) (< (point) end-region-mark))
- (beginning-of-line)
- (f90-indent-line-no)
- (setq f90-cache-position (point))
- (cond ((looking-at "[ \t]*$") (setq ind-curr 0))
- ((looking-at "[ \t]*#") (setq ind-curr 0))
- ((looking-at "!") (setq ind-curr (f90-comment-indent)))
- ((f90-no-block-limit) (setq ind-curr ind-lev))
- ((looking-at f90-else-like-re) (setq ind-curr
- (- ind-lev f90-if-indent)))
- ((looking-at "contains[ \t]*\\($\\|!\\)")
- (setq ind-curr (- ind-lev f90-program-indent)))
- ((setq ind-b
- (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
- ((or (setq struct (f90-looking-at-if-then))
- (setq struct (f90-looking-at-select-case))
- (setq struct (f90-looking-at-where-or-forall)))
- f90-if-indent)
- ((setq struct (f90-looking-at-type-like))
- f90-type-indent)
- ((setq struct (f90-looking-at-associate))
- f90-associate-indent)
- ((setq struct (f90-looking-at-critical))
- f90-critical-indent)
- ((setq struct (f90-looking-at-program-block-start))
- f90-program-indent)))
- (setq ind-curr ind-lev)
- (if ind-b (setq ind-lev (+ ind-lev ind-b)))
- (setq block-list (cons struct block-list)))
- ((setq end-struct (f90-looking-at-program-block-end))
- (setq beg-struct (car block-list)
- block-list (cdr block-list))
- (if f90-smart-end
- (save-excursion
- (f90-block-match (car beg-struct) (cadr beg-struct)
- (car end-struct) (cadr end-struct))))
- (setq ind-b
- (cond ((looking-at f90-end-if-re) f90-if-indent)
- ((looking-at "end[ \t]*do\\>") f90-do-indent)
- ((looking-at f90-end-type-re) f90-type-indent)
- ((looking-at f90-end-associate-re)
- f90-associate-indent)
- ((f90-looking-at-end-critical) f90-critical-indent)
- ((f90-looking-at-program-block-end)
- f90-program-indent)))
- (if ind-b (setq ind-lev (- ind-lev ind-b)))
- (setq ind-curr ind-lev))
- (t (setq ind-curr ind-lev)))
-
- (or (= ind-curr (current-column))
- (f90-indent-to ind-curr))
- (while (and (f90-line-continued) (zerop (forward-line 1))
- (< (point) end-region-mark))
- (if (looking-at "[ \t]*!")
- (f90-indent-to (f90-comment-indent))
- (or (= (current-indentation)
- (+ ind-curr f90-continuation-indent))
- (f90-indent-to
- (+ ind-curr f90-continuation-indent) 'no-line-no)))))
-
- (setq f90-cache-position nil)
- (goto-char save-point)
- (set-marker end-region-mark nil)
- (set-marker save-point nil)
- (if (featurep 'xemacs)
- (zmacs-deactivate-region)
- (deactivate-mark))))
- (defun f90-indent-subprogram ()
- "Properly indent the subprogram containing point."
- (interactive "*")
- (save-excursion
- (let ((program (f90-mark-subprogram)))
- (if program
- (progn
- (message "Indenting %s %s..."
- (car program) (cadr program))
- (indent-region (point) (mark) nil)
- (message "Indenting %s %s...done"
- (car program) (cadr program)))
- (message "Indenting the whole file...")
- (indent-region (point) (mark) nil)
- (message "Indenting the whole file...done")))))
- (defun f90-break-line (&optional no-update)
- "Break line at point, insert continuation marker(s) and indent.
- Unless in a string or comment, or if the optional argument NO-UPDATE
- is non-nil, call `f90-update-line' after inserting the continuation marker."
- (interactive "*P")
- (cond ((f90-in-string)
- (insert "&\n&"))
- ((f90-in-comment)
- (delete-horizontal-space)
- (insert "\n" (f90-get-present-comment-type)))
- (t (insert "&")
- (or no-update (f90-update-line))
- (newline 1)
-
-
- (if f90-beginning-ampersand (insert "&"))))
- (indent-according-to-mode))
- (defun f90-find-breakpoint ()
- "From `fill-column', search backward for break-delimiter."
-
- (if (f90-in-comment)
- (re-search-backward "\\s-" (line-beginning-position))
- (re-search-backward f90-break-delimiters (line-beginning-position))
- (if (not f90-break-before-delimiters)
- (forward-char (if (looking-at f90-no-break-re) 2 1))
- (backward-char)
- (or (looking-at f90-no-break-re)
- (forward-char)))))
- (defun f90-do-auto-fill ()
- "Break line if non-white characters beyond `fill-column'.
- Update keyword case first."
- (interactive "*")
-
-
-
- (f90-update-line)
-
- (unless (and (boundp 'comment-auto-fill-only-comments)
- comment-auto-fill-only-comments
- (not (f90-in-comment)))
- (while (> (current-column) fill-column)
- (let ((pos-mark (point-marker)))
- (move-to-column fill-column)
- (or (f90-in-string) (f90-find-breakpoint))
- (f90-break-line)
- (goto-char pos-mark)
- (set-marker pos-mark nil)))))
- (defun f90-join-lines (&optional arg)
- "Join current line to previous, fix whitespace, continuation, comments.
- With optional argument ARG, join current line to following line.
- Like `join-line', but handles F90 syntax."
- (interactive "*P")
- (beginning-of-line)
- (if arg (forward-line 1))
- (when (eq (preceding-char) ?\n)
- (skip-chars-forward " \t")
- (if (looking-at "\&") (delete-char 1))
- (beginning-of-line)
- (delete-region (point) (1- (point)))
- (skip-chars-backward " \t")
- (and (eq (preceding-char) ?&) (delete-char -1))
- (and (f90-in-comment)
- (looking-at "[ \t]*!+")
- (replace-match ""))
- (or (f90-in-string)
- (fixup-whitespace))))
- (defun f90-fill-region (beg-region end-region)
- "Fill every line in region by forward parsing. Join lines if possible."
- (interactive "*r")
- (let ((end-region-mark (copy-marker end-region))
- (go-on t)
- f90-smart-end f90-auto-keyword-case auto-fill-function)
- (goto-char beg-region)
- (while go-on
-
- (while (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (eq (preceding-char) ?&))
- (f90-join-lines 'forward))
-
- (while (> (save-excursion (end-of-line) (current-column))
- fill-column)
- (move-to-column fill-column)
- (f90-find-breakpoint)
- (f90-break-line 'no-update))
- (setq go-on (and (< (point) end-region-mark)
- (zerop (forward-line 1)))
- f90-cache-position (point)))
- (setq f90-cache-position nil)
- (set-marker end-region-mark nil)
- (if (featurep 'xemacs)
- (zmacs-deactivate-region)
- (deactivate-mark))))
- (defun f90-block-match (beg-block beg-name end-block end-name)
- "Match end-struct with beg-struct and complete end-block if possible.
- BEG-BLOCK is the type of block as indicated at the start (e.g., do).
- BEG-NAME is the block start name (may be nil).
- END-BLOCK is the type of block as indicated at the end (may be nil).
- END-NAME is the block end name (may be nil).
- Leave point at the end of line."
-
-
-
- (or beg-block (setq beg-block "program"))
- (search-forward "end" (line-end-position))
- (catch 'no-match
- (if (and end-block (f90-equal-symbols beg-block end-block))
- (search-forward end-block)
- (if end-block
- (progn
- (message "END %s does not match %s." end-block beg-block)
- (end-of-line)
- (throw 'no-match nil))
- (message "Inserting %s." beg-block)
- (insert (concat " " beg-block))))
- (if (f90-equal-symbols beg-name end-name)
- (and end-name (search-forward end-name))
- (cond ((and beg-name (not end-name))
- (message "Inserting %s." beg-name)
- (insert (concat " " beg-name)))
- ((and beg-name end-name)
- (message "Replacing %s with %s." end-name beg-name)
- (search-forward end-name)
- (replace-match beg-name))
- ((and (not beg-name) end-name)
- (message "Deleting %s." end-name)
- (search-forward end-name)
- (replace-match ""))))
- (or (looking-at "[ \t]*!") (delete-horizontal-space))))
- (defun f90-match-end ()
- "From an end block statement, find the corresponding block and name."
- (interactive)
- (let ((count 1)
- (top-of-window (window-start))
- (end-point (point))
- (case-fold-search t)
- matching-beg beg-name end-name beg-block end-block end-struct)
- (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
- (setq end-struct (f90-looking-at-program-block-end)))
- (setq end-block (car end-struct)
- end-name (cadr end-struct))
- (save-excursion
- (beginning-of-line)
- (while (and (> count 0)
- (not (= (line-beginning-position) (point-min))))
- (re-search-backward f90-blocks-re nil 'move)
- (beginning-of-line)
-
- (skip-chars-forward " \t0-9")
- (cond ((or (f90-in-string) (f90-in-comment)))
- ((setq matching-beg
- (or
- (f90-looking-at-do)
- (f90-looking-at-if-then)
- (f90-looking-at-where-or-forall)
- (f90-looking-at-select-case)
- (f90-looking-at-type-like)
- (f90-looking-at-associate)
- (f90-looking-at-critical)
- (f90-looking-at-program-block-start)
-
-
-
- (if (= (line-beginning-position) (point-min))
- '("program" nil))))
- (setq count (1- count)))
- ((looking-at (concat "end[ \t]*" f90-blocks-re))
- (setq count (1+ count)))))
- (if (> count 0)
- (message "No matching beginning.")
- (f90-update-line)
- (if (eq f90-smart-end 'blink)
- (if (< (point) top-of-window)
- (message "Matches %s: %s"
- (what-line)
- (buffer-substring
- (line-beginning-position)
- (line-end-position)))
- (sit-for blink-matching-delay)))
- (setq beg-block (car matching-beg)
- beg-name (cadr matching-beg))
- (goto-char end-point)
- (beginning-of-line)
- (f90-block-match beg-block beg-name end-block end-name))))))
- (defun f90-insert-end ()
- "Insert a complete end statement matching beginning of present block."
- (interactive "*")
- (let ((f90-smart-end (or f90-smart-end 'blink)))
- (insert "end")
- (f90-indent-new-line)))
- (defun f90-abbrev-start ()
- "Typing `\\[help-command] or `? lists all the F90 abbrevs.
- Any other key combination is executed normally."
- (interactive "*")
- (insert last-command-event)
- (let (char event)
- (if (fboundp 'next-command-event)
- (setq event (next-command-event)
- char (and (fboundp 'event-to-character)
- (event-to-character event)))
- (setq event (read-event)
- char event))
-
- (if (and abbrev-mode (memq char (list ?? help-char)))
- (f90-abbrev-help)
- (setq unread-command-events (list event)))))
- (defun f90-abbrev-help ()
- "List the currently defined abbrevs in F90 mode."
- (interactive)
- (message "Listing abbrev table...")
- (display-buffer (f90-prepare-abbrev-list-buffer))
- (message "Listing abbrev table...done"))
- (defun f90-prepare-abbrev-list-buffer ()
- "Create a buffer listing the F90 mode abbreviations."
- (with-current-buffer (get-buffer-create "*Abbrevs*")
- (erase-buffer)
- (insert-abbrev-table-description 'f90-mode-abbrev-table t)
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (edit-abbrevs-mode))
- (get-buffer-create "*Abbrevs*"))
- (defun f90-upcase-keywords ()
- "Upcase all F90 keywords in the buffer."
- (interactive "*")
- (f90-change-keywords 'upcase-word))
- (defun f90-capitalize-keywords ()
- "Capitalize all F90 keywords in the buffer."
- (interactive "*")
- (f90-change-keywords 'capitalize-word))
- (defun f90-downcase-keywords ()
- "Downcase all F90 keywords in the buffer."
- (interactive "*")
- (f90-change-keywords 'downcase-word))
- (defun f90-upcase-region-keywords (beg end)
- "Upcase all F90 keywords in the region."
- (interactive "*r")
- (f90-change-keywords 'upcase-word beg end))
- (defun f90-capitalize-region-keywords (beg end)
- "Capitalize all F90 keywords in the region."
- (interactive "*r")
- (f90-change-keywords 'capitalize-word beg end))
- (defun f90-downcase-region-keywords (beg end)
- "Downcase all F90 keywords in the region."
- (interactive "*r")
- (f90-change-keywords 'downcase-word beg end))
- (defun f90-change-keywords (change-word &optional beg end)
- "Change the case of F90 keywords in the region (if specified) or buffer.
- CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word."
- (save-excursion
- (setq beg (or beg (point-min))
- end (or end (point-max)))
- (let ((keyword-re
- (concat "\\("
- f90-keywords-re "\\|" f90-procedures-re "\\|"
- f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
- (ref-point (point-min))
- (modified (buffer-modified-p))
- state saveword back-point)
- (goto-char beg)
- (unwind-protect
- (while (re-search-forward keyword-re end t)
- (unless (progn
- (setq state (parse-partial-sexp ref-point (point)))
- (or (nth 3 state) (nth 4 state)
-
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (looking-at "#"))))
- (setq ref-point (point)
- back-point (save-excursion (backward-word 1) (point))
- saveword (buffer-substring back-point ref-point))
- (funcall change-word -1)
- (or (string= saveword (buffer-substring back-point ref-point))
- (setq modified t))))
- (or modified (restore-buffer-modified-p nil))))))
- (defun f90-current-defun ()
- "Function to use for `add-log-current-defun-function' in F90 mode."
- (save-excursion
- (nth 1 (f90-beginning-of-subprogram))))
- (defun f90-backslash-not-special (&optional all)
- "Make the backslash character (\\) be non-special in the current buffer.
- With optional argument ALL, change the default for all present
- and future F90 buffers. F90 mode normally treats backslash as an
- escape character."
- (or (derived-mode-p 'f90-mode)
- (error "This function should only be used in F90 buffers"))
- (when (equal (char-syntax ?\\ ) ?\\ )
- (or all (set-syntax-table (copy-syntax-table (syntax-table))))
- (modify-syntax-entry ?\\ ".")))
- (provide 'f90)
|