code/elbb-misc-utils.el

   1 ;;; elbb-misc-utils.el --- misc-utils for all Emacsen
   2 ;; Keywords: lisp
   3
   4 ;; This is free software: you can redistribute it and/or modify
   5 ;; it under the terms of the GNU General Public License as published by
   6 ;; the Free Software Foundation, either version 2 of the License, or
   7 ;; (at your option) any later version.
   8
   9 ;; This is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 ;; Copyright (C) 2009 by Andreas Roehler
  18 ;; Author Andreas Roehler  <andreas.roehler@online.de>
  19
  20 (defun read-buffer-by-top-level-form (&optional beg end)
  21   "Read buffer step by step by top-level-form.
  22 Prints position into the message-buffer after evaluation.
  23 Stepps through region if activated, otherwise takes the whole buffer."
  24   (interactive)
  25   (when (string-match ".gnu-emacs-all-cvs" (buffer-file-name)) (emacs-lisp-mode))
  26   (let ((beg (cond (beg beg)
  27                    ((region-active-p)
  28                     (region-beginning))
  29                    (t (point-min))))
  30         (end (cond (end (copy-marker end))
  31                    ((region-active-p)
  32                     (copy-marker (region-end)))
  33                    (t (copy-marker (point-max)))))
  34         (last-pos-line 1)
  35         this-pos-line)
  36     (save-excursion
  37       (toggle-read-only 1)
  38       (catch 'fehler
  39         (goto-char beg)
  40         (while (and (not (eobp))
  41                     (< (point) end))
  42           (setq last-pos-line (count-lines 1 (point)))
  43           (message "%s" last-pos-line)
  44           (forward-sexp 1)
  45           ;; in comment
  46           (while (nth 4 (parse-partial-sexp (line-beginning-position) (point)))
  47             (forward-line 1)
  48             (end-of-line))
  49           (message "point %s" (point))
  50           (setq this-pos-line (count-lines 1 (point)))
  51           (if (eq 1 (- this-pos-line last-pos-line))
  52               (unless (y-or-n-p "Attention: Single line espressions. Continue?")
  53                 (throw 'fehler (ignore)))
  54             (save-excursion
  55               (eval-last-sexp nil))))
  56         (message "%s" " Finished! Buffer was set `read-only' for security reasons. ")))))
  57
  58 ;; (global-set-key [(control kp-9)] 'reverse-chars)
  59 (defun reverse-chars ()
  60   "Reverse reciproke chars as \"[\" to \"]\", upcase or downcase. "
  61   (interactive "*")
  62   (let* ((cf (char-after))
  63          (cn (downcase cf)))
  64     (cond ((or (eq cf 62)(eq cf ?\>))
  65            (setq cn "<"))
  66           ((or (eq cf 60)(eq cf ?\<))
  67            (setq cn ">"))
  68           ((or (eq cf 40)(eq cf ?\())
  69            (setq cn ")"))
  70           ((or (eq cf 41)(eq cf ?\)))
  71            (setq cn "("))
  72           ((or (eq cf 123) (eq cf ?\{))
  73            (setq cn "}"))
  74           ((or (eq cf 125) (eq cf ?\}))
  75            (setq cn "{"))
  76           ((or (eq cf 93)(eq cf ?\]))
  77            (setq cn "["))
  78           ((or (eq cf 91)(eq cf ?\[))
  79            (setq cn "]"))
  80           ((or (eq cf 45)(eq cf ?\-))
  81            (setq cn "_"))
  82           ((or (eq cf 95)(eq cf ?\_))
  83            (setq cn "-"))
  84           (t (when (eq cf cn)
  85                (setq cn (upcase cf)))))
  86     (delete-char 1)
  87     (insert cn)))
  88
  89 (require 'thing-at-point-utils)
  90 ;; thing-at-point-utils are available at
  91 ;; https://code.launchpad.net/s-x-emacs-werkstatt/
  92 (defun peel-list-atpt ()
  93   "Remove list at point, preserve inner lists.
  94 Whatever is part of a list at the
  95 beginning and end of the present i.e. sourrounding list
  96 will be deleted.
  97 Must be called from the part of list to remove."
  98   (interactive "*")
  99   (save-excursion
 100     (let* ((bounds (bounds-of-list-atpt))
 101            (beg (car bounds))
 102            (end (cdr bounds)))
 103       (when (eq beg (point))
 104         (forward-char 1))
 105       (down-list)
 106       (let* ((bounds (bounds-of-list-atpt))
 107              (inner-beg (car bounds))
 108              (inner-end (cdr bounds)))
 109         (delete-region inner-end end)
 110         (goto-char beg)
 111         (delete-region beg inner-beg)))))
 112
 113 ;; re-implemented here to run without `thing-at-point-utils'
 114 (require 'thingatpt)
 115 (defun peel-list-at-point ()
 116   "Remove list at point, preserve inner lists.
 117 Whatever is part of a list at the
 118 beginning and end of the present i.e. sourrounding list
 119 will be deleted.
 120 Must be called from the part of list to remove."
 121   (interactive "*")
 122   (save-excursion
 123     (let ((beg (save-excursion (progn (beginning-of-thing 'list) (point))))
 124           (end (save-excursion (progn (end-of-thing 'list) (point)))))
 125       (when (eq beg (point))
 126         (forward-char 1))
 127       (down-list)
 128       (let ((inner-beg (save-excursion (progn (beginning-of-thing 'list) (point))))
 129             (inner-end (save-excursion (progn (end-of-thing 'list) (point)))))
 130         (delete-region inner-end end)
 131         (goto-char beg)
 132         (delete-region beg inner-beg)))))
 133
 134 ;; elbb-misc-utils.el ends here