branch: externals/dismal
commit 723cce61dc1327aa7f57957ebe40e64623f93f88
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
* COPYING: Remove old GPLv2 license; Cleanup some of the code
* auto-aligner: Use lexical-binding.
* dismal-menu3.el: Don't require dismal.el. Instead define our own keymap.
(dismal-menu-map): New var.
* dismal.el: Require dismal-menu3 in the normal way.
(dismal-mode-map): Use dismal-menu-map.
---
COPYING | 339 ------------------------------
auto-aligner.el | 636 ++++++++++++++++++--------------------------------------
dismal-menu3.el | 389 +++++++++++++++++-----------------
dismal.el | 15 +-
4 files changed, 414 insertions(+), 965 deletions(-)
diff --git a/COPYING b/COPYING
deleted file mode 100644
index e77696a..0000000
--- a/COPYING
+++ /dev/null
@@ -1,339 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 675 Mass Ave, Cambridge, MA 02139, USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) 19yy <name of author>
-
- This program 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 of the License, or
- (at your option) any later version.
-
- This program 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 this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) 19yy name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
diff --git a/auto-aligner.el b/auto-aligner.el
index 8dc54c4..68906ff 100644
--- a/auto-aligner.el
+++ b/auto-aligner.el
@@ -1,6 +1,6 @@
-;;; auto-aligner.el --- Specialized extensions to Dismal to support aligning
two sequences
+;;; auto-aligner.el --- Specialized extensions to Dismal to support aligning
two sequences -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2013, 2018 Free Software Foundation, Inc.
;; Author: Frank Ritter
;; Created-On: Wed May 20 15:50:22 1992
@@ -23,13 +23,14 @@
;;; Code:
(require 'dismal-data-structures)
+(require 'dismal)
(require 'rmatrix)
;;;; i. dis-auto-align-model variables
;; General algorithm taken from p. 190, Card, Moran, & Newell.
-;; Extensions:
+;; Extensions:
;; * our predseq ends up being a list of cell references
;; * we don't just want to compute the final comparison, we also want
;; to realign
@@ -44,16 +45,9 @@
;; "regexps that match valid obs codes"
-(defvar dis-paired-regexps nil
+(defvar dis-paired-regexps nil
"*The list of paired expressions the user defines the match with.")
-(defvar dis-pred-regexps (mapcar 'cdr dis-paired-regexps))
-(defvar dis-obs-regexps (mapcar 'car dis-paired-regexps))
-
-;; keep these two around, so you can match up later...
-(defvar dis-predseqresult nil)
-(defvar dis-obsseqresult nil)
-
(defconst dis-auto-aligner-version "1.1 of 8-10-93")
;; 1.1 has improved moving up in lineness
@@ -69,13 +63,23 @@
;; (dis-auto-align-model "B" "J" 42 222) ; for precision
;; (dis-auto-align-model "B" "J" 42 222) ; for axis
+(defvar dis--predseq)
+(defvar dis--predseqresult)
+(defvar dis--predlength)
+(defvar dis--obsseq)
+(defvar dis--obsseqresult)
+(defvar dis--obslength)
+(defvar dis--score)
+(defvar dis--max-seq-length)
+(defvar dis--length-of-result)
+
(defun dis-auto-align-model (obs-col pred-col start-row end-row)
- "Aligns the two meta-column rows based on matching up what's in OBS-COL
+ "Aligns the two meta-column rows based on matching up what's in OBS-COL
and PRED-COL, doing it for all rows between START-ROW and END-ROW.
dis-paired-regexps defines what matches between the rows."
- (interactive "sSubject column to align with (a letter):
-sModel column to align with (a letter):
-nStarting row:
+ (interactive "sSubject column to align with (a letter):
+sModel column to align with (a letter):
+nStarting row:
nEnding row: ")
(if (not (y-or-n-p (format "Align col %s to col %s, from row %s to row %s? "
obs-col pred-col start-row end-row)))
@@ -84,88 +88,92 @@ nEnding row: ")
(error "dis-auto-align-model can only be called in a dismal buffer")
(message "Setting up alignment...")
;; set up the individual items you'll match on each side
- (setq obs-regexps (mapcar 'car dis-paired-regexps))
- (setq pred-regexps (mapcar 'cdr dis-paired-regexps))
- ;; put these variables into a let after debug
- (setq obs-col (dismal-convert-colname-to-number obs-col))
- (setq pred-col (dismal-convert-colname-to-number pred-col))
- (setq obs-range-list
- (dismal-make-range start-row obs-col end-row obs-col))
- (setq pred-range-list (dismal-make-range start-row pred-col end-row pred-col))
- (setq obsseq (dis-match-list obs-range-list obs-regexps))
- (setq predseq (dis-match-list pred-range-list pred-regexps))
-
- ;; Step 1. Initialize
- (setq obslength (length obsseq))
- (setq predlength (length predseq))
- (setq score (matrix-create))
- ;; fill score's edges with 0's
- (setq i 0)
- (while (<= i predlength)
- (matrix-set score i 0 0)
+ (let* ((obs-regexps (mapcar #'car dis-paired-regexps))
+ (pred-regexps (mapcar #'cdr dis-paired-regexps))
+ ;; put these variables into a let after debug
+ (obs-col (dismal-convert-colname-to-number obs-col))
+ (pred-col (dismal-convert-colname-to-number pred-col))
+ (obs-range-list
+ (dismal-make-range start-row obs-col end-row obs-col))
+ (pred-range-list (dismal-make-range start-row pred-col end-row
pred-col))
+ (dis--obsseq (dis-match-list obs-range-list obs-regexps))
+ (dis--predseq (dis-match-list pred-range-list pred-regexps))
+
+ ;; Step 1. Initialize
+ (dis--obslength (length dis--obsseq))
+ (dis--predlength (length dis--predseq))
+ (dis--score (matrix-create))
+ ;; fill dis--score's edges with 0's
+ (i 0) (j 0))
+ (while (<= i dis--predlength)
+ (matrix-set dis--score i 0 0)
(setq i (1+ i)))
- (setq j 0)
- (while (<= j obslength)
- (matrix-set score 0 j 0)
+ (while (<= j dis--obslength)
+ (matrix-set dis--score 0 j 0)
(setq j (1+ j)))
;; Step 2. Compute the scores for a matrix with one row for every operator
;; in the predicted sequence and one column for every operator in the
;; observed sequence.
- (message
+ (message
"Computing score matrix for %s observed actions by %s predicted actions..."
- obslength predlength)
+ dis--obslength dis--predlength)
(setq i 1)
- (while (<= i predlength)
+ (while (<= i dis--predlength)
(setq j 1)
- (while (<= j obslength)
- (if (dis-auto-align-test i j predseq obsseq)
- (matrix-set score i j (1+ (matrix-ref score (1- i) (1- j))))
+ (while (<= j dis--obslength)
+ (if (dis--auto-align-test i j dis--predseq dis--obsseq)
+ (matrix-set dis--score i j (1+ (matrix-ref dis--score (1- i) (1- j))))
; else
- (matrix-set score i j
- (max (matrix-ref score (1- i) j)
- (matrix-ref score i (1- j)))))
+ (matrix-set dis--score i j
+ (max (matrix-ref dis--score (1- i) j)
+ (matrix-ref dis--score i (1- j)))))
(setq j (1+ j)))
(setq i (1+ i)))
;; Step 3. Traverse the matrix forward along the path of higest scores
;; but do it front first...
(message "Computing best match...")
- (setq max-seq-length (matrix-ref score predlength obslength))
- (setq length-of-result (+ max-seq-length (- predlength max-seq-length) (-
obslength max-seq-length)))
- (dis-card-compute-best-match)
- (setq match-amount (/ (* 100 (- (+ predlength obslength) length-of-result))
;; # of matches
- (max 1 predlength obslength)))
- (setq optimistic-match-amount
- (/ (* 100 (- (+ predlength obslength) length-of-result)) ;; # of matches
- (max 1 (min predlength obslength))))
+ (let* ((dis--max-seq-length
+ (matrix-ref dis--score dis--predlength dis--obslength))
+ (dis--length-of-result
+ (+ dis--max-seq-length
+ (- dis--predlength dis--max-seq-length)
+ (- dis--obslength dis--max-seq-length)))
+ (_ (dis--card-compute-best-match))
+ (match-amount (/ (* 100 (- (+ dis--predlength dis--obslength)
dis--length-of-result)) ;; # of matches
+ (max 1 dis--predlength dis--obslength)))
+ (optimistic-match-amount
+ (/ (* 100 (- (+ dis--predlength dis--obslength) dis--length-of-result))
;; # of matches
+ (max 1 (min dis--predlength dis--obslength)))))
;; equivalent formula:
- ;; (/ (* 100 (matrix-ref score predlength obslength))
- ;; length-of-result)
+ ;; (/ (* 100 (matrix-ref dis--score dis--predlength dis--obslength))
+ ;; dis--length-of-result)
;; e.g., 10 & 10, 8 matches + 4, or 12 total
;; 10 & 10, 1 match, +18
(beep t)
- (if (y-or-n-p (format "Do you want matches (%s %% matched) moved up in line?
"
+ (if (y-or-n-p (format "Do you want matches (%s %% matched) moved up in line? "
match-amount))
- (dis-move-references-forward obs-col pred-col))
+ (dis--move-references-forward obs-col pred-col))
;; Step 4a. Approve the matches you have found
- (dis-choose-to-do-edits)
+ (dis--choose-to-do-edits)
;; Step 5. Generate a report
- (save-excursion
- (let* ((old-buffer (current-buffer))
- (old-buffer-file-name buffer-file-name)
- (new-buffer (get-buffer-create "*auto-align-model Output*")) )
- (set-buffer new-buffer)
+ (let* ((old-buffer (current-buffer))
+ (old-buffer-file-name buffer-file-name)
+ (new-buffer (get-buffer-create "*auto-align-model Output*"))
+ dis--obsseqresult
+ dis--predseqresult)
+ (with-current-buffer new-buffer
(goto-char (point-max))
- (if (not (= (point) 0))
+ (if (not (= (point) 0))
(insert "*********************************************************\n"))
(save-excursion
(insert "dis-auto-align-model Output " dis-auto-aligner-version "\n"
(format "Aligned col %s to col %s, from row %s to %s \n"
obs-col pred-col start-row end-row))
- (insert "For file: " (or old-buffer-file-name
+ (insert "For file: " (or old-buffer-file-name
(buffer-name)) "\n" (current-time-string) "\n"
"\nMatching pairs:\n")
(mapc (function (lambda (pair) (insert (format "%s to %s\n" (car pair)
@@ -173,29 +181,27 @@ nEnding row: ")
dis-paired-regexps)
(insert (format "\nMatch = %s %%\n" match-amount))
(insert (format "\nOptimistic Match = %s %%\n" optimistic-match-amount))
- (insert (format " %10s %10s %20s %30s\n" "Observed" "Predicted"
+ (insert (format " %10s %10s %20s %30s\n" "Observed" "Predicted"
"Obs value" "Pred value"))
(setq i 1)
- (while (<= i length-of-result)
- (let ((obsvalue (if (aref obsseqresult i)
- (save-excursion
- (set-buffer old-buffer)
- (dismal-get-val (car (aref obsseqresult i))
- (cdr (aref obsseqresult i))))
+ (while (<= i dis--length-of-result)
+ (let ((obsvalue (if (aref dis--obsseqresult i)
+ (with-current-buffer old-buffer
+ (dismal-get-val (car (aref dis--obsseqresult i))
+ (cdr (aref dis--obsseqresult i))))
"nil"))
- (predvalue (if (aref predseqresult i)
- (save-excursion
- (set-buffer old-buffer)
- (dismal-get-val (car (aref predseqresult i))
- (cdr (aref predseqresult i))))
+ (predvalue (if (aref dis--predseqresult i)
+ (with-current-buffer old-buffer
+ (dismal-get-val (car (aref dis--predseqresult i))
+ (cdr (aref dis--predseqresult i))))
"nil")))
- (let ((obs-value (aref obsseqresult i))
- (pred-value (aref predseqresult i)))
+ (let ((obs-value (aref dis--obsseqresult i))
+ (pred-value (aref dis--predseqresult i)))
(insert (format "%2s: " i)
- (if obs-value
+ (if obs-value
(format "%6s%4s " (dismal-convert-number-to-colname
(cdr obs-value)) (car obs-value))
(format "%10s " obs-value))
- (if pred-value
+ (if pred-value
(format "%6s%4s " (dismal-convert-number-to-colname
(cdr pred-value)) (car pred-value))
(format "%10s " pred-value))
(format " %15s %25s\n"
@@ -212,55 +218,55 @@ nEnding row: ")
"Can't tell where data stops/model begins: you must set dis-middle-col"))
(if (not (y-or-n-p (format "Do you want the %s matches out of %s aligned? "
- max-seq-length (max predlength obslength))))
+ dis--max-seq-length (max dis--predlength
dis--obslength))))
nil
- (setq new-rows (dis-align-columns))
+ (let ((new-rows (dis-align-columns)))
(beep t)
- ;; Now go through and delete any completely blank rows
+ ;; Now go through and delete any completely blank rows
(if (not (y-or-n-p (format "Do you want blank lines deleted? ")))
nil
- (dis-delete-blank-rows start-row (+ end-row new-rows))))
- (message "Thank you for using dis-auto-align-model.") )))
+ (dis-delete-blank-rows start-row (+ end-row new-rows)))))
+ (message "Thank you for using dis-auto-align-model.") )))))
-;;;; II. Utilities
+;;;; II. Utilities
;; (string-match "place-atom \\([0-9]*\\), \\1" "place-atom 33, 33")
;; move the edit references so that they are later.
;; vaiables should be put into a lets
;; ** assumes working with columns 1 and 9 ****
-(defun dis-move-references-forward (obs-col pred-col)
+(defun dis--move-references-forward (obs-col _pred-col)
;; low-post-number is where to start looking for something to move
;; observed on LHS, predicted nominally on RHS
(let ((i 1))
- (setq i 1)
;; (setq obs-col 1)
;; (setq pred-col 9)
- (while (< i (1- (length predseqresult)))
+ (while (< i (1- (length dis--predseqresult)))
;; Set up
- (setq my-quit-flag nil)
- (setq obs-result (aref obsseqresult i))
- (setq pred-result (aref predseqresult i))
+ (let* ((my-quit-flag nil)
+ (obs-result (aref dis--obsseqresult i))
+ (pred-result (aref dis--predseqresult i)))
(if (not (and obs-result pred-result))
nil ;; quit, he's not paired so can't move, rest in progn
- (setq obs-val (dismal-get-val (car obs-result) (cdr obs-result)))
- (setq obs-match-string
- (car (dis-matching-regexp obs-val dis-paired-regexps)))
- (setq pred-match-string
- (cdr (dis-matching-regexp obs-val dis-paired-regexps)))
- (setq low-post-number (1+ i))
-
- ;; (my-message "Doing now ** i= %s, lowpost= %s, flag= %s finali= %s"
- ;; i low-post-number my-quit-flag (length predseqresult))
+ (let* ((obs-val (dismal-get-val (car obs-result) (cdr obs-result)))
+ (obs-match-string
+ (car (dis--matching-regexp obs-val dis-paired-regexps)))
+ ;; (pred-match-string
+ ;; (cdr (dis--matching-regexp obs-val dis-paired-regexps)))
+ (low-post-number (1+ i))
+ new-obs-result)
+
+ ;; (my-message "Doing now ** i= %s, lowpost= %s, flag= %s finali= %s"
+ ;; i low-post-number my-quit-flag (length dis--predseqresult))
;; Search
(while (and (not my-quit-flag)
- (setq new-obs-result (aref obsseqresult low-post-number))
- (< low-post-number (length predseqresult)))
- ;; (message "Doing i= %s, lowpost= %s, flag= %s finali= %s"
- ;; i low-post-number my-quit-flag (length predseqresult))
+ (setq new-obs-result (aref dis--obsseqresult low-post-number))
+ (< low-post-number (length dis--predseqresult)))
+ ;; (message "Doing i= %s, lowpost= %s, flag= %s finali= %s"
+ ;; i low-post-number my-quit-flag (length dis--predseqresult))
;; (beep t) (sit-for 2)
- (setq new-obs-val (dismal-get-val (car new-obs-result) obs-col))
- (setq new-pred-result (aref predseqresult low-post-number))
+ (let* ((new-obs-val (dismal-get-val (car new-obs-result) obs-col))
+ (new-pred-result (aref dis--predseqresult low-post-number)))
;; find a colleague who will move to your place
(cond ((and new-obs-val
(string-match obs-match-string new-obs-val)
@@ -268,133 +274,126 @@ nEnding row: ")
(message "Moving %s at %s matching %s to %s"
obs-match-string obs-result pred-result new-obs-result)
(sit-for 1)
- (aset predseqresult i nil)
- (aset predseqresult low-post-number pred-result)
+ (aset dis--predseqresult i nil)
+ (aset dis--predseqresult low-post-number pred-result)
(setq my-quit-flag t))
((and new-obs-val
new-pred-result)
(setq my-quit-flag t))
- (t (setq low-post-number (1+ low-post-number))))))
+ (t (setq low-post-number (1+ low-post-number)))))))))
(setq i (1+ i)) )))
;; (if (= i 1)
;; (setq low-post-number min-row)
-;; (setq low-post-number (1+ (car (aref obsseqresult (1- i))))))
-;; (if (= i (length predseqresult))
+;; (setq low-post-number (1+ (car (aref dis--obsseqresult (1- i))))))
+;; (if (= i (length dis--predseqresult))
;; (setq high-post-number max-row)
-;; (setq max-post-number (1+ (car (aref obsseqresult (1+ i))))))
+;; (setq max-post-number (1+ (car (aref dis--obsseqresult (1+ i))))))
;; Compute the best match, starting from the front
-;; k is length of match since we use position 0 in array
-(defun dis-card-compute-best-match ()
- ;; predseq comes in as a global
- ;; obsseq comes in as a global
-
- ;; Counters into final sequences
- (setq p predlength) ; counter into predicted sequence
- (setq o obslength) ; counter into observed sequence
- (setq k (- (+ predlength obslength) max-seq-length))
- ;; The results
- ;; add 1 to k, arrays are 0 based reference
- (setq predseqresult (make-vector (1+ k) nil))
- (setq obsseqresult (make-vector (1+ k) nil))
-
- (while (not (and (= p 0) (= o 0)))
- (cond ((and (not (= p 0))
- (or (= o 0) (> (matrix-ref score (1- p) o)
- (matrix-ref score (1- p) (1- o)))))
- (aset predseqresult k (nth (1- p) predseq))
- (aset obsseqresult k nil)
- (setq p (1- p))
- (setq k (1- k)))
- ((and (not (= o 0))
- (or (= p 0) (> (matrix-ref score p (1- o))
- (matrix-ref score (1- p) (1- o)))))
- (aset predseqresult k nil)
- (aset obsseqresult k (nth (1- o) obsseq))
- (setq o (1- o))
- (setq k (1- k)))
- (t
- (aset predseqresult k (nth (1- p) predseq))
- (aset obsseqresult k (nth (1- o) obsseq))
- (setq p (1- p))
- (setq o (1- o))
- (setq k (1- k))))
- ))
+(defun dis--card-compute-best-match ()
+ ;; dis--predseq comes in as a global
+ ;; dis--obsseq comes in as a global
+
+ ;; Counters into final sequences
+ (let ((p dis--predlength) ; counter into predicted sequence
+ (o dis--obslength) ; counter into observed sequence
+ ;; k is length of match since we use position 0 in array
+ (k (- (+ dis--predlength dis--obslength) dis--max-seq-length)))
+ ;; The results
+ ;; add 1 to k, arrays are 0 based reference
+ (setq dis--predseqresult (make-vector (1+ k) nil))
+ (setq dis--obsseqresult (make-vector (1+ k) nil))
+
+ (while (not (and (= p 0) (= o 0)))
+ (cond ((and (not (= p 0))
+ (or (= o 0) (> (matrix-ref dis--score (1- p) o)
+ (matrix-ref dis--score (1- p) (1- o)))))
+ (aset dis--predseqresult k (nth (1- p) dis--predseq))
+ (aset dis--obsseqresult k nil)
+ (setq p (1- p))
+ (setq k (1- k)))
+ ((and (not (= o 0))
+ (or (= p 0) (> (matrix-ref dis--score p (1- o))
+ (matrix-ref dis--score (1- p) (1- o)))))
+ (aset dis--predseqresult k nil)
+ (aset dis--obsseqresult k (nth (1- o) dis--obsseq))
+ (setq o (1- o))
+ (setq k (1- k)))
+ (t
+ (aset dis--predseqresult k (nth (1- p) dis--predseq))
+ (aset dis--obsseqresult k (nth (1- o) dis--obsseq))
+ (setq p (1- p))
+ (setq o (1- o))
+ (setq k (1- k))))
+ )))
;; (my-message "offset: %s matched %s" offset matched)
-;; (my-message "offset: %s matched %s i-test: %s j-test %s"
+;; (my-message "offset: %s matched %s i-test: %s j-test %s"
;; offset matched i-test j-test)
;; (y-or-n-p (format "Doing real test on %s %s, scores: %s %s %s %s "
-;; i-test j-test score0 score+j score+i score+i+j))
+;; i-test j-test dis--score0 dis--score+j dis--score+i
dis--score+i+j))
; (dis-align-columns 19 11)
;; needs cleaned up
(defun dis-align-columns ()
- ;; Align the pred-row with the obs-row looking across dis-middle-col
- ;; returns how many rows it added
- ;; Assumes done from front at initial time, easiest, maybe not best
- ;; assumes that cells below lowest of p-row and o-row aren't aligned
- (setq i 0)
- (setq p-offset 0)
- (setq o-offset 0)
- (while (<= i length-of-result)
- (message "Checking position %s of %s..." i length-of-result)
- (let* ((pred-cell (aref predseqresult i))
- (obs-cell (aref obsseqresult i))
- (p-row (if pred-cell (+ p-offset (dismal-address-row pred-cell))))
- (o-row (if obs-cell (+ o-offset (dismal-address-row obs-cell)))) )
- (if (and pred-cell obs-cell)
- (let* ( (offset (abs (- p-row o-row))) )
- (message "Aligning position %s of %s..." i length-of-result)
- ;; works from front, and keeps cum. offsets for each side
- ;; so only has to do adds to one side
- (cond ((= p-row o-row) nil)
- ((> p-row o-row) ; move o-row down
- (setq o-offset (+ o-offset offset))
- (dismal-insert-range-cells o-row 0
- o-row dis-middle-col offset))
- ((> o-row p-row) ; move p-row down
- (setq p-offset (+ p-offset offset))
- (dismal-insert-range-cells p-row (1+ dis-middle-col)
- p-row dismal-max-col offset))))))
- (setq i (1+ i)) )
- (max p-offset o-offset))
-
- ;; this would have kept alignment
- ;(dismal-insert-range-cells (1+ p-row) (1+ dis-middle-col)
- ; (1+ p-row) dismal-max-col offset)
- ;; this would have kept alignment
- ;(dismal-insert-range-cells (1+ o-row) 0
- ; (1+ o-row) dis-middle-col offset)
-
-
-(defun dis-choose-to-do-edits () ;(dis-choose-to-do-edits)
+ ;; Align the pred-row with the obs-row looking across dis-middle-col
+ ;; returns how many rows it added
+ ;; Assumes done from front at initial time, easiest, maybe not best
+ ;; assumes that cells below lowest of p-row and o-row aren't aligned
+ (let ((i 0)
+ (p-offset 0)
+ (o-offset 0))
+ (while (<= i dis--length-of-result)
+ (message "Checking position %s of %s..." i dis--length-of-result)
+ (let* ((pred-cell (aref dis--predseqresult i))
+ (obs-cell (aref dis--obsseqresult i))
+ (p-row (if pred-cell (+ p-offset (dismal-address-row pred-cell))))
+ (o-row (if obs-cell (+ o-offset (dismal-address-row obs-cell))))
)
+ (if (and pred-cell obs-cell)
+ (let* ( (offset (abs (- p-row o-row))) )
+ (message "Aligning position %s of %s..." i dis--length-of-result)
+ ;; works from front, and keeps cum. offsets for each side
+ ;; so only has to do adds to one side
+ (cond ((= p-row o-row) nil)
+ ((> p-row o-row) ; move o-row down
+ (setq o-offset (+ o-offset offset))
+ (dismal-insert-range-cells o-row 0
+ o-row dis-middle-col offset))
+ ((> o-row p-row) ; move p-row down
+ (setq p-offset (+ p-offset offset))
+ (dismal-insert-range-cells p-row (1+ dis-middle-col)
+ p-row dismal-max-col
offset))))))
+ (setq i (1+ i)) )
+ (max p-offset o-offset)))
+
+
+(defun dis--choose-to-do-edits () ;(dis--choose-to-do-edits)
;; Uses dynamic scoping, so watch out...
;; on y, do nothing, on n, remove from match, on j, quit
;; (my-message "entering choose-to-do-edits")
(let ((do-edit nil) (just-do-rest nil)
- o-row p-row pred-cell obs-cell
(i 0))
- (while (and (< i length-of-result) (not just-do-rest))
- (let* ((pred-cell (aref predseqresult i))
- (obs-cell (aref obsseqresult i))
+ (while (and (< i dis--length-of-result) (not just-do-rest))
+ (let* ((pred-cell (aref dis--predseqresult i))
+ (obs-cell (aref dis--obsseqresult i))
(p-row (if pred-cell (dismal-address-row pred-cell)))
(o-row (if obs-cell (dismal-address-row obs-cell))) )
(if (not (and pred-cell obs-cell))
nil
;; I'm happy to make user type CR to be sure.
- (dis-set-mark (dismal-address-row obs-cell) (dismal-address-col obs-cell))
+ (dismal-set-mark (dismal-address-row obs-cell)
+ (dismal-address-col obs-cell))
(dismal-jump-to-cell (dismal-address-row pred-cell)
(dismal-address-col pred-cell))
(setq do-edit
(dismal-read-minibuffer
(format
"Align match %s/%s, row %s:<%s> with row %s:<%s>? (y/n/a accept the rest)"
- (1+ i) length-of-result
+ (1+ i) dis--length-of-result
o-row (dismal-get-val o-row (dismal-address-col obs-cell))
p-row (dismal-get-val p-row (dismal-address-col
pred-cell)))
nil "y"))
@@ -404,261 +403,40 @@ nEnding row: ")
;; (recursive-edit))
((string= do-edit "y"))
((string= do-edit "n")
- (aset predseqresult i nil)
- (aset obsseqresult i nil))
+ (aset dis--predseqresult i nil)
+ (aset dis--obsseqresult i nil))
((string= do-edit "a")
(setq just-do-rest t))))
(setq i (1+ i)))) ))
-(defun dis-choose-to-do-edit ()
- ;; uses dynamic scoping, so watch out...
- (setq do-edit nil)
- (while (not (or (string= do-edit "y") (string= do-edit "n")))
- (setq do-edit
- (read-minibuffer
- (format "Should I align row %s:<%s> with row %s:<%s>? (y/n/browse) "
- o-row (dismal-get-val o-row (dismal-address-col obs-cell))
- p-row (dismal-get-val p-row (dismal-address-col
pred-cell)))))
- (if (string= do-edit "b")
- (progn (message (substitute-command-keys
- "So look at speadsheet, exit with \\[exit-recursive-edit]"))
- (recursive-edit))))
- (string= do-edit "y"))
-
-(defun dis-auto-align-test (i j predseq obsseq)
+(defun dis--auto-align-test (i j predseq obsseq)
;; finds the cells that match things on dis-paired-regexps
(let* ((predcell-ref (nth (1- i) predseq))
(obscell-ref (nth (1- j) obsseq))
(pred-val (dismal-get-val (car predcell-ref) (cdr predcell-ref)))
(obs-val (dismal-get-val (car obscell-ref) (cdr obscell-ref))))
- (dis-auto-align-test-regexps pred-val obs-val dis-paired-regexps)))
+ (dis--auto-align-test-regexps pred-val obs-val dis-paired-regexps)))
-(defun dis-auto-align-test-regexps (pred-val obs-val regexps)
+(defun dis--auto-align-test-regexps (pred-val obs-val regexps)
;; (my-message "matchine %s %s with %s" pred-val obs-val regexps)
(cond ((not regexps) nil)
((and (consp regexps) (stringp (cdr regexps)))
(and (string-match (cdr regexps) pred-val)
(string-match (car regexps) obs-val)))
- (t (or (dis-auto-align-test-regexps pred-val obs-val (car regexps))
- (dis-auto-align-test-regexps pred-val obs-val (cdr regexps))))))
+ (t (or (dis--auto-align-test-regexps pred-val obs-val (car regexps))
+ (dis--auto-align-test-regexps pred-val obs-val (cdr
regexps))))))
;; (string-match "Tiny" "Boy, I am Tiny I think")
-(defun dis-matching-regexp (obs-val regexps)
+(defun dis--matching-regexp (obs-val regexps)
(cond ((not regexps) nil)
((and (consp regexps) (stringp (cdr regexps)))
(if (string-match (car regexps) obs-val)
regexps
nil))
- (t (or (dis-matching-regexp obs-val (car regexps))
- (dis-matching-regexp obs-val (cdr regexps))))))
-
-;; Original version that goes greedy from the back:
-;; (setq i predlength) (setq j obslength) (setq k 1)
-;; (while (not (and (= i 0) (= j 0)))
-;; (my-message "doing k %s i %s j %s" k i j)
-;; (sit-for 1)
-;; (if (and (not (= i 0))
-;; (or (= j 0) (> (matrix-ref score (1- i) j)
-;; (matrix-ref score (1- i) (1- j)))))
-;; (progn (aset predseqresult k (nth (1- i) predseq))
-;; (aset obsseqresult k nil)
-;; (setq k (1+ k))
-;; (setq i (1- i)))
-;; (if (and (not (= j 0))
-;; (or (= i 0) (> (matrix-ref score i (1- j))
-;; (matrix-ref score (1- i) (1- j)))))
-;; (progn (aset predseqresult k nil)
-;; (aset obsseqresult k (nth (1- j) obsseq))
-;; (setq k (1+ k))
-;; (setq j (1- j)))
-;; (progn
-;; (aset predseqresult k (nth (1- i) obsseq))
-;; (aset obsseqresult k (nth (1- j) obsseq))
-;; (setq k (1+ k))
-;; (setq i (1- i))
-;; (setq j (1- j))) ))
-;; )
-
-
-;; valiant but misplaced attempt to do card algorithm from the front, which is
how it
-;; worked in the first place. 8-Jul-92 -FER
-;;
-;; ;; Compute the best match, starting from the front
-;; ;; k is length of match since we use position 0 in array
-;; (defun dis-compute-best-match ()
-;; (setq predseqresult (make-vector (+ predlength obslength) nil))
-;; (setq obsseqresult (make-vector (+ predlength obslength) nil))
-;; (setq p 0) ; counter into predicted sequence
-;; (setq o 0) ; counter into observed sequence
-;; (setq k 0) ; counter into final sequences
-;; (while (not (and (= p predlength) (= o obslength)))
-;; ;; (my-message "doing k %s i %s o %s" k i o)
-;; (setq score0 (matrix-ref score p o)) ;; score at current cell
-;; (setq score+p (matrix-ref score (1+ p) o)) ;; score at current
cell(p+1,o)
-;; (setq score+o (matrix-ref score p (1+ o))) ;; score at current
cell(p,1+o)
-;; (setq score+p+o (matrix-ref score (1+ p) ;; score at current
cell(p+1,1+o)
-;; (1+ o)))
-;; (cond ((= p predlength) ;; Pad in obs, at edge
-;; (aset predseqresult k nil)
-;; (aset obsseqresult k (nth o obsseq))
-;; (setq k (1+ k))
-;; (setq o (1+ o)))
-;; ((= o obslength) ;; Pad in pred, at edge
-;; (aset predseqresult k (nth p predseq))
-;; (aset obsseqresult k nil)
-;; (setq k (1+ k))
-;; (setq p (1+ p)))
-;; ( ;; good match
-;; (and (= score0 score+p) ;; this looks like 0 0
-;; (= score0 score+o) ;; 0 1
-;; (= (1+ score0) score+p+o))
-;; (aset predseqresult k (nth p predseq))
-;; (aset obsseqresult k (nth o obsseq))
-;; (setq k (1+ k))
-;; (setq p (1+ p)) (setq o (1+ o)))
-;;
-;; (t ;; need to pad some, search to know where to go, and then go
there
-;; (setq next-good-cell (find-good-cell p o predlength obslength))
-;; (setq delta-p (- (car next-good-cell) p))
-;; (setq delta-o (- (cdr next-good-cell) o))
-;; ;; pad in p
-;; (while (> delta-p 0)
-;; (aset predseqresult k (nth p predseq))
-;; (aset obsseqresult k nil)
-;; (setq k (1+ k))
-;; (setq delta-p (1- delta-p))
-;; (setq p (1+ p)))
-;; ;; pad in o
-;; (while (> delta-o 0)
-;; (aset predseqresult k nil)
-;; (aset obsseqresult k (nth o obsseq))
-;; (setq k (1+ k))
-;; (setq delta-o (1- delta-o))
-;; (setq o (1+ o))) )) )
-;; (setq k (1- k)))
-;;
-;;
-;; ;; you start at X.
-;; ;; Predicted(i)
-;; ;; 0
-;; ;; obs(j) 0 X
-;;
-;; ;; the original
-;; (defun find-good-cell (i j predlength obslength)
-;; ;; Find the next good match from cell (i j) in score matrix.
-;; ;; You know that i,j itself is not a good cell
-;; ;; You know that you don't have to look at cells less than i,j
-;; ;; This version prefers to match locally early in predicted and late in obs
-;; (let ((matched nil)
-;; (offset 1) ;; offset of current obverse diagonal
-;; (max-offset (+ (- predlength i) (- obslength j))) )
-;; ;; Generate obverse diagonal cells
-;; (while (and (< offset max-offset) (not matched))
-;; (setq i-test i)
-;; (setq j-test (+ j offset))
-;; (while (and (>= j-test j) (not matched))
-;; ;; you haven't come up to the column across you started on, col j
-;; ;; the use of < here (rather than <=) avoids testing cells on edge
-;; ;; which can't match the (00,01) pattern.
-;; (if (and (< j-test obslength) (< i-test predlength))
-;; ;; test the cell to see if it is the next good one.
-;; (progn
-;; (setq score0 (matrix-ref score i-test j-test))
-;; (setq score+i (matrix-ref score (1+ i-test) j-test))
-;; (setq score+j (matrix-ref score i-test (1+ j-test)))
-;; (setq score+i+j (matrix-ref score (1+ i-test) (1+ j-test)))
-;; (if (and (= score0 score+i) ;; this is a cell looking at 0 0
-;; (= score0 score+j) ;; 0 1
-;; (= (1+ score0) score+i+j))
-;; (setq matched t))))
-;; ;; Move down diagonal |_'
-;; (setq i-test (1+ i-test))
-;; (setq j-test (1- j-test)))
-;; (setq offset (1+ offset)))
-;; ;; Return the max cell if you are in the flatlands or the cell you found.
-;; (if (= offset max-offset)
-;; (cons predlength obslength)
-;; (cons (1- i-test) (1+ j-test))) ))
-;;
-;; ;;
-;; ;; you start at X.
-;; ;; Predicted(i)
-;; ;; 0
-;; ;; obs(j) 0 X
-;;
-;; (defun find-good-cell2 (i j predlength obslength)
-;; ;; Find the next good match from cell (i j) in score matrix.
-;; ;; You know that i,j itself is not a good cell
-;; ;; You know that you don't have to look at cells less than i,j
-;; ;; This version prefers to match locally early in obs and late in predicted
-;; (let ((matched nil)
-;; (offset 1) ;; offset of current obverse diagonal
-;; (max-offset (+ (- predlength i) (- obslength j))) )
-;; ;; Generate obverse diagonal cells
-;; (while (and (< offset max-offset) (not matched))
-;; (setq i-test (+ i offset))
-;; (setq j-test j)
-;; (while (and (>= i-test i) (not matched))
-;; ;; you haven't come up to the column across you started on, col i
-;; (if (and (< j-test obslength) (< i-test predlength))
-;; ;; test the cell to see if it is the next good one.
-;; (progn
-;; (setq score0 (matrix-ref score i-test j-test))
-;; (setq score+i (matrix-ref score (1+ i-test) j-test))
-;; (setq score+j (matrix-ref score i-test (1+ j-test)))
-;; (setq score+i+j (matrix-ref score (1+ i-test) (1+ j-test)))
-;; (if (and (= score0 score+i) ;; this is a cell looking at 0 0
-;; (= score0 score+j) ;; 0 1
-;; (= (1+ score0) score+i+j))
-;; (setq matched t))))
-;; ;; Move down diagonal |_'
-;; (setq i-test (1- i-test))
-;; (setq j-test (1+ j-test)))
-;; (setq offset (1+ offset)))
-;; ;; Return the max cell if you are in the flatlands or the cell you found.
-;; (if (= offset max-offset)
-;; (cons predlength obslength)
-;; ;; correct for last move
-;; (cons (1+ i-test) (1- j-test))) ))
-;;
-
-;; don't know why we have this, seems superfluous 18-Jun-92 -FER
-;(defun dis-align-range ()
-; "Align the two lines represented by the rows in the marked range,
-;looking across dis-middle-col. Returns how many rows it added."
-; (interactive)
-;
-; (setq i 0)
-; (setq p-offset 0)
-; (setq o-offset 0)
-; (while (< i length-of-result)
-; (message "Checking position %s of %s..." (1+ i) length-of-result)
-; (let* ((pred-cell (aref predseqresult i))
-; (obs-cell (aref obsseqresult i))
-; (p-row (if pred-cell (+ p-offset (dismal-address-row pred-cell))))
-; (o-row (if obs-cell (+ o-offset (dismal-address-row obs-cell)))) )
-; (if (and pred-cell obs-cell (dis-choose-to-do-edit))
-; (let* ( (offset (abs (- p-row o-row))) )
-; (message "Aligning position %s of %s..." (1+ i) length-of-result)
-; (cond ((= p-row o-row) nil)
-; ((> p-row o-row) ; move o-row down
-; ;; this would have kept alignment
-; ;(dismal-insert-range-cells (1+ p-row) (1+ dis-middle-col)
-; ; (1+ p-row) dismal-max-col offset)
-; (setq o-offset (+ o-offset offset))
-; (dismal-insert-range-cells o-row 0 o-row
-; dis-middle-col offset))
-; ((> o-row p-row) ; move p-row down
-; ;; this would have kept alignment
-; ;(dismal-insert-range-cells (1+ o-row) 0
-; ; (1+ o-row) dis-middle-col offset)
-; (setq p-offset (+ p-offset offset))
-; (dismal-insert-range-cells p-row (1+ dis-middle-col)
-; p-row dismal-max-col offset))))))
-; (setq i (1+ i)) )
-; (max p-offset o-offset))
+ (t (or (dis--matching-regexp obs-val (car regexps))
+ (dis--matching-regexp obs-val (cdr regexps))))))
(provide 'auto-aligner)
;;; auto-aligner.el ends here
diff --git a/dismal-menu3.el b/dismal-menu3.el
index d1bae83..cddd9c9 100644
--- a/dismal-menu3.el
+++ b/dismal-menu3.el
@@ -35,102 +35,111 @@
;;; Code:
-(require 'dismal) ;For dismal-mode-map.
+(defvar dismal-menu-map (make-sparse-keymap))
-(define-key dismal-mode-map [menu-bar model]
+(define-key dismal-menu-map [model]
(cons "dModel" (make-sparse-keymap "Model")))
-(define-key dismal-mode-map [menu-bar model Utils]
+(define-key dismal-menu-map [model Utils]
'("Utils" . dis-utils-menu))
-(define-key dismal-mode-map [menu-bar model Stats]
+(define-key dismal-menu-map [model Stats]
'("Stats" . dis-stat))
-(define-key dismal-mode-map [menu-bar model Codes]
+(define-key dismal-menu-map [model Codes]
'("Codes" . dis-code))
-(define-key dismal-mode-map [menu-bar model KLM]
+(define-key dismal-menu-map [model KLM]
'("KL model" . dis-klm))
;; UTILS pop-up-menu
-(defvar dis-utils-menu (make-sparse-keymap "Utilities"))
-;; This is a common idiom. It makes the keymap available as a function
-;; call, somehow. It is done for all the submenus.
-(fset 'dis-utils dis-utils-menu)
+(defvar dis-utils-menu
+ (let ((map (make-sparse-keymap "Utilities")))
+ ;; This is a common idiom. It makes the keymap available as a function
+ ;; call, somehow. It is done for all the submenus.
+ (fset 'dis-utils map)
-(define-key dis-utils-menu [auto-align2]
- '("Auto-Align2" . dis-align-columns))
-(define-key dis-utils-menu [auto-align]
- '("Auto-Align" . dis-auto-align-model))
+ (define-key map [auto-align2]
+ '("Auto-Align2" . dis-align-columns))
+ (define-key map [auto-align]
+ '("Auto-Align" . dis-auto-align-model))
+ map))
;; STATS pop-up-menu
-(defvar dis-stat-menu (make-sparse-keymap "Statistics"))
-(fset 'dis-stat dis-stat-menu)
+(defvar dis-stat-menu
+ (let ((map (make-sparse-keymap "Statistics")))
+ (fset 'dis-stat map)
-(define-key dis-stat-menu [stats]
- '("Print Statistics (not defined yet)" . undefined))
-(define-key dis-stat-menu [count]
- '("Count Codes (not defined yet)" . undefined))
+ (define-key map [stats]
+ '("Print Statistics (not defined yet)" . undefined))
+ (define-key map [count]
+ '("Count Codes (not defined yet)" . undefined))
+ map))
;; CODES pop-up-menu
-(defvar dis-code-menu (make-sparse-keymap "Codes"))
-(fset 'dis-code dis-code-menu)
-
-(define-key dis-code-menu [init]
- '("Initialize" . dis-initialize-operator-codes))
-(define-key dis-code-menu [load]
- '("Load" . dis-load-op-codes))
-(define-key dis-code-menu [code]
- '("Code" . dis-op-code-segment))
-(define-key dis-code-menu [save]
- '("Save" . dis-save-op-code))
+(defvar dis-code-menu
+ (let ((map (make-sparse-keymap "Codes")))
+ (fset 'dis-code map)
+
+ (define-key map [init]
+ '("Initialize" . dis-initialize-operator-codes))
+ (define-key map [load]
+ '("Load" . dis-load-op-codes))
+ (define-key map [code]
+ '("Code" . dis-op-code-segment))
+ (define-key map [save]
+ '("Save" . dis-save-op-code))
+ map))
;; KLM pop-up-menu
-(defvar dis-klm-menu (make-sparse-keymap "KLM"))
-(fset 'dis-klm dis-klm-menu)
+(defvar dis-klm-menu
+ (let ((map (make-sparse-keymap "KLM")))
+ (fset 'dis-klm map)
-(define-key dis-klm-menu [init]
- '("Initialize" . dismal-init-make-aliases))
-(define-key dis-klm-menu [dups]
- '("Display dups" . dismal-display-dup-aliases))
+ (define-key map [init]
+ '("Initialize" . dismal-init-make-aliases))
+ (define-key map [dups]
+ '("Display dups" . dismal-display-dup-aliases))
+ map))
;;;
;;; II.b OPTIONS item on menu-bar and all sub-menus
;;;
-(define-key dismal-mode-map [menu-bar options]
+(define-key dismal-menu-map [options]
(cons "dOpts" (make-sparse-keymap "Dis Options")))
-(define-key dismal-mode-map [menu-bar options zrange]
+(define-key dismal-menu-map [options zrange]
'("Redraw Range" . dis-redraw-range))
-(define-key dismal-mode-map [menu-bar options ruler-redraw]
+(define-key dismal-menu-map [options ruler-redraw]
'("Ruler Redraw" . dis-update-ruler))
-(define-key dismal-mode-map [menu-bar options row-redraw]
+(define-key dismal-menu-map [options row-redraw]
'("Redraw Row" . dis-hard-redraw-row))
-(define-key dismal-mode-map [menu-bar options column-redraw]
+(define-key dismal-menu-map [options column-redraw]
'("Redraw Column" . dis-redraw-column))
-(define-key dismal-mode-map [menu-bar options screen-redraw]
+(define-key dismal-menu-map [options screen-redraw]
'("Redraw Screen" . dis-redraw))
-(define-key dismal-mode-map [menu-bar options set-vari-menu]
+(define-key dismal-menu-map [options set-vari-menu]
'("Set dismal Variables" . dis-setv))
;; SetV pop-up-menu
(defvar dis-setv-menu
- (make-sparse-keymap "Set Variables"))
-(fset 'dis-setv dis-setv-menu)
-
-(define-key dis-setv-menu [middle-col]
- '("Middle Column" . dis-set-metacolumn))
-(define-key dis-setv-menu [auto-update]
- '("Auto Update" . dis-toggle-auto-update))
-(define-key dis-setv-menu [2ruler]
- '("Toggle Ruler" . dis-set-ruler))
-(define-key dis-setv-menu [ruler-row]
- '("Ruler Row" . dis-set-ruler-rows))
-(define-key dis-setv-menu [auto-update]
- '("Show update" . dis-toggle-show-update))
+ (let ((map (make-sparse-keymap "Set Variables")))
+ (fset 'dis-setv map)
+
+ (define-key map [middle-col]
+ '("Middle Column" . dis-set-metacolumn))
+ (define-key map [auto-update]
+ '("Auto Update" . dis-toggle-auto-update))
+ (define-key map [2ruler]
+ '("Toggle Ruler" . dis-set-ruler))
+ (define-key map [ruler-row]
+ '("Ruler Row" . dis-set-ruler-rows))
+ (define-key map [auto-update]
+ '("Show update" . dis-toggle-show-update))
+ map))
;; changed to ruler-rowS, 25-May-96 -FER
@@ -139,12 +148,12 @@
;;; II.c DOC item on menu-bar and all sub-menus
;;;
-(define-key dismal-mode-map [menu-bar doc.]
+(define-key dismal-menu-map [doc.]
(cons "dDoc" (make-sparse-keymap "Dis Doc")))
-(define-key dismal-mode-map [menu-bar doc. show]
+(define-key dismal-menu-map [doc. show]
'("Full Dismal Documentation" . dis-open-dis-manual))
-(define-key dismal-mode-map [menu-bar doc. about]
+(define-key dismal-menu-map [doc. about]
'("About Dismal mode" . describe-mode))
(defun dis-open-dis-manual ()
@@ -156,20 +165,20 @@
;;; II.d FORMAT item on menu-bar and all sub-menus
;;;
-(define-key dismal-mode-map [menu-bar format]
+(define-key dismal-menu-map [format]
(cons "dFormat" (make-sparse-keymap "Dis Format")))
-(define-key dismal-mode-map [menu-bar format update-r]
+(define-key dismal-menu-map [format update-r]
'("Update Ruler" . dis-update-ruler))
-(define-key dismal-mode-map [menu-bar format fonts]
+(define-key dismal-menu-map [format fonts]
'("Set Font" . mouse-set-font))
-(define-key dismal-mode-map [menu-bar format auto-width]
+(define-key dismal-menu-map [format auto-width]
'("Automatic Width" . dis-auto-column-width))
-(define-key dismal-mode-map [menu-bar format width]
+(define-key dismal-menu-map [format width]
'("Set Col Width" . dis-read-column-width))
-(define-key dismal-mode-map [menu-bar format align]
+(define-key dismal-menu-map [format align]
'("Alignment" . dis-set-alignment))
-(define-key dismal-mode-map [menu-bar format number]
+(define-key dismal-menu-map [format number]
'("Decimal width" . dis-set-column-decimal))
@@ -183,34 +192,34 @@
;;; II.e COMMANDS item on menu-bar and all sub-menus
;;;
-(define-key dismal-mode-map [menu-bar commands]
+(define-key dismal-menu-map [commands]
(cons "dComms" (make-sparse-keymap "Dis Commands")))
-(define-key dismal-mode-map [menu-bar commands 0log]
+(define-key dismal-menu-map [commands 0log]
'("Logging-Off" . log-quit))
-(define-key dismal-mode-map [menu-bar commands 1log]
+(define-key dismal-menu-map [commands 1log]
'("Logging-On" . log-session-mode))
-(define-key dismal-mode-map [menu-bar commands deblnk]
+(define-key dismal-menu-map [commands deblnk]
'("Del Blank Rows" . dis-delete-blank-rows))
-(define-key dismal-mode-map [menu-bar commands qrep]
+(define-key dismal-menu-map [commands qrep]
'("Query-Replace" . dis-query-replace))
-(define-key dismal-mode-map [menu-bar commands hupdt]
+(define-key dismal-menu-map [commands hupdt]
'("Hard-Update" . dis-recalculate-matrix))
-(define-key dismal-mode-map [menu-bar commands updt]
+(define-key dismal-menu-map [commands updt]
'("Update" . dis-update-matrix))
-(define-key dismal-mode-map [menu-bar commands lisfns]
+(define-key dismal-menu-map [commands lisfns]
'("List dismal user functions" . dis-show-functions))
-(define-key dismal-mode-map [menu-bar commands filrng]
+(define-key dismal-menu-map [commands filrng]
'("Fill Range" . dis-fill-range))
-(define-key dismal-mode-map [menu-bar commands expand]
+(define-key dismal-menu-map [commands expand]
'("Expand hidden cols in range" . dis-expand-cols-in-range))
-(define-key dismal-mode-map [menu-bar commands redrw]
+(define-key dismal-menu-map [commands redrw]
'("Redraw Display" . dis-redraw))
-;;(define-key dismal-mode-map [menu-bar commands dep-clean]
+;;(define-key dismal-menu-map [commands dep-clean]
;; '("Dependencies-clean" . dis-fix-dependencies))
-(define-key dismal-mode-map [menu-bar commands cp2dis]
+(define-key dismal-menu-map [commands cp2dis]
'("Copy text into Dismal" . dis-copy-to-dismal))
-(define-key dismal-mode-map [menu-bar commands align]
+(define-key dismal-menu-map [commands align]
'("Align Metacolumns" . dis-align-metacolumns))
@@ -218,56 +227,58 @@
;;; II.f GO item on menu-bar and all sub-menus
;;;
-(define-key dismal-mode-map [menu-bar go]
+(define-key dismal-menu-map [go]
(cons "dGo" (make-sparse-keymap "Dis Go")))
-(define-key dismal-mode-map [menu-bar go Jump]
+(define-key dismal-menu-map [go Jump]
'("Jump to cell>" . dis-jump))
-(define-key dismal-mode-map [menu-bar go End]
+(define-key dismal-menu-map [go End]
'("End of sheet" . dis-end-of-buffer))
-(define-key dismal-mode-map [menu-bar go Begin]
+(define-key dismal-menu-map [go Begin]
'("Beginning of sheet" . dis-beginning-of-buffer))
;; These either don't work and/or aren't necessary
-;; (define-key dismal-mode-map [menu-bar go Scroll-Right]
+;; (define-key dismal-menu-map [go Scroll-Right]
;; '("-->" . scroll-right))
-;; (define-key dismal-mode-map [menu-bar go Scroll-Left]
+;; (define-key dismal-menu-map [go Scroll-Left]
;; '("<--" . scroll-left))
-(define-key dismal-mode-map [menu-bar go Row]
+(define-key dismal-menu-map [go Row]
'("Row" . dis-row))
-(define-key dismal-mode-map [menu-bar go Column]
+(define-key dismal-menu-map [go Column]
'("Column" . dis-column))
;; ROW pop-up-menu
(defvar dis-row-menu
- (make-sparse-keymap "Row"))
-(fset 'dis-row dis-row-menu)
+ (let ((map (make-sparse-keymap "Row")))
+ (fset 'dis-row map)
-(define-key dis-row-menu [back]
- '("Back a row" . dis-backward-row))
-(define-key dis-row-menu [forward]
- '("Forward a row" . dis-forward-row))
-(define-key dis-row-menu [last]
- '("Goto Last row" . dis-last-row))
-(define-key dis-row-menu [first]
- '("Goto First row" . dis-first-row))
+ (define-key map [back]
+ '("Back a row" . dis-backward-row))
+ (define-key map [forward]
+ '("Forward a row" . dis-forward-row))
+ (define-key map [last]
+ '("Goto Last row" . dis-last-row))
+ (define-key map [first]
+ '("Goto First row" . dis-first-row))
+ map))
;; COLUMN pop-up-menu
(defvar dis-column-menu
- (make-sparse-keymap "Column"))
-(fset 'dis-column dis-column-menu)
-
-(define-key dis-column-menu [back]
- '("Back a column" . dis-backward-column))
-(define-key dis-column-menu [forward]
- '("Forward a column" . dis-forward-column))
-(define-key dis-column-menu [last]
- '("Goto Last column" . dis-end-of-col))
-(define-key dis-column-menu [first]
- '("Goto First column" . dis-start-of-col))
+ (let ((map (make-sparse-keymap "Column")))
+ (fset 'dis-column map)
+
+ (define-key map [back]
+ '("Back a column" . dis-backward-column))
+ (define-key map [forward]
+ '("Forward a column" . dis-forward-column))
+ (define-key map [last]
+ '("Goto Last column" . dis-end-of-col))
+ (define-key map [first]
+ '("Goto First column" . dis-start-of-col))
+ map))
;;;
@@ -275,140 +286,144 @@
;;;
;; Remove other edit, since it contains dangerous commands.
-(define-key dismal-mode-map [menu-bar edit] 'undefined)
-(define-key dismal-mode-map [menu-bar search] 'undefined)
-(define-key dismal-mode-map [menu-bar files] 'undefined)
+(define-key dismal-menu-map [edit] 'undefined)
+(define-key dismal-menu-map [search] 'undefined)
+(define-key dismal-menu-map [files] 'undefined)
-(define-key dismal-mode-map [menu-bar dedit]
+(define-key dismal-menu-map [dedit]
(cons "dEdit" (make-sparse-keymap "Dis Edit")))
-(define-key dismal-mode-map [menu-bar dedit modify]
+(define-key dismal-menu-map [dedit modify]
'("Modify cell justification" . dis-modify))
-(define-key dismal-mode-map [menu-bar dedit delete]
+(define-key dismal-menu-map [dedit delete]
'("Delete" . dis-delete))
-(define-key dismal-mode-map [menu-bar dedit insert]
+(define-key dismal-menu-map [dedit insert]
'("Insert" . dis-insert))
-(define-key dismal-mode-map [menu-bar dedit set]
+(define-key dismal-menu-map [dedit set]
'("Edit cell" . dis-edit-cell-plain))
-(define-key dismal-mode-map [menu-bar dedit erase]
+(define-key dismal-menu-map [dedit erase]
'("Erase range" . dis-erase-range))
-(define-key dismal-mode-map [menu-bar dedit yank]
+(define-key dismal-menu-map [dedit yank]
'("Yank" . dis-paste-range))
-(define-key dismal-mode-map [menu-bar dedit copy]
+(define-key dismal-menu-map [dedit copy]
'("Copy range" . dis-copy-range))
-(define-key dismal-mode-map [menu-bar dedit kill]
+(define-key dismal-menu-map [dedit kill]
'("Kill range" . dis-kill-range))
-;; (define-key dismal-mode-map [menu-bar dedit undo]
+;; (define-key dismal-menu-map [dedit undo]
;; '("Undo" . undefined))
;; MODIFY pop-up-menu
(defvar dis-modify-menu
- (make-sparse-keymap "Modify"))
-(fset 'dis-modify dis-modify-menu)
-
-(define-key dis-modify-menu [e]
- '("Plain" . dis-edit-cell-plain))
-(define-key dis-modify-menu [|]
- '("Center" . dis-edit-cell-center))
-(define-key dis-modify-menu [=]
- '("Default" . dis-edit-cell-default))
-(define-key dis-modify-menu [<]
- '("Left" . dis-edit-cell-leftjust))
-(define-key dis-modify-menu [>]
- '("Right" . dis-edit-cell-rightjust))
+ (let ((map (make-sparse-keymap "Modify")))
+ (fset 'dis-modify map)
+
+ (define-key map [e]
+ '("Plain" . dis-edit-cell-plain))
+ (define-key map [|]
+ '("Center" . dis-edit-cell-center))
+ (define-key map [=]
+ '("Default" . dis-edit-cell-default))
+ (define-key map [<]
+ '("Left" . dis-edit-cell-leftjust))
+ (define-key map [>]
+ '("Right" . dis-edit-cell-rightjust))
+ map))
;; DELETE pop-up-menu
(defvar dis-delete-menu
- (make-sparse-keymap "Delete"))
-(fset 'dis-delete dis-delete-menu)
+ (let ((map (make-sparse-keymap "Delete")))
+ (fset 'dis-delete map)
-(define-key dis-delete-menu [marked-range]
- '("Marked-range" . dis-delete-range))
-(define-key dis-delete-menu [column]
- '("Column" . dis-delete-column))
-(define-key dis-delete-menu [row]
- '("Row" . dis-delete-row))
+ (define-key map [marked-range]
+ '("Marked-range" . dis-delete-range))
+ (define-key map [column]
+ '("Column" . dis-delete-column))
+ (define-key map [row]
+ '("Row" . dis-delete-row))
+ map))
;; INSERT pop-up-menu
(defvar dis-insert-menu
- (make-sparse-keymap "Insert"))
-
-(fset 'dis-insert dis-insert-menu)
-
-(define-key dis-insert-menu [z-box]
- '("Z-Box" . dis-insert-z-box))
-(define-key dis-insert-menu [marked-range]
- '("Marked-Range" . dis-insert-range))
-(define-key dis-insert-menu [lcells]
- '("Cells" . dis-insert-cells))
-(define-key dis-insert-menu [column]
- '("Column" . dis-insert-column))
-(define-key dis-insert-menu [row]
- '("Row" . dis-insert-row))
+ (let ((map (make-sparse-keymap "Insert")))
+
+ (fset 'dis-insert map)
+
+ (define-key map [z-box]
+ '("Z-Box" . dis-insert-z-box))
+ (define-key map [marked-range]
+ '("Marked-Range" . dis-insert-range))
+ (define-key map [lcells]
+ '("Cells" . dis-insert-cells))
+ (define-key map [column]
+ '("Column" . dis-insert-column))
+ (define-key map [row]
+ '("Row" . dis-insert-row))
+ map))
;; SET pop-up-menu
(defvar dis-set-menu
- (make-sparse-keymap "Set Cell Parameters"))
-(fset 'dis-set dis-set-menu)
-
-(define-key dis-set-menu [center]
- '("Center Justified" . dis-edit-cell-center))
-(define-key dis-set-menu [general]
- '("Plain" . dis-edit-cell))
-(define-key dis-set-menu [left]
- '("Left Justified" . dis-edit-cell-leftjust))
-(define-key dis-set-menu [right]
- '("Right Justified" . dis-edit-cell-rightjust))
+ (let ((map (make-sparse-keymap "Set Cell Parameters")))
+ (fset 'dis-set map)
+
+ (define-key map [center]
+ '("Center Justified" . dis-edit-cell-center))
+ (define-key map [general]
+ '("Plain" . dis-edit-cell))
+ (define-key map [left]
+ '("Left Justified" . dis-edit-cell-leftjust))
+ (define-key map [right]
+ '("Right Justified" . dis-edit-cell-rightjust))
+ map))
;;;
;;; II.h File item on menu-bar and all sub-menus
;;;
-;;; These are pushed on, it appears.
+;; These are pushed on, it appears.
-(define-key dismal-mode-map [menu-bar Dfile]
+(define-key dismal-menu-map [Dfile]
(cons "dFile" (make-sparse-keymap "Dis File")))
-(define-key dismal-mode-map [menu-bar Dfile Quit]
+(define-key dismal-menu-map [Dfile Quit]
'("Kill current buffer" . kill-buffer))
-(define-key dismal-mode-map [menu-bar Dfile Unpage]
+(define-key dismal-menu-map [Dfile Unpage]
'("Unpaginate dismal report" . dis-unpaginate))
-(define-key dismal-mode-map [menu-bar Dfile TeXdump1]
+(define-key dismal-menu-map [Dfile TeXdump1]
'("TeX Dump file (raw)" . dis-tex-dump-range))
-(define-key dismal-mode-map [menu-bar Dfile TeXdump2]
+(define-key dismal-menu-map [Dfile TeXdump2]
'("TeX Dump file (with TeX header)" . dis-tex-dump-range-file))
-(define-key dismal-mode-map [menu-bar Dfile htmldumprange]
+(define-key dismal-menu-map [Dfile htmldumprange]
'("Dump range as HTML table" . dis-html-dump-range))
-(define-key dismal-mode-map [menu-bar Dfile htmldumpfile]
+(define-key dismal-menu-map [Dfile htmldumpfile]
'("Dump file as HTML table" . dis-html-dump-file))
-(define-key dismal-mode-map [menu-bar Dfile Rdump]
+(define-key dismal-menu-map [Dfile Rdump]
'("Range-Dump (tabbed)" . dis-dump-range))
-(define-key dismal-mode-map [menu-bar Dfile Tdump]
+(define-key dismal-menu-map [Dfile Tdump]
'("Tabbed-Dump file" . dis-write-tabbed-file))
-(define-key dismal-mode-map [menu-bar Dfile PPrin]
+(define-key dismal-menu-map [Dfile PPrin]
'("Paper-Print" . dis-print-report))
-(define-key dismal-mode-map [menu-bar Dfile FPrin]
+(define-key dismal-menu-map [Dfile FPrin]
'("File-Print" . dis-make-report))
-(define-key dismal-mode-map [menu-bar Dfile 2Prin]
+(define-key dismal-menu-map [Dfile 2Prin]
'("Print Setup" . dis-print-setup))
-(define-key dismal-mode-map [menu-bar Dfile insert-file]
+(define-key dismal-menu-map [Dfile insert-file]
'("Insert File..." . dis-insert-file))
-(define-key dismal-mode-map [menu-bar Dfile Write]
+(define-key dismal-menu-map [Dfile Write]
'("Save buffer as..." . dis-write-file))
-(define-key dismal-mode-map [menu-bar Dfile Save]
+(define-key dismal-menu-map [Dfile Save]
'("Save" . dis-save-file))
-(define-key dismal-mode-map [menu-bar Dfile Open]
+(define-key dismal-menu-map [Dfile Open]
'("Open file" . find-file))
-(define-key dismal-mode-map [menu-bar Dfile New]
+(define-key dismal-menu-map [Dfile New]
'("New sheet" . dis-find-file))
(provide 'dismal-menu3)
diff --git a/dismal.el b/dismal.el
index 6fe6e25..e830717 100644
--- a/dismal.el
+++ b/dismal.el
@@ -4,7 +4,7 @@
;; Author: David Fox, f...@cs.nyu.edu
;; Frank E. Ritter, rit...@cs.cmu.edu
-;; Maintainer: FSF
+;; Maintainer: UnMaintainer <emacs-de...@gnu.org>
;; Created-On: 31 Oct 1991.
;; Version: 1.5
;; Package-Requires: ((cl-lib "0"))
@@ -99,6 +99,7 @@
(eval-when-compile (require 'cl-lib))
(require 'dismal-mouse3)
+(require 'dismal-menu3)
;;;; v. Global user visible variables
@@ -269,7 +270,7 @@ confirmed on entering.")
(defvar dismal-mode-map
(let ((map (make-composed-keymap dismal-mouse-map)))
(suppress-keymap map)
-
+ (define-key map [menu-bar] dismal-menu-map)
;; could del work appropriately?
;; box keys first
@@ -2179,13 +2180,7 @@ argument, inserts the month first."
;;;; VIII. Changed movement functions
-;; used to use
-;;(require 'dismal-mouse-x)
-
;; moved down here so they would load, 19-Jun-96 -FER
-(when t ;; Don't do those `require' at compile-time.
- (provide 'dismal)
- (require 'dismal-menu3))
;; 2-8-93 - EMA: behaves just like move-to-window-line:
(defun dis-move-to-window-line (arg)
@@ -3953,8 +3948,8 @@ Prefix arg (or optional second arg non-nil) UNDO means
uncompress."
;; (dismal-file-header mode-name-to-write)
;; (insert "\n")
;; (mapc (lambda (x)
-;; (let ((real-x (save-excursion (set-buffer real-buffer)
-;; (eval x))))
+;; (let ((real-x (with-current-buffer real-buffer
+;; (symbol-value x))))
;; (insert "(setq " (prin1-to-string x) " '"
;; (prin1-to-string real-x) ")\n")))
;; dismal-saved-variables)
