TSUCHIYA Masatoshi
tsuch****@namaz*****
2002年 10月 1日 (火) 13:03:56 JST
3つ提案です．
1つ目は，record を消す機能の実装です．現在，*LSDB* バッファで record
の先頭部分(= が表示されている部分)で d を押すと，どの entry を削除する
かを質問するようになっています．これを改造して，その record 全体を削除
するようにしてみました．
(lsdb-delete-record-functions): New option.
(lsdb-delete-address-cache): New function.
(lsdb-delete-record): Ditto.
(lsdb-mode-delete-entry): If the cursor is on the first line of a
database entry (the name line) then the entire entry will be
deleted.
;; うっかり spam が ~/.lsdb に混入すると全体を消したくなるので実装しま
;; した．
2つ目は name の部分を編集する機能の実装です．現在，*LSDB* バッファで
record の先頭部分(= が表示されている部分)で e を押すと，どの entry を
編集するかを質問するようになっています．これを改造して，name 自体を編
集するようにしてみました．
(lsdb-read-entry): Removed.
(lsdb-mode-edit-entry): If the cursor is on the first line of a
database entry (the name line), it does not ask target entry and
prepares a buffer to edit the name of this record.
(lsdb-mode-edit-entry-after): New function.
(lsdb-mode-edit-name-after): New function.
;; 文字化けしている From: のメールから record が作成されるとずっとその
;; ままでは悲しくて，手作業で修正したくなる場合があるので，実装しまし
;; た．
第3は，~/.lsdb が保存されたときに，バッファが変更されていないことにす
る変更です．これで，モード行を見ると ~/.lsdb が保存されるべきかが分か
るようになります．
(lsdb-mode-save): Reset buffer modified flag when databse is saved
successfully.
以上，少しパッチが大きくなってしまいましたが，宜しく検討をお願いします．
-------------- next part --------------
--- lsdb.el 29 Sep 2002 21:55:19 -0000 1.1.1.2
+++ lsdb.el 1 Oct 2002 03:47:16 -0000 1.5
@@ -156,6 +156,13 @@
:group 'lsdb
:type 'hook)
+(defcustom lsdb-delete-record-functions
+ '(lsdb-delete-address-cache)
+ "List of functions called after a record is removed.
+The removed record is passed to each function as the argument."
+ :group 'lsdb
+ :type 'hook)
+
(defcustom lsdb-secondary-hash-tables
'(lsdb-address-cache)
"List of the hash tables for reverse lookup"
@@ -545,6 +552,11 @@
(while net
(lsdb-puthash (pop net) (car record) lsdb-address-cache))))
+(defun lsdb-delete-address-cache (record)
+ (let ((net (cdr (assq 'net record))))
+ (while net
+ (lsdb-remhash (pop net) lsdb-address-cache))))
+
;;;_ , #2 Iterate on the All Records (very slow)
(defun lsdb-lookup-full-name-by-fuzzy-matching (sender)
(let ((names
@@ -987,6 +999,12 @@
"Return the current record name."
(get-text-property (point) 'lsdb-record))
+(defun lsdb-delete-record (record)
+ "Delete given RECORD."
+ (lsdb-remhash (car record) lsdb-hash-table)
+ (run-hook-with-args 'lsdb-delete-record-functions record)
+ (setq lsdb-hash-tables-are-dirty t))
+
(defun lsdb-current-entry ()
"Return the current entry name in canonical form."
(save-excursion
@@ -994,20 +1012,6 @@
(if (looking-at "^\t\\([^\t][^:]+\\):")
(intern (downcase (match-string 1))))))
-(defun lsdb-read-entry (record &optional prompt)
- "Prompt to select an entry in the given RECORD."
- (let* ((completion-ignore-case t)
- (entry-name
- (completing-read
- (or prompt
- "Which entry: ")
- (mapcar (lambda (entry)
- (list (capitalize (symbol-name (car entry)))))
- (cdr record))
- nil t)))
- (unless (equal entry-name "")
- (intern (downcase entry-name)))))
-
(defun lsdb-delete-entry (record entry)
"Delete given ENTRY from RECORD."
(setcdr record (delq entry (cdr record)))
@@ -1068,60 +1072,97 @@
(point-max)))))))
(defun lsdb-mode-delete-entry ()
- "Delete the entry on the current line."
+ "Delete the entry on the current line.
+If the cursor is on the first line of a database entry (the name line)
+then the entire entry will be deleted."
(interactive)
(let ((record (lsdb-current-record))
entry-name entry)
(unless record
- (error "There is nothing to follow here"))
- (setq entry-name (or (lsdb-current-entry)
- (lsdb-read-entry record "Which entry to delete: "))
- entry (assq entry-name (cdr record)))
- (when (and entry
- (or (not (interactive-p))
- (not lsdb-verbose)
- (y-or-n-p
- (format "Do you really want to delete entry `%s' of `%s'?"
- entry-name (car record)))))
- (lsdb-delete-entry record entry)
- (lsdb-mode-delete-entry-1 entry))))
+ (error "%s" "There is nothing to follow here"))
+ (if (setq entry-name (lsdb-current-entry))
+ (when (and (setq entry (assq entry-name (cdr record)))
+ (or (not (interactive-p))
+ (not lsdb-verbose)
+ (y-or-n-p
+ (format "Do you really want to delete entry `%s' of `%s'? "
+ entry-name (car record)))))
+ (lsdb-delete-entry record entry)
+ (lsdb-mode-delete-entry-1 entry))
+ ;; Delete the current record.
+ (when (or (not (interactive-p))
+ (not lsdb-verbose)
+ (yes-or-no-p
+ (format "Do you really want to delete entire record of %s? "
+ (car record))))
+ (lsdb-delete-record record)
+ (save-restriction
+ (lsdb-narrow-to-record)
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (delete-region (point-min) (point-max))))))))
(defun lsdb-mode-edit-entry ()
"Edit the entry on the current line."
(interactive)
(let ((record (lsdb-current-record))
- entry-name entry marker)
+ entry-name)
(unless record
(error "There is nothing to follow here"))
- (setq entry-name (or (lsdb-current-entry)
- (lsdb-read-entry record "Which entry to edit: "))
- entry (assq entry-name (cdr record))
- marker (point-marker))
- (lsdb-edit-form
- (cdr entry) "Editing the entry."
- `(lambda (form)
- (unless (equal form ',(cdr entry))
- (save-excursion
- (set-buffer lsdb-buffer-name)
- (goto-char ,marker)
- (let ((record (lsdb-current-record))
- entry
- (inhibit-read-only t)
- buffer-read-only)
- (unless record
- (error "The entry currently in editing is discarded"))
- (setq entry (assq ',entry-name (cdr record)))
- (setcdr entry form)
- (run-hook-with-args 'lsdb-update-record-functions record)
- (setq lsdb-hash-tables-are-dirty t)
- (lsdb-mode-delete-entry-1 entry)
- (beginning-of-line)
- (add-text-properties
- (point)
- (progn
- (lsdb-insert-entry (cons ',entry-name form))
- (point))
- (list 'lsdb-record record)))))))))
+ (if (setq entry-name (lsdb-current-entry))
+ (lsdb-edit-form
+ (cdr (assq entry-name (cdr record))) "Editing the entry."
+ `(lambda (form)
+ (lsdb-mode-edit-entry-after ',record ',entry-name form)))
+ (lsdb-edit-form
+ (car record) "Editing the name."
+ `(lambda (form)
+ (lsdb-mode-edit-name-after ',record form))))))
+
+(defun lsdb-mode-edit-entry-after (record entry-name new)
+ (let ((entry (assq entry-name (cdr record))))
+ (unless (equal new (cdr entry))
+ (setcdr entry new)
+ (run-hook-with-args 'lsdb-update-record-functions record)
+ (setq lsdb-hash-tables-are-dirty t)
+ (with-current-buffer lsdb-buffer-name
+ (let ((inhibit-read-only t)
+ (buffer-read-only)
+ (pos (text-property-any (point-min) (point-max)
+ 'lsdb-record record)))
+ (unless pos
+ (error "%s" "The entry currently in editing is discarded"))
+ (lsdb-mode-delete-entry-1 entry)
+ (forward-line 0)
+ (add-text-properties
+ (point)
+ (progn
+ (lsdb-insert-entry (cons entry-name new))
+ (point))
+ (list 'lsdb-record record)))))))
+
+(defun lsdb-mode-edit-name-after (record new)
+ (let ((old (car record)))
+ (unless (equal new old)
+ (lsdb-delete-record record)
+ (setcar record new)
+ (lsdb-puthash (car record) (cdr record) lsdb-hash-table)
+ (run-hook-with-args 'lsdb-update-record-functions record)
+ (setq lsdb-hash-tables-are-dirty t)
+ (with-current-buffer lsdb-buffer-name
+ (let ((inhibit-read-only t)
+ (buffer-read-only)
+ (pos (text-property-any (point-min) (point-max)
+ 'lsdb-record record)))
+ (unless pos
+ (error "%s" "The entry currently in editing is discarded"))
+ (delete-region (point) (+ (point) (length old)))
+ (add-text-properties
+ (point)
+ (progn
+ (insert new)
+ (point))
+ (list 'lsdb-record record)))))))
(defun lsdb-mode-save (&optional dont-ask)
"Save LSDB hash table into `lsdb-file'."
@@ -1134,6 +1175,7 @@
(y-or-n-p "Save the LSDB now? "))
(lsdb-save-hash-tables)
(setq lsdb-hash-tables-are-dirty nil)
+ (set-buffer-modified-p nil)
(message "The LSDB was saved successfully."))))
(defun lsdb-mode-load ()
-------------- next part --------------
--
土屋 雅稔 ( TSUCHIYA Masatoshi )