 
 ;;(define-key  lse-mode-map "_"  'self-insert-command)
 
-(defconst LEFTWARD_ARROW 342896)
 
 (setq lse-default-font-lock
       ;;"Font-lock for L.S.E. mode.")
       (append 
        '(
+         ;; pretty chars:
+         ("\\(_\\)" (1 (progn (compose-region (match-beginning 1) (match-end 1)
+                                        ?← 'decompose-region) nil)))
+         ("\\(\\^\\)" (1 (progn (compose-region (match-beginning 1) (match-end 1)
+                                        ?↑ 'decompose-region) nil)))
          ;; comments:
          ("\\(^[0-9]+\\|; *\\)\\(\\*.*\\)"
           (2 font-lock-comment-face))
          ;; strings
          ("\\('[^'\n]*'\\)"
-          (1 font-lock-string-face))
-         )
-       (eval-when-compile
-         (let ((lse-keywords
-                '("AFFICHER" "ALLER" "ALORS" "CHAINE" "CHARGER" "DEBUT"
-                  "EN" "ET" "EXECUTER" "FAIRE" "FIN" "GARER"
-                  "JUSQUA" "LIBERER" "LIRE" "LOCAL" "NON" "OU" "PAS"
-                  "PAUSE" "POUR" "PROCEDURE" "QUE" "RESULTAT" "RETOUR"  
-                  "SI" "SINON" "SUPPRIMER" "TABLEAU" "TANT" "TERMINER" ))
-               (lse-builtins
-                '("ENT" "RAC" "ABS" "EXP" "LGN" "SIN" "COS" "ATG" "ALE"
-                  "TEM" "ATT" "DIS" "ETL" "OUL" "OUX" "CCA" "CNB" "CNB"
-                  "DAT" "EQC" "EQN" "EQN" "GRL" "GRL" "LGR" "POS" "PTR"
-                  "PTR" "SCH" "SCH" "SKP" "SKP" ))
-               (lse-types
-                '("CHAINE" "TABLEAU" ))
-               )
-           (list
-            ;;
-            ;; Keywords except those fontified elsewhere.
-            (concat "\\<\\(" (regexp-opt lse-keywords) "\\)\\>")
-            ;;
-            ;; Builtins.
-            (cons (concat "\\<\\(" (regexp-opt lse-builtins) "\\)\\>")
-                  'font-lock-builtin-face)
-            ;;
-            ;; Type names.
-            (cons (concat "\\<\\(" (regexp-opt lse-types) "\\)\\>")
-                  'font-lock-type-face)
-            )))   
+          (1 font-lock-string-face)))
+       
+       (let ((lse-keywords
+              '("AFFICHER" "ALLER" "ALORS" "CHAINE" "CHARGER" "DEBUT"
+                "EN" "ET" "EXECUTER" "FAIRE" "FIN" "GARER"
+                "JUSQUA" "LIBERER" "LIRE" "LOCAL" "NON" "OU" "PAS"
+                "PAUSE" "POUR" "PROCEDURE" "QUE" "RESULTAT" "RETOUR"  
+                "SI" "SINON" "SUPPRIMER" "TABLEAU" "TANT" "TERMINER" ))
+             (lse-builtins
+              '("ENT" "RAC" "ABS" "EXP" "LGN" "SIN" "COS" "ATG" "ALE"
+                "TEM" "ATT" "DIS" "ETL" "OUL" "OUX" "CCA" "CNB" "CNB"
+                "DAT" "EQC" "EQN" "EQN" "GRL" "GRL" "LGR" "POS" "PTR"
+                "PTR" "SCH" "SCH" "SKP" "SKP" ))
+             (lse-types
+              '("CHAINE" "TABLEAU" ))
+             )
+         (list
+          ;;
+          ;; Keywords except those fontified elsewhere.
+          (concat "\\<\\(" (regexp-opt lse-keywords) "\\)\\>")
+          ;;
+          ;; Builtins.
+          (cons (concat "\\<\\(" (regexp-opt lse-builtins) "\\)\\>")
+                'font-lock-builtin-face)
+          ;;
+          ;; Type names.
+          (cons (concat "\\<\\(" (regexp-opt lse-types) "\\)\\>")
+                'font-lock-type-face)
+          ))   
        '(
          ;; fonction
          ("\\(&[A-Z][A-Z0-9]\\{0,4\\}\\)\\>"

    ;;(setq parse-sexp-ignore-comments t)
    (make-local-variable 'font-lock-defaults)
    (setq font-lock-defaults '(lse-font-lock  t t nil nil ))
    (lse-underline-to-assign)
    (setf (buffer-modified-p (current-buffer)) modp))
  (run-hooks 'lse-mode-hook))



;; (defvar lse-assign-image  
;;   (find-image 
;;    (list
;;     (list :type 'xbm 
;;           :width 7
;;           :height 12
;;           :ascent 91
;;           :background nil
;;           :foreground nil
;;           :data
;;           (loop
;;              with lines = (mapcar 
;;                            (lambda (line)
;;                              (loop
;;                                 with vec = (make-bool-vector (length line) nil)
;;                                 for bit in (mapcar
;;                                             (lambda (char) (STRING/= char ".")) 
;;                                             (split-string line ""))
;;                                 for i from 0 below (length vec)
;;                                 do (setf (aref vec i) bit)
;;                                 finally (return vec)))
;;                            (split-string ".......\n.......\n.......\n..**...\n.**....\n******.\n.**....\n..**...\n.......\n.......\n.......\n.......\n"))
;;              with pic = (make-vector (length lines) nil)
;;              for line in lines
;;              for i from 0
;;              do (setf (aref pic i) line)
;;              finally (return pic)))))
;; "A left arrow glyph.")
;; 
;; 
;; (defun lse-underline-to-assign ()
;;   (interactive)
;;   (save-excursion
;;     (save-restriction
;;       (widen)
;;       (goto-char (point-min))
;;       (while (search-forward "_" nil t)
;;         (delete-region (match-beginning 0) (match-end 0))
;;         (insert-image lse-assign-image "_")))))




(defun lse-put-image (image pos &optional string area)
  "Put image IMAGE in front of POS in the current buffer.
IMAGE must be an image created with `create-image' or `defimage'.
IMAGE is displayed by putting an overlay into the current buffer with a
`before-string' STRING that has a `display' property whose value is the
image.  STRING is defaulted if you omit it.
POS may be an integer or marker.
AREA is where to display the image.  AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area."
  (unless string (setq string "x"))
  (let ((buffer (current-buffer)))
    (unless (eq (car-safe image) 'image)
      (error "Not an image: %s" image))
    (unless (or (null area) (memq area '(left-margin right-margin)))
      (error "Invalid area %s" area))
    (let (overlay
          (curpos (point))
          (prop (if (null area) image (list (list 'margin area) image))))
      (setq string (copy-seq string))
      (put-text-property 0 (length string) 'display prop string)
      (insert string)
      (setq overlay (make-overlay curpos (point) buffer))
      (overlay-put overlay 'put-image t)
      (overlay-put overlay 'evaporate t)
      (overlay-put overlay 'intangible nil)
      )))


(defun lse-assign ()
  "Insert an assign operator (the ASCII code of the underline) 
but adding an overlay on it with the `lse-assign-image' (a left arrow)."
  (interactive)
  (lse-put-image lse-assign-image (point) "_"))


(defun lse-newline ()

      (delete-region (match-beginning 0) (match-end 0)))))


(defun* lse-number-region (start end &optional (from 1) (step 1))
  (interactive "r\nnFrom: \nnStep: ")
  (let ((linum from)
        (end (let ((m (make-marker))) (set-marker m end) m)))
    (goto-char start)
    (while (< (point) end)
      (beginning-of-line)
      (when (looking-at " *[0-9]+ *")
        (delete-region (match-beginning 0) (match-end 0)))
      (insert (format "%3d " linum))
      (incf linum step)
      (forward-line 1))))





;; (defparameter lse-assign-image  
;;   (find-image 
;;    (list
;;     (list :type 'xbm 
;;           :width 8
;;           :height 12
;;           :ascent 91
;;           :background nil
;;           :foreground nil
;;           :data
;;           (loop
;;              with lines = (mapcar 
;;                            (lambda (line)
;;                              (loop
;;                                 with vec = (make-bool-vector (length line) nil)
;;                                 for bit in (mapcar
;;                                             (lambda (char) (STRING/= char ".")) 
;;                                             (split-string line ""))
;;                                 for i from 0 below (length vec)
;;                                 do (setf (aref vec i) bit)
;;                                 finally (return vec)))
;;                            (split-string "........\n........\n........\n..**....\n.**.....\n*******.\n.**.....\n..**....\n........\n........\n........\n........\n"))
;;              with pic = (make-vector (length lines) nil)
;;              for line in lines
;;              for i from 0
;;              do (setf (aref pic i) line)
;;              finally (return pic)) )))
;; "A left arrow glyph.")


;; (defun lse-underline-to-assign ()
;;   (interactive)
;;   (save-excursion
;;     (save-restriction
;;       (widen)
;;       (goto-char (point-min))
;;       (while (search-forward "_" nil t)
;;         (delete-region (match-beginning 0) (match-end 0))
;;         (insert-image lse-assign-image "_")))))


;; (defun lse-put-image (image pos &optional string area)
;;   "Put image IMAGE in front of POS in the current buffer.
;; IMAGE must be an image created with `create-image' or `defimage'.
;; IMAGE is displayed by putting an overlay into the current buffer with a
;; `before-string' STRING that has a `display' property whose value is the
;; image.  STRING is defaulted if you omit it.
;; POS may be an integer or marker.
;; AREA is where to display the image.  AREA nil or omitted means
;; display it in the text area, a value of `left-margin' means
;; display it in the left marginal area, a value of `right-margin'
;; means display it in the right marginal area."
;;   (unless string (setq string "x"))
;;   (let ((buffer (current-buffer)))
;;     (unless (eq (car-safe image) 'image)
;;       (error "Not an image: %s" image))
;;     (unless (or (null area) (memq area '(left-margin right-margin)))
;;       (error "Invalid area %s" area))
;;     (let (overlay
;;           (curpos (point))
;;           (prop (if (null area) image (list (list 'margin area) image))))
;;       (setq string (copy-seq string))
;;       (put-text-property 0 (length string) 'display prop string)
;;       (insert string)
;;       (setq overlay (make-overlay curpos (point) buffer))
;;       (overlay-put overlay 'put-image t)
;;       (overlay-put overlay 'evaporate t)
;;       (overlay-put overlay 'intangible nil)
;;       )))


;; (defun lse-assign ()
;;   "Insert an assign operator (the ASCII code of the underline) 
;; but adding an overlay on it with the `lse-assign-image' (a left arrow)."
;;   (interactive)
;;   (lse-put-image lse-assign-image (point) "_"))



(provide 'lse-mode)
;;(provide 'lse)

;;;; THE END ;;;;
