nemunaire/conf-emacs
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Add elpa packages

Browse source
This commit is contained in:
nemunaire 2026-01-24 09:39:42 +08:00
commit afd61b5209
197 changed files with 76816 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

442
elpa/mmm-mode-0.5.11/mmm-cmds.el Normal file
View file

@ -0,0 +1,442 @@
;;; mmm-cmds.el --- MMM Mode interactive commands and keymap -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2003, 2011-2013, 2018 Free Software Foundation, Inc.
;; Author: Michael Abraham Shulman <viritrilbia@gmail.com>
;;{{{ GPL
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;}}}
;;; Commentary:
;; This file contains the interactive commands for MMM Mode.
;;; Code:
(require 'cl-lib)
(require 'font-lock)
(require 'mmm-compat)
(require 'mmm-vars)
(require 'mmm-class)
;; APPLYING CLASSES
;;{{{ Applying Predefined Classes
(defun mmm-ify-by-class (class)
"Add submode regions according to an existing submode CLASS."
(interactive
(list (intern
(completing-read
"Submode Class: "
(cl-remove-duplicates
(mapcar (lambda (spec) (list (symbol-name (car spec))))
(append
(cl-remove-if (lambda (spec) (plist-get (cdr spec) :private))
mmm-classes-alist)
(cl-remove-if #'mmm-autoload-class-private-p
mmm-autoloaded-classes)))
:test #'equal)
nil t))))
(unless (eq class (intern ""))
(mmm-apply-class class)
(mmm-add-to-history class)
(mmm-update-font-lock-buffer)))
;;}}}
;;{{{ Applying by the Region
(defun mmm-ify-region (submode front back)
"Add a submode region for SUBMODE coinciding with current region.
FRONT and BACK should be MMM delimiters."
(interactive "aSubmode: \nr")
(mmm-ify :submode submode :front front :back back)
(setq front (mmm-make-marker front t nil)
back (mmm-make-marker back nil nil))
(mmm-add-to-history `(:submode ,submode :front ,front :back ,back))
(mmm-enable-font-lock submode))
;;}}}
;;{{{ Applying Simple Regexps
(defun mmm-ify-by-regexp
(submode front front-offset back back-offset save-matches)
"Add SUBMODE regions to the buffer delimited by FRONT and BACK.
With prefix argument, prompts for all additional keywords arguments.
See `mmm-classes-alist'."
(interactive "aSubmode:
sFront Regexp:
nOffset from Front Regexp:
sBack Regexp:
nOffset from Back Regexp:
nNumber of matched substrings to save: ")
(let ((args (mmm-save-keywords submode front back front-offset
back-offset save-matches)))
(apply #'mmm-ify args)
(mmm-add-to-history args))
(mmm-enable-font-lock submode))
;;}}}
;; EDITING WITH REGIONS
;;{{{ Re-parsing Areas
(defun mmm-parse-buffer ()
"Re-apply all applicable submode classes to current buffer.
Clears all current submode regions, reapplies all past interactive
mmm-ification, and applies `mmm-classes' and mode-extension classes."
(interactive)
(message "MMM-ifying buffer...")
(mmm-apply-all)
(message "MMM-ifying buffer...done"))
(defun mmm-parse-region (start stop)
"Re-apply all applicable submode classes between START and STOP.
Clears all current submode regions, reapplies all past interactive
mmm-ification, and applies `mmm-classes' and mode-extension classes."
(interactive "r")
(message "MMM-ifying region...")
(mmm-apply-all :start start :stop stop)
(message "MMM-ifying region...done"))
(defun mmm-parse-block (&optional lines)
"Re-parse LINES lines before and after point \(default 1).
Clears all current submode regions, reapplies all past interactive
mmm-ification, and applies `mmm-classes' and mode-extension classes.
This command is intended for use when you have just typed what should
be the delimiters of a submode region and you want to create the
region. However, you may want to look into the various types of
delimiter auto-insertion that MMM Mode provides. See, for example,
`mmm-insert-region'."
(interactive "p")
(message "MMM-ifying block...")
(cl-destructuring-bind (start stop) (mmm-get-block lines)
(when (< start stop)
(mmm-apply-all :start start :stop stop)))
(message "MMM-ifying block...done"))
(defun mmm-get-block (lines)
"Return a region spanning LINES before and after point."
(list (pos-bol (- 1 lines))
(pos-eol (1+ lines))))
;;}}}
;;{{{ Reparse Current Region
(defun mmm-reparse-current-region ()
"Clear and reparse the area of the current submode region.
Use this command if a submode region's boundaries have become wrong."
(interactive)
(let ((ovl (mmm-overlay-at (point) 'all)))
(when ovl
(let ((beg (save-excursion
(goto-char (mmm-front-start ovl))
(forward-line -1)
(point)))
(end (save-excursion
(goto-char (mmm-back-end ovl))
(forward-line 1)
(point))))
(mmm-parse-region beg end)))))
;;}}}
;;{{{ Clear Submode Regions
;; See also `mmm-clear-history' which is interactive.
(defun mmm-clear-current-region ()
"Deletes the submode region point is currently in, if any."
(interactive)
(delete-overlay (mmm-overlay-at (point) 'all)))
(defun mmm-clear-regions (start stop)
"Deletes all submode regions from START to STOP."
(interactive "r")
(mmm-clear-overlays start stop))
(defun mmm-clear-all-regions ()
"Deletes all submode regions in the current buffer."
(interactive)
(mmm-clear-overlays))
;;}}}
;;{{{ End Current Region
(cl-defun mmm-end-current-region (&optional arg)
"End current submode region.
If ARG is nil, end it at the most appropriate place, usually its
current back boundary. If ARG is non-nil, end it at point. If the
current region is correctly bounded, the first does nothing, but the
second deletes that delimiter as well.
If the region's BACK property is a string, it is inserted as above and
the overlay moved if necessary. If it is a function, it is called with
two arguments -- the overlay, and \(if ARG \\='middle t) -- and must do the
entire job of this function."
(interactive "P")
(let ((ovl (mmm-overlay-at)))
(when ovl
(combine-after-change-calls
(save-match-data
(save-excursion
(when (mmm-match-back ovl)
(if arg
(replace-match "")
(cl-return-from mmm-end-current-region)))))
(let ((back (overlay-get ovl 'back)))
(cond ((stringp back)
(save-excursion
(unless arg (goto-char (overlay-end ovl)))
(save-excursion (insert back))
(move-overlay ovl (overlay-start ovl) (point))))
((functionp back)
(funcall back ovl (if arg 'middle t))))))
(mmm-refontify-maybe (save-excursion (forward-line -1) (point))
(save-excursion (forward-line 1) (point))))))
;;}}}
;;{{{ Narrow to Region
(defun mmm-narrow-to-submode-region (&optional pos)
"Narrow to the submode region at POS.
When called interactive, use the submode at point."
(interactive)
;; Probably don't use mmm-current-overlay here, because this is
;; sometimes called from inside messy functions.
(let ((ovl (mmm-overlay-at pos)))
(when ovl
(narrow-to-region (overlay-start ovl) (overlay-end ovl)))))
;; The inverse command is `widen', usually on `C-x n w'
;;}}}
;; INSERTING REGIONS
;;{{{ Insert regions by keystroke
;; This is the "default" binding in the MMM Mode keymap. Keys defined
;; by classes should be control keys, to avoid conflicts with MMM
;; commands.
(defun mmm-insert-region (arg)
"Insert a submode region based on last character in invoking keys.
Keystrokes after `mmm-mode-prefix-key' which are not bound to an MMM
Mode command \(see `mmm-command-modifiers') are passed on to this
function. If they have the modifiers `mmm-insert-modifiers', then they
are looked up, sans those modifiers, in all current submode classes to
find an insert skeleton. For example, in Mason, `p' \(with appropriate
prefix and modifiers) will insert a <%perl>...</%perl> region."
(interactive "P")
(let* ((seq (this-command-keys))
(event (aref seq (1- (length seq))))
(mods (event-modifiers event))
(key (mmm-event-key event)))
(if (cl-subsetp mmm-insert-modifiers mods)
(mmm-insert-by-key
(append (cl-set-difference mods mmm-insert-modifiers)
key)
arg))))
(defvar skeleton-positions) ; Mark as special
(defun mmm-insert-by-key (key &optional arg)
"Insert a submode region based on event KEY.
Inspects all the classes of the current buffer to find a matching
:insert key sequence. See `mmm-classes-alist'. ARG, if present, is
passed on to `skeleton-proxy-new' to control wrapping.
KEY must be a list \(MODIFIERS... . BASIC-KEY) where MODIFIERS are
symbols such as shift, control, etc. and BASIC-KEY is a character code
or a symbol such as tab, return, etc. Note that if there are no
MODIFIERS, the dotted list becomes simply BASIC-KEY."
(cl-multiple-value-bind (class skel str) (mmm-get-insertion-spec key)
(when skel
(let ((after-change-functions nil)
(old-undo buffer-undo-list) undo)
;; XEmacs' skeleton doesn't manage positions by itself, so we
;; have to do it.
(if mmm-xemacs (setq skeleton-positions nil))
(skeleton-proxy-new skel str arg)
(cl-destructuring-bind (back end beg front) skeleton-positions
;; TODO: Find a way to trap invalid-parent signals from
;; make-region and undo the skeleton insertion.
(let ((match-submode (plist-get class :match-submode))
(match-face (plist-get class :match-face))
(match-name (plist-get class :match-name))
(front-form (regexp-quote (buffer-substring front beg)))
(back-form (regexp-quote (buffer-substring end back)))
submode face name)
(setq submode
(mmm-modename->function
(if match-submode
(mmm-save-all (funcall match-submode front-form))
(plist-get class :submode))))
(setq face
(cond ((functionp match-face)
(mmm-save-all
(funcall match-face front-form)))
(match-face
(cdr (assoc front-form match-face)))
(t
(plist-get class :face))))
(setq name
(cond ((plist-get class :skel-name)
;; Optimize the name to the user-supplied str
;; if we are so instructed.
str)
;; Call it if it is a function
((functionp match-name)
(mmm-save-all (funcall match-name front-form)))
;; Now we know it's a string, does it need to
;; be formatted?
((plist-get class :save-name)
;; Yes. Haven't done a match before, so
;; match the front regexp against the given
;; form to format the string
(string-match (plist-get class :front)
front-form)
(mmm-format-matches match-name front-form))
(t
;; No, just use it as-is
match-name)))
(mmm-make-region
submode beg end
:face face
:name name
:front front :back back
:match-front front-form :match-back back-form
:evaporation 'front
;;; :beg-sticky (plist-get class :beg-sticky)
;;; :end-sticky (plist-get class :end-sticky)
:beg-sticky t :end-sticky t
:creation-hook (plist-get class :creation-hook))
(mmm-enable-font-lock submode)))
;; Now get rid of intermediate undo boundaries, so that the entire
;; insertion can be undone as one action. This should really be
;; skeleton's job, but it doesn't do it.
(setq undo buffer-undo-list)
(while (not (eq (cdr undo) old-undo))
(when (eq (cadr undo) nil)
(setcdr undo (cddr undo)))
(setq undo (cdr undo)))))))
(defun mmm-get-insertion-spec (key &optional classlist)
"Get the insertion info for KEY from all classes in CLASSLIST.
Return \(CLASS SKEL STR) where CLASS is the class spec a match was
found in, SKEL is the skeleton to insert, and STR is the argument.
CLASSLIST defaults to the return value of `mmm-get-all-classes',
including global classes."
(cl-loop for classname in (or classlist (mmm-get-all-classes t))
for class = (mmm-get-class-spec classname)
for inserts = (plist-get class :insert)
for skel = (cddr (assoc key inserts))
with str
;; If SKEL is a dotted pair, it means call another key's
;; insertion spec with an argument.
unless (consp (cdr skel))
do (setq str (cdr skel)
skel (cddr (assoc (car skel) inserts)))
if skel return (list class skel str)
;; If we have a group class, recurse.
if (plist-get class :classes)
if (mmm-get-insertion-spec key it)
return it))
;;}}}
;;{{{ Help on Insertion
(defun mmm-insertion-help ()
"Display help on currently available MMM insertion commands."
(interactive)
(with-output-to-temp-buffer "*Help*"
(princ "Available MMM Mode Insertion Commands:\n")
(princ "Key Inserts\n")
(princ "--- -------\n\n")
(mapcar #'mmm-display-insertion-key
(mmm-get-all-insertion-keys))))
(defun mmm-display-insertion-key (spec)
"Print an insertion binding to standard output.
SPEC should be \(KEY NAME ...) where KEY is an insertion key and NAME
is a symbol naming the insertion."
(let* ((str (make-string 16 ?\ ))
;; This gets us a dotted list, because of the way insertion
;; keys are specified.
(key (append mmm-insert-modifiers (car spec)))
(lastkey (nthcdr (max (1- (safe-length key)) 0) key)))
;; Now we make it a true list
(if (consp key)
(setcdr lastkey (list (cdr lastkey)))
(setq key (list key)))
;; Get the spacing right
(store-substring str 0
(key-description
(apply #'vector (append mmm-mode-prefix-key (list key)))))
(princ str)
;; Now print the binding symbol
(princ (cadr spec))
(princ "\n")))
(defun mmm-get-all-insertion-keys (&optional classlist)
"Return an alist of all currently available insertion keys.
Elements look like \(KEY NAME ...) where KEY is an insertion key and
NAME is a symbol naming the insertion."
(cl-remove-duplicates
(cl-loop for classname in (or classlist (mmm-get-all-classes t))
for class = (mmm-get-class-spec classname)
append (plist-get class :insert) into keys
;; If we have a group class, recurse.
if (plist-get class :classes)
do (setq keys (append keys (mmm-get-all-insertion-keys it)))
finally return keys)
:test #'equal
:key (lambda (x) (cons (car x) (cadr x)))
:from-end t))
;;}}}
;;{{{ Auto Insertion (copied from interactive session);-COM-
;-COM-
;-COM-;; Don't use `mmm-ify-region' of course. And rather than having
;-COM-;; classes define their own functions, we should have them pass a
;-COM-;; skeleton as an attribute. Then our insert function can turn off
;-COM-;; after-change hooks and add the submode region afterward.
;-COM-
;-COM-(define-skeleton mmm-see-inline
;-COM- "" nil
;-COM- -1 @ " " _ " " @ "%>"
;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions)))
;-COM-
;-COM-(define-skeleton mmm-see-other
;-COM- "" nil
;-COM- @ ";\n" _ "\n" @ "<%/" str ">"
;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions)))
;-COM-
;-COM-(add-hook 'after-change-functions 'mmm-detect t)
;-COM-
;-COM-(defun mmm-detect (beg end length)
;-COM- (when (mmm-looking-back-at "<% ")
;-COM- (mmm-see-inline))
;-COM- (when (mmm-looking-back-at "<%\\(\\w+\\)>")
;-COM- (mmm-see-other (match-string 1))))
;-COM-
;;}}}
(provide 'mmm-cmds)
;;; mmm-cmds.el ends here