home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / package / dabbrev.mut < prev    next >
Text File  |  1995-01-14  |  8KB  |  229 lines
  1. ;; dynamic abbreviation for me
  2. ;; Patrick TJ McPhee 4 and 11 July, 1993
  3. ;;
  4. ;; this is meant to work like the dabbrev command in GNU emacs, to the
  5. ;; extent that I know how dabbrev works there.  Here's the documentation:
  6. ;;
  7. ;; Dynamic abbreviation allows word replacement without maintaining a
  8. ;; file of abbreviations and replacements.  It's a standard part of GNU
  9. ;; emacs, and I find it useful in most of the circumstances where one
  10. ;; would use an abbrev mode (documents), and also in places where an
  11. ;; abbrev mode is less convenient (programs).  Here's how it works:
  12. ;; Type the beginning of a word and press (by default) M-/.  If there
  13. ;; is another word in the current buffer which starts the same way, the
  14. ;; partial word will be replaced by that other word.  Press M-/ again,
  15. ;; and another will be used, and so-on until all eligible words in the
  16. ;; current buffer are used.  At that point, the original fragment is
  17. ;; put back in place, and the message `Can't satisfy you.' is displayed
  18. ;; in the minibuffer.  You can start again at this point.
  19. ;;
  20. ;; Advantages of this approach over standard abbreviation: you don't need
  21. ;; to define any abbreviations; it's less disconcerting, since you always
  22. ;; ask for the abbreviation explicitly;  and it's easy to undo.
  23. ;; Advantages of standard abbreviation over this approach: you have to
  24. ;; explicitly ask for each abbreviation; standard abbrev is faster, and you
  25. ;; can't abbreviate phrases.
  26. ;;
  27. ;; This is version 1.0.  It seems to work, but I don't know what I'm doing,
  28. ;; and I've only spent about half a day getting it going, so I'm sure there
  29. ;; are improvements waiting to be made.
  30.  
  31. ;; Massive hacks 7/93 C Durland
  32.  
  33. (include me.mh)
  34.  
  35. (bool dabbrev-search-reverse)
  36. (const CMD-NO-FLAG 99)
  37. (int dabbrev-cmd-flag)
  38. (list dabbrev-rejects)
  39. (string dabbrev-search-string)
  40.  
  41. (defun
  42.   MAIN
  43.   {
  44.     (dabbrev-cmd-flag (command-flag CMDFLG-GEN-FLAG 0))
  45.   }
  46.   ;; to initialise, make some buffer vars.  This is for marks - since they
  47.   ;; are buffer specific, don't want to have to search out their buffer to
  48.   ;; free them.
  49.   dabbrev-allocations HIDDEN {
  50.     (create-buffer-var NUMBER "dabbrev-search-location")
  51.  
  52.     ;; take advantage of fact that NUMBERs are initialised to 0 and
  53.     ;; mark 0 is always taken by the dot
  54.     ;; If I knew how to tell that a buffer-var already exists, I'd do this
  55.     ;; differently
  56.     (if (== 0 (buffer-var "dabbrev-search-location")) {
  57.       (buffer-var "dabbrev-search-location" (create-mark TRUE))
  58.       })
  59.     }
  60.  
  61.   dabbrev-expand {
  62.     (int start end search-loc)
  63.     (bool found-it repeating)
  64.     (string replace-text)
  65.     
  66.     ;; This does nothing if previously defined.
  67.     ;; If I knew how to test for previous allocation, I would.
  68.     (dabbrev-allocations)
  69.  
  70.     (search-loc  (buffer-var "dabbrev-search-location"))
  71.  
  72.     (repeating (command-flag CMDFLG-TEST dabbrev-cmd-flag))
  73.     (command-flag CMDFLG-SET dabbrev-cmd-flag)
  74.     (arg-flag FALSE 1)        ;; reset arg count
  75.  
  76.     (start (create-mark))
  77.     (end   (create-mark))
  78.  
  79.     ;; if we're sitting on the end mark, we're repeating.  Otherwise we
  80.     ;; need to do some initialisation.
  81.     (if repeating {
  82.     ;; I'm already at the end of the word
  83.       (set-mark end)
  84.     ;; and can easily find the beginning
  85.       (forward-word -1)(set-mark start)
  86.       }{    ;; else not repeating
  87.       (set-mark end)        ;; might not be end of word, same as GNU
  88.     ;; find the beginning of a word
  89.       (forward-word -1) (set-mark start)
  90.     ;; which is more-or-less where we'll start searching
  91. ;      (forward-char -1)
  92.       (set-mark search-loc)
  93.       (dabbrev-search-reverse TRUE)
  94.  
  95.     ;; now clear out the reject list
  96.       (remove-elements dabbrev-rejects 0 (length-of dabbrev-rejects))
  97.  
  98.     ;; now, is this a word, or is there more than one word put the
  99.     ;; region delimited by start and end into a bag, convert it to a
  100.     ;; string, and check it out.
  101.       (dabbrev-search-string (region-to-string start end))
  102.  
  103.     ;; get out if there isn't a word in the region
  104.       (if (not (re-string '\w+$' dabbrev-search-string)) {
  105.         (msg "No abbreviations here")
  106.         (goto-mark end)
  107.     (command-flag CMDFLG-SET CMD-NO-FLAG)    ;; Start over next time
  108.         (done)
  109.         })
  110.  
  111.     ;; otherwise save the search string and add it to the list of
  112.     ;; rejected values
  113.       (insert-object dabbrev-rejects 0 dabbrev-search-string)
  114.       })
  115.  
  116.     ;; the rest is the same regardless of which time we're doing this.
  117.     ;; search for dabbrev-search-string until you find it at the start
  118.     ;; of a word, and it's not in the list.  Finally add it and replace
  119.     ;; the start/end region with the new text
  120.     (goto-mark search-loc)
  121.  
  122.     (found-it FALSE)
  123.     (if dabbrev-search-reverse
  124.       (while (and 
  125.         (found-it (search-reverse dabbrev-search-string))
  126.         (rejected-p dabbrev-search-string))
  127.     ()))
  128.  
  129.     ;; search forward if we didn't find it
  130.     (if (not found-it) {
  131.       ;; if were searching backwards and haven't found it, switch directions
  132.       (if dabbrev-search-reverse {
  133.     (dabbrev-search-reverse FALSE)
  134.     (goto-mark end)
  135.     (set-mark search-loc)
  136.         })
  137.       (while (and
  138.         (found-it (search-forward dabbrev-search-string))
  139.         (rejected-p dabbrev-search-string))
  140.     ())
  141.       })
  142.  
  143.     ;; now, we've found it, and we haven't rejected it yet
  144.     (if (found-it) {
  145.     ;; big assumption about the last call to looking-at
  146.       (replace-text (get-matched "&"))
  147.       (replace-region (replace-text) start end)
  148.       (insert-object dabbrev-rejects -1 replace-text)
  149.       } {
  150.     ;; otherwise we do the same thing, but put the search text back in
  151.     ;; place.  Also, make sure we don't repeat next time.
  152.       (replace-region dabbrev-search-string start end)
  153.       (command-flag CMDFLG-SET CMD-NO-FLAG)
  154.       (msg "Can't satisfy you.")
  155.       })
  156.   }
  157.  
  158.   ;;;;;;;;;;  
  159.   ;; returns TRUE if current search text is in the list of previous
  160.   ;;   replacements
  161.   rejected-p (string s-t) HIDDEN {
  162.     (bool good-word)
  163.     (string replace-text)
  164.     (int rep-list-length n)
  165.  
  166.     ;; we'll do next search from here regardless
  167.     (set-mark (buffer-var "dabbrev-search-location"))
  168.  
  169.     ;; but we want to do replacement from start of the current word
  170.     (forward-char 1) (forward-word -1)
  171.  
  172.     (good-word (and (looking-at (s-t))(looking-at '\w\w*')))
  173.     (goto-mark (buffer-var "dabbrev-search-location"))
  174.  
  175.     (if (not good-word) { TRUE (done) })
  176.  
  177.     ;; set replace-text to the current word
  178.     (replace-text (get-matched "&"))
  179.  
  180.     ;; and see if it's in the replacement list
  181.     (rep-list-length (length-of dabbrev-rejects))
  182.  
  183.     (for (n 0) (< n rep-list-length) (+= n 1)
  184.       (if (== replace-text (extract-element dabbrev-rejects n)) {
  185.     TRUE
  186.     (done)
  187.       }))
  188.     FALSE    ;; its a new word
  189.     }
  190.  
  191.   ;;;;;;;;;;;
  192.   ;; put r-text in place of the region delimited by s-mark and e-mark
  193.   ;; and leave the dot at the end of the inserted text
  194.   replace-region (string r-text) (int s-mark e-mark) HIDDEN {
  195.     (goto-mark s-mark)
  196.     (delete-region s-mark e-mark)
  197.     (insert-text r-text)
  198.     }
  199.  
  200.   ;;;;;;;;;;
  201.   ;; return TRUE if marks are at the same place, FALSE otherwise
  202.   ;; this is in my wish-list for built-in functions
  203. ;  match-marks-p (int one-mark another-mark) HIDDEN {
  204. ;    (byte type)(small-int left-edge width height)(int size)    ;; RegionInfo
  205. ;
  206. ;    (if (and (mark-valid one-mark)(mark-valid another-mark))
  207. ;      {
  208. ;    (region-stats (loc type) one-mark another-mark)
  209. ;    (and (== 0 width)(== 1 height))
  210. ;      }
  211. ;      FALSE)
  212. ;  }
  213. )
  214.  
  215.     ;; Notes:
  216.     ;;   Don't free the bag so that it will stick around until garbage
  217.     ;;     collection.  This way the string won't be collected before we
  218.     ;;     use it.
  219. (defun
  220.   region-to-string (int start end)
  221.   {
  222.     (int bag)
  223.  
  224.     (bag (create-bag))
  225.     (append-to-bag bag APPEND-REGION start end)
  226.     (bag-to-string bag)
  227.   }
  228. )
  229.