cgit.sxemacs.org Git - packages/blob - xemacs-packages/mmm-mode/mmm-utils.el

   1 ;;; mmm-utils.el --- Coding Utilities for MMM Mode
   2
   3 ;; Copyright (C) 2000 by Michael Abraham Shulman
   4
   5 ;; Author: Michael Abraham Shulman <viritrilbia@users.sourceforge.net>
   6 ;; Version: $Id: mmm-utils.el,v 1.2 2008-12-22 14:02:25 mharnisch Exp $
   7
   8 ;;{{{ GPL
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;}}}
  26
  27 ;;; Commentary:
  28
  29 ;; This file provides a number of macros and other coding utilities
  30 ;; for MMM Mode.
  31
  32 ;;; Code:
  33
  34 (require 'cl)
  35
  36 ;;{{{ Valid Buffer
  37
  38 ;; We used to wrap almost everything in this, but I realized that
  39 ;; only `mmm-mode-on' really needs it. Kept it as a macro, though,
  40 ;; for modularity and in case we need it somewhere else.
  41 (defmacro mmm-valid-buffer (&rest body)
  42   "Execute BODY if in a valid buffer for MMM Mode to be enabled.  This
  43 means not hidden, not a minibuffer, not in batch mode, and not in of
  44 `mmm-never-modes'."
  45   `(unless (or (eq (aref (buffer-name) 0) ?\ )
  46                (window-minibuffer-p (selected-window))
  47                (memq major-mode mmm-never-modes)
  48                noninteractive
  49                ;; Unnecessary as now hidden
  50 ;;;               (equal (buffer-name) mmm-temp-buffer-name)
  51                )
  52      ,@body))
  53
  54 ;;;(def-edebug-spec mmm-valid-buffer t)
  55
  56 ;;}}}
  57 ;;{{{ Save Everything
  58
  59 ;; Never trust callback functions to preserve anything.
  60 (defmacro mmm-save-all (&rest body)
  61   "Execute BODY forms, then restoring point, mark, current buffer,
  62 restrictions, and match data."
  63   `(save-excursion
  64      (save-restriction
  65        (save-match-data
  66          ,@body))))
  67
  68 ;;;(def-edebug-spec mmm-save-all t)
  69
  70 ;;}}}
  71 ;;{{{ String Formatting
  72
  73 (defun mmm-format-string (string arg-pairs)
  74   "Format STRING by replacing arguments as specified by ARG-PAIRS.
  75 Each element of ARG-PAIRS is \(REGEXP . STR) where each STR is to be
  76 substituted for the corresponding REGEXP wherever it matches."
  77   (let ((case-fold-search nil))
  78     (save-match-data
  79       (dolist (pair arg-pairs)
  80         (while (string-match (car pair) string)
  81           (setq string (replace-match (cdr pair) t t string))))))
  82   string)
  83
  84 (defun mmm-format-matches (string &optional on-string)
  85   "Format STRING by matches from the current match data.
  86 Strings like ~N are replaced by the Nth subexpression from the last
  87 global match.  Does nothing if STRING is not a string.
  88
  89 ON-STRING, if supplied, means to use the match data from a
  90 `string-match' on that string, rather than the global match data."
  91   (when (stringp string)
  92     (let ((old-data (match-data))
  93           subexp)
  94       (save-match-data
  95         (while (string-match "~\\([0-9]\\)" string)
  96           (setq subexp (string-to-int (match-string-no-properties 1 string))
  97                 string (replace-match
  98                         (save-match-data
  99                           (set-match-data old-data)
 100                           (match-string-no-properties subexp on-string))
 101                         t t string))))))
 102   string)
 103
 104 ;;}}}
 105 ;;{{{ Save Keywords
 106
 107 (defmacro mmm-save-keyword (param)
 108   "If the value of PARAM as a variable is non-nil, return the list
 109 \(:PARAM (symbol-value PARAM)), otherwise NIL. Best used only when it
 110 is important that nil values disappear."
 111   `(if (and (boundp ',param) ,param)
 112        (list (intern (concat ":" (symbol-name ',param))) ,param)
 113      nil))
 114
 115 (defmacro mmm-save-keywords (&rest params)
 116   "Return a list saving the non-nil elements of PARAMS. E.g.
 117 \(let \(\(a 1) \(c 2)) \(mmm-save-keywords a b c))  ==>  \(:a 1 :c 2)
 118 Use of this macro can make code more readable when there are a lot of
 119 PARAMS, but less readable when there are only a few. Also best used
 120 only when it is important that nil values disappear."
 121   `(append ,@(mapcar #'(lambda (param)
 122                          (macroexpand `(mmm-save-keyword ,param)))
 123                      params)))
 124
 125 ;;}}}
 126 ;;{{{ Looking Back At
 127
 128 (defun mmm-looking-back-at (regexp &optional bound)
 129   "Return t if text before point matches REGEXP.
 130 Modifies the match data. If supplied, BOUND means not to look farther
 131 back that that many characters before point. Otherwise, it defaults to
 132 \(length REGEXP), which is good enough when REGEXP is a simple
 133 string."
 134   (eq (point)
 135       (save-excursion
 136         (and (re-search-backward regexp
 137                (- (point) (or bound (length regexp)))
 138                t)
 139              (match-end 0)))))
 140
 141 ;;}}}
 142 ;;{{{ Markers
 143
 144 ;; Mostly for remembering interactively made regions
 145 (defun mmm-make-marker (pos beg-p sticky-p)
 146   "Make, and return, a marker at POS that is or isn't sticky.
 147 BEG-P represents whether the marker delimits the beginning of a
 148 region \(or the end of it). STICKY-P is whether it should be sticky,
 149 i.e. whether text inserted at the marker should be inside the region."
 150   (let ((mkr (set-marker (make-marker) pos)))
 151     (set-marker-insertion-type mkr (if beg-p (not sticky-p) sticky-p))
 152     mkr))
 153
 154 ;;}}}
 155
 156 (provide 'mmm-utils)
 157
 158 ;;; mmm-utils.el ends here