Mercurial > emacs
annotate lisp/mh-e/mh-acros.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | 183412511935 |
children | 376148b31b5e |
rev | line source |
---|---|
68465 | 1 ;;; mh-acros.el --- macros used in MH-E |
56676 | 2 |
106815 | 3 ;; Copyright (C) 2004, 2006, 2007, 2008, 2009, 2010 |
101465
eadef31351e4
Follow Glenn's lead and update format of Copyright.
Bill Wohler <wohler@newt.com>
parents:
100908
diff
changeset
|
4 ;; Free Software Foundation, Inc. |
56676 | 5 |
6 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> | |
7 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 ;; Keywords: mail | |
9 ;; See: mh-e.el | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
80067
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
56676 | 14 ;; it under the terms of the GNU General Public License as published by |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
80067
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
80067
diff
changeset
|
16 ;; (at your option) any later version. |
56676 | 17 |
18 ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 ;; GNU General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
80067
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
56676 | 25 |
26 ;;; Commentary: | |
27 | |
68465 | 28 ;; This file contains all macros that are used in more than one file. |
107188
183412511935
* mh-acros.el: Comment fixes.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
29 ;; If you run "make recompile" in Bazaar Emacs and see the message |
68465 | 30 ;; "Source is newer than compiled," it is a sign that macro probably |
31 ;; needs to be moved here. | |
68213
a08b47775f9b
* mh-acros.el (require): Remove defadvice of require as defadvice is
Bill Wohler <wohler@newt.com>
parents:
68189
diff
changeset
|
32 |
68465 | 33 ;; Historically, it was so named with a silent "m" so that it would be |
107188
183412511935
* mh-acros.el: Comment fixes.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
34 ;; compiled first. Otherwise, "make recompile" in Bazaar Emacs would use |
68465 | 35 ;; compiled files with stale macro definitions. Later, no-byte-compile |
36 ;; was added to the Local Variables section to avoid this problem and | |
37 ;; because it's pointless to compile a file full of macros. But we | |
38 ;; kept the name. | |
56676 | 39 |
40 ;;; Change Log: | |
41 | |
42 ;;; Code: | |
43 | |
44 (require 'cl) | |
68465 | 45 |
46 | |
56676 | 47 |
68465 | 48 ;;; Compatibility |
49 | |
50 ;;;###mh-autoload | |
56676 | 51 (defmacro mh-require-cl () |
67760
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67758
diff
changeset
|
52 "Macro to load \"cl\" if needed. |
68465 | 53 |
54 Emacs coding conventions require that the \"cl\" package not be | |
55 required at runtime. However, the \"cl\" package in Emacs 21.4 | |
56 and earlier left \"cl\" routines in their macro expansions. In | |
57 particular, the expansion of (setf (gethash ...) ...) used | |
58 functions in \"cl\" at run time. This macro recognizes that and | |
59 loads \"cl\" appropriately." | |
56676 | 60 (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) |
56787
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
61 `(require 'cl) |
56676 | 62 `(eval-when-compile (require 'cl)))) |
63 | |
68465 | 64 ;;;###mh-autoload |
56676 | 65 (defmacro mh-do-in-gnu-emacs (&rest body) |
66 "Execute BODY if in GNU Emacs." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
67 (declare (debug t)) |
56676 | 68 (unless (featurep 'xemacs) `(progn ,@body))) |
69 (put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) | |
70 | |
68465 | 71 ;;;###mh-autoload |
56676 | 72 (defmacro mh-do-in-xemacs (&rest body) |
68465 | 73 "Execute BODY if in XEmacs." |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
74 (declare (debug t)) |
56676 | 75 (when (featurep 'xemacs) `(progn ,@body))) |
76 (put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) | |
77 | |
68465 | 78 ;;;###mh-autoload |
56676 | 79 (defmacro mh-funcall-if-exists (function &rest args) |
80 "Call FUNCTION with ARGS as parameters if it exists." | |
62847
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62465
diff
changeset
|
81 (when (fboundp function) |
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62465
diff
changeset
|
82 `(when (fboundp ',function) |
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62465
diff
changeset
|
83 (funcall ',function ,@args)))) |
56676 | 84 |
68465 | 85 ;;;###mh-autoload |
70061
b3ab71ac7f4e
* mh-acros.el (mh-defun-compat): Rename to defun-mh in order that
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
86 (defmacro defun-mh (name function arg-list &rest body) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
87 "Create function NAME. |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
88 If FUNCTION exists, then NAME becomes an alias for FUNCTION. |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
89 Otherwise, create function NAME with ARG-LIST and BODY." |
68137
ec4727559827
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Move here from
Bill Wohler <wohler@newt.com>
parents:
67760
diff
changeset
|
90 (let ((defined-p (fboundp function))) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
91 (if defined-p |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
92 `(defalias ',name ',function) |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
93 `(defun ,name ,arg-list ,@body)))) |
70061
b3ab71ac7f4e
* mh-acros.el (mh-defun-compat): Rename to defun-mh in order that
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
94 (put 'defun-mh 'lisp-indent-function 'defun) |
95688
33aa6dc538c6
(toplevel): Put `doc-string-elt' properties on `defun-mh'
John Paul Wallington <jpw@pobox.com>
parents:
94663
diff
changeset
|
95 (put 'defun-mh 'doc-string-elt 4) |
68137
ec4727559827
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Move here from
Bill Wohler <wohler@newt.com>
parents:
67760
diff
changeset
|
96 |
68465 | 97 ;;;###mh-autoload |
70061
b3ab71ac7f4e
* mh-acros.el (mh-defun-compat): Rename to defun-mh in order that
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
98 (defmacro defmacro-mh (name macro arg-list &rest body) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
99 "Create macro NAME. |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
100 If MACRO exists, then NAME becomes an alias for MACRO. |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
101 Otherwise, create macro NAME with ARG-LIST and BODY." |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
102 (let ((defined-p (fboundp macro))) |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
103 (if defined-p |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
104 `(defalias ',name ',macro) |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
105 `(defmacro ,name ,arg-list ,@body)))) |
70061
b3ab71ac7f4e
* mh-acros.el (mh-defun-compat): Rename to defun-mh in order that
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
106 (put 'defmacro-mh 'lisp-indent-function 'defun) |
95688
33aa6dc538c6
(toplevel): Put `doc-string-elt' properties on `defun-mh'
John Paul Wallington <jpw@pobox.com>
parents:
94663
diff
changeset
|
107 (put 'defmacro-mh 'doc-string-elt 4) |
68137
ec4727559827
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Move here from
Bill Wohler <wohler@newt.com>
parents:
67760
diff
changeset
|
108 |
68465 | 109 |
110 | |
111 ;;; Miscellaneous | |
112 | |
113 ;;;###mh-autoload | |
56676 | 114 (defmacro mh-make-local-hook (hook) |
115 "Make HOOK local if needed. | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
116 XEmacs and versions of GNU Emacs before 21.1 require |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
117 `make-local-hook' to be called." |
56676 | 118 (when (and (fboundp 'make-local-hook) |
119 (not (get 'make-local-hook 'byte-obsolete-info))) | |
120 `(make-local-hook ,hook))) | |
121 | |
68465 | 122 ;;;###mh-autoload |
56676 | 123 (defmacro mh-mark-active-p (check-transient-mark-mode-flag) |
124 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
125 In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
126 check if variable `transient-mark-mode' is active." |
56676 | 127 (cond ((featurep 'xemacs) ;XEmacs |
128 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) | |
129 ((not check-transient-mark-mode-flag) ;GNU Emacs | |
130 `(and (boundp 'mark-active) mark-active)) | |
131 (t ;GNU Emacs | |
132 `(and (boundp 'transient-mark-mode) transient-mark-mode | |
133 (boundp 'mark-active) mark-active)))) | |
134 | |
68465 | 135 ;; Shush compiler. |
70028
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
136 (defvar struct) ; XEmacs |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
137 (defvar x) ; XEmacs |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
138 (defvar y) ; XEmacs |
68465 | 139 |
140 ;;;###mh-autoload | |
56676 | 141 (defmacro mh-defstruct (name-spec &rest fields) |
67760
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67758
diff
changeset
|
142 "Replacement for `defstruct' from the \"cl\" package. |
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67758
diff
changeset
|
143 The `defstruct' in the \"cl\" library produces compiler warnings, |
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67758
diff
changeset
|
144 and generates code that uses functions present in \"cl\" at |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
145 run-time. This is a partial replacement, that avoids these |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
146 issues. |
56676 | 147 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
148 NAME-SPEC declares the name of the structure, while FIELDS |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
149 describes the various structure fields. Lookup `defstruct' for |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
150 more details." |
56676 | 151 (let* ((struct-name (if (atom name-spec) name-spec (car name-spec))) |
152 (conc-name (or (and (consp name-spec) | |
153 (cadr (assoc :conc-name (cdr name-spec)))) | |
154 (format "%s-" struct-name))) | |
155 (predicate (intern (format "%s-p" struct-name))) | |
156 (constructor (or (and (consp name-spec) | |
157 (cadr (assoc :constructor (cdr name-spec)))) | |
158 (intern (format "make-%s" struct-name)))) | |
159 (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields)) | |
160 (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x))) | |
161 fields)) | |
162 (struct (gensym "S")) | |
163 (x (gensym "X")) | |
164 (y (gensym "Y"))) | |
165 `(progn | |
166 (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y)) | |
167 field-names field-init-forms)) | |
56751
72a02133177e
Upgraded to MH-E version 7.81.
Bill Wohler <wohler@newt.com>
parents:
56677
diff
changeset
|
168 (list (quote ,struct-name) ,@field-names)) |
56676 | 169 (defun ,predicate (arg) |
56751
72a02133177e
Upgraded to MH-E version 7.81.
Bill Wohler <wohler@newt.com>
parents:
56677
diff
changeset
|
170 (and (consp arg) (eq (car arg) (quote ,struct-name)))) |
72a02133177e
Upgraded to MH-E version 7.81.
Bill Wohler <wohler@newt.com>
parents:
56677
diff
changeset
|
171 ,@(loop for x from 1 |
56676 | 172 for y in field-names |
173 collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z) | |
174 (list 'nth ,x z))) | |
175 (quote ,struct-name)))) | |
176 | |
68465 | 177 ;;;###mh-autoload |
178 (defmacro with-mh-folder-updating (save-modification-flag &rest body) | |
179 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY). | |
180 Execute BODY, which can modify the folder buffer without having to | |
181 worry about file locking or the read-only flag, and return its result. | |
182 If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag | |
183 is unchanged, otherwise it is cleared." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
184 (declare (debug t)) |
68465 | 185 (setq save-modification-flag (car save-modification-flag)) ; CL style |
186 `(prog1 | |
187 (let ((mh-folder-updating-mod-flag (buffer-modified-p)) | |
188 (buffer-read-only nil) | |
189 (buffer-file-name nil)) ;don't let the buffer get locked | |
190 (prog1 | |
191 (progn | |
192 ,@body) | |
193 (mh-set-folder-modified-p mh-folder-updating-mod-flag))) | |
194 ,@(if (not save-modification-flag) | |
195 '((mh-set-folder-modified-p nil))))) | |
196 (put 'with-mh-folder-updating 'lisp-indent-hook 'defun) | |
197 | |
198 ;;;###mh-autoload | |
199 (defmacro mh-in-show-buffer (show-buffer &rest body) | |
200 "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). | |
201 Display buffer SHOW-BUFFER in other window and execute BODY in it. | |
202 Stronger than `save-excursion', weaker than `save-window-excursion'." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
203 (declare (debug t)) |
68465 | 204 (setq show-buffer (car show-buffer)) ; CL style |
205 `(let ((mh-in-show-buffer-saved-window (selected-window))) | |
206 (switch-to-buffer-other-window ,show-buffer) | |
207 (if mh-bury-show-buffer-flag (bury-buffer (current-buffer))) | |
208 (unwind-protect | |
209 (progn | |
210 ,@body) | |
211 (select-window mh-in-show-buffer-saved-window)))) | |
212 (put 'mh-in-show-buffer 'lisp-indent-hook 'defun) | |
213 | |
214 ;;;###mh-autoload | |
215 (defmacro mh-do-at-event-location (event &rest body) | |
216 "Switch to the location of EVENT and execute BODY. | |
217 After BODY has been executed return to original window. The | |
218 modification flag of the buffer in the event window is | |
219 preserved." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
220 (declare (debug t)) |
68465 | 221 (let ((event-window (make-symbol "event-window")) |
222 (event-position (make-symbol "event-position")) | |
223 (original-window (make-symbol "original-window")) | |
224 (original-position (make-symbol "original-position")) | |
225 (modified-flag (make-symbol "modified-flag"))) | |
226 `(save-excursion | |
227 (let* ((,event-window | |
228 (or (mh-funcall-if-exists posn-window (event-start ,event)) | |
229 (mh-funcall-if-exists event-window ,event))) | |
230 (,event-position | |
231 (or (mh-funcall-if-exists posn-point (event-start ,event)) | |
232 (mh-funcall-if-exists event-closest-point ,event))) | |
233 (,original-window (selected-window)) | |
234 (,original-position (progn | |
235 (set-buffer (window-buffer ,event-window)) | |
236 (set-marker (make-marker) (point)))) | |
237 (,modified-flag (buffer-modified-p)) | |
238 (buffer-read-only nil)) | |
239 (unwind-protect (progn | |
240 (select-window ,event-window) | |
241 (goto-char ,event-position) | |
242 ,@body) | |
243 (set-buffer-modified-p ,modified-flag) | |
244 (goto-char ,original-position) | |
245 (set-marker ,original-position nil) | |
246 (select-window ,original-window)))))) | |
247 (put 'mh-do-at-event-location 'lisp-indent-hook 'defun) | |
248 | |
249 | |
250 | |
251 ;;; Sequences and Ranges | |
252 | |
253 ;;;###mh-autoload | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
254 (defsubst mh-seq-msgs (sequence) |
68465 | 255 "Extract messages from the given SEQUENCE." |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
256 (cdr sequence)) |
68465 | 257 |
258 ;;;###mh-autoload | |
259 (defmacro mh-iterate-on-messages-in-region (var begin end &rest body) | |
260 "Iterate over region. | |
261 | |
262 VAR is bound to the message on the current line as we loop | |
263 starting from BEGIN till END. In each step BODY is executed. | |
264 | |
265 If VAR is nil then the loop is executed without any binding." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
266 (declare (debug (symbolp body))) |
68465 | 267 (unless (symbolp var) |
268 (error "Can not bind the non-symbol %s" var)) | |
269 (let ((binding-needed-flag var)) | |
270 `(save-excursion | |
271 (goto-char ,begin) | |
272 (beginning-of-line) | |
273 (while (and (<= (point) ,end) (not (eobp))) | |
274 (when (looking-at mh-scan-valid-regexp) | |
275 (let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ()) | |
276 ,@body)) | |
277 (forward-line 1))))) | |
278 (put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun) | |
279 | |
280 ;;;###mh-autoload | |
281 (defmacro mh-iterate-on-range (var range &rest body) | |
282 "Iterate an operation over a region or sequence. | |
283 | |
284 VAR is bound to each message in turn in a loop over RANGE, which | |
285 can be a message number, a list of message numbers, a sequence, a | |
286 region in a cons cell, or a MH range (something like last:20) in | |
287 a string. In each iteration, BODY is executed. | |
288 | |
289 The parameter RANGE is usually created with | |
290 `mh-interactive-range' in order to provide a uniform interface to | |
291 MH-E functions." | |
80067
0f7d101ad47f
(mh-do-in-gnu-emacs, mh-do-in-xemacs)
Richard M. Stallman <rms@gnu.org>
parents:
79713
diff
changeset
|
292 (declare (debug (symbolp body))) |
68465 | 293 (unless (symbolp var) |
294 (error "Can not bind the non-symbol %s" var)) | |
295 (let ((binding-needed-flag var) | |
296 (msgs (make-symbol "msgs")) | |
297 (seq-hash-table (make-symbol "seq-hash-table"))) | |
298 `(cond ((numberp ,range) | |
299 (when (mh-goto-msg ,range t t) | |
300 (let ,(if binding-needed-flag `((,var ,range)) ()) | |
301 ,@body))) | |
302 ((and (consp ,range) | |
303 (numberp (car ,range)) (numberp (cdr ,range))) | |
304 (mh-iterate-on-messages-in-region ,var | |
305 (car ,range) (cdr ,range) | |
306 ,@body)) | |
307 (t (let ((,msgs (cond ((and ,range (symbolp ,range)) | |
308 (mh-seq-to-msgs ,range)) | |
309 ((stringp ,range) | |
310 (mh-translate-range mh-current-folder | |
311 ,range)) | |
312 (t ,range))) | |
313 (,seq-hash-table (make-hash-table))) | |
314 (dolist (msg ,msgs) | |
315 (setf (gethash msg ,seq-hash-table) t)) | |
316 (mh-iterate-on-messages-in-region v (point-min) (point-max) | |
317 (when (gethash v ,seq-hash-table) | |
318 (let ,(if binding-needed-flag `((,var v)) ()) | |
319 ,@body)))))))) | |
320 (put 'mh-iterate-on-range 'lisp-indent-hook 'defun) | |
66357
f5ade15d46f2
* mh-identity.el (mh-assoc-ignore-case): Merge with version in
Bill Wohler <wohler@newt.com>
parents:
64085
diff
changeset
|
321 |
56676 | 322 (provide 'mh-acros) |
323 | |
67681 | 324 ;; Local Variables: |
325 ;; no-byte-compile: t | |
326 ;; indent-tabs-mode: nil | |
327 ;; sentence-end-double-space: nil | |
328 ;; End: | |
56676 | 329 |
56677 | 330 ;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff |
56676 | 331 ;;; mh-acros.el ends here |