diff options
Diffstat (limited to 'elisp/erbot/contrib/lines.el')
| -rw-r--r-- | elisp/erbot/contrib/lines.el | 586 |
1 files changed, 586 insertions, 0 deletions
diff --git a/elisp/erbot/contrib/lines.el b/elisp/erbot/contrib/lines.el new file mode 100644 index 0000000..f938c49 --- /dev/null +++ b/elisp/erbot/contrib/lines.el @@ -0,0 +1,586 @@ +;;; Lines.el -- help deal with data-files. OLDER VERSIONS SECURITY RISK +;;General Public License. +;; Time-stamp: <2004-11-21 11:11:45 deego> +;; GPL'ed under GNU'S public license.. +;; Copyright (C) Deepak Goel 2000 +;; Emacs Lisp Archive entry +;; Filename: lines.el +;; Author: Deepak Goel <deego@glue.umd.edu> +;; Version: 0.3alpha + +;; OLDER VERSIONS OF LINES.EL AREx A SECURITY RISK. IF YOU USE THEM +;; TO FETCH FIELD FROM SOME ONE ELSE'S FILE , CRAFTY EXPRESSIONS CAN +;; MAKE YOUR EMACS EVALUATE ANYTHING, INCLUDING (SHELL-COMMAND "RM +;; -RF")). WE JUST THINK SO, WE HAVEN'T BEEN ABLE TO ACTUALLY COME UP +;; WITH AN EXPLOIT. SO USE version > 0.3 only + +;; EVEN THIS LIBRARY IS A POSSIBLE SECURITY RISK TOO IF YOU DISABLE +;; LINES-SAFE-P. + + + +(defvar lines-version "0.3alpha") + +;;; See also: forms.el (just saw it.. maybe it does all that lines.el +;; does ?) + + +;;;COMMENTARY: lines functions to help deal with data-files.. + +;;; Sometimes you want to use lines- functions instead of point- +;;; functions, even though it is slower. Particularly if u r dealing with +;;; parsing/editing a data-file, with, say data arranged in columns. +;;; lines.el defines most lines- counterparts of (point-max) (point-min) +;;; (point) (kill-region) etc. [for instance, emacs' default lines-what +;;; does not return an integer, which is what u may want during +;;; programming] + +;;; Lines.el also defines functions such as lines-get-fields (which gets +;;; all fields on this line, assuming they are lisp-expressions). + + +;;; BEFORE DOING ANYTHING WITH A BUFFER, please do not forget to call +;;;; lines-narrow-initial.. + + + +;;; CODE: +(eval-when-compile (require 'cl)) + +;;;###autoload +(defmacro lines-ignore-errors (&rest body) + "Copied from utils.el + +Like ignore-errors, but returns a list of body, and the +error... Improved for me by Kalle on 7/3/01: * used backquote: +something i was too lazy to convert my macro to.. * removed the +progn: condition-case automatically has one.. * made sure that +the return is nil.. just as it is in ignore-errors. " + (let ((err (gensym))) + `(condition-case ,err (list (progn ,@body) nil) + (error + (list nil ,err))))) + + +(defmacro lines-with-string (string &rest body) + "This macro treats the string as a buffer... basically, it +temporarily puts the string into a temp-buffer and runs body on it... +Note that when the body is being run, the point is (initially) at the +end of the buffer... " + `(with-temp-buffer + (insert ,string) + ,@body)) + + +(defun lines-empty-error () + "" + (error "Empty buffer. NOTE: M-x lines-warning.") +) + +(defun lines-warning () + "" + (let ((lines-loudness 1)) + (lines-message + "THIS program assumes that the proper form of the (data-) file you + examine ends in \\n. Anything in your file after the last \\n + will be ignored.")) +) + +;;;Mon Jan 15 04:09:30 2001 +;;;###autoload +(defun lines-widen () + (widen) +) + +;;;Mon Jan 15 03:32:05 2001 +;;;###autoload +(defun lines-narrow-initial (&optional ERR) + "Narrows such that the last char is a \\n +If the buffer survives, returns the size of the buffer, else nil. +Optional arg ERR results in ERR upon empty buffer. +FOR FUTURE EDITS: NEVER CALL OTHER LINES FUNCTIONS WITHIN THIS +FUNCTION, THIS ONE IS CALLED BY ALL OTHERS! + +" + (interactive) + (save-excursion + (let + ((lastn + (progn + (goto-char (point-max)) + (if + (search-backward "\n" nil t) + (+ (point) 1) + (point-min))))) + (narrow-to-region (point-min) lastn)) + (if (> (point-max) (point-min)) + (point-max) + nil)) +) + + +(defvar lines-loudness 0.6 "Tells you how noisy lines will be.. +Between 0 and 1 are meaningful values") + +(defun lines-message (&optional args) + (if (> lines-loudness 0.5) (apply 'message args)) +) + + +;;;###autoload +(defalias 'lines-what-line 'lines-what) + +;;;Wed Jan 17 00:11:38 2001 +;;;###autoload +(defun lines-what-narrowed (&optional given-point ) + " Like lines-what-line, except assumes a narrowed buffer. +Mostly like what-line, except: returns integer! +Tells you the current line.. If narrowed, assumes that the first +visible line is number 1.. As if the buffer were the entire buffer.. +Respects narrowing.. + +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (let ((opoint (if given-point given-point (point))) + start) + (save-excursion + (goto-char (point-min)) + (beginning-of-line) + (setq start (point)) + (goto-char opoint) + (beginning-of-line) + (let + ((result + (if (/= start 1) + (1+ (count-lines start (point))) + (1+ (count-lines start (point)))))) + (if (interactive-p) + (message (format "%S" result))) + result))) + ) + +;;;Wed Jan 17 00:11:38 2001 +;;;###autoload +(defun lines-what(&optional given-point ) + " Mostly like what-line, except: returns integer! +Tells you the current line.. Ignores any narrowing when counting +lines, but does not disrupt the narrowing.. + +Hacked from the code of what-line, and i still don't understand some +stuff about the relevance of start here.. + +Thus, even if the buffer has been narrowed, lines-what will try to +return the true line-number.. Agreed this may slow things down for +large files, but makes sense to me.. if u don't like this, please +consider using lines-what-narrowed.. + +In the new emacsen, see also `line-at-pos'. +" + (interactive) + (let ((opoint (if given-point given-point (point))) + start) + (save-excursion + (goto-char (point-min)) + (beginning-of-line) + (setq start (point)) + (goto-char opoint) + (beginning-of-line) + (let + ((result + (if (/= start 1) + (1+ (count-lines 1 (point))) + (1+ (count-lines 1 (point)))))) + (if (interactive-p) + (message (format "%S" result))) + result))) + ) + + +;;;###autoload +(defalias 'lines-line-difference 'lines-difference) + +;;;###autoload +(defun lines-difference (start end ) + "Nothing more than the difference between the line at start and the +one at end. start and end are points.. See also the default +count-lines.. +If DONTNARROW is t, assume that lines has already been narrowed.. + +" + (save-excursion + (- (lines-what-line end ) + (lines-what-line start ))) + ) + + +;;;###autoload +(defalias 'lines-last-line-p 'lines-last-p) + +;;;###autoload +(defun lines-last-p () +" Tells if we are on the last line. " + (interactive) + (save-excursion + (end-of-line) + (equal (point) (point-max))) + ) + +;;;###autoload +(defalias 'lines-first-line-p 'lines-first-p) + +;;;###autoload +(defun lines-first-p () +"If DONTNARROW is t, assume that lines has already been narrowed.." + (interactive) + (save-excursion + (beginning-of-line) + (equal (point) (point-min))) +) + +;;;###autoload +(defalias 'lines-line-min 'lines-min) + +;;;###autoload +(defun lines-min () + "Like point-min.. +If DONTNARROW is t, assume that lines has already been narrowed.. + +" + (interactive) + (save-excursion + (goto-char (point-min)) + (lines-what-line (point) )) +) + +;;;###autoload +(defalias 'lines-line-max 'lines-max) + +(defun lines-max () + "Like point-max +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (save-excursion + (goto-char (point-max)) + (lines-what-line (point) )) +) + + +;;;Tue Jan 16 11:26:30 2001 +;;;###autoload +(defalias 'lines-kill-this 'lines-kill-one) + +;;;Tue Jan 16 11:26:26 2001 +;;;###autoload +(defun lines-kill-one (&optional pt1 ) + (interactive) + (if (null pt1) + (setq pt1 (point))) + (lines-kill pt1 pt1 )) + + +;;;Tue Jan 16 11:50:55 2001 +;;;###autoload +(defun lines-kill-by-lines (&optional l1 l2 ) + "Kills from line1 to line2. If l1 or l2 is not specified, passes nil to +lines-kill.. + +Use this function only if necessary.. +This function calls line-kill.. which is the one to be preferred for +speed.. + +" + (save-excursion + (let + ((pt1 + (if (null l1) nil + (progn + (goto-line l1) + (point)))) + (pt2 + (if (null l2) nil + (progn + (goto-line l2) + (point))))) + (lines-kill pt1 pt2 ))) + ) + + + + +;;;Tue Jan 16 11:26:22 2001 +;;;###autoload +(defalias 'lines-kill-line 'lines-kill-one) + + +;;;###autoload +(defun lines-kill (&optional pt1 pt2 ) + "Kills this line completely. + +If PT1 and PT2 are specified, kills all lines through the line on PT1 +to line on PT2, inclusive. + +If neither PT1 is not specified, kills between point and mark. + +If only PT1 is specified, and PT2 is nil, takes PT2 to be PT1, +viz. kills the line on PT1. + + +If DONTNARROW is t, assume that buffer has already been narrowed +initially. + +If the second point to be killed is point-max, viz. is at a line we +don't consider to be on the buffer, this function appropriately +subtracts 1 from it so as to make it a part of the last legal line. + +" + (interactive) + (when (null pt1) + (setq pt1 (mark)) + (setq pt2 (point))) + (when (null pt1) ;;if mark is undefined.. + (setq pt1 pt2)) + (lines-swap-if-necc 'pt1 'pt2) ;;;ensure pt1 <= pt2. + (if (= pt2 (point-max)) (setq pt2 (- pt2 1))) + (if (= pt1 (point-max)) (setq pt1 (- pt1 1))) + (save-excursion + (let ((a1 + (progn + (goto-char pt1) + (beginning-of-line) + (point))) + (a2 + (progn + (goto-char pt2) + (end-of-line) + (+ (point) 1)))) + (kill-region a1 a2))) + ) + + + + + +(defun lines-backward-char () + "Moves one point back. Returns point if succeeds, else nil. +Never gives error! +Actually, i don't think we need this function.. +" + (interactive) + (let ((pt (point))) + (ignore-errors (backward-char 1)) + (if (/= (point) pt) + pt + nil)) + ) + +;;;Tue Jan 16 17:35:29 2001 +;;;###autoload +(defun lines-get-fields-by-lines (&optional line) + "Gets the field on the given line" + (lines-get-fields (lines-point-for-line line)) +) + + +;;;Thu Feb 8 14:48:47 2001 +;;;###autoload +(defun lines-point-for-line (line) + (save-excursion + (goto-line line) + (point))) + +(defcustom lines-safe-p t + "Set to t to revert to an unsafe, older but faster method of using + lines. ") + +;;;Mon Jan 15 02:42:19 2001 +;;;###autoload +(defun lines-get-fields (&optional pt ) + "Gets the fields if any on the current line, as a list. +Uses scan-sexps==> +will be affected by the value of parse-sexp-ignore-comments.. + +I think this needs to be totally rewritten.. to give the same results, +but much more efficiently.. +" + (interactive) + (let (fields fld buf fld-err err) + (if (null pt) (setq pt (point))) + (if (= pt (point-max)) + (goto-char (- pt 1))) + (save-excursion + (goto-char pt) + (let ((expr (lines-at-point )) + fields) + (cond + (lines-safe-p + (with-temp-buffer + (setq buf (current-buffer)) + (insert expr) + (goto-char (point-min)) + (while + (progn + (setq fld-err + (lines-ignore-errors (read buf))) + (setq fld (car fld-err)) + (setq err (cadr fld-err)) + (not err)) + (push fld fields))) + (setq fields (reverse fields))) + (t + (if (null expr) + (error "Attempt to get fields beyond the last RET ")) + (with-temp-buffer + (insert "(setq fields (quote (") + (insert expr) + (insert " \n)))") + (eval-buffer)))) + (if (interactive-p) (message "%S" fields)) + fields)))) +;;; (let ((doing (point-min))) +;;; (while doing +;;; (setq doing (scan-sexps doing 1)) +;;; (when doing +;;; (goto-char doing) +;;; (setq fields (cons (format "%S" (sexp-at-point)) fields)))))) +;;; (reverse fields)) +;;; ) + + +;;;Mon Jan 15 16:29:12 2001 +;;;###autoload +(defalias 'lines-line-at-point-verbatim 'lines-at-point-verbatim) + +;;;Mon Jan 15 03:02:17 2001 +;;;###autoload +(defun lines-at-point-verbatim ( ) + "Gives you just this one line at tthe current point. +this returns you the line along with the trailing \\n. Thus, if the +buffer ended up empty upon line-narrowing, this will return \"\". +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (buffer-substring + (save-excursion + (beginning-of-line) + (point)) + (save-excursion + (forward-line 1) + (point))) + ) + +;;;Mon Jan 15 16:29:40 2001 +;;;###autoload +(defalias 'lines-line-at-point 'lines-at-point) + +;;;Mon Jan 15 03:55:05 2001 +;;;###autoload +(defun lines-at-point () + "Returns the line at this point, without the trailing \\newline. +If the buffer is empty, returns nil. +If DONTNARROW is t, assume that lines has already been narrowed.. +" + (interactive) + (let ((string (lines-at-point-verbatim ))) + (let ((len (length string))) + (if (> len 0) + (substring string 0 (- len 1)) + nil))) +) + + + + + +;;;Tue Jan 16 11:35:20 2001 +(defun lines-swap-if-necc (sym1 sym2) + "INTERNAL.. +Ensures that the value of symbol SYM1 if less than that of SYM2" + (when (> (eval sym1) (eval sym2)) + (let ((v2 (eval sym2))) + (set sym2 (eval sym1)) + (set sym1 v2))) +) + + + +;;;Tue Jan 16 15:50:31 2001 +;;;###autoload +(defun lines-narrow (&optional pt1 pt2 ) + "If called with no arguments, will assume point mark. If pt2 is +undefined, will take it to be the same as pt1. + +Will narrow buffer from the line starting pt1 to the line ending +pt2, inclusive. If pt1 is > pt2, will be swapped.. " + (interactive) + (if (null pt1) + (progn + (setq pt1 (mark)) + (setq pt2 (point)))) + (if (null pt2) + (setq pt2 pt1)) + (lines-swap-if-necc 'pt1 'pt2) + (save-excursion + (narrow-to-region + (progn + (goto-char pt1) + (beginning-of-line) + (point)) + (progn + (goto-char pt2) + (end-of-line) + (if (not (= (point-max) (point))) + (forward-char 1)) + (point)))) +) + +;;;Tue Jan 16 17:33:51 2001 +;;;###autoload +(defun lines-for-point (&optional pt) + "Line number on the point" + (interactive) + (if (null pt) (setq pt (point))) + (save-excursion + (goto-char pt) + (lines-what))) + +;;; 2002-05-14 T15:24:21-0400 (Tuesday) D. Goel +;;;###autoload +(defun lines-what-string (string) + (lines-with-string string + (lines-what))) + + + +;;; 2002-11-27 T15:21:04-0500 (Wednesday) D. Goel +;;;###autoload +(defun lines-get-fields-file (filename) + "Get fields from a file. A list per line. A list of such lists. +problem: barfs in the middle of comments..." + + (interactive "F") + (save-window-excursion + (let ((fields nil)) + (find-file filename) + (lines-narrow-initial) + (goto-char (point-min)) + (while (not (lines-last-p)) + (add-to-list 'fields (lines-get-fields)) + (next-line 1)) + (reverse fields)))) + +(defun lines-write-fields-file (fields filename) + (with-temp-file filename + (let ((left fields)) + (while left + (insert + (mapconcat + '(lambda (arg) (format "%S" arg)) + (car left) + "\t") "\n") + (pop left))))) + +(provide 'lines) + +;;;lines.el ends here.. |