home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857sr~1.zoo / src / transtab.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-02  |  7.5 KB  |  271 lines
  1. /* GNU Emacs routines to deal with trans tables.
  2.    Copyright (C) 1987 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY.  No author or distributor
  8. accepts responsibility to anyone for the consequences of using it
  9. or for whether it serves any particular purpose or works at all,
  10. unless he says so in writing.  Refer to the GNU Emacs General Public
  11. License for full details.
  12.  
  13. Everyone is granted permission to copy, modify and redistribute
  14. GNU Emacs, but only under the conditions described in the
  15. GNU Emacs General Public License.   A copy of this license is
  16. supposed to have been given to you along with GNU Emacs so you
  17. can know your rights and responsibilities.  It should be in a
  18. file named COPYING.  Among other things, the copyright notice
  19. and this notice must be preserved on all copies.  */
  20.  
  21. /* Written by Howard Gayle.  See chartab.c for details. */
  22.  
  23. #include "config.h"
  24. #include "lisp.h"
  25. #include "buffer.h"
  26. #include "etctab.h"
  27. #include "transtab.h"
  28.  
  29. Lisp_Object Qtrans_table_p;
  30. DEFUN ("trans-table-p", Ftrans_table_p, Strans_table_p, 1, 1, 0,
  31.    "Return t iff ARG is a trans table.")
  32. (obj)
  33. Lisp_Object obj;
  34. {
  35. return ((XTYPE (obj) == Lisp_Transtab) ? Qt : Qnil);
  36. }
  37.  
  38. static Lisp_Object
  39. check_trans_table (obj)
  40. Lisp_Object obj;
  41. {
  42. register Lisp_Object tem;
  43.  
  44. while (tem = Ftrans_table_p (obj), NULL (tem))
  45.    obj = wrong_type_argument (Qtrans_table_p, obj, 0);
  46. return (obj);
  47. }   
  48.  
  49. /* Convert the given Lisp_Transtab to a Lisp_Object. */
  50. static Lisp_Object
  51. enlisp_trans_table (sp)
  52. struct Lisp_Transtab *sp;
  53. {
  54. register Lisp_Object z; /* Return. */
  55.  
  56. XSET (z, Lisp_Transtab, sp);
  57. return (z);
  58. }
  59.  
  60. DEFUN ("downcase-table", Fdowncase_table, Sdowncase_table, 0, 0, 0,
  61.    "Return the lower case conversion trans table of the current buffer.")
  62. ()
  63. {
  64. return (enlisp_trans_table (current_buffer->downcase_table_v));
  65. }
  66.  
  67. DEFUN ("upcase-table", Fupcase_table, Supcase_table, 0, 0, 0,
  68.    "Return the upper case conversion trans table of the current buffer.")
  69. ()
  70. {
  71. return (enlisp_trans_table (current_buffer->upcase_table_v));
  72. }
  73.  
  74. DEFUN ("standard-downcase-table", Fstandard_downcase_table,
  75.    Sstandard_downcase_table, 0, 0, 0,
  76.    "Return the standard lower case conversion trans table.\n\
  77. This is the one used for new buffers.")
  78. ()
  79. {
  80. return (enlisp_trans_table (buffer_defaults.downcase_table_v));
  81. }
  82.  
  83. DEFUN ("standard-upcase-table", Fstandard_upcase_table,
  84.    Sstandard_upcase_table, 0, 0, 0,
  85.    "Return the standard upper case conversion trans table.\n\
  86. This is the one used for new buffers.")
  87. ()
  88. {
  89. return (enlisp_trans_table (buffer_defaults.upcase_table_v));
  90. }
  91.  
  92. /* Store a trans table.  Check for errors. */
  93. static Lisp_Object
  94. set_trans_table (p, t)
  95. struct Lisp_Transtab **p; /* Points to where to store the trans table. */
  96. register Lisp_Object t;   /* The trans table as a Lisp object. */
  97. {
  98. t = check_trans_table (t);
  99. *p = XTRANSTAB (t);
  100. return (t);
  101. }
  102.  
  103. DEFUN ("set-downcase-table", Fset_downcase_table, Sset_downcase_table, 1, 1, 0,
  104.    "Select a new lower case conversion trans table for the current buffer.\n\
  105. One argument, a trans table.")
  106. (table)
  107. Lisp_Object table;
  108. {
  109. return (set_trans_table (¤t_buffer->downcase_table_v, table));
  110. }
  111.  
  112. DEFUN ("set-upcase-table", Fset_upcase_table, Sset_upcase_table, 1, 1, 0,
  113.    "Select a new lower case conversion trans table for the current buffer.\n\
  114. One argument, a trans table.")
  115. (table)
  116. Lisp_Object table;
  117. {
  118. return (set_trans_table (¤t_buffer->upcase_table_v, table));
  119. }
  120.  
  121. DEFUN ("set-standard-downcase-table",
  122.    Fset_standard_downcase_table, Sset_standard_downcase_table, 1, 1, 0,
  123.    "Select a new standard lower case conversion trans table.\n\
  124. This does not change the trans tables of any existing buffers.\n\
  125. One argument, a trans table.")
  126. (table)
  127. Lisp_Object table;
  128. {
  129. return (set_trans_table (&buffer_defaults.downcase_table_v, table));
  130. }
  131.  
  132. DEFUN ("set-standard-upcase-table",
  133.    Fset_standard_upcase_table, Sset_standard_upcase_table, 1, 1, 0,
  134.    "Select a new standard upper case conversion trans table.\n\
  135. This does not change the trans tables of any existing buffers.\n\
  136. One argument, a trans table.")
  137. (table)
  138. Lisp_Object table;
  139. {
  140. return (set_trans_table (&buffer_defaults.upcase_table_v, table));
  141. }
  142.  
  143. DEFUN ("translate-region",
  144.    Ftranslate_region, Stranslate_region, 3, 4, 0,
  145.    "From START to END, translate characters according to trans\n\
  146. table TABLE.  If optional arg NOUNDO is non-nil, don't record\n\
  147. this change for undo and don't mark the buffer as really\n\
  148. changed.  Returns the number of characters changed.")
  149. (start, end, table, noundo)
  150. Lisp_Object start;
  151. Lisp_Object end;
  152. register Lisp_Object table;
  153. Lisp_Object noundo;
  154. {
  155. register int pos, stop; /* Limits of the region. */
  156. register int rec; /* Flag set iff noundo is nil. */
  157. register char_t *tt; /* Trans table. */
  158. register char_t oc; /* Old character. */
  159. register char_t nc; /* New character. */
  160. register int cnt; /* Number of changes made. */
  161. register Lisp_Object z; /* Return. */
  162.  
  163. validate_region (&start, &end);
  164. table = check_trans_table (table);
  165. tt = XTRANSTAB (table)->trt_to;
  166. pos = XINT (start);
  167. stop = XINT (end);
  168. modify_region (pos, stop);
  169. rec = NULL (noundo);
  170. #if 0                /* Removed for Gayle's patches */
  171. // *  if (!rec) bf_modified--;
  172. #endif
  173. cnt = 0;
  174. for (; pos < stop; ++pos)
  175.    {
  176.    oc = FETCH_CHAR (pos);
  177.    nc = tt[oc];
  178.    if (nc != oc)
  179.       {
  180.       if (rec) record_change (pos, 1);
  181.       FETCH_CHAR (pos) = nc;
  182.       ++cnt;
  183.       }
  184.    }
  185. XFASTINT (z) = cnt;
  186. return (z);
  187. }
  188.  
  189. DEFUN ("make-trans-table", Fmake_trans_table, Smake_trans_table, 0, 0, 0,
  190.    "Return a new identity trans table.")
  191. ()
  192. {
  193. register struct Lisp_Transtab *nt; /* New trans table. */
  194. register int                      i;
  195. register Lisp_Object           z;  /* Return. */
  196.  
  197. z = make_etc_table (sizeof (struct Lisp_Transtab), Lisp_Transtab);
  198. nt = XTRANSTAB (z);
  199. for (i = 0; i <= 255; ++i)
  200.    nt->trt_to[i] = (char_t) i;
  201. return (z);
  202. }
  203.  
  204. DEFUN ("get-trans-table-to",
  205.    Fget_trans_table_to, Sget_trans_table_to, 2, 2, 0,
  206.    "Return the character to which character FROM is translated\n\
  207. in trans table TABLE.")
  208. (fromc, table)
  209. Lisp_Object fromc;
  210. register Lisp_Object table;
  211. {
  212. register Lisp_Object z;
  213.  
  214. table = check_trans_table (table);
  215. XFASTINT (z) = XTRANSTAB (table)->trt_to[get_char_arg (fromc)];
  216. return (z);
  217. }
  218.  
  219. DEFUN ("set-trans-table-to",
  220.    Fset_trans_table_to, Sset_trans_table_to, 3, 3, 0,
  221.    "Set the translation from character FROM to character TO in\n\
  222. trans table TABLE.")
  223. (fromc, toc, table)
  224. Lisp_Object fromc;
  225. Lisp_Object toc;
  226. register Lisp_Object table;
  227. {
  228. register char_t f = get_char_arg (fromc);
  229. register char_t t = get_char_arg (toc);
  230.  
  231. table = check_trans_table (table);
  232. XTRANSTAB (table)->trt_to[f] = t;
  233. return (table);
  234. }
  235.  
  236. init_trans_table_once ()
  237. {
  238. register int i;
  239. register char_t *p;
  240.  
  241. Fset_standard_downcase_table (Fmake_trans_table ());
  242. p = buffer_defaults.downcase_table_v->trt_to;
  243. for (i = 'A'; i <= 'Z'; ++i)
  244.    p[i] = (char_t) (i + 'a' - 'A');
  245.  
  246. Fset_standard_upcase_table (Fmake_trans_table ());
  247. p = buffer_defaults.upcase_table_v->trt_to;
  248. for (i = 'a'; i <= 'z'; ++i)
  249.    p[i] = (char_t) (i - 'a' + 'A');
  250. }
  251.  
  252. syms_of_trans_table ()
  253. {
  254. Qtrans_table_p = intern ("trans-table-p");
  255. staticpro (&Qtrans_table_p);
  256.  
  257. defsubr (&Strans_table_p);
  258. defsubr (&Sdowncase_table);
  259. defsubr (&Supcase_table);
  260. defsubr (&Sstandard_downcase_table);
  261. defsubr (&Sstandard_upcase_table);
  262. defsubr (&Sset_downcase_table);
  263. defsubr (&Sset_upcase_table);
  264. defsubr (&Sset_standard_downcase_table);
  265. defsubr (&Sset_standard_upcase_table);
  266. defsubr (&Stranslate_region);
  267. defsubr (&Smake_trans_table);
  268. defsubr (&Sget_trans_table_to);
  269. defsubr (&Sset_trans_table_to);
  270. }
  271.