Mercurial > emacs
annotate lisp/mh-e/mh-acros.el @ 90069:fa0a5c4db2c8
(get_next_display_element): Sync to the change in HEAD
on 2004-12-21.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Sat, 25 Dec 2004 02:31:08 +0000 |
parents | 25da1d331c99 |
children | 4f4f410e6fe8 |
rev | line source |
---|---|
56676 | 1 ;;; mh-acros.el --- Macros used in MH-E |
2 | |
3 ;; Copyright (C) 2004 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> | |
6 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
7 ;; Keywords: mail | |
8 ;; See: mh-e.el | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; This file contains macros that would normally be in mh-utils.el except that | |
30 ;; their presence there would cause a dependency loop with mh-customize.el. | |
31 ;; This file must always be included like this: | |
32 ;; | |
33 ;; (eval-when-compile (require 'mh-acros)) | |
34 ;; | |
35 ;; It is so named with a silent `m' so that it is compiled first. Otherwise, | |
36 ;; "make recompile" in Emacs 21.4 fails. | |
37 | |
38 ;;; Change Log: | |
39 | |
40 ;;; Code: | |
41 | |
42 (require 'cl) | |
43 | |
44 ;; The Emacs coding conventions require that the cl package not be required at | |
45 ;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl | |
46 ;; routines in their macro expansions. Use mh-require-cl to provide the cl | |
47 ;; routines in the best way possible. | |
48 (defmacro mh-require-cl () | |
49 "Macro to load `cl' if needed. | |
50 Some versions of `cl' produce code for the expansion of | |
51 \(setf (gethash ...) ...) that uses functions in `cl' at run time. This macro | |
52 recognizes that and loads `cl' where appropriate." | |
53 (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
|
54 `(require 'cl) |
56676 | 55 `(eval-when-compile (require 'cl)))) |
56 | |
57 ;;; Macros to generate correct code for different emacs variants | |
58 | |
59 (defmacro mh-do-in-gnu-emacs (&rest body) | |
60 "Execute BODY if in GNU Emacs." | |
61 (unless (featurep 'xemacs) `(progn ,@body))) | |
62 (put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) | |
63 | |
64 (defmacro mh-do-in-xemacs (&rest body) | |
65 "Execute BODY if in GNU Emacs." | |
66 (when (featurep 'xemacs) `(progn ,@body))) | |
67 (put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) | |
68 | |
69 (defmacro mh-funcall-if-exists (function &rest args) | |
70 "Call FUNCTION with ARGS as parameters if it exists." | |
71 (if (fboundp function) | |
72 `(funcall ',function ,@args))) | |
73 | |
74 (defmacro mh-make-local-hook (hook) | |
75 "Make HOOK local if needed. | |
76 XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be | |
77 called." | |
78 (when (and (fboundp 'make-local-hook) | |
79 (not (get 'make-local-hook 'byte-obsolete-info))) | |
80 `(make-local-hook ,hook))) | |
81 | |
82 (defmacro mh-mark-active-p (check-transient-mark-mode-flag) | |
83 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. | |
84 In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if | |
85 variable `transient-mark-mode' is active." | |
86 (cond ((featurep 'xemacs) ;XEmacs | |
87 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) | |
88 ((not check-transient-mark-mode-flag) ;GNU Emacs | |
89 `(and (boundp 'mark-active) mark-active)) | |
90 (t ;GNU Emacs | |
91 `(and (boundp 'transient-mark-mode) transient-mark-mode | |
92 (boundp 'mark-active) mark-active)))) | |
93 | |
94 (defmacro mh-defstruct (name-spec &rest fields) | |
95 "Replacement for `defstruct' from the `cl' package. | |
96 The `defstruct' in the `cl' library produces compiler warnings, and generates | |
97 code that uses functions present in `cl' at run-time. This is a partial | |
98 replacement, that avoids these issues. | |
99 | |
100 NAME-SPEC declares the name of the structure, while FIELDS describes the | |
101 various structure fields. Lookup `defstruct' for more details." | |
102 (let* ((struct-name (if (atom name-spec) name-spec (car name-spec))) | |
103 (conc-name (or (and (consp name-spec) | |
104 (cadr (assoc :conc-name (cdr name-spec)))) | |
105 (format "%s-" struct-name))) | |
106 (predicate (intern (format "%s-p" struct-name))) | |
107 (constructor (or (and (consp name-spec) | |
108 (cadr (assoc :constructor (cdr name-spec)))) | |
109 (intern (format "make-%s" struct-name)))) | |
110 (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields)) | |
111 (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x))) | |
112 fields)) | |
113 (struct (gensym "S")) | |
114 (x (gensym "X")) | |
115 (y (gensym "Y"))) | |
116 `(progn | |
117 (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y)) | |
118 field-names field-init-forms)) | |
56751
72a02133177e
Upgraded to MH-E version 7.81.
Bill Wohler <wohler@newt.com>
parents:
56677
diff
changeset
|
119 (list (quote ,struct-name) ,@field-names)) |
56676 | 120 (defun ,predicate (arg) |
56751
72a02133177e
Upgraded to MH-E version 7.81.
Bill Wohler <wohler@newt.com>
parents:
56677
diff
changeset
|
121 (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
|
122 ,@(loop for x from 1 |
56676 | 123 for y in field-names |
124 collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z) | |
125 (list 'nth ,x z))) | |
126 (quote ,struct-name)))) | |
127 | |
56787
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
128 (defadvice require (around mh-prefer-el activate) |
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
129 "Modify `require' to load uncompiled MH-E files." |
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
130 (or (featurep (ad-get-arg 0)) |
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
131 (and (string-match "^mh-" (symbol-name (ad-get-arg 0))) |
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
132 (load (format "%s.el" (ad-get-arg 0)) t t)) |
25da1d331c99
Upgraded to MH-E version 7.82.
Bill Wohler <wohler@newt.com>
parents:
56751
diff
changeset
|
133 ad-do-it)) |
56676 | 134 |
135 (provide 'mh-acros) | |
136 | |
137 ;;; Local Variables: | |
138 ;;; no-byte-compile: t | |
139 ;;; indent-tabs-mode: nil | |
140 ;;; sentence-end-double-space: nil | |
141 ;;; End: | |
142 | |
56677 | 143 ;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff |
56676 | 144 ;;; mh-acros.el ends here |