;;; ASN.1:1997 mode for GNU Emacs and XEmacs,
;;; Major mode for editing ASN.1:1997 specifications

;;; Copyright (c) 1997-99  France Telecom, Cnet, Lannion
;;; Informations: http://asn1.elibel.tm.fr/fr/outils/emacs/   (francais)
;;;               http://asn1.elibel.tm.fr/en/tools/emacs/    (english)
;;; Authors:      Guillaume LATU, Stephane LEVANT, Olivier DUBUISSON
;;; Contact:      asn1@cnet.francetelecom.fr

(defconst asn1-data-version "2.1")
(defconst asn1-data-diff nil)

;;; Keywords: ASN.1, languages, major mode, protocole specifications

;;; Permission is granted to make and distribute verbatim copies of
;;; this software provided the copyright notice and this permission 
;;; notice are preserved on all copies.
;;;
;;; Permission is granted to copy and distribute modified versions 
;;; of this software under the conditions for verbatim copying, 
;;; provided that the entire resulting derived work is distributed 
;;; under the terms of a permission notice identical to this one.
;;;
;;; Permission is granted to copy and distribute translations of 
;;; this software into another language, under the above conditions 
;;; for modified versions, except that this permission notice may be 
;;; stated in a translation approved by France Télécom.



;;; UTILISATION :
;;; =============
;;;
;;; Le mode ASN.1:1997 devrait fonctionner si vous avez une version
;;; superieure ou egale a 19.28 pour Emacs ou bien une version
;;; superieure ou egale a 19.13 pour XEmacs. La version d'Emacs
;;; s'obtient en tapant, apres avoir lance' Emacs, la touche "ESC" puis
;;; "x" puis en tapant "emacs-version". 
;;; La version d'Emacs recommandee est la 20.3
;;; La version d'XEmacs recommandee est la 20.4
;;;
;;; Pour utiliser le mode ASN.1:1997 placez ces lignes dans votre fichier
;;; de configuration  ".emacs" qui se trouve dans votre repertoire
;;; de base : "~/" : 
;;;
;;;   (setq load-path (append load-path '("<REPERTOIRE DU MODE>")))
;;;   (setq auto-mode-alist
;;;          (cons '("\\.[Aa][Ss][Nn][1]?$" . asn1-mode) auto-mode-alist))
;;;   (autoload 'asn1-mode "asn1-mode.el"
;;;      "Major mode for editing ASN.1 specifications." t)
;;;
;;; En remplacant <REPERTOIRE DU MODE> par le nom du repertoire qui 
;;; contient le fichier `asn1-mode.el' et le fichier `asn1-mode.info'.
;;;
;;; Remarque : Si le fichier ".emacs" n'existe pas, creez-le !
;;; (Ce fichier est charge a chaque lancement de Emacs)
;;;
;;; Emacs doit entrer dans le mode "ASN.1" quand vous chargez une
;;; specification ASN.1 (fichier se terminant par ".asn" .asn1" ".ASN"
;;; ".ASN1").
;;; Quand vous demarrez le mode ASN.1, vous pouvez obtenir plus
;;; d'information sur le mode en tapant C-c C-i. Vous pouvez obtenir la
;;; liste des raccourcis claviers en tapant C-h m.


;;; CONVENTIONS D'ECRITURE :
;;; ========================
;;;
;;;	- les variables et fonctions definies pour le mode ASN.1
;;;	  sont toutes prefixees par "asn1"
;;;	- les variables definies dans le mode sont prefixees
;;;	  par "asn1-data"
;;;	- les fonctions qui concernent la manipulation de menu sont
;;;	  prefixees par "asn1-menu"  

;;; CHANGEMENTS :
;;; =============
;;;
;;; version 1.1 : (auteur : Guillaume LATU - France Telecom/Cnet
;;; -----------    date   : 28 novembre 1997)
;;;
;;;   - le mot-cle COMPONENTS OF apparait bien en couleur,
;;;   - le fichier TUTORIAL a subi de legeres corrections,
;;;   - la mise en couleur du sous-typage est amelioree,
;;;   - l'indentation de WITH SYNTAX en debut de ligne est parametrable,
;;;   - la syntaxe conviviale apres WITH SYNTAX peut etre coloriee
;;;
;;; version 1.2 : (auteur : Olivier DUBUISSON - France Telecom/Cnet
;;; -----------    date   : 05 mai 1998)
;;;                
;;;                
;;;
;;;   - les meta-variables de grammaire ASN.1 qui etaient entre angles 
;;;     "--<ProductionGrammaticale>--" seront desormais entre parentheses
;;;     "--(ProductionGrammaticale)--" puisque les commentaires debutant par
;;;     "--<" sont des directives pour certains compilateurs
;;;   - un WORD ne peut pas etre un mot reserve des productions
;;;     RestrictedCharacterStringType ou UsefulType
;;;   - ajout du type UTF8String (ASN.1:1997)
;;;
;;; version 1.3 : (auteur : Guillaume LATU - ENSERB Bordeaux
;;; -----------    date   : 20 juillet 1998)
;;;
;;;   - le menu ASN.1 n'apparaissait pas lorsqu'un second buffer ".asn*"
;;;     etait ouvert
;;;
;;; version 1.4 : (auteur : Olivier DUBUISSON - France Telecom/Cnet
;;; -----------    date   : 06 mai 1999)
;;;
;;;   - la production "ObjectSetFieldSpec" peut etre developpee
;;;   - les deux alternatives de la production "ObjectDefn" et les deux
;;;     alternatives de la production "DefinedObject" sont integrees
;;;     dans la production "Object" pour faciliter sa comprehension
;;;
;;; version 2.0 : (auteur : Stephane LEVANT - France Telecom/Cnet
;;; ------------   date   : 26 juillet 1999)
;;;
;;;   Grammaire :
;;;   - correction de OIDCOmponent1 -> OIDComponents1
;;;   - remplacement de OIDComponent par OIDComponents conformement a
;;;     ISO 8824-1 Amd.1:1999
;;;   - prise en compte du nouveau type RELATIVE-OID (ISO 8824-1 Amd.1:1999)
;;;   - suppression de l'alternative "...,ElementSetSpec" dans ElementSetSpecs
;;;     (ISO 8824-1 Cor.1:1999)
;;;
;;;   Ameliorations :
;;;   - passage a emacs 20 : utilisation de la bibliotheque custom
;;;   - rajout de quelques eval-when-compile
;;;   - compilation (raccourci clavier, couleur, numero de colonne)
;;;   - couleur pour emacs 20.3
;;;   - affichage d'une page de presentation
;;;   - correction du bogue d'affichage du menu syntaxique : celui-ci apparait
;;;     dans tous les buffers ASN.1
;;;   - decoupage de modeasn1.el en deux modules :
;;;      * un module qui definit un mode standard emacs
;;;      * un module avec les menus syntaxiques
;;;   - declaration uniquement locale de completion-ignore-case
;;;   - completion sans passer par le minibuffer
;;;   - correction du bug "Invalid syntax designator ?\t" de l'indentation
;;;   - correction du bug "Wrong type argument: number-or-marker-p, nil"
;;;     de l'indentation
;;;   - suppression de la possibilite de faire un undo apres le chargement
;;;     du mode (region highlight)
;;;   - pas de modification de la 'modeline'
;;;   - compilation correcte :
;;;     pas de chargement de compile.el au demarrage
;;;     pas de modification globale des variables de compilation.
;;;   - rajout d'un "*" au debut de la documentation des variables utilisateurs
;;;   - suppression du bug "mark-inactive"
;;;   - bouton-2 de la souris pour activer les popup menus
;;;     (au lieu de bouton-3). Option pour choisir le bouton de la souris
;;;   - changement de quelques raccourcis clavier et des menus
;;;   - choix du langage anglais/francais
;;;
;;; version 2.1 : (auteur : Olivier DUBUISSON - France Telecom/Cnet
;;; -----------    date   : 10 novembre 1999)
;;;
;;;   - correction de FiedSetting -> FieldSetting

;;; CODE :
;;; ======

;;; for changing langage
(eval-and-compile
  (if (not (boundp 'asn1-language))
      (setq asn1-language (if (equal (getenv "LANG") "fr") 'fr 'en)))

  (defun asn1-lg (fr en)
    (if (eq asn1-language 'fr)
	fr
      en))
  )

; (defmacro defun-lg (fct args docan docfr &rest body)
;   "Like defun but with two doc string : one english and one french"
;   `(defun ,fct ,args ,(asn1-lg docfr docan) ,@body))

; (defmacro defvar-lg (var value docan docfr)
;   "Like defvar but with two doc string : one english and one french"
;   `(defun ,var ,value ,(asn1-lg docfr docan)))

; (defmacro defcustom-lg (var value docan docfr &rest args)
;   "Like defcustom but with two doc string : one english and one french"
;   `(defun ,var ,value ,(asn1-lg docfr docan) ,@args))


;;;---------------------------------------------------------------------
;;;			Custom groups
;;;---------------------------------------------------------------------

(defgroup asn1 nil
  (asn1-lg
      "Mode pour l'edition des specifications ASN.1:1997"
    "Mode for editing ASN.1:1997 specifications")
  :prefix "asn1-"
  :group 'languages)

(defgroup asn1-options nil
  (asn1-lg
      "Les principales options du mode ASN.1"
    "The ASN.1 mode options")
  :prefix "asn1-"
  :group 'asn1)

(defgroup asn1-indentation nil
  (asn1-lg
      "Modifie l'indentation effectuee par le mode ASN.1"
    "Modify the indentation of asn1 mode")
  :prefix "asn1-data-"
  :group 'asn1)

(defgroup asn1-face nil
  (asn1-lg
      "Couleurs et styles d'ecriture du mode ASN.1.
Modifier la valeur de `asn1-use-standard-custom' pour utiliser ce groupe."
    "Color and faces of ASN.1 mode
Modify the value of `asn1-use-standard-custom' for using this group.")
  :prefix "asn1-"
  :group 'asn1)

(defcustom asn1-language 'en
  (asn1-lg
      "*Specifie le langage utilise pour les menus et les messages.
Deux langages sont disponibles :
'fr : francais
'en : anglais
Une modification de cette variable ne prendra reellement effet
qu'apres avoir relance emacs."
    "*Specify the language used for menus and messages.
Two languages are available :
'fr : french
'en : english
Modify this variable take effect only after restart emacs.")
  :type '(choice (const :tag "francais" fr)
		 (const :tag "english" en))
  :group 'asn1-options)

(defcustom asn1-mode-presentation t
  (asn1-lg
    "*N'affiche pas la page de presentation au debut si nil."
      "*Don't show a presentation page at startup if nil.")
  :type 'boolean
  :group 'asn1-options)

(defun asn1-presentation ()
  (cond (asn1-mode-presentation
	 (let ((b (get-buffer-create "*ASN.1:1997*"))
	       (svg (current-buffer))
	       (c (current-window-configuration)))
	   (delete-other-windows)
	   (switch-to-buffer b)
	   (setq buffer-read-only nil)
	   (erase-buffer)
	   (insert (format "
----------------------------------------------------------------------------
   _/_/_/_/              ====> ASN.1:1997 Mode Emacs <====
  _/_/_/_/
 _/_/_/_/    (c) France Telecom - Cnet - LAN/DTL/MSV     [version %s]
----------------------------------------------------------------------------

 ASN.1:1997 mode for GNU Emacs and XEmacs,
 Major mode for editing%sASN.1:1997 specifications.

 Informations: http://asn1.elibel.tm.fr/fr/outils/emacs   (francais)
               http://asn1.elibel.tm.fr/en/tools/emacs    (english)
 Authors:      Guillaume LATU, Stephane LEVANT, Olivier DUBUISSON
 Contact:      asn1@cnet.francetelecom.fr

 Permission is granted to make and distribute verbatim copies of
 this software provided the copyright notice and this permission 
 notice are preserved on all copies.

 Permission is granted to copy and distribute modified versions 
 of this software under the conditions for verbatim copying, 
 provided that the entire resulting derived work is distributed 
 under the terms of a permission notice identical to this one.

 Permission is granted to copy and distribute translations of 
 this software into another language, under the above conditions 
 for modified versions, except that this permission notice may be 
 stated in a translation approved by France Télécom.

" asn1-data-version (if asn1-data-diff " and comparing " " ")))
	   (goto-char (point-min))
	   (set-buffer-modified-p nil)
	   (setq buffer-read-only t)
	   (sit-for 0)
	   (switch-to-buffer svg)
	   (set-window-configuration c)))))

(if (not noninteractive)
    (asn1-presentation))

;; Ce module est compatible emacs et XEmacs. On utilise easymenu qui
;; est un module permettant de gerer l'affichage des menus de la barre
;; des menus sous Emacs et XEmacs.
;; pour ajouter un menu sous emacs : easy-menu-define 1 fois
;;                                   (modifie `current-local-map')
;; pour ajouter un menu sous xemacs : easy-menu-add
;; pour supprimer un menu sous emacs : changer la `current-local-map'
;; pour supprimer un menu sous xemacs : easy-menu-remove
(require 'easymenu)

;; ASN.1 Syntax
(autoload 'asn1-load-syntax-menu "asn1-syntax")

(if (not (fboundp 'customize-save-variable)) ; compatibility emacs 19
    (autoload 'customize-save-variable "cus-edit"))

(cond (asn1-data-diff
       (autoload 'asn1-diff-add-menu "asn1-diff" "" t)
       (autoload 'asn1-diff "asn1-diff" "" t)))

(autoload 'asn1-conf-face "asn1-conf")

(defvar asn1-win
  (not (or (not window-system) (eq window-system 'x))))


;;;---------------------------------------------------------------------
;;;		Variables modifiables par l'utilisateur
;;;---------------------------------------------------------------------

;;; Compilation

(defcustom asn1-compile-command
  (if (and asn1-win load-file-name)
      (if (string-match "\\(.*\\)emacs-[.0-9]+/site-lisp/asn1-mode"
			load-file-name)
	  (concat (match-string 1 load-file-name) "asnp/asnp")
	"asnp")
    "asnp")
  (asn1-lg
   "*Commande lancee lors de la compilation
Pour asnp, il est impératif de donner le chemin complet."
   "*Command to use when compiling
For asnp, you must give the complete path.")
  :type 'string
  :group 'asn1-options)

(defcustom asn1-compile-switches
  (asn1-lg "-fr" "")
  (asn1-lg
   "*Parametres de la commande de compilation."
   "*Options to pass to the compile command.")
  :type 'string
  :group 'asn1-options)

;;; Indentation

(defcustom asn1-data-bracket-indent-text		2
  (asn1-lg
   "*Indique l'indentation utilisee a l'interieur des blocs delimites
par ( ) ou [ ] ou { }."
   "*Indentation used in the blocs (), [] and {}.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-DEFINITIONS		0
  (asn1-lg
   "*Indentation du mot-cle DEFINITIONS par rapport a la marge gauche."
   "*Indentation of the keyword DEFINITIONS compared to the left stroke.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-in-DEFINITION-bloc	0
  (asn1-lg
   "*Indentation de l'entete du module apres le mot-cle DEFINITIONS"
   "*Indentation in a bloc beginning by DEFINITIONS.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-BEGIN		0
  (asn1-lg
   "*Indentation du mot-cle BEGIN par rapport au mot-cle DEFINITIONS qui
precede."
   "*Indentation of the keyword BEGIN compared to the keyword DEFINITIONS
which precedes.")
  :type 'integer
  :group 'asn1-indentation) 

(defcustom asn1-data-indent-in-BEGIN-bloc		0
  (asn1-lg
   "*Indentation des definitions dans le corps d'un module."
   "*Indentation in a bloc beginning by BEGIN.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-END			0
  (asn1-lg
   "*Indentation du mot-cle END par rapport au mot-cle BEGIN qui
precede."
   "*Indentation of keyword END compared to the keyword BEGIN
which precedes.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-IMPORTS		0
  (asn1-lg
   "*Indentation du mot-cle IMPORTS par rapport au mot-cle BEGIN qui
precede."
   "*Indentation of keyword IMPORTS compared to the keyword BEGIN which
precedes.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-in-IMPORTS-bloc	3
  (asn1-lg
   "*Indentation dans un bloc qui commence par IMPORTS."
   "*Indentation in a bloc beginning by IMPORTS.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-EXPORTS		0
  (asn1-lg
   "*Indentation du mot-cle EXPORTS par rapport au mot-cle BEGIN qui
precede." 
   "*Indentation of keyword EXPORTS compared to the keyword BEGIN which
precedes.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-in-EXPORTS-bloc	3
  (asn1-lg
   "*Indentation dans un bloc qui commence par EXPORTS."
   "*Indentation in a bloc beginning by EXPORTS.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-FROM		4
  (asn1-lg
   "*Indentation du mot-cle FROM par rapport au mot-cle 
IMPORTS qui precede."
   "*Indentation of keyword FROM compared to the keyword IMPORTS which
precedes.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-\;			3
  (asn1-lg
   "*Indentation du symbole ; par rapport au mot-cle EXPORTS ou
IMPORTS qui precede."
   "*Indentation of symbol ; compared to the keyword EXPORTS or IMPORTS
which precedes.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-\{			1
  (asn1-lg
   "*Indentation du symbole { par rapport a l'indentation de la ligne
precedente."
   "*Indentation of symbol { compared to the precedent line indentation.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-\(			1
  (asn1-lg
   "*Indentation du symbole ( par rapport a l'indentation de la ligne
precedente."
   "*Indentation of symbol ( compared to the precedent line indentation.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-\[			1
  (asn1-lg
   "*Indentation du symbole [ par rapport a l'indentation de la ligne
precedente."
   "*Indentation of symbol [ compared to the precedent line indentation.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-of-::=			0
  (asn1-lg
   "*Indentation du symbole ::= par rapport a l'indentation de la ligne
precedente."
   "*Indentation of symbol ::= compared to the precedent line indentation.")
  :type 'integer
  :group 'asn1-indentation)

(defcustom asn1-data-indent-WITH-SYNTAX		nil
  (asn1-lg
   "*Si t, WITH SYNTAX est aligne avec CLASS,
sinon WITH SYNTAX n'est pas indente."
   "*If t, WITH SYMBOL is align with CLASS
otherwise, WITH SYNTAX is not indented.")
  :type 'boolean
  :group 'asn1-indentation)

;;; menus

(defcustom asn1-syntax-menu-autoload
  nil
  (asn1-lg
   "*t si le menu de syntaxe \"ASN.1-Syntax\" doit se charger
automatiquement au lancement du mode Emacs."
   "*If t, the \"ASN.1-Syntax\" menu is loaded at startup.")
  :type 'boolean
  :group 'asn1-options)

(defcustom asn1-mice-button
  (if asn1-win 3 2)
  (asn1-lg
   "*Bouton de la souris à utiliser au lieu du bouton 2."
   "*Mice button used to replace the button 2.")
  :type '(choice (item 1)
		 (item 2)
		 (item 3))
  :group 'asn1-options)

;;; Color

(defcustom asn1-use-standard-custom nil
  (asn1-lg
      "*Si t, la personnalisation des couleurs et des styles d'ecriture
se fait en utilisant un buffer \"customize\".
Une modification de cette variable ne prendra reellement effet
qu'apres avoir relance emacs."
    "*If t, the customization colors/faces will made with a standard
customize buffer.
Modify this variable take effect only after restart emacs.")
  :type 'boolean
  :group 'asn1-options)

(eval-and-compile
(defconst asn1-data-faces-default
  `((asn1-skeleton-face		"blue"		nil nil t	nil	nil
	,(asn1-lg "Mots-cles participant a la structure d'un module"
	   "module skeleton"))
    (asn1-type-face		"cadetblue"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles designant des types" "basic types"))
    (asn1-structured-type-face	"darkgoldenrod"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles concernant les types structures"
	   "structured types"))
    (asn1-option-face		"grey40"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles OPTIONAL/DEFAULT" "OPTIONAL/DEFAULT"))
    (asn1-subtyping-face	"forestgreen"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles ayant trait au sous-typage"
	   "subtyping keywords"))
    (asn1-exps-face		"forestgreen"	nil nil t	nil	nil
	,(asn1-lg "Expressions de sous-typage" "subtyping exps"))
    (asn1-tag-face		"grey40"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles et expressions concernant les tags" "tags"))
    (asn1-values-face		"MediumAquamarine" nil nil t	nil	nil
	,(asn1-lg "Mots-cles designant des valeurs" "values"))
;     (font-lock-string-face	"grey40"	nil nil nil	nil	nil
; 	,(asn1-lg "Chaines de caracteres" "Strings"))
    (asn1-class-face		"medium purple"	nil nil t	nil	nil
	,(asn1-lg "Mots-cles concernant les classes d'objets informationnels"
	  "class keywords"))
    (asn1-with-syntax-face	"firebrick"	nil nil nil	nil	nil
	,(asn1-lg "Expression qui suit le WITH SYNTAX entre accolades"
	   "with syntax"))
;     (font-lock-comment-face	"firebrick"	nil nil nil	t	nil
; 	,(asn1-lg "Commentaires" "Comments"))
    )
  "List of faces ASN.1 use by default.
The format of an element of this list is the same than for the function
`modify-face' of emacs 20.3 (except for the DOC) :
FACE FOREGROUND BACKGROUND STIPPLE BOLD ITALIC UNDERLINE DOC

See also `asn1-data-faces' and `asn1-modify-face'."))

(defun asn1-copy-list (list1)
  "Recopie une liste et ceci recursivement sur tous ses 
elements. Ainsi, si la liste initiale est modifiee avec un setcar 
ou un setcdr, la copie n'est pas modifiee."
  (if (atom list1)
      list1
    (mapcar
     'asn1-copy-list
     list1)))

(defvar asn1-data-faces (asn1-copy-list asn1-data-faces-default)
  "The faces used by ASN.1.
See `asn1-data-faces-default'
This list can be incomplete (i.e. not definning all ASN.1 mode faces)")


;;;---------------------------------------------------------------------
;;;		Variables used by ASN.1 mode
;;;---------------------------------------------------------------------

(defvar asn1-tag-file "*.asn")

(defvar asn1-data-dir (if load-file-name
			  (file-name-directory load-file-name)
			""))

(defvar asn1-data-syntax-menu-loaded
  nil
  "t si le menu de syntaxe est present dans la barre des menus, nil si
le menu de syntaxe est absent.")

(defvar asn1-data-diff-menu-p nil
  "Local variable. t if diff menu is present")

(defvar asn1-mode-hook nil
  "Hook run after loading asn1-mode")

(defvar asn1-data-font-lock-keywords nil
  "Liste des mots cles effectivement utilises pour la coloration
 (Voir `font-lock-keywords')")

(defvar asn1-compile-precedent-command nil)

(defvar asn1-compile-line nil)

(defvar asn1-data-mode-map
  (let ((map (make-keymap)))
    (define-key map "\C-c\C-r"  'indent-region)
    (define-key map "\C-c\C-b"  'indent-buffer)
    (if asn1-data-diff
	(define-key map "\C-c\C-d"  'asn1-diff))
    (define-key map "\M-i"	'tab-to-tab-stop)
    (define-key map "\M-;"	'indent-for-comment)
    (define-key map "\^j"	'newline)
    (define-key map "\r"	'reindent-then-newline-and-indent)
    (define-key map "\M-\t"     'asn1-completion)
    (define-key map "\C-c\C-f"  'asn1-create-tag-file)
    (define-key map "\C-c\C-t"  'asn1-tutorial)
    (define-key map "\C-c\C-i"  'asn1-info)
    (define-key map "\C-c\C-h"  'asn1-info)
    (define-key map "\C-c\C-y"  'asn1-load-syntax-menu)
    (define-key map "\C-c\C-c"  'asn1-compile)
    (define-key map "\C-c\C-p"  'asn1-set-compile-command)
    (define-key map "\C-c\C-o"  'asn1-set-compile-switches)
    map)
  "Table des raccourcis clavier utilises dans le
 mode ASN.1.")

(defvar asn1-data-menu nil
  "Le menu du mode ASN.1")

(setq asn1-data-menu
  (append
   (list
   "ASN.1"
   ;; le format d'un item de menu :
   ;; [<nom de l'item>   <fonction a appeler>  <activite de l'item>]
   ;;   chaine de car		fonction		t ou nil
   (vector (asn1-lg "Indenter la Ligne" "Indent Line")
	   'indent-for-tab-command t)
   (vector (asn1-lg "Indenter la Region" "Indent Region")
	   'indent-region '(asn1-mark))	
   (vector (asn1-lg "Indenter Tout" "Indent Buffer")
	   'indent-buffer t)
   (vector (asn1-lg "Indenter un Commentaire" "Indent Comment")
	   'indent-for-comment t)
   (vector (asn1-lg "Inserer une Tabulation" "Tab-to-tab-stop")
	   'tab-to-tab-stop t)
   ["-" (lambda nil nil) nil]

   (vector (asn1-lg "Completion des Mots Cles" "Keywords Completion")
	   'asn1-completion t)
   (vector (asn1-lg "Completion des References" "References Completion")
	   'dabbrev-expand t)
   (list
    (asn1-lg "References" "References")
    (vector (asn1-lg "Creer le Fichier de References..."
		     "Create the References File...")
	    'asn1-create-tag-file t)
    (vector (asn1-lg "Trouver une Definition..." "Find Definition...")
	    'find-tag t)
    (vector (asn1-lg "Chercher une reference..." "Search reference...")
	    'tags-search t)
    (vector (asn1-lg "Chercher et remplacer..." "Search and replace...")
	    'tags-query-replace t)
    (vector (asn1-lg "Continuer la Recherche" "Repeat Search")
	    'tags-loop-continue t)
    (vector (asn1-lg "Aller au Module Precedent"
		     "Goto Previous Module")
	    'backward-page t)
    (vector (asn1-lg "Aller au Module Suivant"
		     "Goto Next Module")
	    'forward-page t)
    (vector (asn1-lg "Aller a la Definition Precedente"
		     "Goto Previous Definition")
	    'backward-paragraph t)
    (vector (asn1-lg "Aller a la Definition Suivante"
		     "Goto Next Definition")
	    'forward-paragraph t))
   ["--" 'ignore nil]

   (vector (asn1-lg "Compiler..." "Compile...")
	   'asn1-compile t)
   )

   (if asn1-data-diff
       (list
	(vector (asn1-lg "Comparer Deux Specifications..."
		  "Compare Specifications...")
		'asn1-diff t)
	(vector (asn1-lg "Afficher le Buffer Diff"
		  "Switch to Diff Buffer")
		'asn1-goto-diff-buffer '(and (featurep 'asn1-diff)
					     (buffer-live-p
					      asn1-diff-buffer))))
     '())
   
   (list
    ["---" (lambda nil nil) nil]
   
   (vector (asn1-lg "Construire le Menu Syntaxique"
	     "Build Syntax Menu")
	   'asn1-load-syntax-menu '(not asn1-data-syntax-menu-loaded))
   (vector (asn1-lg "Couleurs On/Off" "Turn On/Off Colors")
 	   'font-lock-mode t)

   (list
    (asn1-lg "Personnalisation Rapide" "Fast Customization")
    (list
     (asn1-lg "Langage" "Language")
     (vector (asn1-lg "Francais" "French")
	     '(asn1-change-language 'fr) t)
     (vector (asn1-lg "Anglais" "English")	      
	     '(asn1-change-language 'an) t)
      ["----" (lambda nil nil) nil]
     (vector (asn1-lg "Enregistrer" "Save")
	     '(customize-save-variable 'asn1-language asn1-language) t))
    (if asn1-data-diff
	(vector (asn1-lg "Afficher le Menu de Comparaison"
		  "Show Diff Menu")
		'(progn
		   (require 'asn1-diff)
		   (use-local-map asn1-diff-mode-asn1-map)
		   (asn1-menu-add-menu (current-local-map))
		   (asn1-diff-add-menu (current-local-map))
		   (redraw-display))
		'(not asn1-data-diff-menu-p))
      ["-----" (lambda nil nil) nil])
    (if asn1-data-diff
	(vector (asn1-lg "Cacher le Menu de Comparaison"
		  "Hide Diff Menu")
		'(progn
		   (use-local-map asn1-data-mode-map)
		   (easy-menu-remove asn1-diff-menu)
		   (setq asn1-data-diff-menu-p nil)
		   (redraw-display))
		'asn1-data-diff-menu-p)
      ["------" (lambda nil nil) nil])
    (vector (asn1-lg "Menu Syntaxique au Demarrage"
	      "Build Syntax Menu at Startup")
	    '(customize-save-variable 'asn1-syntax-menu-autoload t)
	    '(not asn1-syntax-menu-autoload))
    (vector (asn1-lg "Pas de Menu Syntaxique au Demarrage"
	      "Don't Build Syntax Menu at Startup")
	    '(customize-save-variable 'asn1-syntax-menu-autoload nil)
	    'asn1-syntax-menu-autoload)
    (vector (asn1-lg "Commande de Compilation"
	      "Compile Command")
	    'asn1-set-compile-command t)
    (vector (asn1-lg "Parametres de Compilation" "Compile Switches")
	    'asn1-set-compile-switches t)
    (vector (asn1-lg
		"Sauvegarder les Informations de Compilation"
		"Save Compilation Informations")
	    '(progn
	       (customize-save-variable 'asn1-compile-command
					asn1-compile-command)
	       (customize-save-variable 'asn1-compile-switches
					asn1-compile-switches)) t))
   (list
    (asn1-lg "Personnalisation" "Customization")
    (vector (asn1-lg "Styles d'Ecriture et Couleurs..."
	      "Colors/Faces...")
	    'asn1-custom-face t)
    (vector (asn1-lg "Options Generales..."
	      "General Options...")
	    'asn1-custom-options t)
    (vector (asn1-lg "Indentation..." "Indentation...")
	    'asn1-custom-indentation t))
    ["-------" (lambda nil nil) nil]
    (vector (asn1-lg "Tutorial Emacs"
		     "Emacs Tutorial") 'asn1-tutorial t)
    (vector (asn1-lg "Aide" "Help") 'asn1-info t)
    ))
  )


(defvar asn1-data-mode-syntax-table
  (eval-when-compile
  (let ((table (make-syntax-table)))
    ;; remplissage de la table :
    ;;   1) consulter la documentation "Emacs lisp" avant de modifier la
    ;;      table 
    ;;   2) ne pas oublier de mettre exactement deux caracteres avant la
    ;;      suite de chiffres 1234 indiquant les debuts (12) et fin de
    ;;      commentaires (34). Si cela n'est pas fait, les commentaires
    ;;      peuvent ne pas etre detectes.
    (modify-syntax-entry ?-  "ww1234" table)
    (modify-syntax-entry ?\n ">b"     table)
    (modify-syntax-entry ?\t " "      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)
    table)
  )
  "Table des caracteres et de leur signification dans le
 mode ASN.1.")


;;;---------------------------------------------------------------------
;;;			     Font Lock
;;;---------------------------------------------------------------------

;; Le module `font-lock', afin de pouvoir mettre en valeur, a besoin
;; qu'on lui fournisse une liste d'elements. Ces Elements sont de la
;; forme : (REGEXP FACE NB)
;;   REGEXP :
;;      <expression reguliere a mettre en valeur>
;;   FACE :
;;      <style d'ecriture utilisee pour cette mise en valeur>
;;   NB :
;;      <numero de la sous-expression de REGEXP a mettre
;;      rellement en valeur> 
;; Cette liste d'elements devra etre mis dans la variable
;; font-lock-keywords.

;; On definit dans les variables asn1-data-keywords-* des elements
;; dans le format exige par font-lock (voir la documentation associee
;; a la variable font-lock-keywords (C-h v font-lock-keywords)).

(eval-and-compile
(defconst asn1-data-keywords-skeleton
  (eval-when-compile
  (list 
   (concat "\\b\\(BEGIN\\|DEFINITIONS\\|END\\|EXPORTS\\|"
	   "EXTENSIBILITY\\s +IMPLIED\\|FROM\\|IMPORTS\\)\\b")
   1
   'asn1-skeleton-face))
  "Mots-cles a mettre en valeur, participant a la structure d'un
module ASN.1")

(defconst asn1-data-keywords-class 
  (eval-when-compile
  (list 
   (concat "\\b\\(ABSTRACT-SYNTAX\\|CLASS\\|CONSTRAINED\\s +BY\\|"
	   "INSTANCE\\(\\s +OF\\)?\\|TYPE-IDENTIFIER\\|WITH\\s +SYNTAX\\|"
	   "UNIQUE\\)\\b")
   1
   'asn1-class-face))
  "Mots-cles a mettre en valeur, qui concernent les classes d'objet
d'information.")

(defconst asn1-data-keywords-tag
  (eval-when-compile
  (list 
   (concat "\\(\\[\\s *\\(APPLICATION\\|UNIVERSAL\\|"
	   "PRIVATE\\|\\)\\s *[0-9]*\\s *\\]\\)")
   1
    'asn1-tag-face))
  "Expressions a mettre en valeur, qui concernent les tags. ")

(defconst asn1-data-keywords-ie-tag
  (eval-when-compile
  (list
   "\\b\\(AUTOMATIC\\|EXPLICIT\\|IMPLICIT\\|TAGS\\)\\b"
   1
   'asn1-tag-face))
  "Mots-cles a mettre en valeur, qui concernent les tags. ")

(defconst asn1-data-keywords-option
  (eval-when-compile
  (list 
   "\\b\\(DEFAULT\\|OPTIONAL\\)\\b"
   1
   'asn1-option-face))
  "Mots-cles a mettre en valeur : DEFAULT et OPTIONAL.")

;; Le mot cle OPTIONAL est present dans la classe precedente et dans
;; celle-ci. La priorite definie dans asn1-data-keywords-sets definira
;; quel style d'ecriture sera finalement utilise.
(defconst asn1-data-keywords-subtyping1
  (eval-when-compile
  (list 
   (concat "\\b\\(ALL\\|PRESENT\\|ABSENT\\|OPTIONAL\\|EXCEPT\\|"
	   "COMPONENTS\\(\\s +OF\\)?\\|EXCEPT\\|INCLUDES\\|INTERSECTION\\|"
	   "MAX\\|MIN\\|SIZE\\|UNION\\|WITH\\s +COMPONENTS?\\)\\b")
   1
   'asn1-subtyping-face))
  "Mots-cles a mettre en valeur, ayant trait au sous-typage")

(defconst asn1-data-keywords-subtyping2
  (eval-when-compile
  (list 
   "[(]\\s *\\(FROM\\)\\b"
   1
   'asn1-subtyping-face))
  "Mots-cles a mettre en valeur, ayant trait au sous-typage")

(defconst asn1-data-keywords-exps
  (eval-when-compile
  (list
    (concat
    "\\b[A-Z]\\w*\\([.]\\([A-Z]\\|&\\)\\w*\\)*\\s *"
    "\\([{][^}{]*"
    "\\([{][^}{]*"
    "[}][^}{]*\\)*"   
    "[}]\\s *\\)?"
    "\\("
    "\\([(][^)(]*"
    "\\([(][^)(]*"
    "\\([(][^)(]*"
    "\\([(][^)(]*"
    "[)][^)(]*\\)*"    
    "[)][^)(]*\\)*"
    "[)][^)(]*\\)*"
    "[)]"
    "\\(\\s \\|[\n]\\)*"
    "\\)+"
    "\\)")
    5
    'asn1-exps-face))
  "Expressions de sous-typage a mettre en valeur")

(defconst asn1-data-keywords-structured-type
  (eval-when-compile
  (list 
   "\\b\\(\\(CHOICE\\|SEQUENCE\\|SET\\)\\(\\s +OF\\)?\\)\\b"
   1
   'asn1-structured-type-face))
  "Mots-cles CHOICE, SEQUENCE, SET a mettre en valeur.")

(defconst asn1-data-keywords-values
  (eval-when-compile
  (list
   "\\b\\(FALSE\\|MINUS-INFINITY\\|PLUS-INFINITY\\|NULL\\|TRUE\\)\\b"
   1
   'asn1-values-face))
  "Mots-cles designant des valeurs ASN.1 a mettre en valeur.")

(defconst asn1-data-keywords-type
  (eval-when-compile
  (list
   (concat
    "\\b\\(BIT\\s +STRING\\|BMPString\\|BOOLEAN\\|CHARACTER\\s +STRING\\|" 
    "EMBEDDED\\|PDV\\|ENUMERATED\\|EXTERNAL\\|GeneralizedTime\\|"
    "GeneralString\\|GraphicString\\|IA5String\\|INTEGER\\|ISO646String\\|"
    "NumericString\\|ObjectDescriptor\\|OBJECT\\s +IDENTIFIER\\|"
    "OCTET\\s +STRING\\|PrintableString\\|T61String\\|TeletexString\\|" 
    "REAL\\|RELATIVE-OID\\|UniversalString\\|UTCTime\\|UTF8String\\|"
    "VideotexString\\|VisibleString\\|NULL\\)\\b")
   1
   'asn1-type-face))
  "Mots-cles designant des types ASN.1 a mettre en valeur.")

(defconst asn1-data-keywords-with-syntax
  (eval-when-compile
  (list
   "\\b\\(WITH\\s +SYNTAX[ \t\n\r]*[{]\\)\\([^{}:=;]*\\)[}]"
   2
   'asn1-with-syntax-face))
  "Expression qui suit le WITH SYNTAX entre les accolades.")
)

(defconst asn1-data-keywords-sets
  (eval-when-compile
  (list
   asn1-data-keywords-with-syntax
   asn1-data-keywords-skeleton
   asn1-data-keywords-option
   asn1-data-keywords-values
   asn1-data-keywords-class
   asn1-data-keywords-type
   asn1-data-keywords-structured-type
   asn1-data-keywords-exps
   asn1-data-keywords-subtyping1
   asn1-data-keywords-subtyping2
   asn1-data-keywords-ie-tag
   asn1-data-keywords-tag))
  "Liste des expressions a mettre en valeur avec le module
`font-lock'.
Ordre de priorite de la mise en valeur : du moins prioritaire en haut,
au plus prioritaire en bas. On a par exemple \"exps\" qui prevaut sur
\"subtyping\".")


;;;---------------------------------------------------------------------
;;;			Compatibility Emacs / XEmacs
;;;---------------------------------------------------------------------

(defvar asn1-data-xemacs-p
  (string-match "XEmacs\\|Lucid"  emacs-version)
  "t si l'editeur est XEmacs ou Lucid Emacs, 
nil sinon.") 

;; 'buffer-substring-without-properties dans les nouvelles
;; versions d'Emacs (> 19.30) est equivalent a 'buffer-substring 
;; dans les version d'Emacs plus anciennes ainsi que dans XEmacs.
(cond
 ((fboundp 'buffer-substring-no-properties)
  (defalias 'asn1-substring
    'buffer-substring-no-properties))
 ((fboundp 'buffer-substring-without-properties)
  (defalias 'asn1-substring
    'buffer-substring-without-properties))
 (t
  (defalias 'asn1-substring 'buffer-substring)))

;;; Overlays
(cond (asn1-data-xemacs-p
       ;; faster than (require 'overlay)
       ;; in emacs, there is no overlay-live-p function
       ;; and in xemacs, modify a delete overlay produce
       ;; an error. The solution choosed is to add a
       ;; `condition-case' at each time
       ;; a best choice is to do a function extent-live-p
       ;; who return always t in emacs
       (defalias 'delete-overlay 'delete-extent)
       (defalias 'make-overlay 'make-extent)
       (defalias 'overlay-put 'set-extent-property)
       (defalias 'overlay-get 'extent-property)
       (defalias 'overlay-buffer 'extent-object)
       (defalias 'overlay-start 'extent-start-position)
       (defun asn1-overlay-at (pos)
	 (extent-at pos (current-buffer) 'asn1)))
      (t
       (defun asn1-overlay-at (pos)
	 (asn1-overlay-at-aux (overlays-at pos)))
       (defun asn1-overlay-at-aux (l)
	 (if (null l)
	     nil
	   (if (overlay-get (car l) 'asn1)
	       (car l)
	     (cdr l))))))

(defun asn1-mark ()
  "return nil if there is not active mark"
  (condition-case ()
      (mark)
    (error nil)))

;; for XEmacs :
;; copy-keymap does a bug :
;; the menus don't show the key for commands
(defun asn1-copy-keymap (map-to-copy)
  (if asn1-data-xemacs-p
      (let ((map (make-sparse-keymap)))
	(map-keymap (lambda (key description)
		      (define-key map key (lookup-key map-to-copy key)))
		    map-to-copy)
	map)
    (copy-keymap map-to-copy)))

(defun asn1-menu-add-menu (map)
  "Ajoute le menu \"ASN.1\" contenu dans la variable asn1-data-menu
dans la barre des menus (menubar en anglais)."
  (if asn1-data-xemacs-p
      (easy-menu-add asn1-data-menu map)
    (easy-menu-define asn1-mode-menu map
 		      "Menu keymap for ASN.1 mode." asn1-data-menu)))


;;;---------------------------------------------------------------------
;;;			Le Mode ASN.1
;;;---------------------------------------------------------------------

;;;###autoload
(defun asn1-mode ()
  "
Major mode for editing ASN.1:1997 specifications

\\{asn1-data-mode-map}

The hook `asn1-mode-hook' is evaluated after loading the asn1-mode

Some informations about this mode are availabale in the file
`asn1-mode.ps' or by typing `M-x asn1-info'."
  (interactive)

  ;; Compatibility with old versions of asn1-mode
  (asn1-convert)

  (kill-all-local-variables)
  (use-local-map asn1-data-mode-map)
  (set-syntax-table asn1-data-mode-syntax-table)
  (setq mode-name "ASN.1")
  (setq major-mode 'asn1-mode)
  
  ;; definition et affectation des variables locales
  ;; au mode ASN.1

  ;; fonction d'indentation utilisee par emacs 
  ;; sous ce nom : indent-line-function
  (make-local-variable 'indent-line-function) 
  (setq indent-line-function 'asn1-indent-line)

  ;; compilation
  (make-local-variable 'asn1-compile-line)
  (asn1-set-compile t)

  (make-local-variable 'asn1-tag-file)

  ;; pb si quelqu'un compile autre chose que de l'ASN.1
  ;; une sol : faire un (require 'compile) ds asn1-compile
  ;;           et faire un cons de cette variable apres
  ;; une sol qui marche mieux : faire un (require 'compile) au debut
  (set (make-local-variable 'compilation-error-regexp-alist)
       '(("^->[^(\n]+[(]Fi[a-z]+:\\([^|\n]+\\)[|]Li.. ?\\([^,\n]+\
\\),col\\.\\([^)\n]+\\)" 1 2 3)))

;; Pour que C-x [ et C-x ] permettent de se deplacer de module en module
;; en général, on met seulement un module par fichier.
  (make-local-variable 'page-delimiter)
  (setq page-delimiter
 	"\\(\\|\\<DEFINITIONS\\>\\)")
; 	;"^\\s *\\w+\\(\\s \\|\n\\)*{[^}]+}\\(\\s \\|\n\\)*DEFINITIONS")

  ;; Pour se deplacer de definition en definition
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate "[\t \f]*$")
  (make-local-variable 'paragraph-start)
  (setq paragraph-start "[\t \f]*.*::=")

  ;; cette variable etant a nil les recherches en 
  ;; fonction d'expressions regulieres se font en 
  ;; tenant compte de la casse
  (make-local-variable 'case-fold-search)
  (setq case-fold-search nil)

  ;; Si l'utilisateur fait des remplacements de mots
  ;; a l'aide de la fonction query-replace les 
  ;; remplacement se feront en tenant compte de la 
  ;; casse 
  (make-local-variable 'case-replace)	
  (setq case-replace nil)
  ;; definitions de certaines variables qui concernent
  ;; les commentaires, utilisees par la fonction 
  ;; 'indent-for-comment (M-;)
  (make-local-variable 'comment-start)	       ; chaine a inserer en
  (setq comment-start " -- ")		       ; debut de commentaire
  (make-local-variable 'comment-end)	       ; chaine a inserer a la
  (setq comment-end "")			       ; fin de commentaire
  (make-local-variable 'comment-column)	       ; colonne ou sera insere
  (setq comment-column 50)		       ; le commentaire
                      ;; cette colonne est modifiable avec la fonction
		      ;; 'set-comment-column (C-x ;)
  (make-local-variable 'comment-start-skip)    ; expression reguliere a 
  (setq comment-start-skip "\\(\\)\\(^\\|\\s \\)[-][-] *")    
		      ;; rechercher
                      ;; le \\(\\)\\(^\\|\\s \\) est indispensable et 
                      ;; preserve les espaces eventuels entre les derniers 
		      ;; caracteres d'une ligne de code et le debut du 
		      ;; commentaire. Pour rajouter des espaces, il faut les 
		      ;; introduire apres \\(\\), par exemple :
		      ;;     "\\(\\)  [-][-]"
		      ;; faire tres attention en manipulant cette expres-
		      ;; sion, elle est aussi utilisee par font-lock
		      ;; pour la mise en valeur des commentaires !
		      ;; Les crochets autour du - font
		      ;; qu'il est interprete comme un caractere
		      ;; (nous sommes dans une expression regliere).

  (make-local-variable 'completion-ignore-case)
  ;; t signifie que la completion se fera sans tenir compte de la casse du
  ;; debut de mot entre au clavier :
  (setq completion-ignore-case t)

  
  (if (not (featurep 'asn1-mode))
      (progn
	(if asn1-data-syntax-menu-loaded
	    (asn1-menu-add-syntax-menu (current-local-map)))
	(asn1-menu-add-menu (current-local-map)))
					;si le mode a deja ete charge,
					;certaines operations ne sont
					;pas a refaire.

    ;; si le menu de syntaxe doit se charger automatiquement au
    ;; lancement du mode, il est lance.
    (if asn1-syntax-menu-autoload
	  (asn1-load-syntax-menu))

    ;; chargement du menu principal "ASN.1"
    (asn1-menu-add-menu (current-local-map))
    
    ;; chargement des styles d'ecriture utilises par le mode ASN.1.
;     (if asn1-data-use-colors
; 	(require 'font-lock)) ; for emacs 19
    (cond (asn1-use-standard-custom
	   (mapcar 'asn1-standard-defface asn1-data-faces)
	   (mapcar 'asn1-standard-defface asn1-data-faces-default))
	  (t
	   (asn1-modify-face-list asn1-data-faces)
	   (asn1-defface-list asn1-data-faces-default)))
    ;; information hypertexte sur le mode rendu accessible
    (setq Info-default-directory-list
	  (cons asn1-data-dir Info-default-directory-list))

    )
  
  ;; mots cles a mettre en valeur
  (setq asn1-data-font-lock-keywords asn1-data-keywords-sets)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(asn1-data-font-lock-keywords nil nil nil))

;   (if asn1-data-use-colors
;       (font-lock-mode 1))
  
  ;; Chargement de asn1-mode-hook
  ;; regarder dans Emacs si vous voulez savoir ce qu'est un hook
  (run-hooks 'asn1-mode-hook))

(defun asn1-mode-version ()
  "Retourne une chaine de caracteres qui comporte entre autre le
numero de version du mode ASN.1." 
  (interactive)
  (let ((version
	 (format "Mode ASN.1:1997, version %s" 
		 asn1-data-version)))
    (if (interactive-p)
	(message "%s" version)
      version)))


;;;----------------------------------------------------------------------
;;;	               Outils servant a l'indentation
;;;----------------------------------------------------------------------

;; Fonction de filtrage d'une liste: uniquement les elements
;; de la liste pour lesquels filter-p est vrai sont gardes dans
;; la liste resultat (ces elements restent inchanges)
(defun mapfilter (filter-p entry-list)
  "ENTRY-LIST est une liste d'elements.
Cette fonction recoit la liste des elements de cette liste, pour
lesquels (FILTER-P element) renvoie une valeur non nil."
  (let ((temp-list nil))
    (mapcar
     '(lambda (cell)
	(if (funcall filter-p cell)
	    (setq temp-list (cons cell temp-list))))
     entry-list)
    temp-list))

;; Teste si le curseur est dans un commentaire
;; ou dans une chaine de caracteres
(defun asn1-into-a-commentary-or-string-p ()
  "Renvoie vrai si le curseur est dans un commentaire." 
  (interactive)
  (let ((indent-point (point))
	state)
    (save-excursion
      (beginning-of-line)
      (setq state (parse-partial-sexp (point) indent-point 0))
      ;; si l'on est dans un commentaire la valeur retournee
      ;; est 4, si l'on est dans une chaine elle est de 3
      (or (nth 3 state) (nth 4 state)))))

;; Recherche vers le debut du fichier de l'expression 
;; reguliere "regexp". Celle-ci ne doit pas etre dans des
;; commentaires ou incluses dans une chaine de caracteres
;; i.e incluse dans une expression fermee par une paire
;; de guillemets ou apostrophes. Si la recherche a abouti,
;; la chaine auquelle l'expression reguliere a pu etre 
;; identifiee est renvoyee, sinon nil est renvoye.

(defun asn1-goto-beginning-of-regexp (regexp &optional limit)
  "Deplace la curseur (en arriere) jusqu'au debut de l'expression
reguliere REGEXP. Le curseur ne pourra pas aller avant la limite LIMIT
si celle-ci est precisee. Enfin l'expression reguliere trouvee ne
sera ni dans une chaine de caracteres, ni dans un commentaire, cela est
garanti." 
  (interactive)
  (let ((found t)
	(valid nil))
    (while (and found
		(not valid))
      (setq found (re-search-backward regexp (or limit 0) 'move 1))
      (if found (setq valid (and (goto-char (match-beginning 0))
				 (not (asn1-into-a-commentary-or-string-p))))))
    (if found
	(asn1-substring (match-beginning 0) (match-end 0))
      nil)))

;; Le curseur se place apres tous les commentaires et 
;; espaces eventuels places devant lui.
(defun asn1-skip-comment-and-space ()
  "Positionne le curseur apres tous les espaces et commentaires se
trouvant devant lui. Si la ligne ne se compose que d'espaces et de
commentaires, le curseur sera mis a la fin de la ligne."
  (let ((end-line nil))
    (save-excursion
      (end-of-line)
      (setq end-line (point)))
    (forward-comment (buffer-size))
    (skip-chars-forward "\t ")
    (if (> (point) end-line)
	(goto-char end-line))
    (point)))

(defun asn1-skip-spaces ()
  "Positionne le curseur apres tous les espaces et commentaires se
trouvant devant lui. Si la ligne ne se compose que d'espaces et de
commentaires, le curseur sera mis a la fin de la ligne."
  (let ((end-line nil))
    (save-excursion
      (end-of-line)
      (setq end-line (point)))
    (skip-chars-forward "\t ")
    (if (> (point) end-line)
	(goto-char end-line))
    (point)))

;; place le curseur au debut de la ligne apres
;; les commentaires et espaces eventuels.
(defun asn1-beginning-of-line-of-code ()
  "Deplace le curseur au denut de la ligne, puis passe tous les
espaces qui sont devant lui. Si cela le mene jusqu'au bout de la ligne
courante, il reste a la fin de celle-ci." 
  (beginning-of-line)
  (asn1-skip-spaces))

;; deplace le curseur vers la ligne precedante
;; non vide et ne comportant pas que des commentaires
(defun asn1-previous-line-of-code ()
  "Deplace le curseur vers la ligne precedente la plus proche qui ne
se compose pas seulement de commentaires et/ou d'espaces."
  (let ((finished nil))
    (beginning-of-line)
    (setq finished (bobp))  
    (while (not finished)
      (beginning-of-line 0)
      (setq finished (bobp))  
      (asn1-beginning-of-line-of-code)
      (setq finished (or finished (not (eolp)))))
    (if (eolp)
	(beginning-of-line))))

(defun asn1-indent-to-column (col &optional simple)
  "Indente la ligne courante a la colonne COL.
Ensuite, si SIMPLE est definit et non nil, rien de plus n'est fait,
dans le cas contraire :
	1) si le point est dans des espaces ou du commentaire
		qui precede le corps de la ligne de code alors
		le point se place au debut du corps du code.
	2) si le point est dans une ligne vide le point se place
		a la fin de cette ligne
	3) si le point est entre deux caracteres faisant partie
		du corps du code, il y est encore apres l'indentation"
  (let* ((point-in-whitespace
	  (save-excursion
	    (<= (point) (asn1-beginning-of-line-of-code))))
	 (blank-line-p
	  (save-excursion
	    (beginning-of-line)
	    (looking-at "\\s *$"))))
    (cond ((/= col (current-indentation))
	   (save-excursion
	     (beginning-of-line 1)
	     (delete-horizontal-space)
	     (indent-to col))))
    (if (not simple)
	(cond (blank-line-p
	       (end-of-line))
	      (point-in-whitespace
	       (back-to-indentation))))))


;;;---------------------------------------------------------------------
;;;			Donnees servant a l'indentation
;;;---------------------------------------------------------------------

(defvar asn1-data-indentation-table
  (list (list "DEFINITIONS"	
	      asn1-data-indent-of-DEFINITIONS	
	      asn1-data-indent-in-DEFINITION-bloc
	      "\\bDEFINITIONS\\b"	nil		
	      'asn1-indent-DEFINITIONS)
	(list "BEGIN"		
	      asn1-data-indent-of-BEGIN	
	      asn1-data-indent-in-BEGIN-bloc
	      "\\bBEGIN\\b"     "\\bDEFINITIONS\\b"	
	      'asn1-indent-BEGIN)
        (list "END"		
	      asn1-data-indent-of-END
	      nil
	      "\\bEND\\b"	 "\\bBEGIN\\b"		
	      'asn1-indent-END)
	(list "IMPORTS"		
	      asn1-data-indent-of-IMPORTS
	      asn1-data-indent-in-IMPORTS-bloc
	      "\\bIMPORTS\\b"     "\\bBEGIN\\b"		
	      'asn1-indent-IMPORTS)
	(list "EXPORTS"		
	      asn1-data-indent-of-EXPORTS
	      asn1-data-indent-in-EXPORTS-bloc
	      "\\bEXPORTS\\b"     "\\bBEGIN\\b"		
	      'asn1-indent-EXPORTS)
	(list "FROM"		
	      asn1-data-indent-of-FROM	
	      nil
	      "\\bFROM\\b" "\\bIMPORTS\\b"  
	      'asn1-indent-FROM)
	(list ";"		
	      asn1-data-indent-of-\;
	      nil
	      ";"     "\\b\\(EXPORTS\\|IMPORTS\\)\\b"	
	      'asn1-indent-\;)
	(list "{"		
	      asn1-data-indent-of-\{
	      nil
	      "[{]"		"\\w"			
	      nil)
	(list "("		
	      asn1-data-indent-of-\(
	      nil
	      "[(]"		"\\w"			
	      nil)
	(list "["		
	      asn1-data-indent-of-\[
	      nil
	      "\\["		"\\w"			
	      nil)
	(list "::="		
	      asn1-data-indent-of-::=	
	      nil	
	      "::="		"\\w"			
	      'asn1-indent-::=)
	)
  "Table contenant les informations d'indentation.
Cette liste contient des elements qui sont eux-memes 
des listes. Ces elements sont de la forme
\"(CLEF NB1 NB2 REG1 REG2 FUN1)\". 

CLEF est un delimiteur de bloc. Ce mot commence ou finit donc une
certaine structure. 
Si cette CLEF est presente en debut de ligne, alors la ligne est
indentee de maniere speciale :
	On cherche en arriere dans le document le mot clef REG2, on
	note I1 l'indentation de la ligne ou il est place. La ligne
	comportant CLEF est alors indentee de (I1 + NB1) par rapport a
	la marge gauche.

Pour une ligne quelconque du document, on recherche en arriere la
premiere CLEF que l'on peut trouver et qui n'est pas dans les
commentaires. L'indentation est calculee avec la fonction FUN1 en
utilisant la donnee NB2.

REG1 constitue l'expression reguliere de CLEF utilisee pour recherchee
cette CLEF dans le document.")


;; accesseurs associes a la variable precedente asn1-data-indentation-table
(defun asn1-get-i-table-beginning-of-bloc (cell)
  "renvoie REG2 (voir commentaire de \{asn1-data-indentation-table})"
  (nth 4 cell))
(defun asn1-get-i-table-keyword-indent (cell)
   "renvoie NB1 (voir commentaire de \{asn1-data-indentation-table})"
 (nth 1 cell))
(defun asn1-get-i-table-bloc-indentation (cell)
  "renvoie NB2 (voir commentaire de \{asn1-data-indentation-table})"
  (nth 2 cell))
(defun asn1-get-i-table-regexp (cell)
  "renvoie REG3 (voir commentaire de \{asn1-data-indentation-table})"
  (nth 3 cell))
(defun asn1-get-i-table-bloc-indent-function (cell)
  "renvoie FUN1 (voir commentaire de \{asn1-data-indentation-table})"
 (nth 5 cell))

(defun asn1-string2regexp (string) ; aussi declaree dans asn1-syntax
  "transforme une chaine de caracteres en l'expression reguliere qui
lui correspond" 
  (let ((regexp nil) 
	(iter (length string)))
    (while (> iter 0)
      (setq iter (1- iter))
      (setq 
       regexp 
       (concat "[" (substring string iter (1+ iter)) "]" regexp)))
    regexp))

(defvar asn1-data-keywords-to-search
  (concat
   "\\("
   (mapconcat 
    '(lambda (cell)
       (asn1-string2regexp (car cell)))  
    asn1-data-indentation-table 
    "\\|")
   "\\)")
  "Table des mots-cles pour lesquels on sait indenter si ils
commencent une ligne. Cette table est construite a partir des clefs
contenues dans asn1-data-indentation-table.")

(defvar asn1-data-statement-table
   (concat
   "\\("
   (mapconcat
    (lambda (cell)
      (asn1-get-i-table-regexp cell))
    (mapfilter 
     (lambda (cell) 
       (asn1-get-i-table-bloc-indent-function cell)) 
     asn1-data-indentation-table) 
    "\\)\\|\\(")
   "\\)")
  "Liste  des mots-cles delimitant un bloc par rapport auquel on 
va savoir indenter. Ces mots-cles seront reconnus s'ils sont en debut
de ligne (en sautant les espaces et commentaires qui peuvent se
trouver au debut de cette ligne).")

(defun asn1-indent-IMPORTS (departure)
  "Calcul de l'indentation dans le bloc suivant un IMPORTS"
  (forward-word 1)
  (asn1-skip-comment-and-space)
  (if (eolp)
      (+ (current-indentation) 
	 (asn1-get-i-table-bloc-indentation
	  (assoc "IMPORTS" asn1-data-indentation-table)))
      (current-column)))

(defun asn1-indent-EXPORTS (departure)
  "Calcul de l'indentation dans le bloc suivant un EXPORTS"
  (forward-word 1)
  (asn1-skip-comment-and-space)
  (if (eolp)
      (+ (current-indentation) 
	 (asn1-get-i-table-bloc-indentation
	  (assoc "EXPORTS" asn1-data-indentation-table)))
    (current-column)))

(defun asn1-indent-FROM (departure)
  "Calcul de l'indentation dans le bloc suivant un FROM"
  (cond ((save-excursion
	   (skip-chars-backward " \t\n")
	   (backward-char)
	   (looking-at "[(]"))
	 (asn1-goto-beginning-of-regexp "\\bBEGIN\\b")
	 (asn1-indent-BEGIN departure))
	((asn1-goto-beginning-of-regexp "\\bIMPORTS\\b")
	 (asn1-indent-IMPORTS departure))
	(t
	 0)))

(defun asn1-indent-\; (departure)
  "Calcul de l'indentation dans le bloc suivant un ; (fin d'une clause
d'importation ou d'exportation)"    
  (if (asn1-goto-beginning-of-regexp "\\b\\(BEGIN\\)\\b")
      (progn
	 (+ (current-indentation) 
	    (asn1-get-i-table-bloc-indentation 
	     (assoc "BEGIN"
		    asn1-data-indentation-table))))
    0)) ; au cas ou il n'y a pas de BEGIN

(defun asn1-indent-BEGIN (departure)
  "Calcul de l'indentation dans le bloc suivant un BEGIN"
  (+ (current-indentation) 
     (asn1-get-i-table-bloc-indentation (assoc "BEGIN"
		   asn1-data-indentation-table))))
  
(defun asn1-indent-END (departure)
  "Calcul de l'indentation dans le bloc suivant un END"
  (goto-char departure)
  (beginning-of-line 0)
  (if (looking-at "\\s *$")
      (goto-char departure))
  (current-indentation))

(defun asn1-indent-DEFINITIONS (departure)
   "Calcul de l'indentation apres le bloc suivant un DEFINITIONS"
 (+ (current-indentation) 
     (asn1-get-i-table-bloc-indentation (assoc "DEFINITIONS"
		   asn1-data-indentation-table))))

(defun asn1-indent-::= (departure)
   "Calcul de l'indentation dans le bloc suivant un ::="
   (let ((position (point)))
     (goto-char departure)
     (asn1-beginning-of-line-of-code)
     (if asn1-data-indent-WITH-SYNTAX
	 (progn
	   (if (looking-at  "\\b\\(WITH\\s +SYNTAX\\)\\b")
	       (if (asn1-goto-beginning-of-regexp "\\bCLASS\\b")
		   (current-column)
		 (goto-char position)
		 (current-indentation))
	   (goto-char position)
	   (current-indentation)))
       (goto-char position)
       (current-indentation))))
;       (+ asn1-data-bracket-indent-text (current-indentation)))))
; Pour le ::=
;         INTEGER -> probleme apres : decalage

(defun asn1-indent-line ()
  "Indente la ligne courante, puis place le curseur en fonction du
type de ligne sur laquelle le curseur se trouve." 
  (interactive) ; interactive -> la fonction peut-etre appelee depuis
		; le minibuffer
  (asn1-indent-to-column
   (let ((a (asn1-calculate-indent)))
     (if (number-or-marker-p a)
	 a
       0)))) ; securite : un bug qui renvoyait nil ici a ete corrige
             ;            au cas ou il y en aurait d'autres, on prevoit
	     ;            de renvoyer 0. De toute facon, les bugs
	     ;		  n'apparaissent qu'avec les erreurs syntaxiques.
	     ;		  Il n'est donc pas genant que la ligne soit mal
	     ;		  indentee.

(defun asn1-basic-indent-line ()
  "Indente simplement la ligne courante."
  (asn1-indent-to-column (asn1-calculate-indent) t))

(defun reindent-then-newline-and-indent ()
  "Indente la ligne courante, va a la ligne, puis indente cette
nouvelle ligne."  
  (interactive)
  (insert "\n")
  (save-excursion
    (beginning-of-line 0)
    (asn1-indent-line))
  (asn1-indent-line))

(defun asn1-calculate-indent-keyword-beginning-of-line ()
  "Cherche l'indentation d'une ligne qui commence par un mot-cle qui
delimite un bloc."
  (let   ((search-result nil)
	  associated-info)
    (setq search-result 
	  (asn1-substring 
	   (match-beginning 1) (match-end 1)))
    (setq associated-info 
	  (assoc search-result asn1-data-indentation-table))
    (if (asn1-get-i-table-beginning-of-bloc associated-info)
	(if (asn1-goto-beginning-of-regexp 
	     (asn1-get-i-table-beginning-of-bloc associated-info))
	    (progn
	      (+ (asn1-get-i-table-keyword-indent associated-info) 
		 (current-indentation)))
	  0)
      (asn1-get-i-table-keyword-indent associated-info))))

(defun asn1-calculate-indent-inside-outside-a-block ()
  "Cherche l'indentation d'une ligne qui ne commence pas par un
mot-cle qui delimite un bloc. Cette ligne se trouve donc a l'interieur
ou a l'exterieur d'un bloc."
  (let* ((original-point (point))
	 (begin-line (save-excursion
		      (asn1-beginning-of-line-of-code)
		      (point)))
	 (search-result nil)
	 associated-info
	 (text-after-parenthesis nil)
	 (parenthesis-indentation nil)
	 (base-line-indentation
	  (save-excursion
	    (condition-case ()
		(progn 
		  (beginning-of-line)
		  (up-list -1)
		  (while (asn1-into-a-commentary-or-string-p)
		    (up-list -1))
		  (setq parenthesis-indentation 
			(current-column))
		  (forward-char 1)
		  (asn1-skip-spaces)
		  (if (eolp)
		      (progn
			(setq text-after-parenthesis nil)
			(current-indentation))
		    (progn
		      (setq text-after-parenthesis t)
		      (current-column))))
	      (error nil))))
	 (end-line-p 
	  (save-excursion
	    (condition-case ()
		(progn
		  (beginning-of-line)
		  (up-list 1)
		  (while (asn1-into-a-commentary-or-string-p)
		    (up-list 1))
		  (backward-char 1)
		  (= (point) begin-line))
	      (error nil)))))
    (cond (end-line-p
	   (if text-after-parenthesis
	       (if parenthesis-indentation
		   parenthesis-indentation
		 0)
	     (if base-line-indentation
		 base-line-indentation
	       0)))
	  (text-after-parenthesis
	   (if base-line-indentation
	       base-line-indentation
	     0))
	  (base-line-indentation 
	   (+ asn1-data-bracket-indent-text
	      base-line-indentation))
	  ((progn
	     (beginning-of-line)
	     (asn1-goto-beginning-of-regexp 
	      asn1-data-statement-table))
	   (setq search-result 
		 (asn1-substring 
		  (match-beginning 0) 
		  (match-end 0)))
	   (setq associated-info 
		 (assoc search-result 
			asn1-data-indentation-table))
	   (funcall 
	    (asn1-get-i-table-bloc-indent-function associated-info) 
	    original-point))
	  (t
	   (goto-char original-point)
	   (beginning-of-line 0)
	   (if (looking-at "\\s *$")
	       (goto-char original-point))
	   (current-indentation)))))

(defun asn1-calculate-indent ()
"Fonction principale d'indentation. Elle calcule l'indentation
de la ligne courante. Retourne un entier : la colonne a laquelle la
ligne actuelle doit etre indentee."
(save-excursion
  (setq case-fold-search nil)
  (asn1-beginning-of-line-of-code)
  (cond ((looking-at  
	  (concat asn1-data-keywords-to-search "\\(\\s \\|$\\)"))
	 (asn1-calculate-indent-keyword-beginning-of-line))
	(t
	 (asn1-calculate-indent-inside-outside-a-block)))))

(defun indent-buffer ()
  "Indente le buffer a l'aide de 'asn1-indent-line (et donc incidemment de
'asn1-calculate-indent')."
  (interactive)
  (indent-region (point-min) (point-max) nil))


;;;---------------------------------------------------------------------
;;;			 Completion
;;;---------------------------------------------------------------------

(defconst asn1-data-completion-prelist
  (eval-when-compile
    (mapcar 
     (lambda (string) (list string))
     (let ((liste-rslt nil)
	   (first-list
	    '("BEGIN" "DEFINITIONS" "END" "EXPORTS" "EXTENSIBILITY" "IMPLIED"
	      "EXTENSIBILITY IMPLIED" "FROM" "IMPORTS" 
	      
	      "ABSTRACT-SYNTAX" "BY" "CLASS" "CONSTRAINED" "CONSTRAINED BY" 
	      "INSTANCE" "OF" 
	      "INSTANCE OF" "TYPE-IDENTIFIER" "WITH" "SYNTAX" "WITH SYNTAX" 
	      "UNIQUE" "CONSTRAINED BY"
	      
	      "APPLICATION" "UNIVERSAL" "PRIVATE"
	      
	      "DEFAULT" "OPTIONAL"
	      
	      "ALL" "PRESENT" "ABSENT" "OPTIONAL" "EXCEPT" "COMPONENTS" "OF"
	      "COMPONENTS OF" "EXCEPT" "INCLUDES" "INTERSECTION" "MAX" "MIN" 
	      "SIZE" "UNION" "WITH" "COMPONENT" "WITH COMPONENT"
	      "WITH" "COMPONENTS" "WITH COMPONENTS"
	      
	      "SET" "SEQUENCE" "CHOICE"
	   
	      "SET OF" "SEQUENCE OF" "ANY DEFINED BY"
	      
	      "OF"
	      
	      "FALSE" "MINUS-INFINITY" "PLUS-INFINITY" "NULL" "TRUE"
	      
	      "BIT" "STRING" "BIT STRING" "BMPString" "BOOLEAN" "CHARACTER" 
	      "CHARACTER STRING" "EMBEDDED PDV"
	      "EMBEDDED" "PDV" "ENUMERATED" "EXTERNAL" "GeneralizedTime" 
	      "GeneralString" "GraphicString" "IA5String" "INTEGER"
	      "ISO646String"
	      
	      "NumericString" "ObjectDescriptor" "OBJECT" "IDENTIFIER" 
	      "OBJECT IDENTIFIER" "OCTET" "STRING" "OCTET STRING" 
	      "PrintableString" "T61String" "TeletexString" "REAL"
	      "RELATIVE-OID"

	      "UniversalString" "UTCTime" "UTF8String" "VideotexString" 
	      "VisibleString" "NULL"
	      
	      "AUTOMATIC" "EXPLICIT" "IMPLICIT"  "TAGS"
	      "AUTOMATIC TAGS" "EXPLICIT TAGS" "IMPLICIT TAGS"
	      "HAS" "PROPERTY" "HAS PROPERTY" "IDENTIFIED BY" "IDENTIFIED" "BY"
	      
	      "itu-t(0)" "ccitt(0)" "iso(1)" "joint-iso-itu-t(2)" 
	      "joint-iso-ccitt(2)" "recommendation(0)" "question(1)" 
	      "administration(2)" "network-operator(3)" 
	      "identified-organization(4)"
	      "standard(0)" "member-body(2)" "identified-organization(3)")))

    ;; il faut filtrer la liste pour ne plus avoir de mots y apparaissant
    ;; plusieurs fois, sinon l'utilisateur se servant de la completion
    ;; verra apparaitre plusieurs propositions identiques.
    (mapcar
     (lambda (string)
       (if (not (member string liste-rslt))
	   (setq liste-rslt (append (list string) liste-rslt))))
     first-list)
    liste-rslt))
    )
  "Liste des mots utilises pour la completion ASN.1.")

(defun asn1-completion ()
  "Effectue une completion sur la liste de mots contenus dans
`asn1-data-completion-prelist'." 
  (interactive)
  (let* ((end (point))
	 (buffer-syntax (syntax-table))
	 (beg (unwind-protect
		  (save-excursion
		    (set-syntax-table asn1-data-mode-syntax-table)
		    (skip-syntax-backward "\\w")
		    (point))
		(set-syntax-table buffer-syntax)))
	 (pattern (asn1-substring beg end))
	 (completion (try-completion pattern asn1-data-completion-prelist)))
    (cond ((eq completion t))
	  ((null completion)
	   (message (asn1-lg
		     "Pas de completion pour \"%s\""
		     "Can't find completion for \"%s\"") pattern)
	   (ding))
	  ((not (string= pattern completion))
	   (delete-region beg end)
	   (insert completion))
	  (t
	   (with-output-to-temp-buffer "*Completions*"
	     (display-completion-list
	      (sort (all-completions pattern
				     asn1-data-completion-prelist)
		    'string<)))))))


;;;---------------------------------------------------------------------
;;;				Divers
;;;---------------------------------------------------------------------

(defun asn1-create-tag-file ()
  (interactive)
    (setq asn1-tag-file
	  (asn1-read-shell-command
	   (asn1-lg "Fichiers ou chercher les references : "
		    "Files where find the references: ")
	   asn1-tag-file nil))
  (let ((f asn1-tag-file)
	(b (get-buffer-create "*ASN.1-Tags*")))
    (display-buffer b)
    (set-buffer b)
    (setq buffer-read-only nil)
    (erase-buffer)
    (insert (asn1-lg "Creation du fichier de references..."
		     "Creating tags file..."))
    (set-process-sentinel
     (start-process-shell-command
      "asn1-tag"
      b
      "etags --regex='/^[ \\t]*\\([A-Za-z][-A-Za-z0-9]*\\).*::=/\\1/'"
      f)
     'asn1-tags-sentinel)))
;    (lambda (&rest ignore)
;      (message (asn1-lg "Creation du fichier de tags terminée"
; 		       "Creation of tags file finished")))))

(defun asn1-tags-sentinel (proc msg)
  (let ((buffer (process-buffer proc)))
    (if (memq (process-status proc) '(signal exit))
	(progn
	  (if (null (buffer-name buffer))
	      ;; buffer killed
	      (set-process-buffer proc nil)
	    (let ((obuf (current-buffer)))
	      ;; save-excursion isn't the right thing if
	      ;; process-buffer is current-buffer
	      (unwind-protect
		  (progn
		    ;; Write something in the compilation buffer
		    ;; and hack its mode line.
		    (set-buffer buffer)
		    (goto-char (point-max))
		    (insert
		     (asn1-lg "\nCreation du fichier de references terminee."
			      "\nCreation of tags file finished."))
		    ;; Since the buffer and mode line will show that the
		    ;; process is dead, we can delete it now.  Otherwise it
		    ;; will stay around until M-x list-processes.
		    (delete-process proc))
		(if (buffer-live-p obuf)
		    (set-buffer obuf)))))))))

(defun asn1-mice-button-key (n)
  (vector (list (intern (concat (if asn1-data-xemacs-p
				    "button"
				  "mouse-")
				(number-to-string n))))))

(defun asn1-mice-normal-button (event arg)
  ;; other possibility : lookup key
  (if asn1-data-xemacs-p
      (cond ((eq asn1-mice-button 1)
	     (mouse-track event))
	    ((eq asn1-mice-button 2)
	     (mouse-yank event))
	    ((eq asn1-mice-button 3)
	     (popup-mode-menu)))
    (cond ((eq asn1-mice-button 1)
	   (mouse-yank-at-click event arg))
	  ((eq asn1-mice-button 2)
	   (mouse-drag-region event))
	  ((eq asn1-mice-button 3)
	   (mouse-save-then-kill event)))))

(defun asn1-info ()
  (interactive)
  (delete-other-windows)
  (info (asn1-lg
	 (if (file-exists-p (concat asn1-data-dir "asn1-mode-fr.info"))
	     (concat asn1-data-dir "asn1-mode-fr.info")
	   "asn1-mode-fr.info")
	 (if (file-exists-p (concat asn1-data-dir "asn1-mode-en.info"))
	     (concat asn1-data-dir "asn1-mode-en.info")
	   "asn1-mode-en.info"))))

(defun asn1-tutorial ()
  (interactive)
  (delete-other-windows)
  (if (eq 'fr asn1-language)
      (find-file (concat asn1-data-dir "TUTORIAL"))
    (help-with-tutorial)))

(defun asn1-custom-options ()
  (interactive)
  (delete-other-windows)
  (customize-group 'asn1-options))

(defun asn1-custom-indentation ()
  (interactive)
  (delete-other-windows)
  (customize-group 'asn1-indentation))

(defun asn1-custom-face ()
  "A simply way to custom faces"
  (interactive)
  (delete-other-windows)
  (if asn1-use-standard-custom
      (customize-group 'asn1-face)
    (asn1-conf-face
     (asn1-lg
      "Configuration des styles d'ecritures du mode ASN.1
Remarque : les couleurs des chaines de caracteres et des commentaires sont
           les meme dans tous les modes emacs."
      "Configuration of ASN.1 Faces
Note : colors for string and comment are the same for all emacs modes.")
     'asn1-data-faces
     'asn1-data-faces-default)))

(defun asn1-set-compile (&optional force)
  (let ((cmde (concat asn1-compile-command " "
		      asn1-compile-switches " "
		      buffer-file-name)))
    (if (or force (not (equal cmde asn1-compile-precedent-command)))
	(setq asn1-compile-line cmde))
    (setq asn1-compile-precedent-command cmde)))

(defun asn1-set-compile-command ()
  (interactive)
  (setq asn1-compile-command
	(read-file-name
	 (asn1-lg
	  "Commande de compilation : "
	  "Compile Command : ")))
  (asn1-set-compile t))

(defun asn1-set-compile-switches ()
  (interactive)
  (setq asn1-compile-switches
	(read-from-minibuffer
	 (asn1-lg
	  "Parametres de compilation : "
	  "Compile Switches : ")
	 asn1-compile-switches))
  (asn1-set-compile t))

;; emacs 19.34
(if (not (fboundp 'split-string))
(defun split-string (string &optional separators)
  "Splits STRING into substrings where there are matches for 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 don't 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 asn1-change-language (arg)
  "Change language."
  (interactive "SLanguage : ")
  (set 'asn1-language arg)

  ;; Not very usual
  (load "asn1-mode")
  (if (featurep 'asn1-diff)
      (load "asn1-diff"))
  (let ((l (buffer-list)))
    (while l
      (set-buffer (car l))
      (cond ((eq major-mode 'asn1-mode)
	     (easy-menu-remove asn1-data-menu)
	     (asn1-menu-add-menu (current-local-map))
	     (if (not asn1-data-diff-menu-p) nil
	       (easy-menu-remove asn1-diff-menu)
	       (asn1-diff-add-menu (current-local-map))))
	    ((eq major-mode 'asn1-diff)
	     (easy-menu-remove asn1-diff-menu)
	     (asn1-diff-add-menu (current-local-map))))
      (setq l (cdr l))))
  (mapcar (lambda (buf) (kill-buffer (get-buffer-create buf)))
	  '("*Customize Group: Asn1 Indentation*"
	    "*Customize Group: Asn1 Options*"
	    "*Customize Group: Asn1 Diff*"
	    "*ASN.1 Configuration*"))
  (setq asn1-compile-switches
	(asn1-lg
	 (if (string-match "-fr[ \t]" asn1-compile-switches)
	     asn1-compile-switches
	   (concat "-fr " asn1-compile-switches))
	 (asn1-list-to-string
	  (delete "-fr"
		  (split-string asn1-compile-switches)))))
  (if (featurep 'asn1-diff)
  (setq asn1-diff-switches
	(asn1-lg
	 (if (string-match "-fr[ \t]" asn1-diff-switches)
	     asn1-diff-switches
	   (concat "-fr " asn1-diff-switches))
	 (asn1-list-to-string
	  (delete "-fr"
		  (split-string asn1-diff-switches))))))
  (message (asn1-lg "Langage choisi : francais"
	     "Choosed language : English"))
  )

(defun asn1-list-to-string (list)
  (if (null list)
      ""
    (concat " " (car list)
	    (asn1-list-to-string (cdr list)))))


;;;---------------------------------------------------------------------
;;;			Compilation with asnp
;;;---------------------------------------------------------------------

;; Pour avoir la completion comme sous XEmacs dans le minibuffer

(autoload 'comint-dynamic-complete "comint" "" t)
(autoload 'comint-dynamic-list-completions "comint" "" t)

(defvar asn1-read-shell-command-map
  (let ((map (asn1-copy-keymap minibuffer-local-map)))
    (define-key map "\t" 'comint-dynamic-complete)
    (define-key map "\M-\t" 'comint-dynamic-complete)
    (define-key map "\M-?" 'comint-dynamic-list-completions)
    map))

(defun asn1-read-shell-command (prompt &optional initial-input history)
  "Just like read-string, but uses asn1-read-shell-command-map:
\\{asn1-read-shell-command-map}"
  (let ((minibuffer-completion-table nil))
    (read-from-minibuffer prompt initial-input asn1-read-shell-command-map
			  nil (or history 'shell-command-history))))


(defun asn1-compile ()
  "Like compile but use the completion of comint (like XEmacs does)"
  (interactive)
  (require 'compile)
  (asn1-set-compile)
  (setq asn1-compile-line
	(if (or compilation-read-command current-prefix-arg)
	    ;; XEmacs change
	    (asn1-read-shell-command
	     (asn1-lg
	      "Commande de compilation : "
	      "Compile command: ")
	     asn1-compile-line
	     ;; #### minibuffer code should do this
	     (if (equal (car compile-history)
			asn1-compile-line)
		 '(compile-history . 1)
	       'compile-history))
	  asn1-compile-line))
  (save-some-buffers (not compilation-ask-about-save) nil)
  (compile-internal asn1-compile-line "No more errors"))


;;;---------------------------------------------------------------------
;;;		Functions deals with FACES 
;;;---------------------------------------------------------------------
;; This functions exist because they exist before...
;; defface is actually a best choice

(defun asn1-defface-list (list)
  "Apply asn1-defface to a list of definitions of faces"
  (let ((l list))
    (while l
      (apply 'asn1-defface (car l))
      (setq l (cdr l)))))

(defun asn1-modify-face-list (list)
  "Apply asn1-modify-face to a list of definitions of faces"
  (let ((l list))
    (while l
      (apply 'asn1-modify-face (car l))
      (setq l (cdr l)))))

(defun asn1-defface (face &optional foreground background stipple
			  bold-p italic-p underline-p doc)
  "Create FACE if it doesn't exist.
If FACE exist, don't modify it.
See this `asn1-modify-face' for syntax"
  (if (not (boundp face))
      (eval `(defvar ,face (quote ,face) ,(if doc doc ""))))
  (if (facep face)
      nil
    (make-face face)
    (asn1-modify-face face foreground background stipple
		      bold-p italic-p underline-p)))

(defun asn1-modify-face (face &optional foreground background stipple
			      bold-p italic-p underline-p doc)
  "modify the face FACE
FOREGROUND and BACKGROUND are color (name of color or nil, which means
the current color)
BOLD-P ITALIC-P UNDERLINE-P are nil or p"
  (if (not (boundp face))
      (eval `(defvar ,face (quote ,face) ,(if doc doc ""))))
  (if (facep face)
      nil
    (make-face face))
  (set-face-foreground face
		       (if (and asn1-data-xemacs-p (null foreground))
			   (face-foreground 'default)
			 foreground))
  (set-face-background face
		       (if (and asn1-data-xemacs-p (null background))
			   (face-background 'default)
			 background))
  (if (and stipple (fboundp 'set-face-stipple))
      (set-face-stipple face stipple))
  (asn1-bold face bold-p)
  (asn1-italic face italic-p)
  (set-face-underline-p face underline-p))

(defun asn1-bold (face on)
  "Si ON est nil, le style d'ecriture FACE  est degraisse,
sinon FACE est mise en gras."
  (if asn1-data-xemacs-p
      (if on
	  (make-face-bold face)
	(make-face-unbold face))
    (if on
	(make-face-bold face nil 'noerr)
      (make-face-unbold face nil 'noerr))))

(defun asn1-italic (face on)
 "Si ON est nil, le style d'ecriture FACE est redressee si elle etait
en italique, sinon FACE est mise en italique."
 (if asn1-data-xemacs-p
     (if on
	  (make-face-italic face)
	(make-face-unitalic face))
    (if on
	(make-face-italic face nil 'noerr)
      (make-face-unitalic face nil 'noerr))))

(defun asn1-standard-defface (elt)
  (eval
   (list 'defface
	 (car elt)
	 (list
	  'quote
	  (list
	   (list
	    '((class color))
	   (asn1-standard-defface-aux
	    '(:foreground :background)
	    (cdr elt)))
	   (list
	    t
	   (asn1-standard-defface-aux
	    '(:stipple :bold :italic :underline)
	    (nthcdr 3 elt)))))
	 (nth 7 elt)
	 :group 'asn1-face)))

(defun asn1-standard-defface-aux (l1 l2)
  (if (null l1)
      '()
    (if (car l2)
	(cons (car l1) (cons (car l2)
			     (asn1-standard-defface-aux (cdr l1) (cdr l2))))
      (asn1-standard-defface-aux (cdr l1) (cdr l2)))))

; a faire pour asn1-conf :
; (defun asn1-get-face (face)
;   (list face (face-foreground face) (face-background face)
; 	nil nil nil ...


;;; -----------------------------------------------------------------------
;;;	      Compatibility with precedent versions of asn1-mode
;;; -----------------------------------------------------------------------

(defvar asn1-data-save-file
  (concat "~" init-file-user
	  (if asn1-win "/_emacs" "/.emacs"))
  "*Name of the config file. By default :
\".emacs\" under Unix,
\"_emacs\" under Windows.")

(defun asn1-convert ()
  (if (> (length (car asn1-data-faces)) 5)
      nil

    ;; conversion of the faces
    (setq
     asn1-data-faces
     (mapcar (lambda (l)
	       (let* ((elt (assq (car l) asn1-data-faces-default))
		      (doc (if elt
			       (nth 7 elt)
			     "")))
		 (if (nth 1 l)
		     (list (car l) (nth 2 l)
			   nil nil (nth 3 l) (nth 4 l) nil doc)
		   (list (car l) nil nil
			 nil nil nil nil doc))))
	     asn1-data-faces))

    (if (not (y-or-n-p
	      "You've used an old version of asn1-mode, updating .emacs? "))
	nil
      (message "Updating...")
      (asn1-delete-settings
       ";; ASN.1 Menu Settings\n"
       ";; End of ASN.1 Menu Settings\n")      
      (mapcar (lambda (var) (customize-save-variable var (eval var)))
	      '(asn1-data-faces
		asn1-compile-command
		asn1-compile-switches
		asn1-syntax-menu-autoload)))))

(defun asn1-delete-settings (string-start string-end)
  (let ((output-buffer (find-file-noselect
			(expand-file-name asn1-data-save-file))))
    (save-excursion
      (set-buffer output-buffer)
      (goto-char (point-min))
      (if (re-search-forward (concat "^" string-start) nil 'move)
	  (let ((p (match-beginning 0)))
	    (goto-char p)
	    (or (re-search-forward (concat "^" string-end) nil t)
		(error "can't find END of saved state in .emacs"))
	    (delete-region p (match-end 0)))
	(save-buffer)))))

;; XEmacs additions
;;;###autoload(add-to-list 'auto-mode-alist '("\\.[Aa][Ss][Nn][1]?\\'" . asn1-mode))

;; Ce module fournit le mode asn1-mode
(provide 'asn1-mode)
