home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / builtin / register.mut < prev    next >
Lisp/Scheme  |  1995-01-14  |  5KB  |  175 lines
  1. ;; register.mut
  2. ;; Implements [possibly a subset of] GNU Emacs's register commands.
  3. ;; Diffs:
  4. ;;   In insert register, I use the opposite behavior for dot and mark (of
  5. ;;     GNU) to be consistant with yank.  See comments in insert-register if
  6. ;;     you want to change it back.
  7. ;; C Durland  8/92 4/93    Public Domain
  8.  
  9. (include me.mh)
  10.  
  11. (const    ;; register types
  12.   REGISTER-UNUSED    0    ;; What global arrays are initialized to
  13.   REGISTER-TEXT        1    ;; Region or rectangle, register is a bag
  14.   REGISTER-POSITION    2    ;; Register is a buffer and mark
  15. )
  16.  
  17. (array byte register-type 36)
  18. (array small-int registers 36 register-postion-marks 36)
  19.  
  20. (defun 
  21.   get-register-num (string prompt) HIDDEN
  22.   {
  23.     (int n)
  24.  
  25. ;    (n { (msg prompt " (0-9, a-z): ")(get-key) })
  26.     (if (not (key-waiting 1)) (msg prompt " (0-9, a-z): "))
  27.     (n (get-key))
  28.     (if (== n 0x147) (abort))    ;; ^G
  29.     (if (not (or        ;; !((0 <= x <= 9) || (a <= x <= z))
  30.       (and (<= 0x30 n) (<= n 0x39))        ;; 0-9
  31.       (and (<= 0x61 n) (<= n 0x7A))))    ;; a-z
  32.       { (msg "Out of bounds (0-9, a-z)!")(halt) })
  33.  
  34.     ;; convert key to 0 - 35
  35.     ;; '0' - '9' => 0-9, 'a'-'z' => 10-35
  36.     (if (<= n 0x39) (- n 0x30) (- n 0x57))
  37.   }
  38.     ;; Insert the contents of a register at the dot.
  39.     ;; Normally, the dot is left before the register text, the mark after
  40.     ;;   (oppsite of yank).  With arg, behaves like yank.
  41.     ;;   Uggg.  I can't stand it - for consistancy, I going with the way
  42.     ;;   yank works.  You can change it back by easily (uncomment some
  43.     ;;   lines and comment one).
  44.   insert-register
  45.   {
  46. ;    (byte type)(small-int width height)(int size)    ;; struct BagInfo
  47.     (int n)
  48.  
  49.     (n (get-register-num "Insert register"))
  50.     (if (!= REGISTER-TEXT (register-type n))
  51.       {
  52.     (msg "Register doesn't contain a region or rectangle.")
  53.     (done)
  54.       })
  55.  
  56.     (set-mark THE-MARK)
  57.     (n (registers n))
  58.     (insert-bag n)
  59.  
  60.     ;; GNU Emacs like behaivor:
  61.     ;; if rectangle:   need-to-swap-marks == arg-flag
  62.     ;; if !rectangle:  need-to-swap-marks == !arg-flag
  63. ;    (bag-stats n (loc type))
  64. ;    (if (if (== type BAG-IS-RECTANGLE) (arg-flag) (not (arg-flag)))
  65. ;    (swap-marks THE-DOT THE-MARK))
  66.  
  67.         ;; yank like:
  68.     (if (arg-flag) (swap-marks THE-DOT THE-MARK))
  69.  
  70.     (arg-flag FALSE 1)        ;; reset arg count
  71.   }
  72.   copy-to-register
  73.   {
  74.     (int n bag)
  75.  
  76.     (n (get-register-num "Copy to register"))
  77.     (if (== 0 (bag (clear-register n REGISTER-TEXT))) (bag (create-bag TRUE)))
  78.  
  79.     (clear-bag bag)(append-to-bag bag APPEND-REGION)
  80.  
  81.     (if (arg-flag) (delete-region))
  82.  
  83.     (set-register n REGISTER-TEXT bag 0)
  84.  
  85.     (arg-flag FALSE 1)        ;; reset arg count
  86.   }
  87.   copy-region-to-rectangle
  88.   {
  89.     (int n bag)
  90.  
  91.     (n (get-register-num "Copy rectangle to register"))
  92.     (if (== 0 (bag (clear-register n REGISTER-TEXT))) (bag (create-bag TRUE)))
  93.  
  94.     (clear-bag bag)(append-to-bag bag APPEND-RECTANGLE)
  95.  
  96.     (if (arg-flag) (erase-rectangle TRUE))
  97.  
  98.     (set-register n REGISTER-TEXT bag 0)
  99.  
  100.     (arg-flag FALSE 1)        ;; reset arg count
  101.   }
  102.   point-to-register
  103.   {
  104.     (int n mark)
  105.  
  106.     (n (get-register-num "Point to register"))
  107.     (clear-register n REGISTER-POSITION)
  108.  
  109.     (set-mark (mark (create-mark TRUE)))
  110.     (set-register n REGISTER-POSITION (current-buffer) mark)
  111.   }
  112.   register-to-point
  113.   {
  114.     (int n mark cb the-buffer the-mark)
  115.  
  116.     (n (get-register-num "Register to point"))
  117.     (if (!= REGISTER-POSITION (register-type n))
  118.       {
  119.     (msg "Register doesn't contain a buffer position.")
  120.     (done)
  121.       })
  122.     (cb (current-buffer))
  123.     (the-buffer (registers n))(the-mark (register-postion-marks n))
  124.     (if (buffer-exists the-buffer)
  125.       {
  126.     (current-buffer the-buffer)
  127.     (if (mark-valid the-mark)
  128.       {
  129.         (if (and
  130.           (!= cb the-buffer)
  131.           (!= -2 (n (buffer-displayed the-buffer))))
  132.           (current-window n)
  133.           (current-buffer the-buffer TRUE))
  134.         (goto-mark the-mark)
  135.       }
  136.       {    ;; else the mark is invalid, position is also
  137.         (current-buffer cb)
  138.         (msg "Register contains an invalid position (point).")
  139.       })
  140.       }
  141.       (msg "Register contains an invalid position (buffer)."))
  142.   }
  143.   set-register (int n type x y) HIDDEN
  144.   {
  145.     (register-type n type)
  146.     (registers n x)
  147.     (register-postion-marks n y)
  148.   }
  149.   clear-register (int n type-to-be) HIDDEN
  150.   {
  151.     (int bid cb)
  152.  
  153.     (if (== REGISTER-TEXT type-to-be (register-type n))
  154.       {
  155.     (registers n)
  156.     (done)
  157.       })
  158.     (switch (register-type n)
  159.       REGISTER-TEXT    (free-bag (registers n))
  160.       REGISTER-POSITION
  161.     {
  162.       (bid (registers n))
  163.       (if (buffer-exists bid)
  164.         {
  165.           (cb (current-buffer))
  166.           (current-buffer bid)
  167.           (free-mark (register-postion-marks n))
  168.           (current-buffer cb)
  169.         })
  170.     })
  171.     (register-type n REGISTER-UNUSED)
  172.     0        ;; no bag that can be reused
  173.   }
  174. )
  175.