defmacroの「`」の使い方がずいぶん前に変わってるとして少しの修正を試みたが、ちゃんとエラーになる。
===================================================================
RCS file: RCS/hnf-mode.el,v
retrieving revision 1.1
diff -u -r1.1 hnf-mode.el
--- hnf-mode.el 2023/10/23 09:26:09 1.1
+++ hnf-mode.el 2023/10/26 02:54:59
@@ -3,7 +3,7 @@
;; Copyright (C) 1998-2001 by Akihiro Arisawa
;; Author: Akihiro Arisawa <ari@nijino.com>
-;; Version: $Id: hnf-mode.el,v 1.1 2023/10/23 09:26:09 nakaji Exp $
+;; Version: $Id: hnf-mode.el,v 1.2 2023/10/24 05:49:29 nakaji Exp nakaji $
;; Keywords: hnf nikki hns
;; This file is free software; you can redistribute it and/or modify
@@ -23,9 +23,8 @@
;;; Code:
-(defconst hnf-mode-version "2.5")
+(defconst hnf-mode-version "2.5p1")
-(eval-when-compile (require 'cl))
(require 'poe)
(require 'pcustom)
@@ -68,7 +67,7 @@
(defcustom hnf-index-name-list '("index.html" "index.shtml" "index.phtml")
"File name as index."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-mode-hook nil
"Hook colled by `hnf-mode'."
@@ -88,37 +87,37 @@
(defcustom hnf-variable nil
"Variable name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-rlink nil
"RLINK name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-cat nil
"Category name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-group nil
"Group name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-class nil
"Class name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-mark nil
"MARK name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-alias nil
"ALIAS name used in hnf."
:group 'hnf
- :type 'list)
+ :type '(list string))
(defcustom hnf-font-lock-flag t
"Non-nil means font-lock is used."
@@ -174,7 +173,9 @@
For example, hns-1.03pl0 or earlyer format is \"?%Y%m%h#%Y%m%d%N\",
hns-2.10 or later format is \"?%Y%m%a&to=%Y%m%d%N#%Y%m%d%N\",
-static format is \"%Y%m.html#%Y%m%d%N\".")
+static format is \"%Y%m.html#%Y%m%d%N\"."
+ :group 'hnf
+ :type 'string)
(defcustom hnf-sub-link-name-format "?%Y%m%d%N&to=%Y%m%d%NS%S#%Y%m%d%NS%S"
"The format specification of SUB line link name in `hnf-get-link'.
@@ -182,7 +183,9 @@
For example, hns-1.03pl0 or earlyer format is \"?%Y%m%h#%Y%m%d%NS%S\",
hns-2.10 or later format is \"?%Y%m%a&to=%Y%m%d%NS%S#%Y%m%d%NS%S\",
-static format is \"%Y%m.html#%Y%m%d%NS%S\".")
+static format is \"%Y%m.html#%Y%m%d%NS%S\"."
+ :group 'hnf
+ :type 'string)
(defcustom hnf-hour-not-today 0
"Till the specified hour, considered as the day before.
@@ -279,7 +282,7 @@
(sub . ((outline-level . 2)
(face . hnf-sub-face)))))
(defmacro hnf-command-type-get-variable (type key)
- (` (cdr (assq (, key) (cdr (assq (, type) hnf-command-type-alist))))))
+ `(cdr (assq (, key) (cdr (assq (, type) hnf-command-type-alist)))))
(defvar hnf-commands-table
'(("NEW" . ((type . new)
@@ -373,25 +376,25 @@
"Table of hnf commands.")
(defmacro hnf-command-get-command (command-name)
- (` (assoc (, command-name) hnf-commands-table)))
+ `(assoc (, command-name) hnf-commands-table))
(defmacro hnf-command-get-type (command)
- (` (cdr (assq 'type (cdr (, command))))))
+ `(cdr (assq 'type (cdr (, command)))))
(defmacro hnf-command-get-variable (command key)
- (` (cond ((cdr (assq (, key) (cdr (, command)))))
- ((hnf-command-type-get-variable (hnf-command-get-type (, command))
- (, key))))))
-
+ `(cond ((cdr (assq (, key) (cdr (, command)))))
+ ((hnf-command-type-get-variable (hnf-command-get-type (, command))
+ (, key)))))
+
(defmacro hnf-command-get-arg-detail (command count)
- (` (let ((args (hnf-command-get-variable (, command) 'args)))
- (if (or (eq (nth (, count) args) 'any)
- (eq (nth 1 args) 'any))
- (nth 0 args)
- (nth (, count) args)))))
+ `(let ((args (hnf-command-get-variable (, command) 'args)))
+ (if (or (eq (nth (, count) args) 'any)
+ (eq (nth 1 args) 'any))
+ (nth 0 args)
+ (nth (, count) args))))
(defmacro hnf-command-need-close-p (command)
- (` (assq 'need-close (cdr (, command)))))
+ `(assq 'need-close (cdr (, command))))
(defvar hnf-font-lock-keywords nil
"Expressions to highlight in hnf mode.")
Debugger entered--Lisp error: (invalid-function 'outline-level)
('outline-level)
(assq ('outline-level) (cdr (command)))
(cdr (assq ('outline-level) (cdr (command))))
(cond ((cdr (assq ('outline-level) (cdr (command))))) ((cdr (assq (('outline-level)) (cdr (assq ((hnf-command-get-type ...)) hnf-command-type-alist))))))
(if (cond ((cdr (assq ('outline-level) (cdr (command))))) ((cdr (assq (('outline-level)) (cdr (assq (...) hnf-command-type-alist)))))) (let* ((x (car command))) (if (member x outline-commands) outline-commands (setq outline-commands (cons x outline-commands)))))
(while (setq command (car commands)) (if (cond ((cdr (assq ('outline-level) (cdr (command))))) ((cdr (assq ((...)) (cdr (assq ... hnf-command-type-alist)))))) (let* ((x (car command))) (if (member x outline-commands) outline-commands (setq outline-commands (cons x outline-commands))))) (setq commands (cdr commands)))
(let ((commands hnf-commands-table) command outline-commands) (while (setq command (car commands)) (if (cond ((cdr (assq (...) (cdr ...)))) ((cdr (assq (...) (cdr ...))))) (let* ((x (car command))) (if (member x outline-commands) outline-commands (setq outline-commands (cons x outline-commands))))) (setq commands (cdr commands))) (mapconcat #'identity outline-commands "\\|"))
(defvar hnf-outline-regexp (let ((commands hnf-commands-table) command outline-commands) (while (setq command (car commands)) (if (cond ((cdr (assq ... ...))) ((cdr (assq ... ...)))) (let* ((x (car command))) (if (member x outline-commands) outline-commands (setq outline-commands (cons x outline-commands))))) (setq commands (cdr commands))) (mapconcat #'identity outline-commands "\\|")) "Regular expression to match the beginning of heading.")
eval-buffer(#<buffer *load*> nil "/home/nakaji/elisp/hnf-mode.el" nil t) ; Reading at buffer position 13597
load-with-code-conversion("/home/nakaji/elisp/hnf-mode.el" "/home/nakaji/elisp/hnf-mode.el" nil t)
autoload-do-load((autoload "hnf-mode" "Hyper Nikki File mode" t nil) hnf-mode)
command-execute(hnf-mode record)
execute-extended-command(nil "hnf-mode" "hnf-mo")
funcall-interactively(execute-extended-command nil "hnf-mode" "hnf-mo")
call-interactively(execute-extended-command nil nil)
command-execute(execute-extended-command)
hns-setupを実行後、defined(%array) な箇所のdefinedを全部消して回ったらとりあえず動いた。ただし、付属のhnf-mode.elは、Emacs 30では動かない。
$ freebsd-version
13.2-RELEASE-p4
$ httpd -v
Server version: Apache/2.4.57 (FreeBSD)
$ perl -v
This is perl 5, version 34, subversion 1 (v5.34.1) built for amd64-freebsd-thread-multi
$ pkg info -a | grep ja-hns
ja-hns-2.19.9_1 Hyper NIKKI System, a CGI system for Electric Diary Interchange
Debugger entered--Lisp error: (invalid-function `(cond ((cdr (assq (,key) (cdr (...))))) ((hnf-command-type-get-variable (hnf-command-get-type (,command)) (,key)))))
(`(cond ((cdr (assq (,key) (cdr (...))))) ((hnf-command-type-get-variable (hnf-command-get-type (,command)) (,key)))))
(lambda (command key) (`(cond ((cdr (assq ... ...))) ((hnf-command-type-get-variable (hnf-command-get-type ...) (...))))))(command 'face)
apply((lambda (command key) (`(cond ((cdr (assq ... ...))) ((hnf-command-type-get-variable (hnf-command-get-type ...) (...)))))) (command 'face))
macroexpand-1((hnf-command-get-variable command 'face) nil)
macroexp-macroexpand((hnf-command-get-variable command 'face) nil)
macroexp--expand-all((hnf-command-get-variable command 'face))
macroexp--expand-all((setq face (hnf-command-get-variable command 'face)))
macroexp--all-forms((if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command 'args)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face (cond (... ...) (... ...) (... ...))) (add-to-list 'ret2 (list (concat "^" ... " +" ... "\\([^ ]+\\)") 1 face))) (setq cnt (1+ cnt) args (cdr args))))) 1)
#f(compiled-function (form func) #<bytecode -0x627bbee1c67261>)(((if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command 'args)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face (cond ... ... ...)) (add-to-list 'ret2 (list ... 1 face))) (setq cnt (1+ cnt) args (cdr args)))))) if)
macroexp--expand-all((if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command 'args)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face (cond (... ...) (... ...) (... ...))) (add-to-list 'ret2 (list (concat "^" ... " +" ... "\\([^ ]+\\)") 1 face))) (setq cnt (1+ cnt) args (cdr args))))))
macroexp--all-forms((while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command 'args)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face (cond ... ... ...)) (add-to-list 'ret2 (list ... 1 face))) (setq cnt (1+ cnt) args (cdr args))))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands))) 1)
#f(compiled-function (form func) #<bytecode -0x627bbee1c67261>)(((while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command ...)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face ...) (add-to-list ... ...)) (setq cnt (1+ cnt) args (cdr args))))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands)))) while)
macroexp--expand-all((while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command 'args)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face (cond ... ... ...)) (add-to-list 'ret2 (list ... 1 face))) (setq cnt (1+ cnt) args (cdr args))))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands))))
macroexp--all-forms(((while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command ...)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face ...) (add-to-list ... ...)) (setq cnt (1+ cnt) args (cdr args))))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands))) (append ret1 ret2 (list (cons (concat "^\\(" (mapconcat #'identity ret3 "\\|") "\\)\\>") hnf-command-face)) (list '(eval list (concat "^\\(" (mapconcat ... hnf-variable "\\|") "\\)\\>") '(0 ...))) (list (cons "~$" hnf-tilde-face)))))
macroexp--expand-all((let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" (car command) ".*") face)) (let ((args (hnf-command-get-variable command ...)) (cnt 0) arg) (while (setq arg (car args)) (if (setq face ...) (add-to-list ... ...)) (setq cnt (1+ cnt) args (cdr args))))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands))) (append ret1 ret2 (list (cons (concat "^\\(" (mapconcat #'identity ret3 "\\|") "\\)\\>") hnf-command-face)) (list '(eval list (concat "^\\(" (mapconcat ... hnf-variable "\\|") "\\)\\>") '(0 ...))) (list (cons "~$" hnf-tilde-face)))))
macroexp--expand-all((setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command (car commands)) (if (setq face (hnf-command-get-variable command 'face)) (add-to-list 'ret1 (cons (concat "^" ... ".*") face)) (let ((args ...) (cnt 0) arg) (while (setq arg ...) (if ... ...) (setq cnt ... args ...)))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat (car command) "\\|/" (car command)) (car command))) (setq commands (cdr commands))) (append ret1 ret2 (list (cons (concat "^\\(" (mapconcat ... ret3 "\\|") "\\)\\>") hnf-command-face)) (list '(eval list (concat "^\\(" ... "\\)\\>") '...)) (list (cons "~$" hnf-tilde-face))))))
macroexp--all-forms((lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command (car commands)) (if (setq face (hnf-command-get-variable command ...)) (add-to-list 'ret1 (cons ... face)) (let (... ... arg) (while ... ... ...))) (add-to-list 'ret3 (if (hnf-command-need-close-p command) (concat ... "\\|/" ...) (car command))) (setq commands (cdr commands))) (append ret1 ret2 (list (cons (concat "^\\(" ... "\\)\\>") hnf-command-face)) (list '(eval list ... ...)) (list (cons "~$" hnf-tilde-face)))))) 2)
macroexp--expand-all(#'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command (car commands)) (if (setq face ...) (add-to-list ... ...) (let ... ...)) (add-to-list 'ret3 (if ... ... ...)) (setq commands (cdr commands))) (append ret1 ret2 (list (cons ... hnf-command-face)) (list '...) (list (cons "~$" hnf-tilde-face)))))))
macroexp--all-forms((defalias 'hnf-font-lock-keywords-creation #'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command ...) (if ... ... ...) (add-to-list ... ...) (setq commands ...)) (append ret1 ret2 (list ...) (list ...) (list ...)))))) 1)
#f(compiled-function (form func) #<bytecode -0x627bbee1c67261>)(((defalias 'hnf-font-lock-keywords-creation #'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let (... command type face ret1 ret2 ret3) (while ... ... ... ...) (append ret1 ret2 ... ... ...)))))) defalias)
macroexp--expand-all((defalias 'hnf-font-lock-keywords-creation #'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command ...) (if ... ... ...) (add-to-list ... ...) (setq commands ...)) (append ret1 ret2 (list ...) (list ...) (list ...)))))))
macroexpand--all-toplevel((defalias 'hnf-font-lock-keywords-creation #'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command ...) (if ... ... ...) (add-to-list ... ...) (setq commands ...)) (append ret1 ret2 (list ...) (list ...) (list ...)))))))
internal-macroexpand-for-load((defalias 'hnf-font-lock-keywords-creation #'(lambda nil "Create font-lock-keywords from `hnf-commands-table'." (setq hnf-font-lock-keywords (let ((commands hnf-commands-table) command type face ret1 ret2 ret3) (while (setq command ...) (if ... ... ...) (add-to-list ... ...) (setq commands ...)) (append ret1 ret2 (list ...) (list ...) (list ...)))))) t)
eval-buffer(#<buffer *load*> nil "/home/nakaji/elisp/hnf-mode.el" nil t) ; Reading at buffer position 13119
load-with-code-conversion("/home/nakaji/elisp/hnf-mode.el" "/home/nakaji/elisp/hnf-mode.el" nil t)
autoload-do-load((autoload "hnf-mode" "Hyper Nikki File mode" t nil) hnf-mode)
command-execute(hnf-mode record)
execute-extended-command(nil "hnf-mode" "hnf-mo")
funcall-interactively(execute-extended-command nil "hnf-mode" "hnf-mo")
call-interactively(execute-extended-command nil [27 120])
(if bind (call-interactively bind nil keys) (let (message-log-max) (message "%s is undefined" (key-description keys)) (undefined)))
(let* ((keys (read-key-sequence-vector nil)) (bind (key-binding keys t))) (setq last-command-event (aref keys (1- (length keys)))) (setq this-command bind) (if bind (call-interactively bind nil keys) (let (message-log-max) (message "%s is undefined" (key-description keys)) (undefined))))
(progn (mozc-disable-keymap) (and last-event (setq unread-command-events (cons last-event unread-command-events))) (let* ((keys (read-key-sequence-vector nil)) (bind (key-binding keys t))) (setq last-command-event (aref keys (1- (length keys)))) (setq this-command bind) (if bind (call-interactively bind nil keys) (let (message-log-max) (message "%s is undefined" (key-description keys)) (undefined)))))
(unwind-protect (progn (mozc-disable-keymap) (and last-event (setq unread-command-events (cons last-event unread-command-events))) (let* ((keys (read-key-sequence-vector nil)) (bind (key-binding keys t))) (setq last-command-event (aref keys (1- (length keys)))) (setq this-command bind) (if bind (call-interactively bind nil keys) (let (message-log-max) (message "%s is undefined" (key-description keys)) (undefined))))) (mozc-enable-keymap))
mozc-fall-back-on-default-binding(escape)
(cond ((null output) (mozc-clean-up-session) (mozc-abort) (signal 'mozc-response-error output)) ((mozc-protobuf-get output 'consumed) (let ((result (mozc-protobuf-get output 'result)) (preedit (mozc-protobuf-get output 'preedit)) (candidates (mozc-protobuf-get output 'candidates))) (if (not (or result preedit)) (mozc-clean-up-changes-on-buffer) (if result (progn (mozc-clean-up-changes-on-buffer) (if (eq ... ...) nil (message "mozc.el: Unknown result type") (signal ... ...)) (insert (mozc-protobuf-get result ...)))) (if preedit (mozc-preedit-update preedit candidates) (mozc-preedit-clear)) (if candidates (mozc-candidate-update candidates) (mozc-candidate-clear))))) (t (mozc-clean-up-changes-on-buffer) (mozc-fall-back-on-default-binding event)))
(let ((output (mozc-send-key-event event))) (cond ((null output) (mozc-clean-up-session) (mozc-abort) (signal 'mozc-response-error output)) ((mozc-protobuf-get output 'consumed) (let ((result (mozc-protobuf-get output 'result)) (preedit (mozc-protobuf-get output 'preedit)) (candidates (mozc-protobuf-get output 'candidates))) (if (not (or result preedit)) (mozc-clean-up-changes-on-buffer) (if result (progn (mozc-clean-up-changes-on-buffer) (if ... nil ... ...) (insert ...))) (if preedit (mozc-preedit-update preedit candidates) (mozc-preedit-clear)) (if candidates (mozc-candidate-update candidates) (mozc-candidate-clear))))) (t (mozc-clean-up-changes-on-buffer) (mozc-fall-back-on-default-binding event))))
(cond ((or (integerp event) (symbolp event)) (let ((output (mozc-send-key-event event))) (cond ((null output) (mozc-clean-up-session) (mozc-abort) (signal 'mozc-response-error output)) ((mozc-protobuf-get output 'consumed) (let ((result ...) (preedit ...) (candidates ...)) (if (not ...) (mozc-clean-up-changes-on-buffer) (if result ...) (if preedit ... ...) (if candidates ... ...)))) (t (mozc-clean-up-changes-on-buffer) (mozc-fall-back-on-default-binding event))))) (t (mozc-fall-back-on-default-binding event)))
mozc-handle-event(escape)
funcall-interactively(mozc-handle-event escape)
call-interactively(mozc-handle-event nil nil)
command-execute(mozc-handle-event)