home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34exe.zip / mutt / contrib / accent.mut next >
Text File  |  1995-01-14  |  9KB  |  250 lines
  1. ;;
  2. ;; File:
  3. ;;    accent.mut  -  typewriterlike accents
  4. ;;
  5. ;; Description:
  6. ;;    Code to assit typing characters that have accents; first type the
  7. ;;    accent, then type the character. It's almost like an old
  8. ;;    typewriter.
  9. ;;
  10. ;;    - Characters that have accents can be defined by calling
  11. ;;      'accent-define' from your own 'accent-hook'. 'accent-hook' can
  12. ;;      be used to overwrite the defaults that are set for MS-DOS in the
  13. ;;      function MAIN, or to add new definitions.
  14. ;;
  15. ;;    - Example of 'accent-hook' for SUN-OS:
  16. ;;      (defun
  17. ;;          accent-hook
  18. ;;          {
  19. ;;              (accent-clear-all)
  20. ;;              ;;                   "    `    '    ^    ~    @
  21. ;;              (accent-define 0x61 228  224  225  226  227  229 ) ;; a
  22. ;;              (accent-define 0x41 196  192  193  194  195  197 ) ;; A
  23. ;;              (accent-define 0x63 0x63 0x63 0x63 0x63 231  0x63) ;; c
  24. ;;              (accent-define 0x43 0x43 0x43 0x43 0x43 199  0x43) ;; C
  25. ;;              (accent-define 0x65 235  232  233  234  0x65 0x65) ;; e
  26. ;;              (accent-define 0x45 203  200  201  202  0x45 0x45) ;; E
  27. ;;              (accent-define 0x69 239  236  237  238  0x69 0x69) ;; i
  28. ;;              (accent-define 0x49 207  204  205  206  0x49 0x49) ;; I
  29. ;;              (accent-define 0x6E 0x6E 0x6E 0x6E 0x6E 241  0x6E) ;; n
  30. ;;              (accent-define 0x4E 0x4E 0x4E 0x4E 0x4E 209  0x4E) ;; N
  31. ;;              (accent-define 0x6F 246  242  243  244  245  0x6F) ;; o
  32. ;;              (accent-define 0x4F 214  210  211  212  213  0x4F) ;; O
  33. ;;              (accent-define 0x75 252  249  250  251  0x75 0x75) ;; u
  34. ;;              (accent-define 0x55 220  217  218  219  0x55 0x55) ;; U
  35. ;;              (accent-define 0x79 255  0x79 253  0x79 0x79 0x79) ;; y
  36. ;;              (accent-define 0x59 0x59 0x59 221  0x59 0x59 0x59) ;; Y
  37. ;;          }
  38. ;;      )
  39. ;;
  40. ;; Bugs:
  41. ;;    A fixed length array is used to store the accented characters.
  42. ;;
  43. ;; History:
  44. ;;    940111  M.J. van der Velden
  45. ;;            - more like a typewriter (the cursor does not advance
  46. ;;              after pressing an accent).
  47. ;;            - documentation errors
  48. ;;            Public Domain (Version 1.3)
  49. ;;    931014  M.J. van der Velden
  50. ;;            - added 'accent-help'
  51. ;;            - added 'accent-clear-all'
  52. ;;            - added 'accent-bind-local-keys'
  53. ;;            - documentation errors
  54. ;;            Public Domain (Version 1.2)
  55. ;;    930208  M.J. van der Velden
  56. ;;            - Renamed quote to accent.
  57. ;;            - Renamed hat to caret (^).
  58. ;;            - Renamed att to at (@).
  59. ;;            - Added support for control characters.
  60. ;;            Public Domain (Version 1.1)
  61. ;;    930129  M.J. van der Velden
  62. ;;            Public Domain (Version 1.0)
  63. ;;
  64.  
  65. (include me.mh)
  66.  
  67. (const
  68.     ACCENT-NO-OF-ENTRIES 50    ;; There are 50 characters allowed to have accents.
  69.     ACCENT-NO-OF-ACCENTS 7     ;; " ` ' ^ ~ @ plus 1 for the character itself.
  70.     
  71.     ACCENT-KEY-SPACE     0x20
  72.     ACCENT-KEY-DOUBLE    0x22
  73.     ACCENT-KEY-LEFT      0x60
  74.     ACCENT-KEY-RIGHT     0x27
  75.     ACCENT-KEY-CARET     0x5E
  76.     ACCENT-KEY-TILDE     0x7E
  77.     ACCENT-KEY-AT        0x40
  78.  
  79.     ACCENT-HELP-BUFNAME  "*accents*"
  80.     ACCENT-PROMPT        "=> "
  81. )
  82.  
  83. (array int
  84.     accentTable 350 ;; ACCENT-NO-OF-ACCENTS*ACCENT-NO-OF-ENTRIES
  85. )
  86.  
  87. (int
  88.     accentNoOfEntries
  89.     accentHelpBufId
  90. )
  91.  
  92. (defun
  93.     accent-define (int c double left right caret tilde at)
  94.     {
  95.         (int index)
  96.         (int entryCnt)
  97.  
  98.         (if (== accentNoOfEntries ACCENT-NO-OF-ENTRIES) {
  99.             (msg "To many accents!")
  100.             (get-key)
  101.             (halt)
  102.         })
  103.  
  104.         (for (entryCnt 0) (< entryCnt accentNoOfEntries) (+= entryCnt 1) {
  105.             (if (== c (accentTable (* ACCENT-NO-OF-ACCENTS entryCnt))) {
  106.                 (break)
  107.             })
  108.         })
  109.         (index (* ACCENT-NO-OF-ACCENTS entryCnt))
  110.  
  111.         (accentTable    index    c)
  112.         (accentTable (+ index 1) double)
  113.         (accentTable (+ index 2) left)
  114.         (accentTable (+ index 3) right)
  115.         (accentTable (+ index 4) caret)
  116.         (accentTable (+ index 5) tilde)
  117.         (accentTable (+ index 6) at)
  118.  
  119.         (+= accentNoOfEntries 1)
  120.     }
  121.  
  122.     accent-character
  123.     {
  124.         (int  c)
  125.         (int  newChIndex)
  126.         (int  entryCnt)
  127.         (bool definitionFound)
  128.  
  129.         (insert-text (convert-to CHARACTER (key-pressed)))
  130.         (previous-character)
  131.         (update)
  132.         (c (get-key))
  133.  
  134.     (if (> c 0xFF) {
  135.             ;; c is a control character
  136.             (exe-key c)
  137.             (done)
  138.         })
  139.  
  140.         (if (== c ACCENT-KEY-SPACE) {
  141.             (next-character)
  142.             (done)
  143.         })
  144.  
  145.         (definitionFound FALSE)
  146.         (for (entryCnt 0) (< entryCnt accentNoOfEntries) (+= entryCnt 1) {
  147.             (if (== c (accentTable (* ACCENT-NO-OF-ACCENTS entryCnt))) {
  148.                 (definitionFound TRUE)
  149.                 (break)
  150.             })
  151.         })
  152.  
  153.         (delete-character)
  154.         (if definitionFound {
  155.             (newChIndex
  156.                 (+ (* ACCENT-NO-OF-ACCENTS entryCnt)
  157.                     (switch (key-pressed)
  158.                         ACCENT-KEY-DOUBLE 1
  159.                         ACCENT-KEY-LEFT   2
  160.                         ACCENT-KEY-RIGHT  3
  161.                         ACCENT-KEY-CARET  4
  162.                         ACCENT-KEY-TILDE  5
  163.                         ACCENT-KEY-AT     6
  164.                         default           0
  165.                     )
  166.                 )
  167.             )
  168.             (insert-text (convert-to CHARACTER (accentTable newChIndex)))
  169.         }{
  170.             (insert-text (convert-to CHARACTER c))
  171.         })
  172.     }
  173.  
  174.     accent-bind-local-keys HIDDEN
  175.     {
  176.         (bind-local-key "accent-character" '"')
  177.         (bind-local-key "accent-character" "'")
  178.         (bind-local-key "accent-character" "`")
  179.         (bind-local-key "accent-character" '^')
  180.         (bind-local-key "accent-character" '~')
  181.         (bind-local-key "accent-character" '@')
  182.     }
  183.  
  184.     accent-help
  185.     {
  186.         (int entryCnt)
  187.         (int index)
  188.  
  189.         (if (== -2 (accentHelpBufId (attached-buffer ACCENT-HELP-BUFNAME))) {
  190.             (accentHelpBufId (create-buffer ACCENT-HELP-BUFNAME (bit-or BFFoo BFHidden2)))
  191.         })
  192.         (current-buffer accentHelpBufId TRUE)         
  193.         (clear-buffer)
  194.  
  195.         (insert-text "   \" ` ' \^ ~ @ ^J")
  196.         (for (entryCnt 0) (< entryCnt accentNoOfEntries) (+= entryCnt 1) {
  197.             (index (* ACCENT-NO-OF-ACCENTS entryCnt))
  198.             (insert-text
  199.                 (convert-to CHARACTER (accentTable    index   )) ": "
  200.                 (convert-to CHARACTER (accentTable (+ index 1))) " "                
  201.                 (convert-to CHARACTER (accentTable (+ index 2))) " "                
  202.                 (convert-to CHARACTER (accentTable (+ index 3))) " "                
  203.                 (convert-to CHARACTER (accentTable (+ index 4))) " "                
  204.                 (convert-to CHARACTER (accentTable (+ index 5))) " "                
  205.                 (convert-to CHARACTER (accentTable (+ index 6))) "^J"
  206.             )
  207.         })
  208.  
  209.         (accent-bind-local-keys)
  210.         (insert-text "^JFirst type the accent, then the character: ^J")
  211.         (insert-text ACCENT-PROMPT)
  212.     }
  213.  
  214.     accent-clear-all
  215.     {
  216.         (accentNoOfEntries 0)
  217.     }
  218.  
  219.     MAIN
  220.     {
  221.         (accent-clear-all)
  222.         
  223.         ;;
  224.         ;; These defaults are for MS-DOS. You can provide
  225.         ;; your own values for other systems by creating an
  226.         ;; 'accent-hook'.
  227.         ;;
  228.         ;;                   "    `    '    ^    ~    @
  229.         (accent-define 0x61 132  133  160  131  134  229 ) ;; a
  230.         (accent-define 0x41 142  0x41 0x41 0x41 143  197 ) ;; A
  231.         (accent-define 0x63 0x63 0x63 0x63 0x63 135  0x63) ;; c
  232.         (accent-define 0x43 0x43 0x43 0x43 0x43 128  0x43) ;; C
  233.         (accent-define 0x65 137  138  130  136  0x65 0x65) ;; e
  234.         (accent-define 0x45 0x45 0x45 144  0x45 0x45 0x45) ;; E
  235.         (accent-define 0x69 139  141  161  140  0x69 0x69) ;; i
  236.         (accent-define 0x6E 0x6E 0x6E 0x6E 0x6E 164  0x6E) ;; n
  237.         (accent-define 0x4E 0x4E 0x4E 0x4E 0x4E 165  0x4E) ;; N
  238.         (accent-define 0x6F 148  149  162  147  0x6F 0x6F) ;; o
  239.         (accent-define 0x46 153  0x46 0x46 0x46 0x46 0x46) ;; O
  240.         (accent-define 0x75 129  151  163  150  0x75 0x75) ;; u
  241.         (accent-define 0x55 154  0x55 0x55 0x55 0x55 0x55) ;; U
  242.  
  243.         (accent-bind-local-keys)
  244.  
  245.         (if (pgm-exists "accent-hook") {
  246.             (floc "accent-hook" ())
  247.         })
  248.     }
  249. )
  250.