1;; $Id: sli-tools.el 6643 2005-02-20 18:51:46Z kb $ 2;; sli-tools.el --- structured languages indentation package 3 4;; It works out some tools for indentation of structured programs. 5;; It has been written for mupad.el and pari.el but should apply to 6;; any other structured language like Pascal. 7;; See sli-tools and sli-structures below. 8 9;; The way it works inside: 10;; sli-tell-indent is the main engine. They are two cases 11;; either we want to indent the line the cursor is on, 12;; or we want determine the indent of the next line. 13;; See also sli-forward-sexp. 14 15;; BASICS FROM SLI-STRUCTURES: 16;; you should read the information concerning this variable, 17;; but some basics are required to go further. 18;; In the construct 19;; if toto then tata 20;; else 21;; titi 22;; end_if 23;; "if" is called a HEAD or a head-key, 24;; "else" is called a STRONG, 25;; "end_if" is called an END. 26;; Basically, the "else" is aligned on the "if" and the 27;; "end_if" on previous "else"/"elif"/"if" if the HEREDITY applies. 28;; HEREDITY applies unless otherwise specified. 29;; The key "then" is called a SOFT-key: it implies special 30;; indentation afterwards but is not aimed at being under 31;; the "if". 32;; Keys can also be termed 33;; FIXED (usually global stuff), 34;; BEACON (like "do" in a while-construct), 35;; RELATION (math), 36;; SEPARATOR, 37;; CONSTRUCTOR, 38;; SPECIAL-HEAD (initial declarators like "local", "var", "remember"). 39 40;; The same END can be used for several HEADs, a word can be 41;; a HEAD and a SPECIAL-HEAD, but if so, its corresponding HEAD name 42;; cannot be its own. 43;; HEADs, RELATIONs, BEACONs, SEPARATORs, SOFTs, ENDs should all be different, 44;; and SPECIAL-HEADs can only be also HEADs. 45;; SOFTs, STRONGs or ENDs can be used in fifferent constructs. 46 47;; SYNTACTICALLY speaking, chars used in these strings should be word-constituents, 48;; symbols, open-parenthesis, close-parenthesis or generic-parenthesis. 49;; If sli-case-fold is t, upper/lowercase letters are irrelevant *but* 50;; sli-structures and all should use lowercase letters. 51 52;; INDENT OF THIS LINE: 53;; we look if the first word on this line is a fixed/strong/end/soft 54;; if yes --> fixed keys are easy 55;; --> soft keys: find its ancestor (a strong or a head) 56;; this ancestor is necessarily on another line, 57;; so compute the indent required after this key. 58;; --> strong/end keys: find its ancestor and align 59;; our key on the ancestor (strong or head), with possible offset. 60;; If the attribute is 'absolute, apply this indent. 61;; Else, apply it except if this key belongs to sli-no-heredity-list, 62;; in which case the alignment is on the head. 63;; 64;; if no --> use indentation of previous line 65;; INDENT OF NEXT LINE: 66;; see if previous line has an unclosed head/strong/soft. 67;; if yes --> use its indentation. 68;; if no --> use indentation of previous line. 69;; SEE sli-tools for more info. 70 71;; REGION scanned: the region scanned is extremely important for lengthy programms, 72;; since no unclosed constructs may be found before the very beginning of the file. 73;; So we provide the variable `sli-safe-place-regexp' which indicates where one 74;; can start: after the end of the first grouping. For inctance 75;; "^\(\\\\--\)$" means that a line containing only "\\--" indicates a place 76;; outside any construct. One can start after the string "--" or before the "\\". 77 78;; COMMENTS: nothing much has been done for indenting comments just now. 79 80;; Use of properties: 81;; -- 'sli-type can be 82;; 'head 'special-head 'strong 'soft 'end 'math-relation 'beacon 83;; 'block-comment-start 'block-comment-end 'string 84;; -- 'sli-ancestor if present is a buffer location: 85;; for 'end it is point at beginning of opening 'head or an intermediate 'strong 86;; for 'strong it is point at beginning of corresponding 'head 87;; for 'special-head it is point at beginning of previous 'special-head or 'head 88;; for 'block-comment-end it is point at beginning of corresponding 'block-comment-start 89;; -- 'sli-reverse-ancestor if present is a buffer location: 90;; for 'head it is point at beginning of closing 'end *Not Always Present* 91;; for 'strong it is point at beginning of next 'strong or 'end *Not Always Present* 92;; for 'special-head it is point at beginning of closing separator *Not Always Present* 93;; for 'block-comment-start it is point at beginning of corresponding 'block-comment-end 94;; -- 'sli-time if present is an integer representing the time when 95;; the sli-properties were last set. 96;; These properties are lazily computed: everytime we can deduce such a property, 97;; we do it, but we do not go out of our way to do so. So the absence of a property 98;; only means it has not been computed, and *not* it doesn't exist. 99 100;; Maintainer: Olivier Ramare <ramare@agat.univ-lille1.fr> 101 102;; BUGS: 103;; (1) If I remember well, strings spreading over several lines may 104;; raise some troubles. 105;; (2) sli-tutor has some troubles if used in the middle of already 106;; complete structures. 107;; (3) Due to lazy computations of text properties, sli-show-sexp may 108;; show wrong things. Wait a bit and things will become ok. 109;; See `sli-prop-do-not-recompute-time'. 110;; Use of sli-special-head-heads-alist ?? 111 112(provide 'sli-tools) 113 114;;------------------------------------------------------ 115;; Variables that defines how indentation should occur. 116;; See mupad.el for an example. 117;;------------------------------------------------------ 118 119;; We use "" and \" for strings. 120 121(defgroup sli nil 122"sli customization group" 123:group 'editing :prefix "sli-") 124 125(defcustom sli-handles-sexp nil "A true value advises forward/backward/scan-sexp/s" 126:type 'boolean :group 'sli) 127 128;; These values are modified in sli-tools: 129(defvar sli-verbose nil "A true value gives (debugging) infos") 130(defvar sli-prop-verbose nil "A true value gives (debugging) infos on text properties") 131 132(eval-and-compile 133;; The next variables are here to pacify the compiler ! 134;; Do *not* assign any value to them or they may override .... 135(defvar block-comment-end) 136(defvar block-comment-start)) 137 138(defvar sli-structures nil 139 "List of lists. Each item is a vector or a list which we call a STRUCTURE 140in this explanation. There are several kind of structures : 141 142([HEAD-STRING head INDENT-HEAD] 143 [SOFT-STRING1 soft INDENT-SOFT1] 144 ([STRONG-STRING1 strong INDENT-STRONG1] 145 [SOFT-STRING2 soft INDENT-SOFT2]) 146 ([STRONG-STRING2 strong INDENT-STRONG2]) 147 [END-STRING end]) 148is the usual structure, like in 'if/then/(elif/then)/(else)/end_if'. Between 149the 'head' and the 'soft', INDENT-HEAD is used on subsequent lines to offset the 150new line with respect to the beginning of HEAD-STRING. When the 'soft' is found, 151INDENT-SOFT1 is used still with respect to the 'head'. The next part is 152optional. The STRONG-STRING is aligned on its 'head' and INDENT-STRONG is used 153after that, with respect to the STRONG-STRING. Finally the END-STRING is aligned 154on the previous STRONG-STRING (the 'heredity principle'). If you want to change 155this alignement, use `sli-shift-alist' below. Note that an INDENT-* value can 156be either an integer or a cons pair whose first element is the symbol 'absolute 157and the second one is an integer: it means that the indentation is not relative 158but absolute with respect to the left margin. It applies also to the next 159strong/end key. In this construct, you can also use [SPECIAL-HEAD-STRING 160special-head INDENT-SPECIAL-HEAD SEPARATORS]. This key is closed by SEPARATORS 161which is either a separator which belongs to `sli-separators' or a list of 162separators all in `sli-separators' in which case the first one is the one used 163by sli-maid. No other construct should happen between the special-head and its 164separator except comments and keys termed CONSTRUCTORs; for instance the 165'proc/(option)/begin/end_proc' construct of MuPAD is 166a head/special-head/strong/end. You can use several [END-STRING end]. The first 167one is going to be used by the maid. Furthermore you can use the same END-STR 168for several constructs. It then applies to the first 'head' that appears 169(going backward). Concerning SPECIAL-HEAD, the syntax could make believe that 170a string could be used after a HEAD with some separators and after another one 171with some other separators: in fact they are merge internally so the union 172of all appearing separators for this SPECIAL-HEAD is being used. 173 174([BEACON-STRING beacon INDENT-BEACON]) specifies a special string that can be 175found between a 'head' or a 'strong' and its corresponding 'soft'. The typical 176example being 'for t from 1 to 2 do' and has pattern 177'head/beacon/beacon/soft'. If a newline is asked after the 'from' but before the 178'to', indentation is done with respect to the beginning of 'from' and 179INDENT-BEACON is added except if this newline is asked just after the beacon 180key, in which case indentation is done like from before the beacon but 181'math-relation's are ignored. Simply because 'math-relation' are supposedly 182closed by the appearance of a beacon, whether a separator has occured or not. 183 184([RELATION-STRING math-relation INDENT-RELATION]) specifies a mathematical type 185of relation (like '='). Such operators acts either as beacons (example 'while 186t=3D55 do' with pattern 'strong/math-relation/soft') or else are closed by 187someone in `sli-separators'. They may contain further structures in between like 188in 'foo = if ok then gonethrough=t ; 3 else 5 end_if'. INDENT-RELATION is used 189before the appearance of the proper separator. 190 191HEAD-STRINGs, MATH-RELATION-STRINGs, BEACON-STRINGs, SEPARATORs should all be 192different, except one case for HEAD-STRINGs indicated below. SOFT-STRINGs and 193STRONG-STRINGs are different from any of the above, but a same soft or strong 194key can be used in different constructs. Usual examples are 'then' and 'do' and 195the 'elif' in 'if/elif/end_if' and '%if/elif/end_if'. But because of the way 196things are, the corresponding INDENT should be the same throughout. Note that 197longest match is always taken, so that if 'while(' is a head (like in gp) and 198'(' is also a head (almost everywhere), indentation after 'while(' is the one it 199should. Same applies for the two constructs '%if' and 'if' in mupad. 200 201Concerning HEAD-STRINGs, all starting heads are to be distincts, but inside a 202construct, an existing head can be used as a special head. The typical case in 203MuPAD is 'category' which is normally a head but can be used like a special head 204inside a 'domain' statement. 205 206CONSTRUCTORs are treated in a special way and keys declared as head or end 207or whatever can also be termed constructor. Usual example: ( is a head and 208is also declared as a constructor. 209 210Cdr's are to be evaled. 211 212If downcase/uppercase is relevant is controled by the variable `sli-case-fold'. 213If sli-case-fold is t, sli-structures should use lowercase letters. 214 215Technical note: the first element of this list *has to* contain a 'head'. ") 216 217(defvar sli-case-fold nil 218"The strings used as separators, relations, and all. Not yet used. 219If set to t, all keywords in sli-stryctures, sli-shift-alist ... 220should be in lowercase.") 221 222(defvar sli-escape-key-string "" 223"The strings used as separators, relations, and all. Not yet used.") 224 225(defvar sli-shift-alist nil 226"Usual 'strong/end' are aligned on the previous 227occurence of a corresponding head/strong. 228You can add an offset between two keys. 229This is also valid in case of an absolute indent. 230Elements of this list have format ([key1 key2] . offset). 231Cdr's are to be evaled.") 232 233(defvar sli-no-heredity-list nil 234"Usual 'strong/end' are aligned on the previous 235occurence of a corresponding head/strong except 236if mentionned in this list. 237Elements of this list have format [head-key key].") 238 239(defvar sli-separators nil "Do not forget `sli-is-a-separatorp'.") 240 241(defvar sli-is-a-separatorp-fn 'sli-is-a-separatorp-default 242 "Function called to decide if character after POINT 243is a separator. This function takes an optional argument 244which is the value of POINT and should be surrounded by 245save-excursion and save-match-data, see `sli-is-a-separatorp-default'.") 246 247(defun sli-is-a-separatorp-default (&optional pt) 248 (save-excursion 249 (when pt (goto-char pt)) 250 (save-match-data 251 (if sli-separators 252 (let ((case-fold-search sli-case-fold)) 253 (looking-at (regexp-opt sli-separators))) 254 nil)))) 255 256(defun sli-is-a-separatorp (&optional pt) 257 (funcall sli-is-a-separatorp-fn pt)) 258 259(defvar sli-put-newline-fn 'sli-put-newline-default 260"Function used to insert a newline. Takes no argument.") 261 262(defun sli-put-newline-default nil (insert-char ?\n 1)) 263 264(defun sli-put-newline nil 265"Indirection. Puts a newline according to `sli-put-newline-fn' 266and takes care not to write anything on read-only parts." 267 (unless (get-text-property (point) 'read-only) 268 (funcall sli-put-newline-fn))) 269 270(defvar sli-safe-place-regexp "^\\(//--+\\|/\\*-+-\\*/\\)$" 271"Marker used to tell emacs this point is outside a commented area, a string or a sexp. The safe place starts at beginning of match-group 1 and ends at end of match-group 1.") 272 273(defvar sli-fixed-keys-alist '() 274"Some keys should be placed at a fixed place with respect to the 275indentation of previous line when following a RELATION sign. See 276`sli-relation-keys'. This is the corresponding alist. 277List of (STRING . INDENTATION).") 278 279(defvar sli-keys-with-newline nil 280"When `sli-maid' tries to further your constructs, some keys should be 281followed by a newline before completion is added.") 282 283(defvar sli-keys-without-newline nil 284"When `sli-maid' tries to further your constructs, some keys should never be 285followed by a newline.") 286 287(defvar sli-maid-correction-alist nil "See `sli-maid'") 288 289(defvar sli-add-to-key-alist nil "See `sli-maid'.") 290 291(defvar sli-more-maidp t "See `sli-maid'.") 292 293(defvar sli-tab-always-indent t "See `sli-electric-tab'.") 294 295(defvar sli-comment-starts '() 296"A list of possible starters of one-line comments. 297That is to say an extension of `comment-start' in this special case.") 298 299(defvar sli-block-comment-middle-offset -1 300"Indentation of block comments: they start with block-comment-start and then 301either some whitespace and a word on the same line, on which case next lines 302are aligned on this first word. Or the text starts on next line in which case 303they start at column-of-end-of-block-comment-start + this-offset. 304Exception for the last line if it contains only one word ending with 305'block-comment-end in which case this word is where placed at 306column-of-end-of-block-comment-start+sli-block-comment-end-offset spaces 307from the margin.") 308 309(defvar sli-block-comment-end-offset -1 310"See `sli-block-comment-middle-offset'.") 311 312 313;;;-------------------------------------------------------------------------- 314;;; Inner variables 315;;;-------------------------------------------------------------------------- 316 317(defvar sli-head-keys nil) 318(defvar sli-special-head-keys nil) 319(defvar sli-soft-keys nil) 320(defvar sli-beacon-keys nil) 321(defvar sli-math-relation-keys nil) 322(defvar sli-relation-keys nil) 323(defvar sli-constructor-keys nil) 324(defvar sli-keys-nomrelations nil) ; nomrelations means no-math-relations 325(defvar sli-strong-keys nil) 326(defvar sli-end-keys nil) 327(defvar sli-keys nil) 328(defvar sli-max-keys-length 0 329"An integer: the maximum length of a keyword in sli-structures. 330Used in `sli-anchored-posix-search-backward', a fix for `posix-search-backward'. ") 331(defvar sli-all-keys-nomrelations-noseparators-regexp nil) 332(defvar sli-all-keys-regexp nil) ; including string quotes and all kind of comments. 333(defvar sli-all-end-strong-regexp nil) 334(defvar sli-fixed-regexp nil) 335(defvar sli-head-regexp nil) 336(defvar sli-strong-regexp nil) 337(defvar sli-all-keys-and-constructors-regexp nil) 338 339(defvar sli-head-end-alist nil "The alist ((end . head) ...).") 340(defvar sli-ends-head-alist nil "The alist ((head . (end1 end2 ...) ...).") 341(defvar sli-heads-strong-alist nil "The alist ((strong . (head1 head2 ...)) ...).") 342(defvar sli-special-head-alist nil "The alist ((special-head . (separator1 separator2 ...)) ...).") 343(defvar sli-special-head-heads-alist nil 344 "The alist ((special-head . heads) ...) for those special heads that are also heads.") 345(defvar sli-special-head-previous-keys-alist nil 346 "The alist ((special-head . keys) ...) for special-heads that can be heads. 347keys are the keys that can be before special-head.") 348(defvar sli-companion-strong-keys-alist nil 349 "The alist ((strong/head . (strongs that could be after)) ...). 350The car should be a member of the cdr if the car is a strong.") 351(defvar sli-soft-alist nil 352 "The alist ((ambiguous-soft . (head-or-strong1 head-or-strong2 ...)) ...).") 353(defvar sli-soft-head-or-strong-alist nil "The alist ((head-or-strong . soft) ...)") 354(defvar sli-first-offset-alist nil) ; to apply before the soft 355 ; it applies to head/strong keys that are followed by a soft with no 356 ; head or strong in between. Morally speaking this soft "closes" the head/strong. 357(defvar sli-relevant-alist nil 358"An alist. Put all head/strong/end's in one bundle. say two keys are linked if 359they occur in a same constructs. Close this relation transitively. 360this is the alist ((key . (keys in the same class)) ...).") 361(defvar sli-ancestors-alist nil 362"The alist ((end/strong-key . (head/strong1 head/strong2 ...)) ...) 363of keys that can occur before the first key.") 364 365(defvar sli-second-offset-alist nil "Alist (key . offset) where 366OFFSET is the one to apply after the soft key if it exist, after 367KEY if it doesn't have any soft. KEY can be a head/end/strong/soft.") ; to apply after the soft 368(defvar sli-special-head-offset-alist nil "Alist (special-head . offset).") 369(defvar sli-relation-offset-alist nil) 370 371(defvar sli-maid-alist nil) 372(defvar sli-ambiguous-keys nil 373 "List of keys that may ask for a different following key according 374to context. They *should be* soft or strong keys.") 375 376;; Only to shut up compiler. These two variables should be defined when the 377;; correct buffer is set ! Used by sli-show-sexp. 378(defvar sli-overlay-beg nil "overlay set by `sli-show-sexp' and showing the head key.") 379(defvar sli-overlay-end nil "overlay set by `sli-show-sexp' and showing the end key.") 380 381(defvar sli-prop-do-not-recompute-time 10 382"Time span in milliseconds under which it is not necessary to recompute 383text properties alloted by sli-tools.") 384(defvar sli-prop-used 0 385"Number of times text-properties have been used.") 386(defvar sli-key-is-a-special-headp nil 387 "Set by `sli-get-corresponding-key' and `sli-get-first-non-end-key'.") 388 389(mapc 'make-variable-buffer-local 390'(sli-verbose sli-prop-verbose sli-handles-sexp sli-overlay-beg sli-overlay-end 391sli-prop-do-not-recompute-time sli-structures sli-shift-alist sli-separators 392sli-is-a-separatorp-fn sli-more-maidp sli-add-to-key-alist 393sli-math-relation-keys sli-max-keys-length sli-no-heredity-list sli-head-keys 394sli-special-head-keys sli-soft-keys sli-beacon-keys sli-relation-keys 395sli-keys-nomrelations sli-strong-keys sli-end-keys sli-keys sli-prop-used 396sli-all-keys-nomrelations-noseparators-regexp sli-all-keys-regexp sli-all-end-strong-regexp 397sli-soft-head-or-strong-alist sli-head-end-alist sli-heads-strong-alist 398sli-special-head-alist sli-special-head-heads-alist 399sli-special-head-previous-keys-alist sli-ends-head-alist sli-head-regexp 400sli-strong-regexp sli-relevant-alist sli-ancestors-alist sli-fixed-keys-alist 401sli-fixed-regexp sli-companion-strong-keys-alist sli-soft-alist 402sli-first-offset-alist sli-second-offset-alist sli-relation-offset-alist 403sli-maid-alist sli-ambiguous-keys sli-constructor-keys sli-all-keys-and-constructors-regexp 404sli-block-comment-middle-offset sli-block-comment-end-offset sli-key-is-a-special-headp 405sli-special-head-offset-alist)) 406 407;;;----------------------------------------------------------------------------- 408;;; This section is devoted to some precomputations from sli-structures. 409;;; Lots of work is done several time, but I prefer this modularity 410;;; since it is easier to modify. 411;;;----------------------------------------------------------------------------- 412 413(defun sli-split-list (lst) 414 (let ((wordother '()) (otherword '()) (wordword '()) (otherother '()) ls) 415 (mapc 416 (lambda (wd) 417 (setq ls (string-to-list wd)) 418 (cond 419 ((and (= (char-syntax (car ls)) ?w) (= (char-syntax (car (last ls))) ?w)) 420 (add-to-list 'wordword wd)) 421 ((= (char-syntax (car ls)) ?w) 422 (add-to-list 'wordother wd)) 423 ((= (char-syntax (car (last ls))) ?w) 424 (add-to-list 'otherword wd)) 425 (t (add-to-list 'otherother wd)))) 426 lst) 427 (list wordword wordother otherword otherother))) 428 429(defun sli-regexp-opt (lst) 430 (let ((qlst (sli-split-list lst))) 431 (if (null (elt qlst 0)) 432 (if (null (elt qlst 1)) 433 (if (null (elt qlst 2)) 434 (if (null (elt qlst 3)) 435 "\\<\\>" 436 (regexp-opt (elt qlst 3) t)) ; grouping required for posix 437 (concat 438 (regexp-opt (elt qlst 2) t) "\\>" 439 (if (null (elt qlst 3)) 440 "" 441 (concat "\\|" (regexp-opt (elt qlst 3) t))))) 442 (concat 443 "\\<" (regexp-opt (elt qlst 1) t) 444 (if (null (elt qlst 2)) 445 (if (null (elt qlst 3)) 446 "" 447 (concat "\\|" (regexp-opt (elt qlst 3) t))) 448 (concat 449 "\\|" (regexp-opt (elt qlst 2) t) "\\>" 450 (if (null (elt qlst 3)) 451 "" 452 (concat "\\|" (regexp-opt (elt qlst 3) t))))))) 453 (concat 454 "\\<" (regexp-opt (elt qlst 0) t) "\\>" 455 (if (null (elt qlst 1)) 456 (if (null (elt qlst 2)) 457 (if (null (elt qlst 3)) 458 "" 459 (concat "\\|" (regexp-opt (elt qlst 3) t))) 460 (concat 461 "\\|" (regexp-opt (elt qlst 2) t) "\\>" 462 (if (null (elt qlst 3)) 463 "" 464 (concat "\\|" (regexp-opt (elt qlst 3) t))))) 465 (concat 466 "\\|\\<" (regexp-opt (elt qlst 1) t) 467 (if (null (elt qlst 2)) 468 (if (null (elt qlst 3)) 469 "" 470 (concat "\\|" (regexp-opt (elt qlst 3) t))) 471 (concat 472 "\\|" (regexp-opt (elt qlst 2) t) "\\>" 473 (if (null (elt qlst 3)) 474 "" 475 (concat "\\|" (regexp-opt (elt qlst 3) t))))))))))) 476 477(defun sli-flatten (ls) 478 (let ((res '())) 479 (mapc 480 (lambda (ph) 481 (cond 482 ((listp ph) (setq res (append res (sli-flatten ph)))) 483 (t (setq res (append res (list ph)))))) 484 ls) 485 res)) 486 487(defun sli-scan-structures-locally (stru symbol) 488 (let ((res '())) 489 (mapc (lambda (ph) 490 (setq res 491 (append res 492 (cond 493 ((listp ph) (sli-scan-structures-locally ph symbol)) 494 ((equal (elt ph 1) symbol) (list (elt ph 0))) 495 (t '()))))) 496 stru) 497 res)) 498 499(defsubst sli-compact-list (lst) 500 ; remove same consecutive occurences. 501 (let* ((old (car lst)) (nlst (list old)) (lst (cdr lst))) 502 (while lst 503 (if (equal (car lst) old) 504 (setq lst (cdr lst)) 505 (setq nlst (cons (setq old (car lst)) nlst) lst (cdr lst)))) 506 (nreverse nlst))) 507 508(defun sli-scan-structures (symbol) 509 (let ((res '())) 510 (mapc 511 (lambda (st) 512 (when (equal (elt st 1) symbol) 513 (add-to-list 'res (elt st 0)))) 514 (sli-flatten sli-structures)) 515 res)) 516 517(defun sli-get-ends-head-alist nil 518 (let ((res '()) all-ends) ; forme la liste (head-key . (end1 end2 ...)) 519 (mapc 520 (lambda (ph) 521 (when (equal (elt (elt ph 0) 1) 'head) 522 (setq all-ends '()) 523 (mapc 524 (lambda (s) 525 (when (and (vectorp s) (equal (elt s 1) 'end)) 526 (setq all-ends (append all-ends (list (elt s 0)))))) 527 ph) 528 (add-to-list 'res (cons (elt (elt ph 0) 0) all-ends)))) 529 sli-structures) 530 res)) 531 532(defun sli-get-head-end-alist nil 533 (let ((res '()) all-heads) ; forme la liste (end-key . (head1 head2 ...)) 534 (mapc 535 (lambda (end) 536 (setq all-heads '()) 537 (mapc 538 (lambda (s) 539 (if (member end (cdr s)) 540 (add-to-list 'all-heads (car s)))) 541 sli-ends-head-alist) 542 (add-to-list 'res (cons end all-heads))) 543 sli-end-keys) 544 res)) 545 546(defun sli-get-strong (ph) 547 (let ((res '())) 548 (mapc 549 (lambda (st) 550 (when (equal (elt st 1) 'strong) 551 (add-to-list 'res (elt st 0)))) 552 ph) 553 res)) 554 555(defun sli-get-heads-strong-alist nil 556 (let ((res '()) (aux '()) possible-heads) ; forme la liste des (strong-key . (head-key1 head-key2 ...)) 557 ; Peut-etre plusieurs strong pour chaque head. 558 (mapc 559 (lambda (ph) 560 (if (equal (elt (elt ph 0) 1) 'head) 561 (let ((strongs (sli-get-strong (sli-flatten ph)))) 562 (unless (null strongs) 563 (mapc (lambda (st) 564 (setq aux (add-to-list 'aux 565 (cons st (elt (elt ph 0) 0))))) 566 strongs))))) 567 sli-structures) 568 ; Une strong peut etre liee a plusieurs heads. Il faut les reunir: 569 (mapc 570 (lambda (strong) 571 (setq possible-heads '()) 572 (mapc 573 (lambda (ajoint) 574 (when (equal (car ajoint) strong) 575 (setq possible-heads (append possible-heads (list (cdr ajoint)))))) 576 aux) 577 (when (> (length possible-heads) 1) 578 (add-to-list 'sli-ambiguous-keys strong)) 579 (setq res (append res (list (cons strong possible-heads))))) 580 (sli-compact-list (sort (mapcar 'car aux) 'string-lessp))) 581 res)) 582 583(defun sli-get-soft-alist nil ; forme la liste (soft . (head of strong using it)) 584 (let ((resaux '()) loc (res '()) astrong-list (asoft-list '())) 585 (mapc 586 (lambda (ph) 587 (setq astrong-list '()) 588 (mapc 589 (lambda (ve) 590 (cond 591 ((equal (elt ve 1) 'soft) (unless (null astrong-list) 592 (add-to-list 'resaux (cons (elt ve 0) astrong-list)) 593 (add-to-list 'asoft-list (elt ve 0)))) 594 ((member (elt ve 1) '(strong head)) (setq astrong-list (list (elt ve 0)))))) 595 (sli-flatten ph))) 596 sli-structures) 597 ;; now gather identical soft: 598 (mapc 599 (lambda (asoft) 600 (setq loc '()) 601 (mapc 602 (lambda (dd) 603 (when (string-equal asoft (car dd)) 604 (setq loc (append loc (cdr dd))))) 605 resaux) 606 (add-to-list 'res (cons asoft (sli-compact-list (sort loc 'string-lessp))))) 607 asoft-list) 608 res 609 )) 610 611(defun sli-common-pointp (l1 l2) 612 "t if l1 and l2 have a common element. Test is done through member." 613 (let ((ok nil)) 614 (mapc (lambda (c) (setq ok (or ok (member c l1)))) l2) 615 ok)) 616 617(defun sli-get-companion-alist nil ; case ?? It was not there. 618 (let ((res '())) 619 ; on prend les car de sli-heads-strong-alist on leur 620 ; associe la liste des car qui ont au moins une tete en commun : 621 (mapc 622 (lambda (co) 623 (let ((end (cdr co)) (companions '())) 624 (mapc 625 (lambda (coo) 626 (when (sli-common-pointp (cdr coo) end) 627 (setq companions (add-to-list 'companions (car coo))))) 628 sli-heads-strong-alist) 629 (setq res (append res (list (cons (car co) companions)))))) 630 sli-heads-strong-alist) 631 ; on prend les cdr de sli-heads-strong-alist on leur 632 ; associe la liste des car possibles : 633 (mapc 634 (lambda (head) 635 (let ((companions '())) 636 (mapc 637 (lambda (coo) 638 (when (member head (cdr coo)) 639 (setq companions (add-to-list 'companions (car coo))))) 640 sli-heads-strong-alist) 641 (setq res (add-to-list 'res (cons head companions))))) 642 (sli-compact-list (sort (sli-flatten (mapcar 'cdr sli-heads-strong-alist)) 'string-lessp))) 643 res)) 644 645(defun sli-get-soft-head-or-strong-alist nil 646 (let ((res '()) asoft astrong-list) 647 (mapc 648 (lambda (ass) 649 (setq asoft (car ass)) 650 (setq res (append res (mapcar (lambda (st) (cons st asoft)) (cdr ass))))) 651 sli-soft-alist) 652 res)) 653 654(defun sli-equivalence-classes-local (lst) 655 (cond 656 ((null lst) lst) 657 (t (let (lstbis (done nil) (l1 (car lst))) 658 (setq lstbis 659 (mapcar 660 (lambda (c) 661 (if (sli-common-pointp l1 c) 662 (progn 663 (setq done t) 664 (sli-compact-list (sort (append l1 c) 'string-lessp))) 665 c)) 666 (sli-equivalence-classes-local (cdr lst)))) 667 (unless done 668 (setq lstbis (append lstbis (list l1)))) 669 lstbis)))) 670 671(defun sli-equivalence-classes (lst) 672 (while (> (length lst) (length (setq lst (sli-equivalence-classes-local lst))))) 673 lst) 674 675(defun sli-get-relevant-alist nil 676 (let (key-lst (res '())) 677 ;; relevant keys are head/strong or end keys. 678 (mapc 679 (lambda (class) 680 (mapc 681 (lambda (el) 682 (add-to-list 'res (cons el class))) 683 class)) 684 (sli-equivalence-classes 685 (delq nil ; nil had better not be the first one ... 686 (mapcar 687 (lambda (ph) 688 (setq key-lst '()) 689 (mapcar 690 (lambda (co) 691 (when (member (elt co 1) '(head strong end)) 692 (add-to-list 'key-lst (elt co 0)))) 693 ph) 694 key-lst) 695 (mapcar 'sli-flatten sli-structures))))) 696 res)) 697 698(defun sli-get-ancestors-alist nil 699 (append 700 ;; Ancestors for end-keys: 701 (mapcar 702 (lambda (end) 703 (cons end 704 (sli-flatten 705 (mapcar 706 (lambda (head) 707 (or (assoc head sli-companion-strong-keys-alist) ; works only if a strong is present 708 (cdr (assoc end sli-head-end-alist)))) 709 (cdr (assoc end sli-head-end-alist)))))) 710 sli-end-keys) 711 ;; Ancestors for strong-keys: 712 (mapcar 713 (lambda (strong) 714 (cons strong 715 (append (cdr (assoc strong sli-heads-strong-alist)) 716 ;; The next one is bad: for "begin" it associates "begin" which 717 ;; can not be an anscestor ... 718 (cdr (assoc strong sli-companion-strong-keys-alist))))) 719 sli-strong-keys))) 720 721(defun sli-get-first-offset-alist nil 722 (let ((res '()) last-head-or-strong stru pl) 723 (mapc 724 (lambda (ph) 725 (setq last-head-or-strong nil stru (sli-flatten ph)) 726 (while (not (null stru)) 727 (setq pl (car stru)) 728 (cond 729 ((member (elt pl 1) '(head strong)) (setq last-head-or-strong pl)) 730 ((equal (elt pl 1) 'soft) 731 (when last-head-or-strong 732 (setq res (append res (list (cons (elt last-head-or-strong 0) 733 (elt last-head-or-strong 2)))) 734 last-head-or-strong nil)))) 735 (setq stru (cdr stru)))) 736 sli-structures) 737 res)) 738 739(defun sli-get-second-offset-alist nil 740 (let ((res '()) last-cand stru pl) 741 (mapc 742 (lambda (ph) 743 (setq last-cand nil stru (sli-flatten ph)) 744 (while (not (null stru)) 745 (setq pl (car stru)) 746 (cond 747 ((equal (elt pl 1) 'head) 748 (setq last-cand pl)) 749 ((and (member (elt pl 1) '(end strong)) 750 (not (assoc (elt pl 0) sli-special-head-heads-alist))) ;; ??? 751 (when last-cand ;; no soft after last-cand. 752 (setq res (append res (list (cons (elt last-cand 0) 753 (elt last-cand 2)))))) 754 (if (equal (elt pl 1) 'end) 755 (setq last-cand nil) 756 (setq last-cand pl))) 757 ((equal (elt pl 1) 'soft) 758 (when last-cand ;; last-cand is followed by a soft 759 (setq res (append res (list (cons (elt last-cand 0) 760 (elt pl 2)))) 761 last-cand nil)))) 762 (setq stru (cdr stru)))) 763 sli-structures) 764 res)) 765 766(defun sli-get-relation-offset-alist nil 767 (let ((res '())) 768 (mapc 769 (lambda (ph) 770 (mapc 771 (lambda (pl) 772 (cond 773 ((member (elt pl 1) '(math-relation beacon)) 774 (add-to-list 'res (cons (elt pl 0) (elt pl 2)))))) 775 ph)) 776 (mapcar 'sli-flatten sli-structures)) 777 res)) 778 779(defun sli-get-special-head-offset-alist nil 780 (let ((res '())) 781 (mapc 782 (lambda (ph) 783 (mapc 784 (lambda (pl) 785 (cond 786 ((member (elt pl 1) '(special-head)) 787 (add-to-list 'res (cons (elt pl 0) (elt pl 2)))))) 788 ph)) 789 (mapcar 'sli-flatten sli-structures)) 790 res)) 791 792(defun sli-get-maid-alist-locally (ph lst) 793 (let ((res '()) aux resaux (nlst '())) 794 (cond 795 ((null ph)) 796 ((listp (car ph)) 797 (setq ; process the internal with no 'lst' since it is optional: 798 aux (sli-get-maid-alist-locally (car ph) '()) 799 ; Then process the remainder with both candidates 'lst' and (cadr aux): 800 resaux (sli-get-maid-alist-locally (cdr ph) (append (cadr aux) lst)) 801 ; glue things together: 802 res (list (append aux (car resaux)) (cadr resaux)))) 803 (t (setq aux (elt (car ph) 0) ; the new 'last-word (lst=(last-word)) 804 ph (cdr ph)) 805 ; Link 'lst' to the new compulsory: 806 (mapc (lambda (s) (add-to-list 'res (cons s aux))) lst) 807 (while (and (not (null ph)) (listp (car ph))) 808 ; (car ph) is an optional construct. Scan it with no 'lst' 809 (setq resaux (sli-get-maid-alist-locally (car ph) '()) 810 ; gather all 'last-words': 811 nlst (append nlst (cadr resaux)) 812 ; gather all bindings : 813 res (append res (car resaux)) 814 ph (cdr ph))) 815 (when (car ph) ; aux is linked to the new guy: 816 (add-to-list 'res (cons aux (elt (car ph) 0))) 817 ; the new guy is linked with all the 'last-words': 818 (mapc(lambda (s) (add-to-list 'res (cons s (elt (car ph) 0)))) nlst)) 819 ; process things farther: 820 (setq resaux (sli-get-maid-alist-locally ph '()) 821 res (list (append (car resaux) res) 822 (if (null (cadr resaux)) (append (list aux) nlst) 823 (cadr resaux)))))) 824 res)) 825 826(defsubst sli-full-stuff (key alist fn1 fn2) 827 (let ((res '()) aux) 828 (while alist 829 (when (setq aux (funcall fn1 (funcall fn2 key alist))) 830 (add-to-list 'res aux)) 831 (setq alist (cdr alist))) 832 res)) 833 834(defsubst sli-full-assoc (key alist) 835 "The list of cdrs in alist whose car is key." 836 (sli-full-stuff key alist 'cdr 'assoc)) 837 838(defsubst sli-full-rassoc (key alist) 839 "The list of cars in alist whose cdr is key." 840 (sli-full-stuff key alist 'car 'rassoc)) 841 842(defun sli-get-automatic-maid-alist nil 843;; sli-ambiguous-keys is also created here. 844 ;(setq sli-ambiguous-keys nil) 845 (let ((res '())) 846 (mapc 847 (lambda (ph) 848 (setq res (append res (car (sli-get-maid-alist-locally ph '()))))) 849 sli-structures) ;(princ "\n") (princ (list "sli-get-automatic-maid-alist" res)) 850 (add-to-list 'res (cons block-comment-start block-comment-end)) 851 ; well, soft keys may correspond to different strong keys... 852 (mapcar (lambda (co) (let ((to (sli-full-assoc co res))) 853 (cons co (if (null (cdr to)) (car to) 854 (progn 855 (add-to-list 'sli-ambiguous-keys co) to))))) 856 (sli-compact-list (sort (mapcar 'car res) 'string-lessp))))) 857 858(defun sli-get-maid-alist nil 859 ;; First, create the list automatically: 860 (setq sli-maid-alist (sli-get-automatic-maid-alist)) 861 ;(princ "\n") (princ (list "sli-get-maid-alist" sli-maid-alist)) 862 ;; But now users may want something else. A typical example is 863 ;; for-from-do-end_for where the proposed completion of "for" 864 ;; is "do" because "from" is only a beacon. 865 ;; Correction is done is two steps: first the elements who have 866 ;; a car is sli-maid-correction-alist are removed from 867 ;; from sli-maid-alist and then sli-maid-correction-alist 868 ;; is added. 869 (let ((new-lst '()) (correction-words (mapcar 'car sli-maid-correction-alist))) 870 (while sli-maid-alist ;(princ "\n") (car sli-maid-alist) 871 (unless (member (caar sli-maid-alist) correction-words) 872 (setq new-lst (append new-lst (list (car sli-maid-alist))))) 873 (setq sli-maid-alist (cdr sli-maid-alist))) 874 (append new-lst sli-maid-correction-alist))) 875 876(defun sli-get-special-head-alist nil 877 (let ((res '()) aux) 878 (mapc 879 (lambda (ph) 880 (if (equal (elt ph 1) 'special-head) 881 (progn 882 (if (setq aux (assoc (elt ph 0) res)) 883 ;; This special-head has already been used, but maybe with 884 ;; different separators. Merge everything ... Sorry ! 885 (progn 886 (setq res (delq aux res));(print res) 887 (setq aux (cdr aux)) 888 (mapc (lambda (wd) (add-to-list 'aux wd)) 889 (if (listp (elt ph 3)) (elt ph 3)(list (elt ph 3)))) 890 (add-to-list 'res (cons (elt ph 0) aux))) 891 (add-to-list 'res (cons (elt ph 0) 892 (if (listp (elt ph 3)) 893 (elt ph 3) 894 (list (elt ph 3))))))))) 895 (sli-flatten sli-structures)) 896 res)) 897 898(defun sli-agglomerate (lst) 899 "LST is a list of list (beg end). 900If beg1 = beg2= ... = begN, we answer (beg1 end1 end2 ... endN)." 901 (let ((res '()) beg (listend '())) 902 (mapc 903 (lambda (ph) 904 (unless (assoc (setq beg (elt ph 0)) res) ;; already done 905 (setq listend '()) 906 (mapc 907 (lambda (nph) 908 (when (equal (elt nph 0) beg) 909 (add-to-list 'listend (elt nph 1)))) 910 lst) 911 (setq res (append res (list (append (list beg) listend)))))) 912 lst) 913 res)) 914 915(defun sli-get-special-head-head-alist nil 916 (let ((res '()) previous-head (previous-keys '())) 917 (mapc 918 (lambda (ph) 919 (cond 920 ((equal (elt ph 1) 'head) 921 (setq previous-head (list (elt ph 0)) previous-keys (list (elt ph 0)))) 922 ((and (equal (elt ph 1) 'special-head) (member (elt ph 0) sli-head-keys)) 923 (add-to-list 'res (cons (elt ph 0) previous-head)); (print (list (elt ph 0) previous-keys)) 924 (add-to-list 'sli-special-head-previous-keys-alist (cons (elt ph 0) previous-keys))) 925 (t (add-to-list 'previous-keys (elt ph 0))))) 926 (sli-flatten sli-structures)) 927 ;; Some work for sli-special-head-previous-keys-alist and res: 928 ;; some special-head are linked to different things. 929 (setq sli-special-head-previous-keys-alist (sli-agglomerate sli-special-head-previous-keys-alist)) 930 (sli-agglomerate res))) 931 932(defun sli-get-max-keys-length (lst) 933 (let ((res 0)) 934 (mapc (lambda (to) (setq res (max res to))) 935 (mapcar 'length lst)) 936 res)) 937 938(defun sli-precomputations nil 939 ;; variables: 940 ;(princ "\nPrecomputations: variables") 941 (setq sli-head-keys (sli-scan-structures 'head) 942 sli-special-head-keys (sli-scan-structures 'special-head) 943 sli-soft-keys (sli-scan-structures 'soft) 944 sli-beacon-keys (sli-scan-structures 'beacon) 945 sli-math-relation-keys (sli-scan-structures 'math-relation) 946 sli-relation-keys (append sli-beacon-keys sli-math-relation-keys) 947 sli-strong-keys (sli-scan-structures 'strong) 948 sli-end-keys (sli-scan-structures 'end) 949 sli-constructor-keys (sli-scan-structures 'constructor) 950 sli-keys-nomrelations (append sli-head-keys sli-soft-keys sli-strong-keys sli-beacon-keys 951 sli-special-head-keys ;; momentanous !! 952 sli-end-keys) 953 sli-keys (append sli-keys-nomrelations sli-relation-keys) 954 sli-max-keys-length (sli-get-max-keys-length sli-keys)) 955 ;(princ "...done.\n") 956 ;;regexps: 957 ;(princ "\nPrecomputations: regexps") 958 (setq sli-all-end-strong-regexp (sli-regexp-opt (append sli-end-keys sli-strong-keys)) 959 sli-fixed-regexp (sli-regexp-opt (mapcar 'car sli-fixed-keys-alist)) 960 sli-head-regexp (sli-regexp-opt sli-head-keys) 961 sli-strong-regexp (sli-regexp-opt sli-strong-keys) 962 sli-all-keys-nomrelations-noseparators-regexp 963 (sli-regexp-opt (append sli-keys-nomrelations sli-comment-starts 964 (list "\"" block-comment-start block-comment-end))) 965 sli-all-keys-regexp 966 (sli-regexp-opt (append sli-keys sli-separators sli-comment-starts 967 (list "\"" block-comment-start block-comment-end))) 968 sli-all-keys-and-constructors-regexp 969 (sli-regexp-opt (append sli-keys sli-separators sli-comment-starts 970 sli-constructor-keys 971 (list "\"" block-comment-start block-comment-end)))) 972 ;(princ "...done.\n") 973 ;; association lists: 974 ;(princ "\nPrecomputations: alists") 975 (setq sli-ends-head-alist (sli-get-ends-head-alist) 976 sli-head-end-alist (sli-get-head-end-alist) 977 sli-heads-strong-alist (sli-get-heads-strong-alist) ; sli-ambiguous-keys also is partly created there. 978 sli-companion-strong-keys-alist (sli-get-companion-alist) 979 sli-soft-alist (sli-get-soft-alist) 980 sli-soft-head-or-strong-alist (sli-get-soft-head-or-strong-alist) 981 sli-special-head-alist (sli-get-special-head-alist) 982 sli-special-head-heads-alist (sli-get-special-head-head-alist) ;; sli-special-head-previous-keys-alist is also created here 983 sli-relevant-alist (sli-get-relevant-alist) 984 sli-ancestors-alist (sli-get-ancestors-alist) 985 ;; offsets : 986 sli-first-offset-alist (sli-get-first-offset-alist) 987 sli-second-offset-alist (sli-get-second-offset-alist) 988 sli-relation-offset-alist (sli-get-relation-offset-alist) 989 sli-special-head-offset-alist (sli-get-special-head-offset-alist) 990 ;; the maid : 991 sli-maid-alist (sli-get-maid-alist) ; sli-ambiguous-keys also is partly created there. 992 ) 993 ;(princ "...done.\n") 994 ) 995 996;;;-------------------------------------------------------------------------------------- 997;;; End of the section devoted to precomputations from sli-structures. 998;;;-------------------------------------------------------------------------------------- 999 1000;;;-------------------------------------------------------------------------------------- 1001;;; This section is devoted to some simple functions extracting informations 1002;;; from the variables defined above. 1003;;;-------------------------------------------------------------------------------------- 1004 1005 ;; A full-key is a cons (STRING . PT) where PT is the 1006 ;; value of point at the beginning of STRING. 1007 1008(defsubst sli-keyword (el) 1009 (if sli-case-fold (downcase el) el)) 1010 1011(defsubst sli-member (el lst) 1012 (if sli-case-fold (member (downcase el) lst) (member el lst))) 1013 1014(defsubst sli-following-key (key) 1015 (cdr (assoc (sli-keyword key) sli-maid-alist))) 1016 1017(defun sli-indent-after (key &optional before-soft) 1018 ;; answer is an integer or a cons ('absolute . integer) 1019 (setq key (sli-keyword key)) 1020 (eval 1021 (cond 1022 ;; See how special-heads are handled: if specified by sli-key-is-a-special-headp 1023 ;; put to t they take precedence, otherwise the head-offset has precedence. 1024 ;; If no head exist then the offset as a special-head is finally used. 1025 (sli-key-is-a-special-headp 1026 (cdr (assoc key sli-special-head-offset-alist))) 1027 ((and before-soft (sli-member key (append sli-head-keys sli-strong-keys))) 1028 (cdr (assoc key sli-first-offset-alist))) 1029 ((sli-member key (append sli-head-keys sli-strong-keys)) 1030 (cdr (assoc key sli-second-offset-alist))) 1031 ((sli-member key sli-relation-keys) 1032 (cdr (assoc key sli-relation-offset-alist))) 1033 ((sli-member key sli-soft-keys) 1034 (cdr (assoc key sli-second-offset-alist))) 1035 ((sli-member key sli-special-head-keys) 1036 (cdr (assoc key sli-special-head-offset-alist))) 1037 (t 0)))) 1038 1039(defsubst sli-get-shift (beg end) 1040 (or (eval (cdr (assoc (vector (sli-keyword beg) (sli-keyword end)) 1041 sli-shift-alist))) 0)) 1042 1043(defsubst sli-get-strongs-from-strong-or-head (strong) 1044 (cdr (assoc (sli-keyword strong) sli-companion-strong-keys-alist))) 1045 1046(defsubst sli-get-heads-from-end (end) 1047 (cdr (assoc (sli-keyword end) sli-head-end-alist))) 1048 1049(defsubst sli-get-heads-from-strong (strong) 1050 (cdr (assoc (sli-keyword strong) sli-heads-strong-alist))) 1051 1052(defsubst sli-get-ends-from-head (head) 1053 (cdr (assoc (sli-keyword head) sli-ends-head-alist))) 1054 1055(defsubst sli-get-head-and-strong-from-soft (soft) 1056 (cdr (assoc (sli-keyword soft) sli-soft-alist))) 1057 1058(defsubst sli-get-ends-from-strong (strong) 1059 (sli-flatten 1060 (mapcar 'sli-get-ends-from-head 1061 (sli-get-heads-from-strong strong)))) 1062 1063(defsubst sli-get-relevant (key) 1064 (cdr (assoc (sli-keyword key) sli-relevant-alist))) 1065 1066(defsubst sli-get-special-head-previous-keys (key) 1067 (cdr (assoc (sli-keyword key) sli-special-head-previous-keys-alist))) 1068 1069(defsubst sli-get-special-head-previous-heads (key) 1070 (cdr (assoc (sli-keyword key) sli-special-head-heads-alist))) 1071 1072(defsubst sli-possible-ancestors (key) 1073 (cdr (assoc (sli-keyword key) sli-ancestors-alist))) 1074 1075;;;------------------------------------------------------------------------------------------- 1076;;; Some general primitives. 1077;;;------------------------------------------------------------------------------------------- 1078 1079(defsubst sli-remove-trailing-spaces nil 1080 (if (and (looking-at "\\s-+\\($\\|\\'\\)") 1081 (not (text-property-any (match-beginning 0) (match-end 0) 'read-only t))) 1082 (delete-horizontal-space))) 1083 1084(defsubst sli-remove-trailing-spaces-previous-line nil 1085 (save-excursion 1086 (forward-line -1) 1087 (end-of-line) 1088 (save-restriction 1089 (condition-case err 1090 (unwind-protect 1091 (progn 1092 (narrow-to-region (line-beginning-position) (point)) 1093 (while (and (progn 1094 (forward-char -1) 1095 (looking-at "\\s-")) 1096 (not (text-property-any (match-beginning 0) (match-end 0) 'read-only t)))) 1097 (unless (looking-at "\\s-") (forward-char 1)); in case we are not at bol 1098 (when sli-verbose 1099 (princ "\n") 1100 (princ (list "(sli-remove-trailing-spaces-previous-line) removing spaces from/to: " 1101 (point) (line-end-position)))) 1102 (delete-char (- (line-end-position) (point)))) 1103 (widen)) 1104 (error (when sli-verbose (princ "\n(sli-remove-trailing-spaces-previous-line): ") (princ err)) nil))))) 1105 1106(defsubst sli-only-spacep (&optional pt) 1107 ;; t if the line contains only spaces. 1108 (unless pt (setq pt (point))) 1109 (let ((only-spacep t)) 1110 (mapc (lambda (ch) (setq only-spacep 1111 (and only-spacep (= (char-syntax ch) ?\ )))) 1112 (string-to-list 1113 (buffer-substring-no-properties (line-beginning-position) pt))) 1114 only-spacep)) 1115 1116(defun sli-only-spaces-on-line-before nil 1117 "t if point is between beginning-of-line 1118and first non-whitespace character, nil else. 1119nil if point is at beginning of line." 1120 (let (res) 1121 (save-excursion 1122 (save-restriction 1123 (narrow-to-region (line-beginning-position) (line-end-position)) 1124 (skip-syntax-forward " ") ; beware: linefeed/newline are whitespaces 1125 (setq res 1126 (if (= 0 (current-column)) 1127 nil 1128 (= (current-indentation) (current-column))))) 1129 (widen)) 1130 res)) 1131 1132(defun sli-backward-to-indentation nil 1133 (interactive) 1134 (if (not (sli-only-spaces-on-line-before)) 1135 (delete-char -1) 1136 (let ((foundp nil) (cc (current-indentation)) ncc) 1137 ;;(if sli-verbose 1138 ;; (print (list "(sli-backward-to-indentation) Current indentation: " cc))) 1139 (save-excursion 1140 (while (and (not (bobp)) (not foundp)) 1141 (forward-line -1) 1142 (beginning-of-line) ; for the bobp to work 1143 (setq foundp (> cc (setq ncc (current-indentation)))))) 1144 (save-restriction 1145 (narrow-to-region (line-beginning-position) (line-end-position)) 1146 (skip-syntax-forward " ") 1147 (if (not foundp) 1148 (backward-delete-char-untabify cc) 1149 (backward-delete-char-untabify (- cc ncc))) 1150 (widen))))) 1151 1152(defsubst sli-point-to-indent (pt) 1153 (save-excursion 1154 (progn (goto-char pt) (current-column)))) 1155 1156(defsubst sli-indent-at (full-key) ;; used only here 1157 ;; A full-key is a cons (STRING . PT) where PT is the 1158 ;; value of point at the beginning of STRING. PT alone is also accepted. 1159 (sli-point-to-indent (if (consp full-key) (car full-key) full-key))) 1160 1161(defsubst sli-in-one-line-comment nil 1162 (and sli-comment-starts ; if sli-comment-starts is nil, answer is nil 1163 (re-search-backward (regexp-opt sli-comment-starts) (line-beginning-position) t))) 1164 1165(defsubst sli-get-safe-backward-place nil 1166 (save-excursion 1167 (when (eobp) (forward-char -1)) 1168 (if (re-search-backward sli-safe-place-regexp nil t) 1169 (match-end 1) (point-min)))) 1170 1171(defsubst sli-get-safe-forward-place nil 1172 (save-excursion 1173 (when (bobp) (forward-char 1)) 1174 (if (re-search-forward sli-safe-place-regexp nil t) 1175 (match-beginning 1) (point-max)))) 1176 1177(defsubst sli-within-long-comment nil 1178 (let*((aux (sli-get-safe-backward-place)) 1179 (res (parse-partial-sexp aux (point)))) ;(princ (list " Yol " (nth 4 res) (not (nth 7 res)))) 1180 (if (and (nth 4 res) (not (nth 7 res))) 1181 (nth 8 res) 1182 nil))) 1183 1184(defun sli-anchored-posix-search-backward (regexp lim &optional no-error) 1185;;; ??? DOES NOT SEEM TO WORK: (posix-search-backward regexp lim no-error)) 1186 (let ((case-fold-search sli-case-fold)) 1187 (and (re-search-backward regexp lim no-error) 1188 (let*((end-pt (match-end 0)) 1189 (beg (- end-pt sli-max-keys-length))) 1190 ;(princ "\n") (princ (list "Anchored posix. Candidate: " (match-beginning 0) (match-end 0) " beg=" beg)) 1191 ;;(princ (save-excursion (goto-char beg) (posix-search-forward regexp end-pt t))) 1192 (while (save-excursion 1193 (goto-char beg) 1194 (posix-search-forward regexp end-pt t) 1195 (< (match-end 0) end-pt)) 1196 ;;(princ "\n") (princ (list "Inside anchored posix: " (match-beginning 0) " beg=" beg)) 1197 (setq beg (1+ beg))) 1198 ;(princ "\n") (princ (list "Out of anchored posix: " (match-beginning 0) " beg=" beg)) 1199 (goto-char (match-beginning 0)))))) 1200 1201;;;--------------------------------------------------------------------------------- 1202;;; Handling text properties 1203;;;--------------------------------------------------------------------------------- 1204 1205(defsubst sli-prop-should-remove (beg props) 1206 (let ((lola 0) (res t)) 1207 (or (and (get-text-property beg 'sli-time) 1208 (> (- (cadr (current-time)) (get-text-property beg 'sli-time)) 1209 sli-prop-do-not-recompute-time)) 1210 (progn 1211 (while (< lola (/ (length props) 2)) 1212 (setq res (and res (get-text-property beg (elt props (* lola 2)))) 1213 lola (+ 1 lola))) 1214 ;; res is nil if one of the properties that PROPS wants to set 1215 ;; is not already set. 1216 (not res))))) 1217 1218(defsubst sli-prop-word (beg) 1219 (buffer-substring-no-properties beg (next-property-change beg))) 1220 1221(defsubst sli-prop-full-key (beg) 1222 (cons (buffer-substring-no-properties beg (next-property-change beg)) beg)) 1223 1224(defsubst sli-prop-region (beg) 1225 (cons beg (next-property-change beg))) 1226 1227(defun sli-prop-renew (beg end props) 1228 "PROPS is '(sli-type head sli-ancestor 66) for instance." 1229 (let ((old-buff-modp (buffer-modified-p))) 1230 (when (sli-prop-should-remove beg props) 1231 (remove-text-properties beg end '(sli-type nil sli-ancestor nil sli-reverse-ancestor nil sli-time nil)) 1232 (when sli-prop-verbose 1233 (princ "\n((sli-prop-renew) propertying ")(princ beg)) 1234 (add-text-properties beg end props) 1235 (add-text-properties beg end (list 'sli-time (cadr (current-time)))) 1236 (set-buffer-modified-p old-buff-modp)))) 1237 1238(defsubst sli-prop-renew2 (full-key props) 1239 "Same as sli-prop-renew except that full-key replaces BEG END" 1240 (sli-prop-renew (cdr full-key) (+ (cdr full-key) (length (car full-key))) props)) 1241 1242(defsubst sli-prop-has-type (beg) 1243 "Answer sli-type at BEG if it exists and is not stale. 1244Answer is nil otherwise." 1245 (if (sli-prop-should-remove beg '(sli-time 0)) nil 1246 (setq sli-prop-used (+ 1 sli-prop-used)) 1247 (get-text-property beg 'sli-type))) 1248 1249;;;--------------------------------------------------------------------------------- 1250;;; The real stuff starts here. 1251;;;--------------------------------------------------------------------------------- 1252;;; 1253;;; Functions to get pairs .... 1254;;; 1255 1256(defun sli-reduce-skel (skel &optional full) 1257 ; (cdr skel) is reduced if FULL is nil. With a t value, 1258 ; (cdr skel goes through reduction. 1259 (if (null skel) nil 1260 (let*((word (car skel)) end-lst strong-lst 1261 (found-strongp nil) (found-endp nil) 1262 (skel (if full (sli-reduce-skel (cdr skel) t) (cdr skel)))) 1263 (cond 1264 ((sli-member word sli-end-keys) ; don't do a thing ! 1265 (append (list word) skel)) 1266 ((sli-member word sli-head-keys) 1267 ;; its end should be below or it is the key we seek. Erase this closed part. 1268 (setq end-lst (sli-get-ends-from-head word)) 1269 ;(princ "\n") (princ (list "(sli-reduce-skel): end-lst is " end-lst)) 1270 (while (and skel (not (sli-member (car skel) end-lst))) 1271 (setq skel (cdr skel))) 1272 ;(princ "\n") (princ (list "(sli-reduce-skel): last skel is " skel)) 1273 (if (null skel) (list word) (cdr skel))) ; the answer. 1274 ((sli-member word sli-strong-keys) 1275 ;; its end should be below or it is the key we seek. 1276 (setq end-lst (sli-get-ends-from-strong word) 1277 strong-lst (sli-get-strongs-from-strong-or-head word)) 1278 (mapc (lambda (s) 1279 (setq found-endp (or found-endp (sli-member s end-lst)) 1280 found-strongp (or found-strongp (sli-member s strong-lst)))) 1281 skel) 1282 (cond 1283 (found-endp 1284 (while (and skel (not (sli-member (car skel) end-lst))) 1285 (setq skel (cdr skel)))) 1286 ;; So word is a strong key with no end below. 1287 (found-strongp 1288 (while (and skel (not (sli-member (car skel) strong-lst))) 1289 (setq skel (cdr skel))) 1290 (when (and (cdr skel) (sli-member (cadr skel) strong-lst)) 1291 (setq skel (cdr skel))))) 1292 (append (list word) skel)))))) 1293 1294(defun sli-find-matching-key (pt whatwewant relevant &optional givekey forspecialhead) ; goes backward 1295"PT is supposedly at beginning of an end/strong-key, out of comment or 1296string and we look for the first element of WHATWEWANT which is not 1297in a complete expression. RELEVANT is the list of keys that may 1298intervene. If GIVEKEY, then full-key is given else key only. 1299That's a kind of backward-sexp... 1300If FORSPECIALHEAD is t, then if we find a special-head before PT, 1301we stop and answer t. 1302Supports imbedded comments. Answer nil if not found." 1303 (save-excursion 1304 (goto-char pt) 1305 ;(princ "\n") (princ (list "(sli-find-matching-key) getting in with " pt whatwewant relevant)) 1306 (if (and (sli-prop-has-type (point)) 1307 (get-text-property (point) 'sli-ancestor) 1308 (sli-member (sli-prop-word (get-text-property (point) 'sli-ancestor)) whatwewant)) 1309 (sli-prop-full-key (get-text-property (point) 'sli-ancestor)) 1310 (when (and (sli-prop-has-type (point)) 1311 (get-text-property (point) 'sli-ancestor)) 1312 ;; but the ancestor is not the good one. Still go till there : 1313 (setq pt (get-text-property (point) 'sli-ancestor))) 1314 (let ((level-comment1 0) (skel '()) 1315 (foundp nil) (ans nil) (case-fold-search sli-case-fold) 1316 word start (in-stringp nil) ancestor 1317 (aregexp (sli-regexp-opt 1318 (append relevant 1319 (list "\"" block-comment-start block-comment-end))))) 1320 (while (and (not foundp) (not (bobp))) 1321 ;(princ "\n") (princ (list "(sli-find-matching-key) word " word "skel" skel)) 1322 (if (sli-anchored-posix-search-backward aregexp nil 1) 1323 (cond 1324 ((string= (setq word (match-string-no-properties 0)) "\"") 1325 (if (= (preceding-char) ?\\) 1326 (setq in-stringp t) ; it should already be. 1327 (setq in-stringp (not in-stringp)))) 1328 (in-stringp) 1329 ; Out of strings: 1330 ((string= word block-comment-end) 1331 (sli-prop-renew (match-beginning 0) (match-end 0) '(sli-type block-comment-end)) 1332 (setq level-comment1 (+ 1 level-comment1))) 1333 ((string= word block-comment-start) 1334 ; in case the string we look for is a block-comment-start 1335 (sli-prop-renew (match-beginning 0) (match-end 0) '(sli-type block-comment-start)) 1336 (setq level-comment1 (1- level-comment1)) 1337 (when (and (< level-comment1 0) 1338 (equal (list block-comment-start) whatwewant)) 1339 ; in case the string we look for is a block-comment-start 1340 ;(princ (list "Found !" (point))) 1341 (setq ans (if givekey (cons word (point)) (point)) 1342 foundp t))) 1343 ((sli-member word sli-comment-starts)) ; within a one-line-comment 1344 ((> level-comment1 0)); within a multiline-comment 1345 ;; Out of imbedded comments. Now word is in RELEVANT. 1346 ((not (sli-member word relevant)) ; should not happen!! 1347 (setq foundp t ans nil)) 1348 ((and forspecialhead 1349 (sli-member word whatwewant)) 1350 ;; Avoid crossed recursivity of next point. 1351 (setq foundp t ans (if givekey (cons word (point)) (point)))) 1352 ((setq ancestor (sli-is-a-special-head (point) word)) 1353 ;; crossed recursivity ... But point is going backward ! 1354 (sli-prop-renew2 (cons word (point)) 1355 (list 'sli-type 'special-head 'sli-ancestor (cdr ancestor))) 1356 (if (or (sli-separator-directly-afterp pt word) 1357 (sli-in-one-line-comment)) 1358 (goto-char (+ (cdr ancestor) (length (car ancestor)))) 1359 (setq ans (if givekey (cons word (point)) (point)) foundp t))) 1360 ((save-excursion (sli-in-one-line-comment))) 1361 (t (setq skel (sli-reduce-skel (append (list word) skel)) 1362 forspecialhead nil) 1363 (when (and (= 1 (length skel)) (sli-member (car skel) whatwewant)) 1364 (setq ans (if givekey (cons word (point)) (point)) 1365 foundp t)))) ; end of cond 1366 )) ; end of while 1367 ;(princ "\n") (princ (list "(sli-find-matching-key) out with " ans)) 1368 ans)))) 1369 1370(defsubst sli-special-head-headp (word) 1371 "Answer not nil if WORD is a special-head that can be a head." 1372 (assoc (sli-keyword word) sli-special-head-heads-alist)) 1373 1374(defun sli-is-a-special-head (pt word) 1375 "Answer nil if WORD located at PT is not a special-head. WORD should not be 1376in comment, and PT is before WORD. If WORD is a special-head that can be a 1377head, answer is nil if it acts like a head; else answer is 1378(previousword . previouspt) where previousword is the one that showed that word 1379was a special-head: it is thus a special-head or a head located before (word . pt). " 1380 (save-match-data 1381 (cond 1382 ((sli-special-head-headp word) 1383 (cond 1384 ((and (eq (sli-prop-has-type pt) 'special-head) 1385 (get-text-property pt 'sli-ancestor)) 1386 (sli-prop-full-key (get-text-property pt 'sli-ancestor))) 1387 ;; An easy trick: if a separator is not after, it can't be a special-head ! 1388 ((not (sli-separator-directly-afterp (point-max) word)) 1389 (sli-prop-renew pt (+ pt (length word)) '(sli-type head)) 1390 nil) 1391 (t (let ((appui (sli-find-matching-key 1392 pt (sli-get-special-head-previous-heads word) 1393 (sli-get-relevant word) t t))) 1394 (if (consp appui) 1395 (sli-prop-renew pt (+ pt (length word)) 1396 (list 'sli-type 'special-head 'sli-ancestor (cdr appui))) 1397 (if appui (sli-prop-renew pt (+ pt (length word)) '(sli-type special-head)) 1398 (sli-prop-renew pt (+ pt (length word)) '(sli-type head)))) 1399 appui)))) 1400 (t (sli-member word sli-special-head-keys))))) 1401 1402(defun sli-get-corresponding-key (pt whatwewant) 1403 ;; answer is (block-comment-start . point) 1404 ;; if PT is within a multiline-comment. 1405 ;; PT is at the beginning of the word we want to match. 1406 ;; This function skips 1407 ;; head/end blocks by using sli-find-matching-key. 1408 ;; Answers the first element of what we want that is not 1409 ;; enclosed in a construct. 1410 (save-excursion 1411 (goto-char pt) 1412 (let ((level-comment1 0) (foundp nil) beg aux 1413 word start (in-stringp nil) (case-fold-search sli-case-fold) 1414 (relevant (append whatwewant 1415 sli-comment-starts 1416 (list "\"" block-comment-start block-comment-end))) 1417 aregexp) 1418 (dolist (wd whatwewant) 1419 (dolist (x (cdr (assoc (sli-keyword wd) sli-relevant-alist))) 1420 (when (sli-member x sli-end-keys) (add-to-list 'relevant x)))) 1421 (setq aregexp (sli-regexp-opt relevant) sli-key-is-a-special-headp nil) 1422 ;(princ "\n") (princ (list "(sli-get-corresponding-key) getting in " relevant)) 1423 (while (and (not foundp) (not (bobp))) 1424 (if (sli-anchored-posix-search-backward aregexp nil 1) 1425 (cond 1426 ((string= (setq word (match-string-no-properties 0)) "\"") 1427 (if (= (preceding-char) ?\\) 1428 (setq in-stringp t) ; it should already be. 1429 (setq in-stringp (not in-stringp)))) 1430 (in-stringp) 1431 ; Out of strings: 1432 ((string= word block-comment-end) 1433 (sli-prop-renew (point) (+ (point) (length word)) '(sli-type block-comment-end)) 1434 (setq level-comment1 (1+ level-comment1))) 1435 ((string= word block-comment-start) 1436 (sli-prop-renew (point) (+ (point) (length word)) '(sli-type block-comment-start)) 1437 (if (= level-comment1 0) 1438 (setq foundp t) 1439 (setq level-comment1 (1- level-comment1)))) 1440 ((sli-member word sli-comment-starts)) ; within a one-line-comment 1441 ((> level-comment1 0)); within a multiline-comment 1442 ;; Out of imbedded comments: 1443 ((sli-member word sli-end-keys) 1444 (setq start (point)) 1445 (unless (sli-in-one-line-comment) 1446 (if (setq beg (sli-find-matching-key 1447 start (sli-get-heads-from-end word) (sli-get-relevant word) t)) 1448 (progn 1449 (goto-char (cdr beg)) 1450 (sli-prop-renew start (+ start (length word)) 1451 (list 'sli-type 'end 'sli-ancestor (cdr beg))) 1452 (sli-prop-renew2 beg (list 'sli-type 'head 'sli-reverse-ancestor start))) 1453 (goto-char (point-min))))) 1454 ((not (sli-member word whatwewant))) 1455 ((sli-special-head-headp word) ;; special heads that can be heads 1456 (when sli-verbose 1457 (princ "\n") 1458 (princ 1459 (list "(sli-get-corresponding-key) Found special-head that could be a head: " 1460 word "..."))) 1461 (if (setq aux (sli-is-a-special-head (point) word)) 1462 ;; acts like a special head: 1463 (unless (or (sli-separator-directly-afterp pt word) 1464 (sli-in-one-line-comment)) 1465 (sli-prop-renew (point) (+ (point) (length word)) 1466 (list 'sli-type 'special-head 'sli-ancestor (cdr aux))) 1467 (setq foundp t sli-key-is-a-special-headp t)) 1468 ;; acts like a head: 1469 (when sli-verbose (princ "\n( ... and is indeed one !)")) 1470 (sli-prop-renew (point) (+ (point) (length word)) '(sli-type head)) 1471 (setq foundp (sli-member word whatwewant)))) 1472 ((sli-member word sli-special-head-keys) 1473 (unless (or (sli-separator-directly-afterp pt word) 1474 (sli-in-one-line-comment)) 1475 (setq foundp t))) 1476 ((sli-member word whatwewant) 1477 (setq start (point)) 1478 (unless (sli-in-one-line-comment) 1479 (setq foundp t))) 1480 (t nil)) 1481 )) 1482 ;(princ "\n") (princ (list "(sli-get-corresponding-key) out with " (if foundp (cons word (point)) nil))) 1483 (if foundp (cons word (point)) nil)))) 1484 1485(defsubst sli-get-key-for-soft (pt soft) 1486 (sli-get-corresponding-key pt (sli-get-head-and-strong-from-soft soft))) 1487 1488(defun sli-get-key-for-strong (pt strong) 1489 (sli-get-corresponding-key pt (sli-get-heads-from-strong strong))) 1490 1491(defun sli-get-key-for-end (pt end) 1492 "Looking for head of (END.PT)." 1493 (sli-get-corresponding-key pt (sli-get-heads-from-end end))) 1494 1495(defsubst sli-get-head-from-ambiguous (pt key) 1496 (let (auxkey) 1497 (cond 1498 ((sli-member key sli-strong-keys) 1499 (sli-get-key-for-strong pt key)) 1500 ((sli-member key sli-soft-keys) 1501 (unless (sli-member (car (setq auxkey (sli-get-key-for-soft (point) key))) sli-head-keys) 1502 (setq auxkey (sli-get-key-for-strong pt (car auxkey)))) 1503 (if auxkey auxkey 'sli-fail)) 1504 (t 'sli-fail)))) 1505 1506(defun sli-separator-directly-afterp (end word) 1507 "t if there is SEPARATOR between (1+ point) and end 1508which is not within a comment or a string and such that 1509no keyword appear in between except maybe someone in 1510sli-constructor-keys." 1511 (save-excursion 1512 (forward-char 1) 1513 ;(princ "\n") (princ (list "Getting in sli-separator-directly-afterp with " (point) end word)) 1514 (let ((level-comment1 0) (level 0) (foundp nil) 1515 wd (in-stringp nil) (directlyp nil) 1516 (separators (cdr (assoc (sli-keyword word) sli-special-head-alist))) 1517 (case-fold-search sli-case-fold)) 1518 (while (and (not foundp) (< (point) end)) 1519 (when (posix-search-forward sli-all-keys-and-constructors-regexp end 1) 1520 (cond 1521 ((string= (setq wd (match-string-no-properties 0)) "\"") 1522 (if (= (preceding-char) ?\\) 1523 (setq in-stringp t) ; it should already be. 1524 (setq in-stringp (not in-stringp)))) 1525 (in-stringp) 1526 ; Out of strings: 1527 ((string= wd block-comment-end) 1528 (setq level-comment1 (1- level-comment1))) 1529 ((string= wd block-comment-start) 1530 (setq level-comment1 (1+ level-comment1))) 1531 ((sli-member wd sli-comment-starts) (forward-line 1)) ; within a one-line-comment 1532 ((> level-comment1 0)); within a multiline-comment 1533 ;; Out of imbedded comments: 1534 ((and (member wd separators) (sli-is-a-separatorp (1- (point)))) 1535 (setq foundp t directlyp t)) 1536 ((sli-member wd sli-constructor-keys)) 1537 (t (setq foundp t)) 1538 ))) 1539 ;(princ "\n") (princ (list "Out of sli-separator-directly-afterp. directlyp = " directlyp)) 1540 directlyp))) 1541 1542;;;---------------------------------------------------------------------------- 1543;;;--- beginning of forward/backward/scan-sexp/s 1544;;;---------------------------------------------------------------------------- 1545 1546(defsubst sli-move-a-bit-before nil 1547 (let ((p (point))(case-fold-search sli-case-fold)) 1548 (save-restriction 1549 (unwind-protect 1550 (progn 1551 (narrow-to-region 1552 (progn (re-search-backward "\\s-" nil 1) 1553 (when (and (not (eobp)) 1554 (not (member (char-syntax (char-after)) '(?w ?_ ?\( ?\) ?$)))) 1555 (forward-char 1)); at beob 1556 (point)) 1557 (progn (re-search-forward "\\s-" nil 1) 1558 (when (and (not (bobp)) 1559 (not (member (char-syntax (preceding-char)) '(?w ?_ ?\( ?\) ?$)))) 1560 (forward-char -1)); at eob 1561 (point))) 1562 (goto-char p) 1563 (when (member (char-syntax (preceding-char)) '(?w ?_ ?\( ?\) ?$)) 1564 (skip-syntax-backward "w_()$")) 1565 (while (and (<= (point) p);(princ (list "sli-move-a-bit-before" (point))) 1566 (posix-search-forward sli-all-keys-regexp nil t))); we have gone too far. 1567 (sli-anchored-posix-search-backward sli-all-keys-regexp nil 1)) 1568 (widen))) 1569 (when sli-verbose (print (list p (point)))) 1570 (if (> (point) p) (progn (goto-char p) nil) t))) 1571 1572(defun sli-skip-to-beginning-of-keyword nil 1573 (sli-move-a-bit-before)) 1574 1575(defun sli-find-full-key-at-point (&optional move) 1576 (save-excursion 1577 (if (or (sli-move-a-bit-before) move) 1578 (progn 1579 ;(princ "\n")(princ (list "sli-find-full-key-at-point"(match-string-no-properties 0) (point))) 1580 (cons (match-string-no-properties 0) (point))) 1581 nil))) 1582 1583(defun sli-backward-sexp (&optional arg) 1584 "A backward-sexp. If point is after an end or a strong, 1585go to its head. If point is in the middle of the text, 1586use backward-word. If ARG, repeat that many times. 1587Answer POINT of where to go" 1588 (save-restriction 1589 (condition-case err 1590 (progn 1591 (if (and arg (< arg 0)) 1592 (sli-forward-sexp (- arg)) 1593 (let ((n (or arg 1)) first-stuff beg pt (modifiedp (buffer-modified-p)) 1594 (case-fold-search sli-case-fold)) 1595 (while (> n 0) 1596 (setq first-stuff (sli-find-full-key-at-point t)) 1597 (goto-char (setq pt (cdr first-stuff))) 1598 (when sli-verbose 1599 (princ "\n") (princ (list "(sli-backward-sexp) to be matched: " first-stuff))) 1600 (if (or (null first-stuff) 1601 (search-backward " " pt t) 1602 (not (sli-member (car first-stuff) (append sli-end-keys sli-strong-keys)))) 1603 ;; The previous word is not an end or a strong: 1604 (progn 1605 (when sli-verbose 1606 (princ "\n") (princ (list "(sli-backward-sexp) nothing special"))) 1607 ;; Do *not* use backward-sexp, it is advised !!! 1608 (forward-word -1)) 1609 (cond 1610 ((and (sli-prop-has-type (cdr first-stuff)) 1611 (get-text-property (cdr first-stuff) 'sli-ancestor) 1612 (sli-member (sli-prop-word (get-text-property (cdr first-stuff) 'sli-ancestor)) 1613 sli-head-keys)) 1614 (goto-char (get-text-property (cdr first-stuff) 'sli-ancestor))) 1615 ((sli-member (car first-stuff) sli-end-keys) 1616 (setq beg (sli-get-key-for-end 1617 (if (and (sli-prop-has-type (cdr first-stuff)) 1618 (get-text-property (cdr first-stuff) 'sli-ancestor)) 1619 ;; An ancestor exists. It is a strong. Still it is better than nothing. 1620 (get-text-property (cdr first-stuff) 'sli-ancestor) 1621 (cdr first-stuff)) 1622 (car first-stuff))) 1623 (when sli-verbose 1624 (princ "\n") (princ (list "(sli-backward-sexp) match: " beg))) 1625 (cond 1626 ((and (consp beg) (equal (car beg) block-comment-start));;un' 1627 (sli-prop-renew2 beg '(sli-type block-comment-start)) 1628 (goto-char (cdr beg))) 1629 ((consp beg) 1630 (sli-prop-renew2 first-stuff (list 'sli-type 'end 'sli-ancestor (cdr beg))) 1631 (sli-prop-renew2 beg (list 'sli-type 'head 'sli-reverse-ancestor (cdr first-stuff))) 1632 (goto-char (cdr beg))) 1633 (t nil))) 1634 ((sli-member (car first-stuff) sli-strong-keys) 1635 (setq beg (sli-get-key-for-strong (cdr first-stuff) (car first-stuff))) 1636 (when sli-verbose (princ "\n") (princ (list "(sli-backward-sexp) match: " beg))) 1637 (cond 1638 ((and (consp beg) (equal (car beg) block-comment-start));;un' 1639 (sli-prop-renew2 beg '(sli-type block-comment-start)) 1640 (goto-char (cdr beg))) 1641 ((consp beg) 1642 (sli-prop-renew2 first-stuff (list 'sli-type 'strong 'sli-ancestor (cdr beg))) 1643 (sli-prop-renew2 beg (list 'sli-type 'head 'sli-reverse-ancestor (cdr first-stuff))) 1644 (goto-char (cdr beg))) 1645 (t nil))) 1646 (t (when sli-verbose (princ "\n(sli-backward-sexp) Should not be here!)"))))) 1647 (setq n (- n 1))) 1648 (set-buffer-modified-p modifiedp))) 1649 (when sli-verbose (princ "\n") (princ (list "(sli-backward-sexp) answer: " (point)))) 1650 (point)) 1651 (error (princ "\n(sli-backward-sexp): ") (princ err) nil)))) 1652 1653(defun sli-find-end-forward (pt word) 1654 "WORD is a head or a strong. PT is at beginning of WORD. 1655Answer is (endword . endpoint)." 1656 (let ((whatwewant-regexp (if (sli-member word sli-head-keys) 1657 (sli-regexp-opt (sli-get-ends-from-head word)) 1658 (sli-regexp-opt (sli-get-ends-from-strong word)))) 1659 foundp end his-head (case-fold-search sli-case-fold)) 1660 (if (and (sli-prop-has-type pt) 1661 (get-text-property pt 'sli-reverse-ancestor)) 1662 (sli-prop-full-key (get-text-property pt 'sli-reverse-ancestor)) 1663 ;; Start the swallow/unswallow process : 1664 (save-restriction 1665 (unwind-protect 1666 (progn 1667 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 1668 (while (and (re-search-forward whatwewant-regexp nil t) 1669 (not foundp)) 1670 (goto-char (match-beginning 0)) 1671 (setq end (cons (match-string-no-properties 0) (match-beginning 0))) 1672 (when sli-verbose 1673 (princ "\n") 1674 (princ (list "(sli-find-end-forward) Potential end:" end))) 1675 (setq his-head (sli-get-key-for-end (point) (car end)) 1676 foundp (or (null his-head) ; meaning we don't understand a thing! 1677 (and (consp his-head) (<= (cdr his-head) pt)))) 1678 (when sli-verbose 1679 (princ "\n") 1680 (princ (list "(sli-find-end-forward) His head:" his-head))) 1681 (when (consp his-head) 1682 (sli-prop-renew2 end (list 'sli-type 'end 'sli-ancestor (cdr his-head))) 1683 (sli-prop-renew2 1684 his-head (list 'sli-type 'head 'sli-reverse-ancestor (cdr end)))) 1685 ;; In case the end found was closing something in between, continue from after: 1686 (goto-char (+ (cdr end) (length (car end)))) 1687 )) 1688 (widen))) 1689 (if foundp end nil)))) 1690 1691(defun sli-forward-sexp (&optional arg) 1692 "A forward-sexp. If point is before a head or a strong, 1693go to its end. If point is in the middle of the text, 1694use forward-word. If ARG, repeat that many times. 1695Answer POINT of where to go." 1696 (save-restriction 1697 (condition-case err 1698 (progn 1699 (if (and arg (< arg 0)) 1700 (sli-backward-sexp (- arg)) 1701 (let ((n (or arg 1)) end beg aux (modifiedp (buffer-modified-p)) 1702 (case-fold-search sli-case-fold)) 1703 (while (> n 0) 1704 (sli-skip-to-beginning-of-keyword) 1705 (cond 1706 ((posix-looking-at (regexp-opt (if (boundp 'block-comment-start) 1707 (append sli-comment-starts (list block-comment-start)) 1708 sli-comment-starts))) 1709 ;; In comment: use text forward-sexp. 1710 (when sli-verbose (princ "\n((sli-forward-sexp) comments)")) 1711 ;; Do *not* use forward-sexp !!! 1712 (forward-word 2)) 1713 ((or (setq aux (member (sli-prop-has-type (point)) '(head strong))) 1714 (and (posix-looking-at sli-head-regexp) 1715 (not (sli-is-a-special-head (match-beginning 0) (match-string-no-properties 0)))) 1716 (posix-looking-at sli-strong-regexp)) 1717 (if aux 1718 (setq beg (sli-prop-full-key (point)) 1719 end (sli-find-end-forward (point) (car beg))) 1720 (setq beg (cons (match-string-no-properties 0) (match-beginning 0)) 1721 end (sli-find-end-forward (point) (match-string-no-properties 0)))) 1722 (when sli-verbose 1723 (princ "\n") (princ (list "(sli-forward-sexp) to be matched: " beg)) 1724 (princ "\n") (princ (list "(sli-forward-sexp) match: " end))) 1725 (cond 1726 ((and (consp end) (equal (car end) block-comment-end));;un' 1727 (sli-prop-renew2 beg (list 'sli-type (if (sli-member (car beg) sli-head-keys) 1728 'head 'strong))) 1729 (sli-prop-renew2 end '(sli-type block-comment-end)) 1730 (goto-char (+ (length block-comment-end) (cdr end)))) 1731 ((consp end) 1732 (sli-prop-renew2 1733 beg (list 'sli-type (if (sli-member (car beg) sli-head-keys) 'head 'strong) 1734 'sli-reverse-ancestor (cdr end))) 1735 (sli-prop-renew2 end (list 'sli-type 'end 'sli-ancestor (cdr beg))) 1736 (goto-char (+ (length (car end)) (cdr end)))) 1737 (t nil))) 1738 (t (when sli-verbose (princ "\n((sli-forward-sexp) nothing found)")) 1739 (forward-word 2))) 1740 (setq n (- n 1))) 1741 (set-buffer-modified-p modifiedp))) 1742 (when sli-verbose (princ "\n") (princ (list "(sli-forward-sexp) answer: " (point)))) 1743 (point)) 1744 (error (princ "\n(sli-forward-sexp): ") (princ err) nil)))) 1745 1746(defun sli-scan-sexps (pt count) 1747 (goto-char pt) 1748 (when sli-verbose (princ "\n((sli-scan-sexps))")) 1749 (if (< count 0) 1750 (sli-backward-sexp count) 1751 (sli-forward-sexp count))) 1752 1753(defvar sli-select-end-of-overlay-fn 1754 'sli-select-end-of-overlay-fn-default 1755"Function used to give the end of the overlay. 1756Takes two arguments KEY and PT. 1757Default value is `sli-select-end-of-overlay-fn-default'.") 1758 1759(defun sli-select-end-of-overlay-fn-default (key pt) 1760 (+ pt (length key))) 1761 1762(defun sli-select-end-of-overlay (key pt) 1763 (funcall sli-select-end-of-overlay-fn key pt)) 1764 1765(defun sli-show-sexp (&optional arg) 1766 "POINT is on a head or end key. 1767This key is highlighted as well as its corresponding end/head. 1768Color used is `show-paren-match-face'. Nothing is highlighted 1769if no corresponding key is found. 1770 When used with prefix C-u, remove stale text properties and 1771recompute things by setting `sli-prop-do-not-recompute-time' to 0." 1772 (interactive "P") 1773 (save-excursion 1774 (save-restriction 1775 (let ((old-sli-prop-do-not-recompute-time sli-prop-do-not-recompute-time)) 1776 (unwind-protect 1777 (let ((full-key (sli-find-full-key-at-point)) pt 1778 (modifiedp (buffer-modified-p))) 1779 (when sli-verbose 1780 (princ "\n") 1781 (princ (list "(sli-show-sexp) full-key-at-point: " full-key))) 1782 (when full-key (setq pt (goto-char (cdr full-key)))) 1783 (when (and arg (= (car arg) 4)) ;; call prefixed by C-u 1784 (setq sli-prop-do-not-recompute-time 0)) 1785 (setq sli-prop-used 0) 1786 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 1787 (cond 1788 ((and full-key (sli-member (car full-key) sli-head-keys) 1789 (not (sli-is-a-special-head (cdr full-key) (car full-key))));(print full-key) 1790 (move-overlay sli-overlay-beg (cdr full-key) 1791 (sli-select-end-of-overlay (car full-key) (cdr full-key))) 1792 (if (and (sli-forward-sexp) 1793 (equal (get-text-property (1- (point)) 'sli-type) 'end)); ?(1- point) ?? 1794 (progn 1795 (overlay-put sli-overlay-beg 'face 'show-paren-match-face) 1796 (overlay-put sli-overlay-end 'face 'show-paren-match-face) 1797 (when sli-prop-verbose 1798 (princ "\n") 1799 (princ (list "(sli-show-sexp) overlay-end:" 1800 (get-text-property pt 'sli-reverse-ancestor) (point)))) 1801 (goto-char (1- (point))) 1802 (setq full-key (sli-find-full-key-at-point));(print full-key) 1803 (move-overlay sli-overlay-end (get-text-property pt 'sli-reverse-ancestor) 1804 (sli-select-end-of-overlay (car full-key) (cdr full-key)))) 1805 (overlay-put sli-overlay-beg 'face 'show-paren-mismatch-face) 1806 (move-overlay sli-overlay-end (point-min) (point-min)))) 1807 ((and full-key (sli-member (car full-key) sli-end-keys)) 1808 (move-overlay sli-overlay-end (cdr full-key) 1809 (sli-select-end-of-overlay (car full-key) (cdr full-key))) 1810 (if (and (sli-backward-sexp) 1811 (equal (get-text-property (point) 'sli-type) 'head)) 1812 (progn 1813 (overlay-put sli-overlay-beg 'face 'show-paren-match-face) 1814 (overlay-put sli-overlay-end 'face 'show-paren-match-face) 1815 (when sli-prop-verbose 1816 (princ "\n") 1817 (princ (list "(sli-show-sexp) overlay-beg:" 1818 (get-text-property pt 'sli-ancestor) (next-property-change (point)))) 1819 (princ "\n") 1820 (princ (list "(sli-show-sexp) number of text-properties used:" sli-prop-used))) 1821 (goto-char (get-text-property pt 'sli-ancestor)) 1822 (setq full-key (sli-find-full-key-at-point)) 1823 (move-overlay sli-overlay-beg (cdr full-key) 1824 (sli-select-end-of-overlay (car full-key) (cdr full-key)))) 1825 (overlay-put sli-overlay-end 'face 'show-paren-mismatch-face) 1826 (move-overlay sli-overlay-beg (point-min) (point-min)))) 1827 (t ;; Erase overlays: 1828 (when sli-prop-verbose 1829 (princ (list "\n(sli-show-sexp) Erasing overlays"))) 1830 (move-overlay sli-overlay-beg (point-min) (point-min)) 1831 (move-overlay sli-overlay-end (point-min) (point-min)))) 1832 (set-buffer-modified-p modifiedp) 1833 (widen) 1834 (setq sli-prop-do-not-recompute-time old-sli-prop-do-not-recompute-time))))))) 1835 1836(defvar sli-show-sexp-idle-timer nil) 1837 1838(defun sli-show-sexp-semi-mode (arg) 1839 "When ARG>0 corresponding head/end keys are automatically 1840shown with an idle timer. When ARG=0, sli-show-sexp is bound 1841to f8. When ARG is anything else, remove `sli-overlay-beg' and 1842`sli-overlay-end'." 1843 (when sli-show-sexp-idle-timer 1844 (cancel-timer sli-show-sexp-idle-timer)) 1845 (cond 1846 ((< 0 arg) 1847 (setq sli-show-sexp-idle-timer 1848 (run-with-idle-timer (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) 1849 t 'sli-show-sexp))) 1850 ((= 0 arg) 1851 (move-overlay sli-overlay-beg (point-min) (point-min)) 1852 (move-overlay sli-overlay-end (point-min) (point-min)) 1853 (local-set-key [f8] 'sli-show-sexp)) 1854 (t 1855 (move-overlay sli-overlay-beg (point-min) (point-min)) 1856 (move-overlay sli-overlay-end (point-min) (point-min))))) 1857 1858(defadvice forward-sexp (around sli-handles-forward-sexp (&optional arg)) 1859 (interactive) 1860 (if (bound-and-true-p sli-handles-sexp) (sli-forward-sexp arg) ad-do-it)) 1861 1862(defadvice backward-sexp (around sli-handles-backward-sexp (&optional arg)) 1863 (interactive) 1864 (if (bound-and-true-p sli-handles-sexp) (sli-backward-sexp arg) ad-do-it)) 1865 1866(require 'advice) 1867(ad-activate 'forward-sexp 'around) 1868(ad-activate 'backward-sexp 'around) 1869 1870;;;---------------------------------------------------------------------------- 1871;;;--- end of forward/backward/scan-sexp/s 1872;;;---------------------------------------------------------------------------- 1873;;; 1874;;; Indentation 1875;;; 1876 1877(defun sli-get-first-fixed-or-strong-or-end-or-soft (pt) 1878 ; Go to first non whitespace char on line on which PT lies and before PT. 1879 ; Then nil if within comment or first word is not a fixed/end/strong/soft key, 1880 ; the cons (KEY . point-at-its-beginning) otherwise. 1881 (save-excursion 1882 (save-restriction 1883 (unwind-protect 1884 (let (aux (case-fold-search sli-case-fold)) 1885 (narrow-to-region (progn (beginning-of-line) (point)) pt) 1886 (skip-chars-forward " \t") 1887 ;(princ "\n") (princ (list "(sli-get-first-fixed-or-strong-or-end-or-soft)" (point))) 1888 (cond ((setq aux (sli-prop-has-type (point))) 1889 (cond ((member aux '(block-comment-end block-comment-start)) 1890 (cons (eval aux) (point))) 1891 ((and (or (member aux '(end strong soft)) 1892 (assoc (sli-keyword (sli-prop-word (point))) sli-fixed-keys-alist)) 1893 (<= (next-property-change (point)) pt)) 1894 (sli-prop-full-key (point))) 1895 (t nil))) 1896 ((posix-looking-at (regexp-opt (append sli-comment-starts (list block-comment-start)))) 1897 (sli-prop-renew (match-beginning 0) (match-end 0) (list 'sli-type 'block-comment-start)) 1898 (cons block-comment-start (point))) 1899 ((posix-looking-at (regexp-opt (list block-comment-end))) 1900 (sli-prop-renew (match-beginning 0) (match-end 0) (list 'sli-type 'block-comment-end)) 1901 (cons block-comment-end (point))) 1902 ((posix-looking-at (sli-regexp-opt sli-soft-keys)) 1903 (sli-prop-renew (match-beginning 0) (match-end 0) (list 'sli-type 'soft)) 1904 (cons (match-string-no-properties 0) (point))) 1905 ((or (posix-looking-at sli-fixed-regexp) 1906 (posix-looking-at sli-all-end-strong-regexp)) 1907 (cons (match-string-no-properties 0) (point))) 1908 (t nil))) 1909 (widen))))) 1910 1911(defun sli-get-first-non-end-key (pt &optional nomrelation) ; goes backward 1912"Find first non-end-key before PT outside comment 1913or string which is not matched by an end-key. 1914Imbedded comments are supported. 1915If NOMRELATION is t, then this key is not a math-relation 1916either. Answer is a full-key (KEY . POINT) 1917where POINT indicates the beginning of the occurence 1918of KEY we're interested in. 1919Answer is (block-comment-start . point) 1920if PT is within a multiline-comment." 1921 (save-excursion 1922 (goto-char pt) 1923 (let ((level-comment1 0) (foundp nil) beg 1924 (accessible-separator (sli-member (char-to-string (preceding-char)) sli-separators)) 1925 word start (in-stringp nil) (case-fold-search sli-case-fold) 1926 (aregexp 1927 (if nomrelation sli-all-keys-nomrelations-noseparators-regexp sli-all-keys-regexp))) 1928 (setq sli-key-is-a-special-headp nil) 1929 (while (and (not foundp) (not (bobp))) 1930 (if (sli-anchored-posix-search-backward aregexp nil 1) 1931 (progn ;(princ "\n") 1932 ;(princ (list "(sli-get-first-non-end-key). word = " (match-string-no-properties 0) (point))) 1933 (cond 1934 ((string= (setq word (match-string-no-properties 0)) "\"") 1935 (if (= (preceding-char) ?\\) 1936 (setq in-stringp t) ; it should already be. 1937 (setq in-stringp (not in-stringp)))) 1938 (in-stringp) 1939 ;; Out of strings: 1940 ((string= word block-comment-end) 1941 (setq start (point)) 1942 ;(princ "\n") (princ (list "(sli-get-first-non-end-key) In block-comment.")) 1943 (unless (sli-in-one-line-comment) 1944 (if (setq beg (sli-find-matching-key 1945 start (list block-comment-start) (list block-comment-start) t)) 1946 (progn 1947 (goto-char (cdr beg)) 1948 (sli-prop-renew start (+ start (length word)) 1949 (list 'sli-type 'block-comment-end 'sli-ancestor (cdr beg))) 1950 (sli-prop-renew2 1951 beg (list 'sli-type 'block-comment-start 'sli-reverse-ancestor start))) 1952 (setq level-comment1 (1+ level-comment1)) 1953 (goto-char (point-min))))) 1954 ((string= word block-comment-start) 1955 (sli-prop-renew start (+ start (length word)) '(sli-type block-comment-start)) 1956 (if (= level-comment1 0) 1957 (setq foundp t) 1958 (setq level-comment1 (1- level-comment1)))) 1959 ((sli-member word sli-comment-starts)) ; within a one-line-comment 1960 ((> level-comment1 0)); within a multiline-comment 1961 ;; Out of imbedded comments: 1962 ((sli-is-a-separatorp) ; only if NOMRELATION is t. 1963 (setq start (point)) 1964 (unless (sli-in-one-line-comment) 1965 (goto-char start) (setq accessible-separator t))) 1966 ((sli-member word sli-math-relation-keys) ; only if NOMRELATION is t. 1967 (unless accessible-separator 1968 (setq start (point)) 1969 (unless (sli-in-one-line-comment) 1970 (goto-char start) (setq foundp t)))) 1971 ((sli-member word sli-end-keys) 1972 (setq start (point)) 1973 (unless (sli-in-one-line-comment) 1974 (if (setq beg (sli-find-matching-key 1975 start (sli-get-heads-from-end word) (sli-get-relevant word) t)) 1976 (progn 1977 (goto-char (cdr beg)) 1978 (sli-prop-renew start (+ start (length word)) 1979 (list 'sli-type 'end 'sli-ancestor (cdr beg))) 1980 (sli-prop-renew2 beg (list 'sli-type 'head 'sli-reverse-ancestor start))) 1981 (goto-char (point-min))))) 1982 ((sli-special-head-headp word) ;; special heads that can be heads 1983 (when sli-verbose 1984 (princ "\n") 1985 (princ 1986 (list "(sli-get-first-non-end-key) Found a special head that could be a head: " 1987 word " at " (point) "..."))) 1988 (if (sli-is-a-special-head (point) word) 1989 ;; acts like a special head: 1990 (unless (or (sli-separator-directly-afterp pt word) 1991 (sli-in-one-line-comment)) 1992 (sli-prop-renew (point) (+ (point) (length word)) '(sli-type special-head)) 1993 (setq foundp t sli-key-is-a-special-headp t)) 1994 ;; acts like a head: 1995 (when sli-verbose (princ "\n((sli-get-first-non-end-key) ... and is indeed one !)")) 1996 (sli-prop-renew (point) (+ (point) (length word)) '(sli-type head)) 1997 (setq foundp t))) 1998 ((sli-member word sli-special-head-keys);(princ " lyo ") 1999 (unless (or (sli-separator-directly-afterp pt word) 2000 (sli-in-one-line-comment)) 2001 (setq foundp t))) 2002 ((sli-member word sli-separators)) ;; momentanous 2003 (t (setq foundp (not (sli-in-one-line-comment)))))) 2004 )) 2005 ;(princ "\n") 2006 ;(princ (list "Out of sli-get-first-non-end-key with " 2007 ; (if foundp (cons word (point)) nil) accessible-separator)) 2008 (if foundp (cons word (point)) nil)))) 2009 2010 2011(defsubst sli-compute-indent-after (full-key &optional before-soft) 2012 (let ((the-indent (sli-indent-after (car full-key) before-soft))) ;(princ full-key) 2013 ;(princ (list "Yummy!!" the-indent)) 2014 (throw 'indent (if (consp the-indent) 2015 (cdr the-indent) ; absolute indent 2016 (+ (sli-point-to-indent (cdr full-key)) 2017 the-indent))))) 2018 2019(defsubst sli-on-same-linep (pt1 pt2) 2020 ;(princ "\n") (princ (list "(sli-on-same-linep)" pt1 pt2 ?\n 2021 ; (string-to-list (buffer-substring-no-properties pt1 pt2)))) 2022 (if (member ?\n (string-to-list (buffer-substring-no-properties pt1 pt2))) 2023 nil t)) 2024 2025(defun sli-tell-indent-within-long-comment (afterp pos-beg-comment) 2026 (when sli-verbose 2027 (princ "\n") 2028 (princ (list "(sli-tell-indent-within-long-comment) getting in with afterp = " afterp 2029 " and pos-beg-comment = "pos-beg-comment))) 2030 ;; AFTERP like in sli-tell-indent. 2031 ;; If pos-beg-comment and (point) are on the same line, do nothing: 2032 (when (and (not afterp) (sli-on-same-linep pos-beg-comment (point))) 2033 (when sli-verbose 2034 (princ "\n") 2035 (princ "((sli-tell-indent-within-long-comment) On same line as beginning of comment : no indent.)")) 2036 (throw 'indent 0)) 2037 (let*((pos-first-char (save-excursion 2038 (goto-char (+ pos-beg-comment (length block-comment-start))) 2039 (skip-syntax-forward "^w") (point))) 2040 (on-same-linep (and (or (not afterp) (< pos-first-char (point))) 2041 ; because if afterp is true, a \n will be inserted just before (point) 2042 (sli-on-same-linep pos-beg-comment pos-first-char))) 2043 (pos-end-comment (save-excursion 2044 (goto-char (+ pos-beg-comment (length block-comment-start))) 2045 (search-forward block-comment-end nil t))) 2046 (end (line-end-position)) 2047 (special-last-linep (and pos-end-comment 2048 (= pos-end-comment 2049 (save-excursion 2050 (beginning-of-line);(princ (point))(princ " ") 2051 (skip-syntax-forward "-" end);(princ (point))(princ " ") 2052 (skip-syntax-forward "^-" end);(princ (point))(princ " ") 2053 (point)))))) 2054 2055 ;; check whether heredity should apply: 2056 ;(princ (count-lines pos-beg-comment (point))) 2057 (when (and (not afterp) 2058 (not special-last-linep) 2059 (> (count-lines pos-beg-comment (point)) 2)) 2060 (throw 'indent (save-excursion 2061 (forward-line -1) 2062 (current-indentation)))) 2063 ;; Else align on the start : 2064 (when sli-verbose 2065 (princ "\n") 2066 (princ (list "(sli-tell-indent-within-long-comment) align on first line?" 2067 (and on-same-linep (not special-last-linep))))) 2068 (if (and on-same-linep (not special-last-linep)) 2069 (throw 'indent (sli-point-to-indent pos-first-char)) 2070 ;; Special treatment of last line of comment: 2071 (when sli-verbose 2072 (princ "\n") 2073 (princ (list "(sli-tell-indent-within-long-comment) last line?" special-last-linep))) 2074 (if special-last-linep 2075 ;; only one word on this line ending with block-comment-end. 2076 ;; For instance "**/" 2077 (throw 'indent (+ (sli-point-to-indent pos-beg-comment) 2078 (length block-comment-start) 2079 sli-block-comment-end-offset 2080 )) 2081 (throw 'indent (+ (sli-point-to-indent pos-beg-comment) 2082 (length block-comment-start) 2083 sli-block-comment-middle-offset 2084 )))))) 2085 2086(defun sli-tell-indent (&optional afterp nomrelation point-is-the-end) ;; used only here 2087 "Gives the indentation of line on which point lies. 2088Or on line after if AFTERP is t." 2089 ;; This indentation depends on what is on the previous 2090 ;; line except that the first word of the line could be 2091 ;; a strong or end key in which case it is to be aligned 2092 ;; on the previous head/strong of the same block. 2093 ;; The only thing we don't do is if a string spreads across lines. 2094 (sli-remove-trailing-spaces); for current-indentation 2095 (catch 'indent 2096 (let ((pos-beg-comment (if afterp (sli-within-long-comment) 2097 (save-excursion 2098 (beginning-of-line) 2099 (sli-within-long-comment))))) 2100 (when pos-beg-comment 2101 (when sli-verbose 2102 (princ "\n") (princ (list "(sli-tell-indent) looking on next line ?" afterp)) 2103 (princ "\n") 2104 (princ (list "(sli-indent-line) Within long comment starting at " pos-beg-comment))) 2105 (sli-tell-indent-within-long-comment afterp pos-beg-comment))) 2106 2107 (unless (or afterp point-is-the-end) (end-of-line)) 2108 2109 (let*((pt (point)) wd-lst beg-str full-key appui head opp the-indent 2110 (first-stuff (and (not afterp) (sli-get-first-fixed-or-strong-or-end-or-soft pt))) 2111 is-a-fixed-keyp) 2112 (when sli-verbose 2113 (princ "\n") (princ (list "(sli-tell-indent) looking on next line ?" afterp)) 2114 (princ "\n") (princ (list "(sli-tell-indent) first-stuff on line = " first-stuff))) 2115 ; Zeroth case, indentation of this line and (car first-stuff) is a block-comment-end: 2116 (when (and (not (null first-stuff)) 2117 (string= (car first-stuff) block-comment-end)) 2118 (when sli-verbose 2119 (princ "\n") (princ (list "(sli-tell-indent) first-stuff is block-comment-end"))) 2120 (throw 'indent 0)) 2121 ; First case, indentation of this line and (car first-stuff) is a fixed key: 2122 (when (and (not (null first-stuff)) 2123 (setq opp (assoc (sli-keyword (car first-stuff)) sli-fixed-keys-alist))) 2124 (when sli-verbose 2125 (princ "\n") (princ (list "(sli-tell-indent) first-stuff is in sli-fixed-keys-alist"))) 2126 (setq is-a-fixed-keyp t) 2127 ;; Old treatment: 2128 ;(throw 'indent (+ (save-excursion (forward-line -1) (current-indentation)) 2129 ; (eval (cdr opp))))) 2130 ) 2131 ; Second case, line starts by a soft key: 2132 ; it has to be done in case of "if 2<3 \n then" since the "then" 2133 ; has been aligned with respect to the math-relation and not to the "if" 2134 (when (and first-stuff (sli-member (car first-stuff) sli-soft-keys)) 2135 (setq appui (sli-get-key-for-soft (cdr first-stuff) (car first-stuff))) 2136 (when sli-verbose 2137 (princ "\n") (princ (list "(sli-tell-indent) first-stuff is in sli-soft-keys"))) 2138 (sli-compute-indent-after appui)) 2139 ; Third case, indentation of this line 2140 ; and (car first-stuff) is not a fixed key or a comment or a soft-key: 2141 (when (and first-stuff (not (string= (car first-stuff) block-comment-start)) 2142 (not is-a-fixed-keyp)) 2143 ; line starts by a strong/end key. We select the key from which to 2144 ; compute the indent. Usually we align it on the previous head/strong 2145 ; key and add possible offset. That's the heredity principle. But we can also 2146 ; align strong/end-keys on the head if this head is in sli-no-heredity-list. 2147 ; Another case is when the previous corresponding strong/head had the 2148 ; attribute 'absolute, in which case its indentation applies. 2149 (setq appui 2150 (sli-find-matching-key ; backward 2151 (cdr first-stuff) ; where to start the search. 2152 (sli-possible-ancestors (car first-stuff)) 2153 (sli-get-relevant (car first-stuff)) t)) 2154 ; see whether the absolute attribute is present: 2155 (when (and (not (null appui)) 2156 (consp (setq the-indent (sli-indent-after (car appui)))) 2157 (eq (car the-indent) 'absolute)) 2158 (sli-prop-renew2 first-stuff 2159 (list 'sli-type (if (sli-member (car first-stuff) sli-end-keys) 'end 'strong) 2160 'sli-ancestor (cdr appui))) 2161 (sli-prop-renew2 appui 2162 (list 'sli-type (if (sli-member (car appui) sli-head-keys) 'head 'strong) 2163 'sli-reverse-ancestor (cdr first-stuff))) 2164 (when sli-verbose 2165 (princ "\n") (princ (list "(sli-indent) Absolute indent. Indent resting on: " (car appui)))) 2166 (throw 'indent (+ (cdr the-indent) 2167 (sli-get-shift (car appui) (car first-stuff))))) 2168 ; see whether heredity applies: 2169 (unless (or (null appui) (sli-member (car appui) sli-head-keys)) 2170 ; select head from appui and not from full-key because 2171 ; (1) it is shorter (2) (car head) *is* a strong key. 2172 (setq head (sli-get-head-from-ambiguous (cdr appui) (car appui))) 2173 ;(princ "\n") (princ (list "heredity ? for " (vector (car head) (car first-stuff)))) 2174 (sli-prop-renew2 first-stuff 2175 (list 'sli-type (if (sli-member (car first-stuff) sli-end-keys) 'end 'strong) 2176 'sli-ancestor (cdr appui))) 2177 (if (eq head 'sli-fail) 2178 (sli-prop-renew2 appui (list 'sli-type 'strong 'sli-reverse-ancestor (cdr first-stuff))) 2179 (sli-prop-renew2 appui 2180 (list 'sli-type 'strong 2181 'sli-reverse-ancestor (cdr first-stuff) 'sli-ancestor (cdr head))) 2182 (sli-prop-renew2 head (list 'sli-type 'head 'sli-reverse-ancestor (cdr appui))) 2183 (when (sli-member (vector (car head) (car first-stuff)) sli-no-heredity-list) 2184 (setq appui head)))) 2185 (when sli-verbose 2186 (princ "\n((sli-tell-indent) indentation of this line and not in comment)") 2187 (princ "\n") (princ (list " Resting on: " (car appui) (cdr appui)))) 2188 (throw 'indent (if (null appui) 0 2189 (+ (sli-get-shift (car appui) (car first-stuff)) 2190 (sli-indent-at (cdr appui)))))) 2191 ; Fourth case, indentation of this line and (car first-stuff) is a comment: 2192 (when (and first-stuff (string= (car first-stuff) block-comment-start)) 2193 ; PT is within multi-line-comment. 2194 (sli-prop-renew2 first-stuff '(sli-type block-comment-start)) 2195 (when sli-verbose 2196 (princ "\n((sli-tell-indent) indentation of this line and in comment)")) 2197 (throw 'indent (current-indentation))) 2198 2199 (unless afterp 2200 ; ; Fifth case : line doesn't start by a strong/end/soft key: 2201 (save-excursion 2202 (if (= -1 (forward-line -1)) 2203 ; we are already on the first line: 2204 (if first-stuff (throw 'indent (current-indentation)) 2205 (throw 'indent 0))) 2206 (when sli-verbose 2207 (princ "\n((sli-tell-indent) line doesn't start by a strong/end/soft key)")) 2208 (end-of-line) 2209 (setq pt (point)))) 2210 2211 ;; This point can be reached only if AFTERP is t OR first-stuff is nothing special 2212 ;; (which could be a fixed key). 2213 (setq first-stuff (sli-get-first-non-end-key pt nomrelation)) ; backward search 2214 ;; sli-key-is-a-special-headp is set. 2215 (when sli-verbose 2216 (princ "\n") (princ (list "(sli-tell-indent) indentation of line after?" afterp)) 2217 (princ "\n") (princ (list "(sli-tell-indent) key deciding of indent = " first-stuff))) 2218 2219 (cond 2220 ((null first-stuff) 2221 ;; no construct active or within comment. Don't do a thing: 2222 (when sli-verbose 2223 (princ "\n((sli-tell-indent) no construct active or within comment)")) 2224 (throw 'indent (current-indentation))) 2225 ((string= (car first-stuff) block-comment-start) 2226 (sli-prop-renew2 first-stuff '(sli-type block-comment-start)) 2227 (when sli-verbose 2228 (princ "\n") (princ (list "(sli-tell-indent) within comment"))) 2229 (throw 'indent (current-indentation))) 2230 (sli-key-is-a-special-headp ;; a special head; 2231 (when sli-verbose (princ "\n((sli-tell-indent) within special-head.)")) 2232 (sli-compute-indent-after first-stuff t)) 2233 ((and (sli-member (car first-stuff) (append sli-head-keys sli-strong-keys)) 2234 (not (assoc (sli-keyword (car first-stuff)) sli-soft-head-or-strong-alist))) 2235 ;; head/strong without soft: 2236 (when sli-verbose 2237 (princ "\n") 2238 (princ (list "(sli-tell-indent) within a head/strong construct never followed by a soft"))) 2239 (sli-prop-renew2 first-stuff (list 'sli-type (if (sli-member (car first-stuff) sli-head-keys) 2240 'head 'strong))) 2241 (sli-compute-indent-after first-stuff)) 2242 ((sli-member (car first-stuff) 2243 (append sli-head-keys sli-strong-keys sli-special-head-keys)) 2244 ;; head/strong with soft missing or special-head: 2245 (sli-prop-renew2 first-stuff (list 'sli-type 2246 (cond ((sli-member (car first-stuff) sli-head-keys) 'head) 2247 ((sli-member (car first-stuff) sli-strong-keys) 'strong) 2248 (t 'special-head)))) 2249 (when sli-verbose 2250 (princ "\n((sli-tell-indent) within special-head or head/strong sometimes") 2251 (princ "\n followed by currently missing soft)")) 2252 (sli-compute-indent-after first-stuff t)) 2253 ((and is-a-fixed-keyp 2254 (sli-member (car first-stuff) sli-relation-keys)) 2255 (throw 'indent 2256 (+ (eval (cdr opp)) 2257 (save-excursion 2258 (goto-char (cdr first-stuff)) 2259 (beginning-of-line) 2260 (skip-syntax-forward "-" (cdr first-stuff)) 2261 (sli-point-to-indent (point)))))) 2262 ((sli-member (car first-stuff) sli-relation-keys) 2263 ; relation: if it is just before point ignore it: 2264 ; (but can you tell me why????) 2265 (if (save-excursion 2266 (save-restriction 2267 (unwind-protect 2268 (progn 2269 (narrow-to-region (goto-char (cdr first-stuff)) pt) 2270 (posix-looking-at (concat (car first-stuff) " *$"))) 2271 (widen)))) 2272 (save-excursion 2273 (goto-char (cdr first-stuff)) 2274 (sli-tell-indent t t point-is-the-end)) 2275 (when sli-verbose 2276 (princ "\n") (princ (list "(sli-tell-indent) last non-end-key is in sli-relation-keys"))) 2277 (sli-compute-indent-after first-stuff))) 2278 ((sli-member (car first-stuff) sli-soft-keys) 2279 ; a soft key. Find its head/strong and align things on it. 2280 (setq full-key (sli-get-key-for-soft (cdr first-stuff) (car first-stuff))) 2281 (when sli-verbose 2282 (princ "\n") (princ (list "(sli-tell-indent) last non-end-key is in sli-soft-keys"))) 2283 (sli-compute-indent-after full-key)))))) 2284 2285;;;----------------------------------------------------------------------- 2286;;; Functions that are used outside. Avoid using the two first ones 2287;;; as they are not nicely surrounded by a condition-case ! 2288;;;----------------------------------------------------------------------- 2289 2290(defsubst sli-safe-insert (wd) 2291 (unless (get-text-property (point) 'read-only) 2292 (insert wd))) 2293 2294(defsubst sli-insert-indent (ind) 2295 (or (null ind) 2296 (let ((beg (point)) (last (current-column)) move-p (cc (current-indentation)) 2297 (old-buff-modp (buffer-modified-p))) 2298 (when sli-verbose 2299 (princ "\n") (princ (list "(sli-insert-indent) indent for: " (point)))) 2300 ;;(princ "\n") (princ (list "(sli-insert-indent) buffer-modifiedp: " old-buff-modp)) 2301 (save-excursion 2302 (setq move-p (re-search-backward "[^ \t]" (line-beginning-position) t)) 2303 (beginning-of-line) 2304 (if (get-text-property (point) 'read-only) 2305 (setq move-p t) 2306 (delete-horizontal-space) ; Simply because I Hate \t chars. 2307 (indent-to ind)) ;(insert-char ? ind) 2308 ) ;(princ "\nInserting indent: done.") 2309 ;; If ind is cc on unmodified buffer, declare the buffer as unmodified: 2310 (set-buffer-modified-p (or old-buff-modp (not (= cc ind)))) 2311 ;; if point was inside the removed spaces, 2312 ;; then now it is at the beginning of the line. 2313 ;; Not what we wanted. 2314 ;(princ "\n") (princ (list "Deplacement Automatique ?" move-p)) 2315 (unless move-p ; point has been moved automatically 2316 (move-to-column ind)) 2317 ))) 2318 2319(defun sli-indent-line nil 2320 (save-restriction 2321 (condition-case err 2322 (save-excursion 2323 (sli-insert-indent (sli-tell-indent))) 2324 (error (princ "\n(sli-indent-line): ") (princ err) nil)))) 2325 2326(defun sli-indent-region (beg end) 2327 (interactive "r") 2328 (save-restriction 2329 (condition-case err 2330 (save-excursion 2331 (setq end (progn (goto-char end) (end-of-line) (point))) 2332 (narrow-to-region (progn (goto-char beg) (sli-get-safe-backward-place)) 2333 (progn (goto-char end) (sli-get-safe-forward-place))) 2334 (when sli-verbose 2335 (princ "\n") 2336 (princ (list "(sli-indent-region) Narrowing to: " (point-min) (point-max)))) 2337 ;; Use text-properties as much as possible: 2338 (let ((sli-prop-do-not-recompute-time 10000) (modifiedp (buffer-modified-p))) 2339 (remove-text-properties beg end '(sli-type nil)) 2340 (goto-char beg) 2341 (while (progn (sli-indent-line) 2342 (and (re-search-forward "$" end t) 2343 (not (= end (point))))) 2344 (forward-line 1)) 2345 (set-buffer-modified-p modifiedp))) 2346 (error (princ "\n(sli-indent-region): ") (princ err) nil)))) 2347 2348(defun sli-electric-tab nil ;; linked to 'indent-line-function 2349 "The interactive counterpart of 'sli-indent-line. 2350Does a number of other things: 2351 -- if there are nothing but spaces between beginning-of-line 2352 and (point), then indents the line and sends (point) 2353 to the first non space ot tab character of the line. 2354 -- else if sli-tab-always-indent then indents the line 2355 the cursor being 'relatively' fixed. 2356In a program, use `sli-indent-line'." 2357 (interactive) 2358 (save-restriction 2359 (condition-case err 2360 (unwind-protect 2361 (progn 2362 (setq sli-prop-used 0) 2363 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 2364 (if (sli-only-spacep) 2365 (progn 2366 (sli-indent-line) 2367 (skip-chars-forward " \t")) 2368 (when sli-tab-always-indent (sli-indent-line))) 2369 (when sli-verbose 2370 (princ "\n") 2371 (princ (list "(sli-electric-tab) number of text-properties used:" sli-prop-used)))) 2372 (widen)) 2373 (error (princ "\n(sli-electric-tab): ") (princ err) nil)))) 2374 2375(defun sli-electric-terminate-line (&optional beg) 2376 "Terminate line and indent next line." 2377 (interactive) 2378 (save-restriction 2379 (condition-case err 2380 (unwind-protect 2381 ;(if (sli-within-long-comment) 2382 ; (sli-put-newline) 2383 (setq sli-prop-used 0) 2384 (when sli-verbose 2385 (princ "\n") 2386 (princ (list "(sli-electric-terminate-line) narrowing to " 2387 (sli-get-safe-backward-place) (sli-get-safe-forward-place)))) 2388 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 2389 (let (this-indent next-indent only-spacep) 2390 (sli-remove-trailing-spaces) 2391 (setq only-spacep (sli-only-spacep)) 2392 ; (princ "\n") (princ (list "only-spacep = " only-spacep)) 2393 (sli-insert-indent (setq this-indent (sli-tell-indent nil nil t))) 2394 (unless only-spacep (sli-safe-insert " ")) 2395 ;--> in case of thendo with point between then and do. 2396 (setq next-indent (sli-tell-indent t nil t)) 2397 (when sli-verbose 2398 (princ "\n") (princ (list "(sli-electric-terminate-line) indent before:" this-indent)) 2399 (princ "\n") (princ (list "(sli-electric-terminate-line) indent after:" next-indent))) 2400 (unless only-spacep (if (= (char-syntax (preceding-char)) ?\ )(delete-char -1))) 2401 ;(princ "\n") (princ (list "(sli-electric-terminate-line) inserting a newline at: " (point))) 2402 (sli-put-newline) 2403 (sli-remove-trailing-spaces-previous-line) 2404 ;(princ "\n") (princ (list "(sli-electric-terminate-line) inserting indent at: " (point))) 2405 (sli-insert-indent next-indent)) 2406 (when sli-verbose 2407 (princ "\n") 2408 (princ (list "(sli-electric-terminate-line) number of text-properties USED:" sli-prop-used))) 2409 (widen)) 2410 (error (princ "\n(sli-electric-terminate-line): ") (princ err) nil)))) 2411 2412(defun sli-newline (&optional beg) 2413 "Insert a newline without indenting current line. 2414Next line is properly indented." 2415 (interactive) 2416 (save-restriction 2417 (condition-case err 2418 (unwind-protect 2419 ;(if (sli-within-long-comment) 2420 ; (sli-put-newline) 2421 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 2422 (sli-remove-trailing-spaces) 2423 (sli-put-newline) 2424 (sli-remove-trailing-spaces-previous-line) 2425 (sli-insert-indent (sli-tell-indent nil nil t)) 2426 (widen)) 2427 (error (princ "\n(sli-newline): ") (princ err) nil)))) 2428 2429(defun sli-maid (&optional arg on-listp) 2430 "Closes constructs for you, puts the children to bed and 2431may order a pizza if you know how to ask. 2432 Usually, adds the corresponding part of `sli-add-to-key-alist' 2433except when the call is prefixed by C-u. If the variable 2434`sli-more-maidp' is nil, this behaviour is reversed. 2435The word to pursue the structure is taken from `sli-maid-alist'. 2436This list is created automatically but can be corrected 2437by specifying special furtherings in `sli-maid-correction-alist'" 2438 (interactive "P") 2439 (save-restriction 2440 (condition-case err 2441 (unwind-protect 2442 ;; *Before* any narrowing, check the possibility of inserting !! 2443 (unless (get-text-property (point) 'read-only) 2444 (narrow-to-region (sli-get-safe-backward-place) (sli-get-safe-forward-place)) 2445 (let*((full-key (sli-get-first-non-end-key (point) t)) (key nil) (head nil) smore 2446 (where-to-write '()) is-a-special-head-head-keyp has-answered) 2447 (when sli-verbose 2448 (princ "\n") 2449 (princ (list "(sli-maid) Key to be continued: " full-key))) 2450 (sli-remove-trailing-spaces) 2451 ;; Sort ambiguity arising from ambiguous-keys: 2452 (when (and full-key (sli-member (car full-key) sli-ambiguous-keys)) 2453 (if (eq (setq smore (sli-get-head-from-ambiguous (cdr full-key) (car full-key))) 'sli-fail) 2454 (setq head 'sli-fail) 2455 (setq head (car smore))) 2456 (when sli-verbose 2457 (princ "\n") 2458 (princ (list "(sli-maid) The previous key was soft/strong and ambiguous. Its head is : " head)))) 2459 ;; Sort ambiguity head-special-head-keys: 2460 (when (and full-key (sli-special-head-headp (car full-key))) 2461 ;(print (list "yes" (cdr full-key) (sli-get-special-head-previous-keys (car full-key)) 2462 ; (sli-get-relevant (car full-key)))) 2463 (setq head 2464 (sli-find-matching-key 2465 (cdr full-key) 2466 (sli-get-special-head-previous-keys (car full-key)) (sli-get-relevant (car full-key)) t)) 2467 (setq is-a-special-head-head-keyp t) 2468 (when sli-verbose 2469 (princ "\n") 2470 (princ (list "(sli-maid) The previous key was a head-special-head. Its head is : " head)))) 2471 ;; Go out of one-line-comment: 2472 (when (save-excursion (sli-in-one-line-comment)) 2473 (if on-listp 2474 (setq where-to-write (append where-to-write (list 'newline))) 2475 (sli-electric-terminate-line))) 2476 ;; add a newline before insertion if required: 2477 (unless (sli-only-spacep) 2478 (when (or (and (not is-a-special-head-head-keyp) 2479 full-key (sli-member (car full-key) sli-keys-with-newline)) 2480 (and is-a-special-head-head-keyp (not head) 2481 (sli-member head sli-keys-with-newline))) 2482 (if on-listp 2483 (setq where-to-write (append where-to-write (list 'newline))) 2484 (sli-electric-terminate-line)))) 2485 ;(princ "\n") (princ (list "Inside mupad-maid. full-key/head = " full-key head)) 2486 ;; find or insert closing-key: 2487 (cond 2488 ((eq head 'sli-fail) (message "Could not resolve ambiguity")) 2489 ((null full-key) 2490 ;; No construct to be closed. 2491 (setq key (buffer-substring-no-properties 2492 (save-excursion (forward-word -1) (point)) (point)))) 2493 ((equal (car full-key) block-comment-start) 2494 (if on-listp 2495 (setq where-to-write (append where-to-write (list (setq key block-comment-end)))) 2496 (setq has-answered t) 2497 (sli-safe-insert (setq key block-comment-end)))) 2498 ((and (sli-member (car full-key) sli-separators) 2499 ; Beware !! this key could be **very far** 2500 (= (count-lines (cdr full-key) (point)) 0)) 2501 (setq key nil)) ; We shall put a newline, see below. 2502 (is-a-special-head-head-keyp ; a special head possibly a head 2503 (if head 2504 ;; it is a special head: 2505 (setq key (cadr (assoc (sli-keyword (car full-key)) sli-special-head-alist))) 2506 ;; it is a head: 2507 (setq key (sli-following-key (car full-key)))) 2508 ;(print (list "yes" key head)) 2509 (unless (and (not (null key)) 2510 (or (not (member (char-syntax (string-to-char key)) '(?w ?_ ?\( ?\) ?$))) 2511 (= (char-syntax (preceding-char)) ?\ ))) 2512 (if on-listp 2513 (setq where-to-write (append where-to-write '(" "))) 2514 (setq has-answered t) 2515 (sli-safe-insert " "))) 2516 (if on-listp 2517 (setq where-to-write (append where-to-write (list key))) 2518 (setq has-answered t) 2519 (sli-safe-insert key))) 2520 ((and (sli-member (car full-key) sli-special-head-keys) 2521 (not (sli-separator-directly-afterp (point-max) (car full-key)))) 2522 (if on-listp 2523 (setq where-to-write 2524 (append where-to-write 2525 (list (cadr (assoc (sli-keyword (car full-key)) sli-special-head-alist))))) 2526 (setq has-answered t) 2527 (sli-safe-insert (cadr (assoc (sli-keyword (car full-key)) sli-special-head-alist))))) 2528 (t (setq key (if head ; completion of an ambiguous-key: 2529 (car (sli-get-ends-from-head head)) 2530 (sli-following-key (car full-key)))) 2531 ;(princ " Yol ") ; add a space if required: 2532 (unless (and (not (null key)) 2533 (or (not (member (char-syntax (string-to-char key)) '(?w ?_ ?\( ?\) ?$))) 2534 (= (char-syntax (preceding-char)) ?\ ))) 2535 (if on-listp 2536 (setq where-to-write (append where-to-write '(" "))) 2537 (setq has-answered t) 2538 (sli-safe-insert " "))) 2539 (or (null key) 2540 (if on-listp 2541 (setq where-to-write (append where-to-write (list key))) 2542 (setq has-answered t) 2543 (sli-safe-insert key))))) 2544 ;(princ "\n") (princ (list "Inside mupad-maid. key = " key)) 2545 ;; add things if required: 2546 (unless (if sli-more-maidp 2547 (and arg (= (car arg) 4)) ; call is prefixed by C-u 2548 (not (and arg (= (car arg) 4)))) ; call is not prefixed by C-u 2549 (cond 2550 ((or (null key) (eq head 'sli-fail))) 2551 ((setq smore (assoc (sli-keyword key) sli-add-to-key-alist)) 2552 (if on-listp 2553 (setq where-to-write (append where-to-write (list (cdr smore)))) 2554 (setq has-answered t) 2555 (sli-safe-insert (cdr smore)))))) 2556 ;; Add a newline if required: 2557 ;(princ "\n(sli-maid) looking if a newline is required") 2558 (cond 2559 ((or (sli-member key sli-keys-without-newline) (eq head 'sli-fail))) 2560 ((eobp) (if on-listp 2561 (setq where-to-write (append where-to-write (list 'newline))) 2562 (sli-electric-terminate-line))) 2563 ((or (null key) 2564 (< 2 (count-lines (point) 2565 (save-excursion (skip-chars-forward " \t\n") (point))))) 2566 (if on-listp 2567 (setq where-to-write (append where-to-write (list 'indent 'forward-line 'indent))) 2568 ;(princ "\n(sli-maid) indentation plus going to next line") 2569 (sli-indent-line) (forward-line 1) (indent-to (sli-tell-indent nil nil t)))) 2570 ; beware if it is only an empty line. 2571 (t (if on-listp 2572 (setq where-to-write (append where-to-write (list 'indent))) 2573 ;(princ "\n(sli-maid) indentation but not going to next line") 2574 (sli-indent-line)))) 2575 (unless has-answered (message "Nothing to do")) 2576 where-to-write)) 2577 (widen)) 2578 (error (princ "\nsli-maid can't understand what to do: ")(princ err) nil)))) 2579 2580(defun sli-tutor nil 2581 "*Adds what all you should add to end your construct." 2582 ;; Not so good if used in the middle of a mess ... 2583 ;; in mupad, try "while foo do" with point before "do". 2584 (interactive) 2585 (condition-case err 2586 (let ((some-more '()) what-to-do) 2587 (while (and (setq some-more (sli-maid nil t)) 2588 (not (member some-more '((indent) (newline))))) 2589 ; (princ "\n") (princ (list "Tutor:" some-more (point))) 2590 (while some-more 2591 (cond 2592 ((equal (setq what-to-do (car some-more)) 'newline) 2593 (sli-electric-terminate-line)) 2594 ((equal what-to-do 'indent) 2595 (sli-indent-line)) 2596 ((equal what-to-do 'forward-line) 2597 (forward-line 1)) 2598 (t (sli-safe-insert what-to-do))) 2599 (setq some-more (cdr some-more))))) 2600 (error (princ "\nsli-tutor can't understand what to do: ")(princ err) nil))) 2601 2602(defun sli-tools 2603 (struct shift sep sepp fixed safe keyn keynn mkey comm noher 2604 &optional newl corr showsexpp case-fold eoov) 2605"Once these tools are loaded, you should have 2606`sli-newline' and `sli-electric-terminate-line' 2607which behave like `newline-and-indent' and 2608`reindent-then-newline-and-indent'. Also 2609`indent-line-function' is `sli-electric-tab' 2610and 2611`indent-region-function' is `sli-indent-region'. 2612Finally `sli-backward-to-indentation' is a good 2613function to bind [backspace] to. 2614 2615When `sli-handles-sexp' is t then forward-sexp, 2616backward-sexp and scan-sexps are advised so that 2617for instance C-M-f on a head sends cursor on its end. 2618 2619`sli-show-sexp' works like show-paren-mode. Two 2620ways: either showsexpp is t, either showsexpp is nil 2621in which case one should press [f8] to see the 2622corresponding key. 2623C-u[f8] forces to recompute text-properties locally. 2624 2625C-M-f/C-M-b run forward-sexp/backward-sexp in a special 2626way: heads will be atuned to ends and strongs to either 2627one. 2628Finally, `sli-maid' tries to further constructs for you 2629while `sli-tutor' strives to end all constructs. 2630 2631For these tools to work, the parameters are 2632`sli-structures' 2633`sli-shift-alist' 2634`sli-separators' 2635`sli-is-a-separatorp-fn' 2636`sli-fixed-keys-alist' 2637`sli-safe-place-regexp' ; safe place starts at the end of first grouping 2638`sli-keys-with-newline' 2639`sli-keys-without-newline' 2640`sli-add-to-key-alist' 2641`sli-comment-starts' 2642`sli-no-heredity-list' 2643`sli-put-newline-fn' 2644`sli-maid-correction-alist' 2645showsexpp 2646`sli-case-fold' 2647`sli-select-end-of-overlay-fn' 2648and you should also set 2649`block-comment-start' `block-comment-end' 2650`sli-more-maidp' `sli-tab-always-indent' 2651and the syntax table should be ok. 2652Beware that `block-comment-start' and `block-comment-end' 2653are NOT regexp but simple strings." 2654 (interactive) 2655 (condition-case err 2656 (progn 2657 (setq sli-structures struct sli-shift-alist shift 2658 sli-separators sep sli-fixed-keys-alist fixed 2659 sli-case-fold case-fold sli-keys-with-newline keyn 2660 sli-keys-without-newline keynn sli-add-to-key-alist mkey 2661 sli-comment-starts comm sli-no-heredity-list noher 2662 sli-maid-correction-alist corr) 2663 (if safe 2664 (setq sli-safe-place-regexp safe) 2665 (setq sli-safe-place-regexp "\\(\\'\\|\\`\\)")) ;beginning/end of buffer ! 2666 (when sepp 2667 (setq sli-is-a-separatorp-fn sepp)) 2668 (when newl 2669 (setq sli-put-newline-fn newl)) 2670 (when eoov 2671 (setq sli-select-end-of-overlay-fn eoov)) 2672 (set (make-local-variable 'indent-line-function) 'sli-electric-tab) 2673 (set (make-local-variable 'indent-region-function) 'sli-indent-region) 2674 (setq sli-handles-sexp t sli-verbose nil sli-prop-verbose nil) 2675 (setq sli-overlay-beg (make-overlay (point-min) (point-min))) 2676 (setq sli-overlay-end (make-overlay (point-min) (point-min))) 2677 (overlay-put sli-overlay-beg 'face 'show-paren-match-face) 2678 (overlay-put sli-overlay-end 'face 'show-paren-match-face) 2679 (overlay-put sli-overlay-beg 'priority 0) 2680 (overlay-put sli-overlay-end 'priority 0) 2681 (sli-show-sexp-semi-mode (if showsexpp 1 0)) 2682 (sli-precomputations)) 2683 (error (princ "\nSomething went wrong in sli-tools: ")(princ err) nil))) 2684 2685;;------------------ sli-tools ends here. 2671 lines ?? 2686