home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / gener-code.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  14.9 KB  |  356 lines
  1. ;From: quiroz@cs.rochester.edu (Cesar Quiroz)
  2. ;Newsgroups: comp.emacs
  3. ;Subject: Re: Looking for an insert at column function
  4. ;Message-ID: <1989Jun17.230717.28962@cs.rochester.edu>
  5. ;Date: 22 Jul 89 03:07:17 GMT
  6. ;Reply-To: quiroz@cs.rochester.edu (Cesar Quiroz)
  7. ;Organization: U of Rochester, Dept. of Computer Science, Rochester, NY 14627
  8. ;Lines: 345
  9. ;Summary: provided here function goto-column
  10. ;
  11. ;At the end of this posting is a program (generic-code-mode) I use
  12. ;whenever dealing with roughly block structured files (like shell
  13. ;scripts, awk programs, etc.), for which there is no specific mode
  14. ;that knows their syntax.  The General Public License applies, as
  15. ;usual.  I haven't done much work on it for a while, but I use it
  16. ;frequently.  I don't expect bugs, but I am not happy with the fake
  17. ;unix-script-mode.  So I am posting it in `pre-release' condition,
  18. ;for criticism and improvement from the user community.
  19. ;
  20. ;Frank: The function you need can be synthesized from `goto-column'.
  21. ;(I think you can separate goto-column from the rest, you may not
  22. ;need the bulk of generic-code-mode for this application).  Suppose
  23. ;you need to insert a string at column N (remember it is 0-based) _in
  24. ;the current line_, you would just go there and insert.  So, if you
  25. ;need to navigate by lines and columns, I would use something like
  26. ;this (vastly untested, careful):
  27. ;
  28. ;;;; Bug: if line LINE does not exist, you get to the end of the
  29. ;;;; buffer.  Exercise for the reader: using count-lines or its
  30. ;;;; friends, first figure out if the buffer needs to be stretched.
  31. ;;;; Another exercise:  figure out a reasonable interactive setting.
  32. ;(defun go-and-insert (string column &optional line)
  33. ;  "Drop STRING at COLUMN of LINE.  Omitting LINE defaults to the current line,
  34. ;the line point is on.  LINE counts from 1 at the top of the buffer, COLUMN
  35. ;counts from 0 at the left edge.  Point is left at the end of the inserted
  36. ;string."
  37. ;  ;; you wouldn't want this to be (interactive), now would you?
  38. ;  (if line (goto-line line))
  39. ;  (goto-column column)
  40. ;  (insert string))
  41. ;
  42. ;The peculiar argument order is justified by the desire to make the
  43. ;line number optional, of course.  The function you need requires
  44. ;more work (has to drop the string more than once, etc.), but it
  45. ;shouldn't be hard to modify go-and-insert to accomplish it.
  46. ;
  47. ;Cesar
  48. ;; Editing generic block structured files
  49. ;; Pre-release. 
  50. ;; Copyright (C) 1989 Free Software Foundation, Inc.
  51.  
  52. ;; Although this file is not yet part of GNU Emacs, it is
  53. ;; distributed in the same spirit.
  54.  
  55. ;; GNU Emacs is distributed in the hope that it will be useful,
  56. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  57. ;; accepts responsibility to anyone for the consequences of using it
  58. ;; or for whether it serves any particular purpose or works at all,
  59. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  60. ;; License for full details.
  61.  
  62. ;; Everyone is granted permission to copy, modify and redistribute
  63. ;; GNU Emacs, but only under the conditions described in the
  64. ;; GNU Emacs General Public License.   A copy of this license is
  65. ;; supposed to have been given to you along with GNU Emacs so you
  66. ;; can know your rights and responsibilities.  It should be in a
  67. ;; file named COPYING.  Among other things, the copyright notice
  68. ;; and this notice must be preserved on all copies.
  69.  
  70. ;;; Generic code mode for EMACS.
  71. ;;;
  72. ;;; Integrated more stuff.  Point-to-tab-stop lets you move point
  73. ;;; without adding whitespace.  Goto-column lets you go to a column of
  74. ;;; your choice, even when the line is shorter than that.  CQ, 14 sep 88.
  75. ;;;
  76. ;;; This library lets the user deal with editing inputs that look
  77. ;;; block structured and have optional comments.  It cannot be too
  78. ;;; bright, as there is little or no indication of the intended
  79. ;;; syntax, but the user can indicate his preferences via syntactic
  80. ;;; classes, abbrevs and such.  CQ, 30 sep 87.
  81.  
  82. (provide 'generic-code-mode)
  83. (require 'cl)
  84.  
  85. (defvar generic-code-mode-hook nil)
  86. (defvar generic-code-mode-syntax-table nil)
  87. (defvar generic-code-mode-abbrev-table nil)
  88. (defvar generic-code-mode-map nil)
  89.  
  90. (define-abbrev-table 'generic-code-mode-abbrev-table ())
  91.  
  92. (cond ((null generic-code-mode-map)
  93.        (setq generic-code-mode-map (copy-keymap indented-text-mode-map))
  94.        (define-key generic-code-mode-map "\M-o"    'indent-to-point)
  95.        (define-key generic-code-mode-map "\C-i"    'indent-to-tab-stop)
  96.        (define-key generic-code-mode-map "\M-\C-i" 'tab-to-tab-stop)
  97.        (define-key generic-code-mode-map "\M-i"    'point-to-tab-stop)
  98.        (define-key generic-code-mode-map "\C-x|"   'goto-column)
  99.        ))
  100.  
  101. (defun generic-code-mode ()
  102.   "Sets generic code mode, essentially indented-text mode
  103. with no fill.  TAB is rebound to run indent-to-tab-stop (q.v.),
  104. which is used to advance or retreat the indentation of the 
  105. current line.  See the function `set-scripts-syntax' for a simple
  106. customization useful when editing shell scripts, awk programs or icon
  107. programs, and the function `unix-script-mode' for a simple way to use
  108. it.  See `right-adjust-line' too. 
  109. \\{generic-code-mode-map}"
  110.   (interactive)
  111.   (indented-text-mode)
  112.   ;; the variables specific to generic code mode are made buffer-local
  113.   ;; in order to preserve the possibility of editing simultaneously
  114.   ;; with slightly different `less-generic' modes based on this one.
  115.   (make-local-variable 'generic-code-mode-map)
  116.   (use-local-map generic-code-mode-map)
  117.   (auto-fill-mode -1)
  118.   (setq major-mode 'generic-code-mode)
  119.   (setq mode-name "Code")
  120.   (make-local-variable 'generic-code-mode-syntax-table)
  121.   (setq generic-code-mode-syntax-table (make-syntax-table))
  122.   (make-local-variable 'generic-code-mode-syntax-table)
  123.   (set-syntax-table generic-code-mode-syntax-table)
  124.   (make-local-variable 'generic-code-mode-abbrev-table)
  125.   (setq local-abbrev-table generic-code-mode-abbrev-table)
  126.   ;;
  127.   (make-local-variable 'comment-start)
  128.   (make-local-variable 'comment-end)
  129.   (make-local-variable 'comment-start-skip)
  130.   (make-local-variable 'comment-indent-hook)
  131.   ;;
  132.   (run-hooks 'generic-code-mode-hook))
  133.  
  134. (defun indent-to-tab-stop (n)
  135.   "Advance or retreat the indentation of this line.
  136. A positive argument (interactive default) advances,
  137. a negative argument retreats,
  138. a zero argument aligns with the previous nonblank line.
  139. The number of tab stops actually moved is the absolute value of the
  140. argument.
  141. Just using \C-u as prefix means the same as -1."
  142.   (interactive "p")
  143.   ;; Special case suggested by Neil:  Just giving
  144.   ;; `C-u' means `-', instead of `M- 4'.
  145.   (when (consp current-prefix-arg)      ;Any number of `C-u's
  146.     (setq n -1))
  147.   (let ((here (point-marker))
  148.         (do-not-return nil))
  149.     (back-to-indentation)
  150.     (setq do-not-return (looking-at "[ \t]*$"))
  151.     (multiple-value-bind
  152.         (prev-tab next-tab)
  153.         (find-neighboring-tabs (current-column))
  154.       ;; Depending on sign of n, move forward or backward
  155.       (cond ((> n 0)
  156.              (indent-to-column next-tab)
  157.              (when (> (decf n) 0)
  158.                (indent-to-tab-stop n)))
  159.             ((= n 0)
  160.              (delete-horizontal-space)
  161.              (indent-relative-maybe))
  162.             ((< n 0)
  163.              (delete-horizontal-space)
  164.              (indent-to-column prev-tab)
  165.              (when (< (incf n) 0)
  166.                (indent-to-tab-stop n)))))
  167.     ;; go back to the correct relative position
  168.     (unless do-not-return
  169.       (goto-char (marker-position here)))))
  170.  
  171. (defun point-to-tab-stop (n)
  172.   "Advance or retreat the current-column to a near tab stop.  Just
  173. move the cursor, don't add nor delete anything.  Compare with
  174. tab-to-tab-stop, that pushes things to the right.
  175. A positive argument (interactive default) advances, 
  176. a negative argument retreats.
  177. The number of tab stops actually moved is the absolute value of the
  178. argument.  Giving it \C-u means `-', not 4."
  179.   (interactive "p")
  180.   ;; Special case suggested by Neil:  Just giving
  181.   ;; `C-u' means `-', instead of `M- 4'.
  182.   (when (consp current-prefix-arg)      ;Any number of `C-u's
  183.     (setq n -1))
  184.   (multiple-value-bind
  185.       (prev-tab next-tab)
  186.       (find-neighboring-tabs (current-column))
  187.     ;; Depending on sign of n, move forward or backward
  188.     (cond ((> n 0)
  189.            (goto-column next-tab)
  190.            (when (> (decf n) 0)
  191.              (point-to-tab-stop n)))
  192.           ((< n 0)
  193.            (goto-column prev-tab)
  194.            (when (< (incf n) 0)
  195.              (point-to-tab-stop n))))))
  196.  
  197. (defun find-neighboring-tabs (column)
  198.   "Return previous and next tab positions, when at position COLUMN.
  199. The values returned are chosen from tab-stop-list (if not null) or
  200. computed as exact multiples of tab-width.  If COLUMN is outside the
  201. range of tab-stop-list, either 0 or (+ Column Tab-Width) are used as
  202. the missing bounds."
  203.   (cond  ((null tab-stop-list)          ; have to use multiples of tab-width
  204.           (cond ((= (mod column tab-width) 0) ;exact match
  205.                  (values (max 0 (- column tab-width)) (+ column tab-width)))
  206.                 (t                      ;in between matches
  207.                  (let* ((prev (floor column tab-width))
  208.                         (next (+ prev tab-width)))
  209.                    (values prev next)))))
  210.          (t                             ;there is a tab-stop-list
  211.           (do* ((tabs                   ;add special terminator
  212.                  (append tab-stop-list (list (+ column tab-width)))
  213.                  (cdr tabs))
  214.                 (past 0 this)
  215.                 (this (car tabs) (car tabs))
  216.                 (next)                  ;used to store the values
  217.                 (prev)                  ; to return.
  218.                 (done nil))
  219.               (done (values prev next))
  220.             ;; we compare the current column against each tab stop
  221.             ;; (the tab-stop-list being augmented by a catch-all
  222.             ;; terminator) until the current column either matches one
  223.             ;; of the tab stops or is precisely contained between two
  224.             ;; of them.
  225.             (cond ((= column this)
  226.                    ;; column matches a tab-stop=>return surrounding ones.
  227.                    (setf prev past      ;need to protect value of past!
  228.                          next (cadr tabs) ;cadr won't ever fail here
  229.                          done t))
  230.                   ((and (>= column past)
  231.                         (<  column this))
  232.                    ;; column is in between past and this
  233.                    (setf prev past      ;need to protect value of past!
  234.                          next this
  235.                          done t))
  236.                   (t
  237.                    ;; no need to do anything, do* will step for us
  238.                    ))))))
  239.  
  240. (defun indent-to-point (here)
  241.   "Move indentation of this line to the column of point.
  242. Used to force indentation to a given spot.  When called from a
  243. program, give it a character position.  The line that contains that
  244. position will be indented to the column of that position in it."
  245.   (interactive "d")
  246.   ;; Make sure you are really HERE (in the line containing HERE)
  247.   (goto-char here)
  248.   (let ((indentation (current-column)))
  249.     (beginning-of-line)
  250.     (delete-horizontal-space)
  251.     (indent-to-column indentation)))
  252.  
  253. ;;; Customizations of code mode
  254.  
  255. (defun unix-script-mode ()
  256.   "This function sets up generic-code-mode with the syntax for scripts
  257. that is provided by set-scripts-syntax.  It is not a real major mode,
  258. so it appears to be generic-code-mode for all intents and purposes."
  259.   (interactive)
  260.   (generic-code-mode)
  261.   (set-scripts-syntax))
  262.  
  263. (defun set-scripts-syntax ()
  264.   "Establish # as a comment character, etc...  Modifies
  265. generic-code-mode such that it is useful for scripts to
  266. be fed to sh, csh, awk, icont and the like."
  267.   (interactive)
  268.   ;; special commenting conventions
  269.   (modify-syntax-entry ?# "<")
  270.   (modify-syntax-entry ?\n ">")
  271.   (modify-syntax-entry ?\f ">")
  272.   (setq comment-start "#")
  273.   (setq comment-end "")
  274.   (setq comment-start-skip "#+ *")
  275.   (setq comment-indent-hook 'generic-code-hash-comment-indent))
  276.  
  277. (defun generic-code-hash-comment-indent ()
  278.   "Indent comments that begin with at least one #.
  279. Comments at the beginning of a line or that begin with more than one
  280. hash are left alone.  Move them around with indent-to-tab-stop, if you
  281. must."
  282.   (if (or (bolp) (looking-at "##"))
  283.       (current-column)
  284.     (skip-chars-backward " \t")
  285.     (max (if (bolp) 0 (1+ (current-column)))
  286.          comment-column)))
  287.  
  288. ;;; This routine provides absolute motions in a line, with possible
  289. ;;; extension of the line if so requested.  Note that the standard
  290. ;;; `move-to-column' stops at line end.  I bind this usually to `C-x |'.
  291.  
  292. (defun goto-column (n)
  293.   "Go to column N in this line, extend line at end with spaces if
  294. needed.  Interactively, take the prefix argument as a column number or
  295. query in the minibuffer if none given."
  296.   (interactive "p")
  297.   (if (and (interactive-p) (null current-prefix-arg))
  298.       (setq n (call-interactively
  299.                '(lambda (n) (interactive "nColumn to go to? ") n))))
  300.   (if (< n 0)
  301.       (error "Negative column `%d' given to goto-column." n))
  302.   (let* ((line-length (save-excursion (end-of-line)
  303.                                       (current-column)))
  304.         (difference   (- n line-length)))
  305.     (cond ((<= difference 0)
  306.            (move-to-column n))
  307.           (t
  308.            (end-of-line)
  309.            (while (> difference 0)
  310.              (insert " ")
  311.              (setq difference (- difference 1)))))))
  312.  
  313. (defun right-adjust-line ()
  314.   "Have the current line end in a non-whitespace character aligned to
  315. the rightmost position.  Rightmost here means 'at the fill-column or
  316. at window end'.  Sort of complements any usage of `center-line' and
  317. the usage of `delete-horizontal-space' at the beginning of a line."
  318.   (interactive)
  319.   (beginning-of-line)
  320.   (let ((had-fill-prefix    (and fill-prefix (looking-at fill-prefix)))
  321.         (fill-prefix-length (length fill-prefix)))        
  322.     (if had-fill-prefix
  323.         (delete-char fill-prefix-length))
  324.     ;; trim horizontal space around the remaining text
  325.     (delete-horizontal-space)
  326.     (end-of-line)
  327.     (delete-horizontal-space)
  328.     ;; ASSERTION: Cursor is now at end of line
  329.     (let* ((text-length  (current-column))
  330.            (line-length  (if fill-column
  331.                              fill-column
  332.                            (window-width)))
  333.            (slack        (- line-length text-length)))
  334.       (beginning-of-line)
  335.       (if (> slack 0)
  336.           (indent-to-column slack))
  337.       ;; restore fill-prefix, if removed earlier
  338.       (cond  (had-fill-prefix
  339.               (beginning-of-line)
  340.               (cond ((> slack fill-prefix-length)
  341.                      (delete-char fill-prefix-length)
  342.                      (insert fill-prefix))
  343.                     (t                  ;give up on this
  344.                      (delete-char slack)
  345.                      (insert fill-prefix)))))
  346.       ;; have to put the cursor somewhere...
  347.       (end-of-line))))
  348.  
  349. ;;; end of generic-code-mode.el
  350.  
  351. ;-- 
  352. ;                                      Cesar Augusto Quiroz Gonzalez
  353. ;                                      Department of Computer Science
  354. ;                                      University of Rochester
  355. ;                                      Rochester,  NY 14627
  356.